2016-01-18 12:29:33 +01:00
|
|
|
{-# LANGUAGE DataKinds #-}
|
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE TypeOperators #-}
|
2016-01-16 19:17:46 +01:00
|
|
|
|
|
|
|
module Servant.MockSpec where
|
|
|
|
|
2016-01-18 12:29:33 +01:00
|
|
|
import Data.Aeson as Aeson
|
2016-01-18 13:22:58 +01:00
|
|
|
import Data.ByteString.Conversion.To
|
2016-01-18 12:29:33 +01:00
|
|
|
import Data.Proxy
|
2016-01-18 13:22:58 +01:00
|
|
|
import Data.String
|
2016-01-18 12:29:33 +01:00
|
|
|
import GHC.Generics
|
2016-01-18 13:22:58 +01:00
|
|
|
import Network.Wai
|
2016-01-18 12:29:33 +01:00
|
|
|
import Servant.API
|
|
|
|
import Test.Hspec hiding (pending)
|
|
|
|
import Test.Hspec.Wai
|
|
|
|
import Test.QuickCheck
|
2016-01-16 19:17:46 +01:00
|
|
|
|
2016-01-18 12:29:33 +01:00
|
|
|
import Servant
|
2016-01-16 19:17:46 +01:00
|
|
|
import Servant.API.Internal.Test.ComprehensiveAPI
|
|
|
|
import Servant.Mock
|
|
|
|
|
2016-01-18 19:55:14 +01:00
|
|
|
-- This declaration simply checks that all instances are in place.
|
2016-01-16 19:17:46 +01:00
|
|
|
_ = mock comprehensiveAPI
|
|
|
|
|
2016-01-18 12:29:33 +01:00
|
|
|
data Body
|
|
|
|
= Body
|
|
|
|
| ArbitraryBody
|
2016-01-18 13:22:58 +01:00
|
|
|
deriving (Generic)
|
|
|
|
|
|
|
|
instance ToJSON Body
|
2016-01-18 12:29:33 +01:00
|
|
|
|
|
|
|
instance Arbitrary Body where
|
|
|
|
arbitrary = return ArbitraryBody
|
|
|
|
|
2016-01-18 13:22:58 +01:00
|
|
|
data TestHeader
|
|
|
|
= TestHeader
|
|
|
|
| ArbitraryHeader
|
|
|
|
deriving (Show)
|
|
|
|
|
|
|
|
instance ToByteString TestHeader where
|
|
|
|
builder = fromString . show
|
|
|
|
|
|
|
|
instance Arbitrary TestHeader where
|
|
|
|
arbitrary = return ArbitraryHeader
|
|
|
|
|
2016-01-16 19:17:46 +01:00
|
|
|
spec :: Spec
|
2016-01-18 12:29:33 +01:00
|
|
|
spec = do
|
|
|
|
describe "mock" $ do
|
|
|
|
context "Get" $ do
|
|
|
|
let api :: Proxy (Get '[JSON] Body)
|
|
|
|
api = Proxy
|
|
|
|
app = serve api (mock api)
|
|
|
|
with (return app) $ do
|
|
|
|
it "serves arbitrary response bodies" $ do
|
|
|
|
get "/" `shouldRespondWith` 200{
|
|
|
|
matchBody = Just $ Aeson.encode ArbitraryBody
|
|
|
|
}
|
2016-01-18 13:22:58 +01:00
|
|
|
|
|
|
|
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)
|
|
|
|
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")
|
|
|
|
}
|