API.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

module API where

import Servant

type API = "ping" :> Get '[JSON] Bool

api :: Proxy API
api = Proxy

app :: Application
app = serve api server

server :: Server API
server = ping

--ping :: Handler Bool
ping :: Server API
ping = pure True

APITest.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module APITest where

import           Network.HTTP.Client
import           Network.Wai
import qualified Network.Wai.Handler.Warp as Warp
--import           Servant.Client.Core (BaseUrl(..))
import           Servant.Client -- (BaseUrl(..), runClientM)

import           Test.Hspec

import API (app, api, ping)

withGrendelApp :: (Warp.Port -> IO ()) -> IO ()
withGrendelApp = Warp.testWithApplication (pure app)

spec_businessLogic :: Spec
spec_businessLogic = do
  around withGrendelApp $ do
    let pingClient = client api
    baseUrl <- runIO (parseBaseUrl "http://localhost")
    manager <- runIO (newManager defaultManagerSettings)
    let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })

    describe "GET /ping" $ do
      it "should reply with True" $ \port -> do
        result <- runClientM ping (clientEnv port)
        result `shouldBe` Right True

    • Couldn't match type ‘Servant.Server.Internal.Handler.Handler
                             Bool’
                     with ‘ClientM Bool’
      Expected type: ClientM Bool
        Actual type: Servant.Server.Internal.Server Grendel.API.API
    • In the first argument of ‘runClientM’, namely ‘ping’
      In a stmt of a 'do' block:
        result <- runClientM ping (clientEnv port)
      In the expression:
        do result <- runClientM ping (clientEnv port)
           result `shouldBe` Right True
   |        
32 |         result <- runClientM ping (clientEnv port)
   |                              ^^^^