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

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