expose client runner as a typeclass with base implementation #798
* defined a typeclass abstracting the execution of a query * provide ClientM-based instances for this typeclass * changed signature of client and clientWithRoute to add proxy for context * updated tests
This commit is contained in:
Arnaud Bailly
parent
3058a54458
commit
2dcc92bd9a
4 changed files with 126 additions and 117 deletions
|
|
@ -30,6 +30,7 @@ source-repository head
|
|||
library
|
||||
exposed-modules:
|
||||
Servant.Client
|
||||
Servant.Client.Class
|
||||
Servant.Client.HttpClient
|
||||
Servant.Client.Generic
|
||||
Servant.Client.Experimental.Auth
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
#include "overlapping-compat.h"
|
||||
-- | This module provides 'client' which can automatically generate
|
||||
|
|
@ -62,15 +63,15 @@ import Servant.Common.Req
|
|||
-- > getAllBooks :: ClientM [Book]
|
||||
-- > postNewBook :: Book -> ClientM Book
|
||||
-- > (getAllBooks :<|> postNewBook) = client myApi
|
||||
client :: HasClient api => Proxy api -> Client m api
|
||||
client p = clientWithRoute p defReq
|
||||
client :: HasClient m api => Proxy m -> Proxy api -> Client m api
|
||||
client pm p = clientWithRoute pm p defReq
|
||||
|
||||
-- | This class lets us define how each API combinator
|
||||
-- influences the creation of an HTTP request. It's mostly
|
||||
-- an internal class, you can just use 'client'.
|
||||
class HasClient api where
|
||||
class HasClient m api where
|
||||
type Client (m :: * -> *) (api :: *) :: *
|
||||
clientWithRoute :: Proxy api -> Req -> Client m api
|
||||
clientWithRoute :: Proxy m -> Proxy api -> Req -> Client m api
|
||||
|
||||
|
||||
-- | A client querying function for @a ':<|>' b@ will actually hand you
|
||||
|
|
@ -86,11 +87,11 @@ class HasClient api where
|
|||
-- > getAllBooks :: ClientM [Book]
|
||||
-- > postNewBook :: Book -> ClientM Book
|
||||
-- > (getAllBooks :<|> postNewBook) = client myApi
|
||||
instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
|
||||
instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
|
||||
type Client m (a :<|> b) = Client m a :<|> Client m b
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy a) req :<|>
|
||||
clientWithRoute (Proxy :: Proxy b) req
|
||||
clientWithRoute pm Proxy req =
|
||||
clientWithRoute pm (Proxy :: Proxy a) req :<|>
|
||||
clientWithRoute pm (Proxy :: Proxy b) req
|
||||
|
||||
-- | Singleton type representing a client for an empty API.
|
||||
data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
|
||||
|
|
@ -105,9 +106,9 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
|
|||
-- >
|
||||
-- > getAllBooks :: ClientM [Book]
|
||||
-- > (getAllBooks :<|> EmptyClient) = client myApi
|
||||
instance HasClient EmptyAPI where
|
||||
instance HasClient m EmptyAPI where
|
||||
type Client m EmptyAPI = EmptyClient
|
||||
clientWithRoute Proxy _ = EmptyClient
|
||||
clientWithRoute pm Proxy _ = EmptyClient
|
||||
|
||||
-- | If you use a 'Capture' in one of your endpoints in your API,
|
||||
-- the corresponding querying function will automatically take
|
||||
|
|
@ -128,14 +129,14 @@ instance HasClient EmptyAPI where
|
|||
-- > getBook :: Text -> ClientM Book
|
||||
-- > getBook = client myApi
|
||||
-- > -- then you can just use "getBook" to query that endpoint
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (Capture capture a :> api) where
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
|
||||
=> HasClient m (Capture capture a :> api) where
|
||||
|
||||
type Client m (Capture capture a :> api) =
|
||||
a -> Client m api
|
||||
|
||||
clientWithRoute Proxy req val =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req val =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(appendToPath p req)
|
||||
|
||||
where p = unpack (toUrlPiece val)
|
||||
|
|
@ -160,14 +161,14 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient api)
|
|||
-- > getSourceFile :: [Text] -> ClientM SourceFile
|
||||
-- > getSourceFile = client myApi
|
||||
-- > -- then you can use "getSourceFile" to query that endpoint
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
|
||||
=> HasClient (CaptureAll capture a :> sublayout) where
|
||||
instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
|
||||
=> HasClient m (CaptureAll capture a :> sublayout) where
|
||||
|
||||
type Client m (CaptureAll capture a :> sublayout) =
|
||||
[a] -> Client m sublayout
|
||||
|
||||
clientWithRoute Proxy req vals =
|
||||
clientWithRoute (Proxy :: Proxy sublayout)
|
||||
clientWithRoute pm Proxy req vals =
|
||||
clientWithRoute pm (Proxy :: Proxy sublayout)
|
||||
(foldl' (flip appendToPath) req ps)
|
||||
|
||||
where ps = map (unpack . toUrlPiece) vals
|
||||
|
|
@ -175,27 +176,31 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
|
|||
instance OVERLAPPABLE_
|
||||
-- Note [Non-Empty Content Types]
|
||||
(RunClient m ct ([H.Header], a), MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
|
||||
) => HasClient (Verb method status cts' a) where
|
||||
) => HasClient m (Verb method status cts' a) where
|
||||
type Client m (Verb method status cts' a) = m a
|
||||
clientWithRoute Proxy req = do
|
||||
snd <$> runRequest (Proxy :: Proxy ct) method req
|
||||
clientWithRoute pm Proxy req = do
|
||||
(_hdrs, a) :: ([H.Header], a) <- runRequest (Proxy :: Proxy ct) method req
|
||||
return a
|
||||
where method = reflectMethod (Proxy :: Proxy method)
|
||||
|
||||
instance OVERLAPPING_
|
||||
(RunClient m NoContent [H.Header], ReflectMethod method) => HasClient (Verb method status cts NoContent) where
|
||||
( RunClient m NoContent [HTTP.Header]
|
||||
, ReflectMethod method) => HasClient m (Verb method status cts NoContent) where
|
||||
type Client m (Verb method status cts NoContent)
|
||||
= m NoContent
|
||||
clientWithRoute Proxy req = do
|
||||
runRequest (Proxy :: Proxy NoContent) method req >> return NoContent
|
||||
clientWithRoute pm Proxy req = do
|
||||
_hdrs :: [H.Header] <- runRequest (Proxy :: Proxy NoContent) method req
|
||||
return NoContent
|
||||
where method = reflectMethod (Proxy :: Proxy method)
|
||||
|
||||
instance OVERLAPPING_
|
||||
-- Note [Non-Empty Content Types]
|
||||
( RunClient m ct ([H.Header], a), MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
|
||||
) => HasClient (Verb method status cts' (Headers ls a)) where
|
||||
( RunClient m ct ([H.Header], a)
|
||||
, MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
|
||||
) => HasClient m (Verb method status cts' (Headers ls a)) where
|
||||
type Client m (Verb method status cts' (Headers ls a))
|
||||
= m (Headers ls a)
|
||||
clientWithRoute Proxy req = do
|
||||
clientWithRoute pm Proxy req = do
|
||||
let method = reflectMethod (Proxy :: Proxy method)
|
||||
(hdrs, resp) <- runRequest (Proxy :: Proxy ct) method req
|
||||
return $ Headers { getResponse = resp
|
||||
|
|
@ -203,13 +208,14 @@ instance OVERLAPPING_
|
|||
}
|
||||
|
||||
instance OVERLAPPING_
|
||||
( RunClient m NoContent [H.Header], BuildHeadersTo ls, ReflectMethod method
|
||||
) => HasClient (Verb method status cts (Headers ls NoContent)) where
|
||||
( RunClient m NoContent [H.Header]
|
||||
, BuildHeadersTo ls, ReflectMethod method
|
||||
) => HasClient m (Verb method status cts (Headers ls NoContent)) where
|
||||
type Client m (Verb method status cts (Headers ls NoContent))
|
||||
= m (Headers ls NoContent)
|
||||
clientWithRoute Proxy req = do
|
||||
clientWithRoute pm Proxy req = do
|
||||
let method = reflectMethod (Proxy :: Proxy method)
|
||||
hdrs <- runRequest method req
|
||||
hdrs <- runRequest (Proxy :: Proxy NoContent) method req
|
||||
return $ Headers { getResponse = NoContent
|
||||
, getHeadersHList = buildHeadersTo hdrs
|
||||
}
|
||||
|
|
@ -240,14 +246,14 @@ instance OVERLAPPING_
|
|||
-- > viewReferer = client myApi
|
||||
-- > -- then you can just use "viewRefer" to query that endpoint
|
||||
-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (Header sym a :> api) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
|
||||
=> HasClient m (Header sym a :> api) where
|
||||
|
||||
type Client m (Header sym a :> api) =
|
||||
Maybe a -> Client m api
|
||||
|
||||
clientWithRoute Proxy req mval =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req mval =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(maybe req
|
||||
(\value -> Servant.Common.Req.addHeader hname value req)
|
||||
mval
|
||||
|
|
@ -257,26 +263,26 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
|||
|
||||
-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
|
||||
-- functions.
|
||||
instance HasClient api
|
||||
=> HasClient (HttpVersion :> api) where
|
||||
instance HasClient m api
|
||||
=> HasClient m (HttpVersion :> api) where
|
||||
|
||||
type Client m (HttpVersion :> api) =
|
||||
Client m api
|
||||
|
||||
clientWithRoute Proxy =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
|
||||
-- | Ignore @'Summary'@ in client functions.
|
||||
instance HasClient api => HasClient (Summary desc :> api) where
|
||||
instance HasClient m api => HasClient m (Summary desc :> api) where
|
||||
type Client m (Summary desc :> api) = Client m api
|
||||
|
||||
clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
|
||||
|
||||
-- | Ignore @'Description'@ in client functions.
|
||||
instance HasClient api => HasClient (Description desc :> api) where
|
||||
instance HasClient m api => HasClient m (Description desc :> api) where
|
||||
type Client m (Description desc :> api) = Client m api
|
||||
|
||||
clientWithRoute _ = clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
|
||||
|
||||
-- | If you use a 'QueryParam' in one of your endpoints in your API,
|
||||
-- the corresponding querying function will automatically take
|
||||
|
|
@ -303,15 +309,15 @@ instance HasClient api => HasClient (Description desc :> api) where
|
|||
-- > -- then you can just use "getBooksBy" to query that endpoint.
|
||||
-- > -- 'getBooksBy Nothing' for all books
|
||||
-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (QueryParam sym a :> api) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
|
||||
=> HasClient m (QueryParam sym a :> api) where
|
||||
|
||||
type Client m (QueryParam sym a :> api) =
|
||||
Maybe a -> Client m api
|
||||
|
||||
-- if mparam = Nothing, we don't add it to the query string
|
||||
clientWithRoute Proxy req mparam =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req mparam =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(maybe req
|
||||
(flip (appendToQueryString pname) req . Just)
|
||||
mparamText
|
||||
|
|
@ -348,14 +354,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
|||
-- > -- 'getBooksBy []' for all books
|
||||
-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
|
||||
-- > -- to get all books by Asimov and Heinlein
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
||||
=> HasClient (QueryParams sym a :> api) where
|
||||
instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
|
||||
=> HasClient m (QueryParams sym a :> api) where
|
||||
|
||||
type Client m (QueryParams sym a :> api) =
|
||||
[a] -> Client m api
|
||||
|
||||
clientWithRoute Proxy req paramlist =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req paramlist =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
|
||||
req
|
||||
paramlist'
|
||||
|
|
@ -386,14 +392,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient api)
|
|||
-- > -- then you can just use "getBooks" to query that endpoint.
|
||||
-- > -- 'getBooksBy False' for all books
|
||||
-- > -- 'getBooksBy True' to only get _already published_ books
|
||||
instance (KnownSymbol sym, HasClient api)
|
||||
=> HasClient (QueryFlag sym :> api) where
|
||||
instance (KnownSymbol sym, HasClient m api)
|
||||
=> HasClient m (QueryFlag sym :> api) where
|
||||
|
||||
type Client m (QueryFlag sym :> api) =
|
||||
Bool -> Client m api
|
||||
|
||||
clientWithRoute Proxy req flag =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req flag =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(if flag
|
||||
then appendToQueryString paramname Nothing req
|
||||
else req
|
||||
|
|
@ -404,12 +410,13 @@ instance (KnownSymbol sym, HasClient api)
|
|||
|
||||
-- | Pick a 'Method' and specify where the server you want to query is. You get
|
||||
-- back the full `Response`.
|
||||
instance HasClient Raw where
|
||||
instance (RunClient m NoContent (Int, ByteString, MediaType, [HTTP.Header], Response ByteString))
|
||||
=> HasClient m Raw where
|
||||
type Client m Raw
|
||||
= H.Method -> m (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
|
||||
|
||||
clientWithRoute :: Proxy Raw -> Req -> Client Raw
|
||||
clientWithRoute Proxy req httpMethod = do
|
||||
clientWithRoute :: Proxy m -> Proxy Raw -> Req -> Client m Raw
|
||||
clientWithRoute pm Proxy req httpMethod = do
|
||||
runRequest (Proxy :: Proxy NoContent) httpMethod req
|
||||
|
||||
-- | If you use a 'ReqBody' in one of your endpoints in your API,
|
||||
|
|
@ -430,14 +437,14 @@ instance HasClient Raw where
|
|||
-- > addBook :: Book -> ClientM Book
|
||||
-- > addBook = client myApi
|
||||
-- > -- then you can just use "addBook" to query that endpoint
|
||||
instance (MimeRender ct a, HasClient api)
|
||||
=> HasClient (ReqBody (ct ': cts) a :> api) where
|
||||
instance (MimeRender ct a, HasClient m api)
|
||||
=> HasClient m (ReqBody (ct ': cts) a :> api) where
|
||||
|
||||
type Client m (ReqBody (ct ': cts) a :> api) =
|
||||
a -> Client m api
|
||||
|
||||
clientWithRoute Proxy req body =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req body =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(let ctProxy = Proxy :: Proxy ct
|
||||
in setReqBodyLBS (mimeRender ctProxy body)
|
||||
-- We use first contentType from the Accept list
|
||||
|
|
@ -446,54 +453,54 @@ instance (MimeRender ct a, HasClient api)
|
|||
)
|
||||
|
||||
-- | Make the querying function append @path@ to the request path.
|
||||
instance (KnownSymbol path, HasClient api) => HasClient (path :> api) where
|
||||
instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
|
||||
type Client m (path :> api) = Client m api
|
||||
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy api)
|
||||
clientWithRoute pm Proxy req =
|
||||
clientWithRoute pm (Proxy :: Proxy api)
|
||||
(appendToPath p req)
|
||||
|
||||
where p = symbolVal (Proxy :: Proxy path)
|
||||
|
||||
instance HasClient api => HasClient (Vault :> api) where
|
||||
instance HasClient m api => HasClient m (Vault :> api) where
|
||||
type Client m (Vault :> api) = Client m api
|
||||
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy api) req
|
||||
clientWithRoute pm Proxy req =
|
||||
clientWithRoute pm (Proxy :: Proxy api) req
|
||||
|
||||
instance HasClient api => HasClient (RemoteHost :> api) where
|
||||
instance HasClient m api => HasClient m (RemoteHost :> api) where
|
||||
type Client m (RemoteHost :> api) = Client m api
|
||||
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy api) req
|
||||
clientWithRoute pm Proxy req =
|
||||
clientWithRoute pm (Proxy :: Proxy api) req
|
||||
|
||||
instance HasClient api => HasClient (IsSecure :> api) where
|
||||
instance HasClient m api => HasClient m (IsSecure :> api) where
|
||||
type Client m (IsSecure :> api) = Client m api
|
||||
|
||||
clientWithRoute Proxy req =
|
||||
clientWithRoute (Proxy :: Proxy api) req
|
||||
clientWithRoute pm Proxy req =
|
||||
clientWithRoute pm (Proxy :: Proxy api) req
|
||||
|
||||
instance HasClient subapi =>
|
||||
HasClient (WithNamedContext name context subapi) where
|
||||
instance HasClient m subapi =>
|
||||
HasClient m (WithNamedContext name context subapi) where
|
||||
|
||||
type Client m (WithNamedContext name context subapi) = Client m subapi
|
||||
clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
|
||||
clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
|
||||
|
||||
instance ( HasClient api
|
||||
) => HasClient (AuthProtect tag :> api) where
|
||||
instance ( HasClient m api
|
||||
) => HasClient m (AuthProtect tag :> api) where
|
||||
type Client m (AuthProtect tag :> api)
|
||||
= AuthenticateReq (AuthProtect tag) -> Client m api
|
||||
|
||||
clientWithRoute Proxy req (AuthenticateReq (val,func)) =
|
||||
clientWithRoute (Proxy :: Proxy api) (func val req)
|
||||
clientWithRoute pm Proxy req (AuthenticateReq (val,func)) =
|
||||
clientWithRoute pm (Proxy :: Proxy api) (func val req)
|
||||
|
||||
-- * Basic Authentication
|
||||
|
||||
instance HasClient api => HasClient (BasicAuth realm usr :> api) where
|
||||
instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
|
||||
type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api
|
||||
|
||||
clientWithRoute Proxy req val =
|
||||
clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req)
|
||||
clientWithRoute pm Proxy req val =
|
||||
clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
|
||||
|
||||
|
||||
{- Note [Non-Empty Content Types]
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ import Servant.API
|
|||
import Servant.Common.Req
|
||||
|
||||
class (Monad m) => RunClient m ct result where
|
||||
runRequest :: MimeUnrender ct result
|
||||
=> Proxy ct
|
||||
-> Method -> Req -> m result
|
||||
runRequest :: Proxy ct
|
||||
-> Method
|
||||
-> Req
|
||||
-> m result
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ import Servant.Server
|
|||
import Servant.Server.Experimental.Auth
|
||||
|
||||
-- This declaration simply checks that all instances are in place.
|
||||
_ = client comprehensiveAPI
|
||||
_ = client (Proxy :: Proxy ClientM) comprehensiveAPI
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Servant.Client" $ do
|
||||
|
|
@ -147,7 +147,7 @@ getGet
|
|||
:<|> getMultiple
|
||||
:<|> getRespHeaders
|
||||
:<|> getDeleteContentType
|
||||
:<|> EmptyClient = client api
|
||||
:<|> EmptyClient = client (Proxy :: Proxy ClientM) api
|
||||
|
||||
server :: Application
|
||||
server = serve api (
|
||||
|
|
@ -241,7 +241,7 @@ data GenericClient = GenericClient
|
|||
, mkNestedClient1 :: String -> NestedClient1
|
||||
} deriving Generic
|
||||
instance SOP.Generic GenericClient
|
||||
instance (Client GenericClientAPI ~ client) => ClientLike client GenericClient
|
||||
instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient
|
||||
|
||||
type NestedAPI1
|
||||
= QueryParam "int" Int :> NestedAPI2
|
||||
|
|
@ -252,7 +252,7 @@ data NestedClient1 = NestedClient1
|
|||
, idChar :: Maybe Char -> SCR.ClientM Char
|
||||
} deriving Generic
|
||||
instance SOP.Generic NestedClient1
|
||||
instance (Client NestedAPI1 ~ client) => ClientLike client NestedClient1
|
||||
instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
|
||||
|
||||
type NestedAPI2
|
||||
= "sum" :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
|
||||
|
|
@ -263,7 +263,7 @@ data NestedClient2 = NestedClient2
|
|||
, doNothing :: SCR.ClientM ()
|
||||
} deriving Generic
|
||||
instance SOP.Generic NestedClient2
|
||||
instance (Client NestedAPI2 ~ client) => ClientLike client NestedClient2
|
||||
instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
|
||||
|
||||
genericClientServer :: Application
|
||||
genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
|
||||
|
|
@ -359,7 +359,7 @@ wrappedApiSpec = describe "error status codes" $ do
|
|||
test (WrappedApi api, desc) =
|
||||
it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
|
||||
let getResponse :: SCR.ClientM ()
|
||||
getResponse = client api
|
||||
getResponse = client (Proxy :: Proxy ClientM) api
|
||||
Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)
|
||||
responseStatus `shouldBe` (HTTP.Status 500 "error message")
|
||||
in mapM_ test $
|
||||
|
|
@ -374,35 +374,35 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
|||
|
||||
context "client returns errors appropriately" $ do
|
||||
it "reports FailureResponse" $ \(_, baseUrl) -> do
|
||||
let (_ :<|> getDeleteEmpty :<|> _) = client api
|
||||
let (_ :<|> getDeleteEmpty :<|> _) = client (Proxy :: Proxy ClientM) api
|
||||
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
|
||||
case res of
|
||||
FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
|
||||
_ -> fail $ "expected 404 response, but got " <> show res
|
||||
|
||||
it "reports DecodeFailure" $ \(_, baseUrl) -> do
|
||||
let (_ :<|> _ :<|> getCapture :<|> _) = client api
|
||||
let (_ :<|> _ :<|> getCapture :<|> _) = client (Proxy :: Proxy ClientM) api
|
||||
Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)
|
||||
case res of
|
||||
DecodeFailure _ ("application/json") _ -> return ()
|
||||
_ -> fail $ "expected DecodeFailure, but got " <> show res
|
||||
|
||||
it "reports ConnectionError" $ \_ -> do
|
||||
let (getGetWrongHost :<|> _) = client api
|
||||
let (getGetWrongHost :<|> _) = client (Proxy :: Proxy ClientM) api
|
||||
Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))
|
||||
case res of
|
||||
ConnectionError _ -> return ()
|
||||
_ -> fail $ "expected ConnectionError, but got " <> show res
|
||||
|
||||
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
|
||||
let (getGet :<|> _ ) = client api
|
||||
let (getGet :<|> _ ) = client (Proxy :: Proxy ClientM) api
|
||||
Left res <- runClientM getGet (ClientEnv manager baseUrl)
|
||||
case res of
|
||||
UnsupportedContentType ("application/octet-stream") _ -> return ()
|
||||
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
|
||||
|
||||
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
|
||||
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
|
||||
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client (Proxy :: Proxy ClientM) api
|
||||
Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)
|
||||
case res of
|
||||
InvalidContentTypeHeader "fooooo" _ -> return ()
|
||||
|
|
@ -410,7 +410,7 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
|
|||
|
||||
data WrappedApi where
|
||||
WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
|
||||
HasClient api, Client api ~ SCR.ClientM ()) =>
|
||||
HasClient ClientM api, Client ClientM api ~ SCR.ClientM ()) =>
|
||||
Proxy api -> WrappedApi
|
||||
|
||||
basicAuthSpec :: Spec
|
||||
|
|
@ -418,14 +418,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
|
|||
context "Authentication works when requests are properly authenticated" $ do
|
||||
|
||||
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
|
||||
let getBasic = client basicAuthAPI
|
||||
let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI
|
||||
let basicAuthData = BasicAuthData "servant" "server"
|
||||
(left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
|
||||
|
||||
context "Authentication is rejected when requests are not authenticated properly" $ do
|
||||
|
||||
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
|
||||
let getBasic = client basicAuthAPI
|
||||
let getBasic = client (Proxy :: Proxy ClientM) basicAuthAPI
|
||||
let basicAuthData = BasicAuthData "not" "password"
|
||||
Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)
|
||||
responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
|
||||
|
|
@ -435,14 +435,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
|
|||
context "Authentication works when requests are properly authenticated" $ do
|
||||
|
||||
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
|
||||
let getProtected = client genAuthAPI
|
||||
let getProtected = client (Proxy :: Proxy ClientM) genAuthAPI
|
||||
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
|
||||
(left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
|
||||
|
||||
context "Authentication is rejected when requests are not authenticated properly" $ do
|
||||
|
||||
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
|
||||
let getProtected = client genAuthAPI
|
||||
let getProtected = client (Proxy :: Proxy ClientM) genAuthAPI
|
||||
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
|
||||
Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
|
||||
responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
|
||||
|
|
@ -451,11 +451,11 @@ genericClientSpec :: Spec
|
|||
genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
|
||||
describe "Servant.Client.Generic" $ do
|
||||
|
||||
let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
|
||||
let GenericClient{..} = mkClient (client (Proxy :: Proxy ClientM) (Proxy :: Proxy GenericClientAPI))
|
||||
NestedClient1{..} = mkNestedClient1 "example"
|
||||
NestedClient2{..} = mkNestedClient2 (Just 42)
|
||||
|
||||
it "works for top-level client function" $ \(_, baseUrl) -> do
|
||||
it "works for top-level client (Proxy :: Proxy ClientM) function" $ \(_, baseUrl) -> do
|
||||
(left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
|
||||
|
||||
it "works for nested clients" $ \(_, baseUrl) -> do
|
||||
|
|
|
|||
Loading…
Reference in a new issue