git.iko.soy/servant
on master help sign in
add some basic tests for the cleanup machinery in Delayed
commit92786feeada3a81074f4e8bd62c93436633d392f authorAlp Mestanogullari <alpmestan@gmail.com> dateThu 12 Jan 2017, 02:58 (10 years ago) parent5d1f03b
3 files changed+55−4
compare with master
unifiedsplit
servant-server/servant-server.cabal+1 servant-server/src/Servant/Server/Internal/RoutingApplication.hs+3−4 servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hs+51
servant-server/servant-server.cabal+1
@@ -109,6 +109,7 @@ test-suite spec
109109 Servant.ArbitraryMonadServerSpec
110110 Servant.Server.ErrorSpec
111111 Servant.Server.Internal.ContextSpec
112+ Servant.Server.Internal.RoutingApplicationSpec
112113 Servant.Server.RouterSpec
113114 Servant.Server.StreamingSpec
114115 Servant.Server.UsingContextSpec
servant-server/src/Servant/Server/Internal/RoutingApplication.hs+3−4
@@ -9,7 +9,7 @@
99{-# LANGUAGE TupleSections #-}
1010module Servant.Server.Internal.RoutingApplication where
1111
12−import Control.Exception (bracket)
12+import Control.Exception (finally)
1313import Control.Monad (ap, liftM, (>=>))
1414import Control.Monad.Trans (MonadIO(..))
1515import Control.Monad.Trans.Except (runExceptT)
@@ -290,9 +290,8 @@ runAction :: Delayed env (Handler a)
290290 -> IO r
291291runAction action env req respond k = do
292292 cleanupRef <- newCleanupRef
293− bracket (runDelayed action env req cleanupRef)
294− (const $ runCleanup cleanupRef)
295− (go >=> respond)
293+ (runDelayed action env req cleanupRef >>= go >>= respond)
294+ `finally` runCleanup cleanupRef
296295
297296 where
298297 go (Fail e) = return $ Fail e
servant-server/test/Servant/Server/Internal/RoutingApplicationSpec.hsnew file+51
@@ -0,0 +1,51 @@
1+module Servant.Server.Internal.RoutingApplicationSpec (spec) where
2+
3+import Control.Exception hiding (Handler)
4+import Control.Monad.IO.Class
5+import Servant.Server
6+import Servant.Server.Internal.RoutingApplication
7+import System.Directory
8+import Test.Hspec
9+
10+ok :: IO (RouteResult ())
11+ok = return (Route ())
12+
13+delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ())
14+delayed body srv = Delayed
15+ { capturesD = \() -> DelayedIO $ \_req _cl -> ok
16+ , methodD = DelayedIO $ \_req_ _cl -> ok
17+ , authD = DelayedIO $ \_req _cl -> ok
18+ , bodyD = do
19+ liftIO (writeFile "delayed.test" "hia")
20+ addCleanup (removeFile "delayed.test" >> putStrLn "file removed")
21+ body
22+ , serverD = \() () _body _req -> srv
23+ }
24+
25+simpleRun :: Delayed () (Handler ())
26+ -> IO ()
27+simpleRun d = fmap (either ignoreE id) . try $
28+ runAction d () undefined (\_ -> return ()) (\_ -> FailFatal err500)
29+
30+ where ignoreE :: SomeException -> ()
31+ ignoreE = const ()
32+
33+spec :: Spec
34+spec = do
35+ describe "Delayed" $ do
36+ it "actually runs clean up actions" $ do
37+ _ <- simpleRun $ delayed (return ()) (Route $ return ())
38+ fileStillThere <- doesFileExist "delayed.test"
39+ fileStillThere `shouldBe` False
40+ it "even with exceptions in serverD" $ do
41+ _ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero)
42+ fileStillThere <- doesFileExist "delayed.test"
43+ fileStillThere `shouldBe` False
44+ it "even with routing failure in bodyD" $ do
45+ _ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ())
46+ fileStillThere <- doesFileExist "delayed.test"
47+ fileStillThere `shouldBe` False
48+ it "even with exceptions in bodyD" $ do
49+ _ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
50+ fileStillThere <- doesFileExist "delayed.test"
51+ fileStillThere `shouldBe` False