servant/servant-mock/test/Servant/MockSpec.hs

86 lines
2.6 KiB
Haskell
Raw Normal View History

{-# LANGUAGE ConstraintKinds #-}
2016-01-18 12:29:33 +01:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
2016-01-18 12:29:33 +01:00
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
module Servant.MockSpec where
2016-01-18 12:29:33 +01:00
import Data.Aeson as Aeson
import Data.ByteString.Conversion.To
2016-01-18 12:29:33 +01:00
import Data.Proxy
import Data.String
2016-01-18 12:29:33 +01:00
import GHC.Generics
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-18 12:29:33 +01:00
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 '[NamedConfig "foo" '[]])
2016-01-18 12:29:33 +01:00
data Body
= Body
| ArbitraryBody
deriving (Generic)
instance ToJSON Body
2016-01-18 12:29:33 +01:00
instance Arbitrary Body where
arbitrary = return ArbitraryBody
data TestHeader
= TestHeader
| ArbitraryHeader
deriving (Show)
instance ToByteString TestHeader where
builder = fromString . show
instance Arbitrary TestHeader where
arbitrary = return ArbitraryHeader
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 EmptyConfig (mock api Proxy)
2016-01-18 12:29:33 +01:00
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 EmptyConfig (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")
}