60 lines
2.1 KiB
Haskell
60 lines
2.1 KiB
Haskell
module Servant.Server.Internal.RoutingApplicationSpec (spec) where
|
|
|
|
import Prelude ()
|
|
import Prelude.Compat
|
|
|
|
import Control.Exception hiding (Handler)
|
|
import Control.Monad.Trans.Resource (register)
|
|
import Control.Monad.IO.Class
|
|
import Data.Maybe (isJust)
|
|
import Data.IORef
|
|
import Servant.Server
|
|
import Servant.Server.Internal.RoutingApplication
|
|
import Test.Hspec
|
|
|
|
import System.IO.Unsafe (unsafePerformIO)
|
|
|
|
-- Let's not write to the filesystem
|
|
delayedTestRef :: IORef (Maybe String)
|
|
delayedTestRef = unsafePerformIO $ newIORef Nothing
|
|
|
|
delayed :: DelayedIO () -> RouteResult (Handler ()) -> Delayed () (Handler ())
|
|
delayed body srv = Delayed
|
|
{ capturesD = \_ -> return ()
|
|
, methodD = return ()
|
|
, authD = return ()
|
|
, bodyD = do
|
|
liftIO (writeIORef delayedTestRef (Just "hia") >> putStrLn "garbage created")
|
|
_ <- register (writeIORef delayedTestRef Nothing >> putStrLn "garbage collected")
|
|
body
|
|
, serverD = \() () _body _req -> srv
|
|
}
|
|
|
|
simpleRun :: Delayed () (Handler ())
|
|
-> IO ()
|
|
simpleRun d = fmap (either ignoreE id) . try $
|
|
runAction d () undefined (\_ -> return ()) (\_ -> FailFatal err500)
|
|
|
|
where ignoreE :: SomeException -> ()
|
|
ignoreE = const ()
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
describe "Delayed" $ do
|
|
it "actually runs clean up actions" $ do
|
|
_ <- simpleRun $ delayed (return ()) (Route $ return ())
|
|
cleanUpDone <- isJust <$> readIORef delayedTestRef
|
|
cleanUpDone `shouldBe` False
|
|
it "even with exceptions in serverD" $ do
|
|
_ <- simpleRun $ delayed (return ()) (Route $ throw DivideByZero)
|
|
cleanUpDone <- isJust <$> readIORef delayedTestRef
|
|
cleanUpDone `shouldBe` False
|
|
it "even with routing failure in bodyD" $ do
|
|
_ <- simpleRun $ delayed (delayedFailFatal err500) (Route $ return ())
|
|
cleanUpDone <- isJust <$> readIORef delayedTestRef
|
|
cleanUpDone `shouldBe` False
|
|
it "even with exceptions in bodyD" $ do
|
|
_ <- simpleRun $ delayed (liftIO $ throwIO DivideByZero) (Route $ return ())
|
|
cleanUpDone <- isJust <$> readIORef delayedTestRef
|
|
cleanUpDone `shouldBe` False
|