git.iko.soy/servant
on master help sign in
Test case for tweakResponse.
dd1d308Matthias Fischmann
servant-server/test/Servant/ServerSpec.hs+32−4
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
@@ -8,7 +9,9 @@
8
9
9module Servant.ServerSpec where
10module Servant.ServerSpec where
10
11
11−
12+#if !MIN_VERSION_base(4,8,0)
13+import Control.Applicative ((<$>))
14+#endif
12import Control.Monad (forM_, when)
15import Control.Monad (forM_, when)
13import Control.Monad.Trans.Except (ExceptT, throwE)
16import Control.Monad.Trans.Except (ExceptT, throwE)
14import Data.Aeson (FromJSON, ToJSON, decode', encode)
17import Data.Aeson (FromJSON, ToJSON, decode', encode)
@@ -23,10 +26,12 @@ import GHC.Generics (Generic)
23import Network.HTTP.Types (hAccept, hContentType,
26import Network.HTTP.Types (hAccept, hContentType,
24 methodDelete, methodGet, methodHead,
27 methodDelete, methodGet, methodHead,
25 methodPatch, methodPost, methodPut,
28 methodPatch, methodPost, methodPut,
26− ok200, parseQuery, status409)
29+ ok200, parseQuery, status409,
30+ Status(..))
27import Network.Wai (Application, Request, pathInfo,
31import Network.Wai (Application, Request, pathInfo,
28 queryString, rawQueryString,
32 queryString, rawQueryString,
29− responseLBS)
33+ responseLBS, responseBuilder)
34+import Network.Wai.Internal (Response(ResponseBuilder))
30import Network.Wai.Test (defaultRequest, request,
35import Network.Wai.Test (defaultRequest, request,
31 runSession, simpleBody)
36 runSession, simpleBody)
32import Test.Hspec (Spec, describe, it, shouldBe)
37import Test.Hspec (Spec, describe, it, shouldBe)
@@ -41,8 +46,12 @@ import Servant.API ((:<|>) (..), (:>),
41 Post, Put, RemoteHost, QueryFlag, QueryParam,
46 Post, Put, RemoteHost, QueryFlag, QueryParam,
42 QueryParams, Raw, ReqBody)
47 QueryParams, Raw, ReqBody)
43import Servant.Server (Server, serve, ServantErr(..), err404)
48import Servant.Server (Server, serve, ServantErr(..), err404)
49+import Servant.Server.Internal.Router
50+ (tweakResponse, runRouter,
51+ Router, Router'(LeafRouter))
44import Servant.Server.Internal.RoutingApplication
52import Servant.Server.Internal.RoutingApplication
45− (RouteMismatch (..))
53+ (RouteResult(..), RouteMismatch(..),
54+ toApplication)
46
55
47
56
48-- * test data types
57-- * test data types
@@ -92,6 +101,7 @@ spec = do
92 unionSpec
101 unionSpec
93 prioErrorsSpec
102 prioErrorsSpec
94 errorsSpec
103 errorsSpec
104+ routerSpec
95 responseHeadersSpec
105 responseHeadersSpec
96 miscReqCombinatorsSpec
106 miscReqCombinatorsSpec
97
107
@@ -697,6 +707,24 @@ errorsSpec = do
697 nf <> ib `shouldBe` ib
707 nf <> ib `shouldBe` ib
698 nf <> wm `shouldBe` wm
708 nf <> wm `shouldBe` wm
699
709
710+routerSpec :: Spec
711+routerSpec = do
712+ describe "Servant.Server.Internal.Router" $ do
713+ let app' :: Application
714+ app' = toApplication $ runRouter router'
715+
716+ router', router :: Router
717+ router' = tweakResponse (twk <$>) router
718+ router = LeafRouter $ \_ cont -> cont (RR . Right $ responseBuilder (Status 201 "") [] "")
719+
720+ twk :: Response -> Response
721+ twk (ResponseBuilder (Status i s) hs b) = ResponseBuilder (Status (i + 1) s) hs b
722+ twk b = b
723+
724+ describe "tweakResponse" . with (return app') $ do
725+ it "calls f on route result" $ do
726+ get "" `shouldRespondWith` 202
727+
700type MiscCombinatorsAPI
728type MiscCombinatorsAPI
701 = "version" :> HttpVersion :> Get '[JSON] String
729 = "version" :> HttpVersion :> Get '[JSON] String
702 :<|> "secure" :> IsSecure :> Get '[JSON] String
730 :<|> "secure" :> IsSecure :> Get '[JSON] String