on master help sign in
make cleanup in Delayed more resistant to exceptions
commit7fb11dae3c0eeb88bde0f1c7ebd068b7d999307a authorAlp Mestanogullari <alpmestan@gmail.com> dateFri 21 Oct 2016, 19:24 (10 years ago) parent6ab0296
2 files changed+14−10
servant-server/src/Servant/Server/Internal.hs+8−5 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+6−5
servant-server/src/Servant/Server/Internal.hs+8−5
@@ -23,6 +23,7 @@ module Servant.Server.Internal
2323 , module Servant.Server.Internal.ServantErr
2424 ) where
2525
26+import Control.Exception (finally)
2627import Control.Monad.Trans (liftIO)
2728import qualified Data.ByteString as B
2829import qualified Data.ByteString.Char8 as BC8
@@ -400,11 +401,13 @@ instance HasServer Raw context where
400401 type ServerT Raw m = Application
401402
402403 route Proxy _ rawApplication = RawRouter $ \ env request respond -> do
403− (r, _) <- runDelayed rawApplication env request
404− case r of
405− Route app -> app request (respond . Route)
406− Fail a -> respond $ Fail a
407− FailFatal e -> respond $ FailFatal e
404+ (r, cleanup) <- runDelayed rawApplication env request
405+ go r request respond `finally` cleanup
406+
407+ where go r request respond = case r of
408+ Route app -> app request (respond . Route)
409+ Fail a -> respond $ Fail a
410+ FailFatal e -> respond $ FailFatal e
408411
409412-- | If you use 'ReqBody' in one of the endpoints for your API,
410413-- 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 @@
99{-# LANGUAGE TupleSections #-}
1010module Servant.Server.Internal.RoutingApplication where
1111
12+import Control.Exception (bracket)
1213import Control.Monad (ap, liftM)
1314import Control.Monad.Trans (MonadIO(..))
1415import Control.Monad.Trans.Except (runExceptT)
@@ -272,11 +273,11 @@ runAction :: Delayed env (Handler a)
272273 -> (RouteResult Response -> IO r)
273274 -> (a -> RouteResult Response)
274275 -> IO r
275−runAction action env req respond k = do
276− (routeResult, cleanup) <- runDelayed action env req
277− resp <- go routeResult
278− cleanup
279− respond resp
276+runAction action env req respond k =
277+ bracket (runDelayed action env req)
278+ snd
279+ (\(res, _) -> go res >>= respond)
280+
280281 where
281282 go (Fail e) = return $ Fail e
282283 go (FailFatal e) = return $ FailFatal e