git.iko.soy/servant
on master help sign in
make cleanup in Delayed more resistant to exceptions
7fb11daAlp Mestanogullari
servant-server/src/Servant/Server/Internal.hs+8−5
compare with master
unifiedsplit
@@ -23,6 +23,7 @@ module Servant.Server.Internal
23 , module Servant.Server.Internal.ServantErr
23 , module Servant.Server.Internal.ServantErr
24 ) where
24 ) where
25
25
26+import Control.Exception (finally)
26import Control.Monad.Trans (liftIO)
27import Control.Monad.Trans (liftIO)
27import qualified Data.ByteString as B
28import qualified Data.ByteString as B
28import qualified Data.ByteString.Char8 as BC8
29import qualified Data.ByteString.Char8 as BC8
@@ -400,11 +401,13 @@ instance HasServer Raw context where
400 type ServerT Raw m = Application
401 type ServerT Raw m = Application
401
402
402 route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
403 route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
403− (r, _) <- runDelayed rawApplication env request
404+ (r, cleanup) <- runDelayed rawApplication env request
404− case r of
405+ go r request respond `finally` cleanup
406+
407+ where go r request respond = case r of
405− Route app -> app request (respond . Route)
408+ Route app -> app request (respond . Route)
406− Fail a -> respond $ Fail a
409+ Fail a -> respond $ Fail a
407− FailFatal e -> respond $ FailFatal e
410+ FailFatal e -> respond $ FailFatal e
408
411
409-- | If you use 'ReqBody' in one of the endpoints for your API,
412-- | If you use 'ReqBody' in one of the endpoints for your API,
410-- this automatically requires your server-side handler to be a function
413-- this automatically requires your server-side handler to be a function
servant-server/src/Servant/Server/Internal/RoutingApplication.hs+6−5
@@ -9,6 +9,7 @@
9{-# LANGUAGE TupleSections #-}
9{-# LANGUAGE TupleSections #-}
10module Servant.Server.Internal.RoutingApplication where
10module Servant.Server.Internal.RoutingApplication where
11
11
12+import Control.Exception (bracket)
12import Control.Monad (ap, liftM)
13import Control.Monad (ap, liftM)
13import Control.Monad.Trans (MonadIO(..))
14import Control.Monad.Trans (MonadIO(..))
14import Control.Monad.Trans.Except (runExceptT)
15import Control.Monad.Trans.Except (runExceptT)
@@ -272,11 +273,11 @@ runAction :: Delayed env (Handler a)
272 -> (RouteResult Response -> IO r)
273 -> (RouteResult Response -> IO r)
273 -> (a -> RouteResult Response)
274 -> (a -> RouteResult Response)
274 -> IO r
275 -> IO r
275−runAction action env req respond k = do
276+runAction action env req respond k =
276− (routeResult, cleanup) <- runDelayed action env req
277+ bracket (runDelayed action env req)
277− resp <- go routeResult
278+ snd
278− cleanup
279+ (\(res, _) -> go res >>= respond)
279− respond resp
280+
280 where
281 where
281 go (Fail e) = return $ Fail e
282 go (Fail e) = return $ Fail e
282 go (FailFatal e) = return $ FailFatal e
283 go (FailFatal e) = return $ FailFatal e