Expose ResourceT, fix the test

Author: phadej

servant-server/src/Servant/Server/Internal.hs

@@ -24,6 +24,7 @@ module Servant.Server.Internal
   ) where
 
 import           Control.Monad.Trans        (liftIO)
+import           Control.Monad.Trans.Resource (runResourceT)
 import qualified Data.ByteString            as B
 import qualified Data.ByteString.Char8      as BC8
 import qualified Data.ByteString.Lazy       as BL
@@ -399,12 +400,12 @@ instance HasServer Raw context where
 
   type ServerT Raw m = Application
 
-  route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
+  route Proxy _ rawApplication = RawRouter $ \ env request respond -> runResourceT $ do
     -- note: a Raw application doesn't register any cleanup
     -- but for the sake of consistency, we nonetheless run
     -- the cleanup once its done
     r <- runDelayed rawApplication env request
-    go r request respond
+    liftIO $ go r request respond
 
     where go r request respond = case r of
             Route app   -> app request (respond . Route)

servant-server/src/Servant/Server/Internal/RoutingApplication.hs

@@ -21,7 +21,7 @@ import           Control.Monad.Reader               (MonadReader (..), ReaderT,
 import           Control.Monad.Trans                (MonadIO (..), MonadTrans (..))
 import           Control.Monad.Trans.Control        (ComposeSt, MonadBaseControl (..), MonadTransControl (..),
                                                      defaultLiftBaseWith, defaultRestoreM)
-import           Control.Monad.Trans.Resource       (MonadResource (..), ResourceT, runResourceT)
+import           Control.Monad.Trans.Resource       (MonadResource (..), ResourceT, runResourceT, transResourceT)
 import           Network.Wai                        (Application, Request, Response, ResponseReceived)
 import           Prelude                            ()
 import           Prelude.Compat
@@ -197,8 +197,8 @@ instance MonadBaseControl IO DelayedIO where
     liftBaseWith f = DelayedIO $ liftBaseWith $ \g -> f (g . runDelayedIO')
     restoreM       = DelayedIO . restoreM
 
-runDelayedIO :: DelayedIO a -> Request -> IO (RouteResult a)
-runDelayedIO m req = runRouteResultT $ runResourceT $ runReaderT (runDelayedIO' m) req
+runDelayedIO :: DelayedIO a -> Request -> ResourceT IO (RouteResult a)
+runDelayedIO m req = transResourceT runRouteResultT $ runReaderT (runDelayedIO' m) req
 
 -- | A 'Delayed' without any stored checks.
 emptyDelayed :: RouteResult a -> Delayed env a
@@ -303,7 +303,7 @@ passToServer Delayed{..} x =
 runDelayed :: Delayed env a
            -> env
            -> Request
-           -> IO (RouteResult a)
+           -> ResourceT IO (RouteResult a)
 runDelayed Delayed{..} env req  =
   runDelayedIO
     (do c <- capturesD env
@@ -325,12 +325,12 @@ runAction :: Delayed env (Handler a)
           -> (RouteResult Response -> IO r)
           -> (a -> RouteResult Response)
           -> IO r
-runAction action env req respond k = do
-    runDelayed action env req >>= go >>= respond
+runAction action env req respond k = runResourceT $ do
+    runDelayed action env req >>= go >>= liftIO . respond
   where
     go (Fail e)      = return $ Fail e
     go (FailFatal e) = return $ FailFatal e
-    go (Route a)     = do
+    go (Route a)     = liftIO $ do
       e <- runHandler a
       case e of
         Left err -> return . Route $ responseServantErr err