servant/servant-mock/test/Servant/MockSpec.hs
Alex Mason a1b23018f9 Replace use of ToByteString with HttpApiData for GetHeaders, fixes servant/#581
* Version bump because this changes the API for GetHeaders
2016-09-02 19:47:32 +10:00

86 lines
2.7 KiB
Haskell

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Servant.MockSpec where
import Data.Aeson as Aeson
import Data.Proxy
import GHC.Generics
import Network.Wai
import Servant.API
import Test.Hspec hiding (pending)
import Test.Hspec.Wai
import Test.QuickCheck
import Servant
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Mock
-- This declaration simply checks that all instances are in place.
_ = mock comprehensiveAPI (Proxy :: Proxy '[NamedContext "foo" '[]])
data Body
= Body
| ArbitraryBody
deriving (Generic)
instance ToJSON Body
instance Arbitrary Body where
arbitrary = return ArbitraryBody
data TestHeader
= TestHeader
| ArbitraryHeader
deriving (Show)
instance ToHttpApiData TestHeader where
toHeader = toHeader . show
toUrlPiece _ = error "ToHttpApiData.toUrlPiece not implemented for TestHeader"
toQueryParam _ = error "ToHttpApiData.toQueryParam not implemented for TestHeader"
instance Arbitrary TestHeader where
arbitrary = return ArbitraryHeader
spec :: Spec
spec = do
describe "mock" $ do
context "Get" $ do
let api :: Proxy (Get '[JSON] Body)
api = Proxy
app = serve api (mock api Proxy)
with (return app) $ do
it "serves arbitrary response bodies" $ do
get "/" `shouldRespondWith` 200{
matchBody = Just $ Aeson.encode ArbitraryBody
}
context "response headers" $ do
let withHeader :: Proxy (Get '[JSON] (Headers '[Header "foo" TestHeader] Body))
withHeader = Proxy
withoutHeader :: Proxy (Get '[JSON] (Headers '[] Body))
withoutHeader = Proxy
toApp :: (HasMock api '[]) => Proxy api -> IO Application
toApp api = return $ serve api (mock api (Proxy :: Proxy '[]))
with (toApp withHeader) $ do
it "serves arbitrary response bodies" $ do
get "/" `shouldRespondWith` 200{
matchHeaders = return $ MatchHeader $ \ h ->
if h == [("Content-Type", "application/json"), ("foo", "ArbitraryHeader")]
then Nothing
else Just ("headers not correct\n")
}
with (toApp withoutHeader) $ do
it "works for no additional headers" $ do
get "/" `shouldRespondWith` 200{
matchHeaders = return $ MatchHeader $ \ h ->
if h == [("Content-Type", "application/json")]
then Nothing
else Just ("headers not correct\n")
}