Test case for tweakResponse.

This commit is contained in:
Matthias Fischmann 2015-10-12 19:23:13 +02:00
parent f953d05212
commit dd1d30843b

View file

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
@ -8,7 +9,9 @@
module Servant.ServerSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (forM_, when)
import Control.Monad.Trans.Except (ExceptT, throwE)
import Data.Aeson (FromJSON, ToJSON, decode', encode)
@ -23,10 +26,12 @@ import GHC.Generics (Generic)
import Network.HTTP.Types (hAccept, hContentType,
methodDelete, methodGet, methodHead,
methodPatch, methodPost, methodPut,
ok200, parseQuery, status409)
ok200, parseQuery, status409,
Status(..))
import Network.Wai (Application, Request, pathInfo,
queryString, rawQueryString,
responseLBS)
responseLBS, responseBuilder)
import Network.Wai.Internal (Response(ResponseBuilder))
import Network.Wai.Test (defaultRequest, request,
runSession, simpleBody)
import Test.Hspec (Spec, describe, it, shouldBe)
@ -41,8 +46,12 @@ import Servant.API ((:<|>) (..), (:>),
Post, Put, RemoteHost, QueryFlag, QueryParam,
QueryParams, Raw, ReqBody)
import Servant.Server (Server, serve, ServantErr(..), err404)
import Servant.Server.Internal.Router
(tweakResponse, runRouter,
Router, Router'(LeafRouter))
import Servant.Server.Internal.RoutingApplication
(RouteMismatch (..))
(RouteResult(..), RouteMismatch(..),
toApplication)
-- * test data types
@ -92,6 +101,7 @@ spec = do
unionSpec
prioErrorsSpec
errorsSpec
routerSpec
responseHeadersSpec
miscReqCombinatorsSpec
@ -697,6 +707,24 @@ errorsSpec = do
nf <> ib `shouldBe` ib
nf <> wm `shouldBe` wm
routerSpec :: Spec
routerSpec = do
describe "Servant.Server.Internal.Router" $ do
let app' :: Application
app' = toApplication $ runRouter router'
router', router :: Router
router' = tweakResponse (twk <$>) router
router = LeafRouter $ \_ cont -> cont (RR . Right $ responseBuilder (Status 201 "") [] "")
twk :: Response -> Response
twk (ResponseBuilder (Status i s) hs b) = ResponseBuilder (Status (i + 1) s) hs b
twk b = b
describe "tweakResponse" . with (return app') $ do
it "calls f on route result" $ do
get "" `shouldRespondWith` 202
type MiscCombinatorsAPI
= "version" :> HttpVersion :> Get '[JSON] String
:<|> "secure" :> IsSecure :> Get '[JSON] String