{-# 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") }