{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

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

import Data.Kind
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
""
      )

-- | Like 'servantSpec', but allows setting a context. Useful for example when your server uses basic auth.
servantSpecWithContext ::
  forall api (ctx :: [Type]).
  (HasServer api ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
  Servant.Proxy api ->
  Context ctx ->
  ServerT api Handler ->
  ServantSpec ->
  Spec
servantSpecWithContext :: Proxy api
-> Context ctx -> ServerT api Handler -> ServantSpec -> Spec
servantSpecWithContext Proxy api
py Context ctx
ctx ServerT api Handler
server = Proxy api
-> Context ctx
-> SetupFunc (ServerT api Handler)
-> ServantSpec
-> Spec
forall api (ctx :: [*]).
(HasServer api ctx,
 HasContextEntry
   (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
Proxy api
-> Context ctx
-> SetupFunc (ServerT api Handler)
-> ServantSpec
-> Spec
servantSpecWithSetupFuncWithContext Proxy api
py Context ctx
ctx (ServerT api Handler -> SetupFunc (ServerT api Handler)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerT api Handler
server)

-- | Like 'servantSpecWithSetupFunc', but allows setting a context. Useful for example when your server uses basic auth.
servantSpecWithSetupFuncWithContext ::
  forall api (ctx :: [Type]).
  (HasServer api ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
  Servant.Proxy api ->
  Context ctx ->
  SetupFunc (ServerT api Handler) ->
  ServantSpec ->
  Spec
servantSpecWithSetupFuncWithContext :: Proxy api
-> Context ctx
-> SetupFunc (ServerT api Handler)
-> ServantSpec
-> Spec
servantSpecWithSetupFuncWithContext Proxy api
py Context ctx
ctx SetupFunc (ServerT api Handler)
setupFunc = Proxy api
-> Context ctx
-> (() -> SetupFunc (ServerT api Handler))
-> ServantSpec
-> Spec
forall api (ctx :: [*]) inner.
(HasServer api ctx,
 HasContextEntry
   (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
Proxy api
-> Context ctx
-> (inner -> SetupFunc (ServerT api Handler))
-> ServantSpec
-> SpecWith inner
servantSpecWithSetupFuncWithContext' Proxy api
py Context ctx
ctx ((() -> SetupFunc (ServerT api Handler)) -> ServantSpec -> Spec)
-> (() -> SetupFunc (ServerT api Handler)) -> ServantSpec -> Spec
forall a b. (a -> b) -> a -> b
$ \() -> SetupFunc (ServerT api Handler)
setupFunc

servantSpecWithSetupFuncWithContext' ::
  forall api (ctx :: [Type]) inner.
  (HasServer api ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
  Servant.Proxy api ->
  Context ctx ->
  (inner -> SetupFunc (ServerT api Handler)) ->
  ServantSpec ->
  SpecWith inner
servantSpecWithSetupFuncWithContext' :: Proxy api
-> Context ctx
-> (inner -> SetupFunc (ServerT api Handler))
-> ServantSpec
-> SpecWith inner
servantSpecWithSetupFuncWithContext' Proxy api
py Context ctx
ctx 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
-> Context ctx
-> Manager
-> ServerT api Handler
-> SetupFunc ClientEnv
forall api (ctx :: [*]).
(HasServer api ctx,
 HasContextEntry
   (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
Proxy api
-> Context ctx
-> Manager
-> ServerT api Handler
-> SetupFunc ClientEnv
clientEnvSetupFuncWithContext Proxy api
py Context ctx
ctx Manager
man)

clientEnvSetupFuncWithContext ::
  forall api (ctx :: [Type]).
  (HasServer api ctx, HasContextEntry (ctx .++ DefaultErrorFormatters) ErrorFormatters) =>
  Servant.Proxy api ->
  Context ctx ->
  HTTP.Manager ->
  ServerT api Handler ->
  SetupFunc ClientEnv
clientEnvSetupFuncWithContext :: Proxy api
-> Context ctx
-> Manager
-> ServerT api Handler
-> SetupFunc ClientEnv
clientEnvSetupFuncWithContext Proxy api
py Context ctx
x Manager
man ServerT api Handler
server = do
  let application :: Application
application = Proxy api -> Context ctx -> ServerT api Handler -> Application
forall api (context :: [*]).
(HasServer api context, ServerContext context) =>
Proxy api -> Context context -> Server api -> Application
serveWithContext Proxy api
py Context ctx
x 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

instance IsTest (ClientM ()) where
  type Arg1 (ClientM ()) = ()
  type Arg2 (ClientM ()) = ClientEnv
  runTest :: ClientM ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (ClientM ()) -> Arg2 (ClientM ()) -> IO ()) -> IO ())
-> IO TestRunResult
runTest ClientM ()
func = (() -> ClientM ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (() -> ClientM ()) -> Arg2 (() -> ClientM ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() -> ClientM ()
func)

instance IsTest (outerArgs -> ClientM ()) where
  type Arg1 (outerArgs -> ClientM ()) = outerArgs
  type Arg2 (outerArgs -> ClientM ()) = ClientEnv
  runTest :: (outerArgs -> ClientM ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> ClientM ())
     -> Arg2 (outerArgs -> ClientM ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest outerArgs -> ClientM ()
func = (outerArgs -> ClientEnv -> IO ())
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (outerArgs -> ClientEnv -> IO ())
     -> Arg2 (outerArgs -> ClientEnv -> IO ()) -> IO ())
    -> IO ())
-> IO TestRunResult
forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\outerArgs
outerArgs ClientEnv
clientEnv -> ClientEnv -> ClientM () -> IO ()
forall a. ClientEnv -> ClientM a -> IO a
testClient ClientEnv
clientEnv (outerArgs -> ClientM ()
func outerArgs
outerArgs))