86 lines
2.6 KiB
Haskell
86 lines
2.6 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 = toUrlPiece . show
|
|
toQueryParam = toQueryParam . show
|
|
|
|
|
|
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")
|
|
}
|