{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Syd.Servant
  ( servantSpec,
    servantSpecWithSetupFunc,
    clientEnvSetupFunc,
    testClient,
    testClientOrError,
  )
where

import Network.HTTP.Client as HTTP
import Servant
import Servant.Client
import Test.Syd
import Test.Syd.Wai

type ServantSpec = TestDef '[HTTP.Manager] ClientEnv

-- | Run a given servant server around every test
servantSpec :: forall api. HasServer api '[] => Servant.Proxy api -> ServerT api Handler -> ServantSpec -> Spec
servantSpec :: Proxy api -> ServerT api Handler -> ServantSpec -> Spec
servantSpec Proxy api
py ServerT api Handler
server = Proxy api -> SetupFunc (ServerT api Handler) -> ServantSpec -> Spec
forall api.
HasServer api '[] =>
Proxy api -> SetupFunc (ServerT api Handler) -> ServantSpec -> Spec
servantSpecWithSetupFunc Proxy api
py (ServerT api Handler -> SetupFunc (ServerT api Handler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerT api Handler
server)

-- | Run a servant server around every test, based around the given 'SetupFunc'
servantSpecWithSetupFunc :: forall api. HasServer api '[] => Servant.Proxy api -> SetupFunc (ServerT api Handler) -> ServantSpec -> Spec
servantSpecWithSetupFunc :: Proxy api -> SetupFunc (ServerT api Handler) -> ServantSpec -> Spec
servantSpecWithSetupFunc Proxy api
py SetupFunc (ServerT api Handler)
setupFunc = Proxy api
-> (() -> SetupFunc (ServerT api Handler)) -> ServantSpec -> Spec
forall api inner.
HasServer api '[] =>
Proxy api
-> (inner -> SetupFunc (ServerT api Handler))
-> ServantSpec
-> SpecWith inner
servantSpecWithSetupFunc' Proxy api
py ((() -> SetupFunc (ServerT api Handler)) -> ServantSpec -> Spec)
-> (() -> SetupFunc (ServerT api Handler)) -> ServantSpec -> Spec
forall a b. (a -> b) -> a -> b
$ \() -> SetupFunc (ServerT api Handler)
setupFunc

servantSpecWithSetupFunc' :: forall api inner. HasServer api '[] => Servant.Proxy api -> (inner -> SetupFunc (ServerT api Handler)) -> ServantSpec -> SpecWith inner
servantSpecWithSetupFunc' :: Proxy api
-> (inner -> SetupFunc (ServerT api Handler))
-> ServantSpec
-> SpecWith inner
servantSpecWithSetupFunc' Proxy api
py inner -> SetupFunc (ServerT api Handler)
serverSetupFunc = TestDefM '[Manager] inner () -> SpecWith inner
forall (outers :: [*]) inner result.
TestDefM (Manager : outers) inner result
-> TestDefM outers inner result
managerSpec (TestDefM '[Manager] inner () -> SpecWith inner)
-> (ServantSpec -> TestDefM '[Manager] inner ())
-> ServantSpec
-> SpecWith inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manager -> inner -> SetupFunc ClientEnv)
-> ServantSpec -> TestDefM '[Manager] inner ()
forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' (\Manager
man inner
inner -> inner -> SetupFunc (ServerT api Handler)
serverSetupFunc inner
inner SetupFunc (ServerT api Handler)
-> (ServerT api Handler -> SetupFunc ClientEnv)
-> SetupFunc ClientEnv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy api -> Manager -> ServerT api Handler -> SetupFunc ClientEnv
forall api.
HasServer api '[] =>
Proxy api -> Manager -> ServerT api Handler -> SetupFunc ClientEnv
clientEnvSetupFunc Proxy api
py Manager
man)

clientEnvSetupFunc :: forall api. HasServer api '[] => Servant.Proxy api -> HTTP.Manager -> ServerT api Handler -> SetupFunc ClientEnv
clientEnvSetupFunc :: Proxy api -> Manager -> ServerT api Handler -> SetupFunc ClientEnv
clientEnvSetupFunc Proxy api
py Manager
man ServerT api Handler
server = do
  let application :: Application
application = Proxy api -> ServerT api Handler -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve Proxy api
py ServerT api Handler
server
  PortNumber
p <- Application -> SetupFunc PortNumber
applicationSetupFunc Application
application
  ClientEnv -> SetupFunc ClientEnv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientEnv -> SetupFunc ClientEnv)
-> ClientEnv -> SetupFunc ClientEnv
forall a b. (a -> b) -> a -> b
$
    Manager -> BaseUrl -> ClientEnv
mkClientEnv
      Manager
man
      ( Scheme -> String -> Int -> String -> BaseUrl
BaseUrl
          Scheme
Http
          String
"127.0.0.1"
          (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral PortNumber
p) -- Safe because it is PortNumber -> Int
          String
""
      )

testClient :: ClientEnv -> ClientM a -> IO a
testClient :: ClientEnv -> ClientM a -> IO a
testClient ClientEnv
cenv ClientM a
func = do
  Either ClientError a
errOrRes <- ClientEnv -> ClientM a -> IO (Either ClientError a)
forall a. ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError ClientEnv
cenv ClientM a
func
  case Either ClientError a
errOrRes of
    Left ClientError
err -> String -> IO a
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ ClientError -> String
forall a. Show a => a -> String
show ClientError
err
    Right a
r -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r

#if MIN_VERSION_servant_client(0,16,0)
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ClientError a)
testClientOrError = (ClientM a -> ClientEnv -> IO (Either ClientError a))
-> ClientEnv -> ClientM a -> IO (Either ClientError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM
#else
testClientOrError :: ClientEnv -> ClientM a -> IO (Either ServantError a)
testClientOrError = flip runClientM
#endif