Safe Haskell | None |
---|---|
Language | Haskell2010 |
This module provides backend-agnostic functionality for generating clients
from
servant
APIs. By "backend," we mean something that concretely
executes the request, such as:
-
The
http-client
library -
The
haxl
library - GHCJS via FFI
etc.
Each backend is encapsulated in a monad that is an instance of the
RunClient
class.
This library is primarily of interest to backend-writers and combinator-writers. For more information, see the README.md
Synopsis
- clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
- class RunClient m => HasClient m api where
- foldMapUnion :: forall c a (as :: [ Type ]). All c as => Proxy c -> ( forall x. c x => x -> a) -> Union as -> a
- matchUnion :: forall a (as :: [ Type ]). IsMember a as => Union as -> Maybe a
- type Request = RequestF RequestBody Builder
-
data
RequestF
body path =
Request
{
- requestPath :: path
- requestQueryString :: Seq QueryItem
- requestBody :: Maybe (body, MediaType )
- requestAccept :: Seq MediaType
- requestHeaders :: Seq Header
- requestHttpVersion :: HttpVersion
- requestMethod :: Method
- defaultRequest :: Request
- data RequestBody
- mkAuthenticatedRequest :: AuthClientData a -> ( AuthClientData a -> Request -> Request ) -> AuthenticatedRequest a
- basicAuthReq :: BasicAuthData -> Request -> Request
-
newtype
AuthenticatedRequest
a =
AuthenticatedRequest
{
- unAuthReq :: ( AuthClientData a, AuthClientData a -> Request -> Request )
- type family AuthClientData a :: *
- data ClientError
- data EmptyClient = EmptyClient
- type Response = ResponseF ByteString
- data ResponseF a = Response { }
-
class
Monad
m =>
RunClient
m
where
- runRequestAcceptStatus :: Maybe [ Status ] -> Request -> m Response
- throwClientError :: ClientError -> m a
-
data
BaseUrl
=
BaseUrl
{
- baseUrlScheme :: Scheme
- baseUrlHost :: String
- baseUrlPort :: Int
- baseUrlPath :: String
- data Scheme
- showBaseUrl :: BaseUrl -> String
- parseBaseUrl :: MonadThrow m => String -> m BaseUrl
- newtype InvalidBaseUrlException = InvalidBaseUrlException String
-
class
RunClient
m =>
RunStreamingClient
m
where
- withStreamingRequest :: Request -> ( StreamingResponse -> IO a) -> m a
- type StreamingResponse = ResponseF ( SourceIO ByteString )
- addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request
- appendToQueryString :: Text -> Maybe ByteString -> Request -> Request
- appendToPath :: Text -> Request -> Request
- setRequestBodyLBS :: ByteString -> MediaType -> Request -> Request
- setRequestBody :: RequestBody -> MediaType -> Request -> Request
Client generation
clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api Source #
clientIn
allows you to produce operations to query an API from a client
within a
RunClient
monad.
type MyApi = "books" :> Get '[JSON] [Book] -- GET /books :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books myApi :: Proxy MyApi myApi = Proxy clientM :: Proxy ClientM clientM = Proxy getAllBooks :: ClientM [Book] postNewBook :: Book -> ClientM Book (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
class RunClient m => HasClient m api where Source #
This class lets us define how each API combinator influences the creation of an HTTP request.
Unless you are writing a new backend for
servant-client-core
or new
combinators that you want to support client-generation, you can ignore this
class.
clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api Source #
hoistClientMonad :: Proxy m -> Proxy api -> ( forall x. mon x -> mon' x) -> Client mon api -> Client mon' api Source #
Instances
( RunClient m, TypeError ( NoInstanceFor ( HasClient m api)) :: Constraint ) => HasClient m api Source # | |
RunClient m => HasClient m Raw Source # |
Pick a
|
RunClient m => HasClient m EmptyAPI Source # |
The client for
type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books :<|> "nothing" :> EmptyAPI myApi :: Proxy MyApi myApi = Proxy getAllBooks :: ClientM [Book] (getAllBooks :<|> EmptyClient) = client myApi |
( forall (n :: Type -> Type ). GClient api n, HasClient m ( ToServantApi api), RunClient m) => HasClient m ( NamedRoutes api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( NamedRoutes api) Source # clientWithRoute :: Proxy m -> Proxy ( NamedRoutes api) -> Request -> Client m ( NamedRoutes api) Source # hoistClientMonad :: Proxy m -> Proxy ( NamedRoutes api) -> ( forall x. mon x -> mon' x) -> Client mon ( NamedRoutes api) -> Client mon' ( NamedRoutes api) Source # |
|
( RunClient m, ReflectMethod method) => HasClient m ( NoContentVerb method) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( NoContentVerb method) Source # clientWithRoute :: Proxy m -> Proxy ( NoContentVerb method) -> Request -> Client m ( NoContentVerb method) Source # hoistClientMonad :: Proxy m -> Proxy ( NoContentVerb method) -> ( forall x. mon x -> mon' x) -> Client mon ( NoContentVerb method) -> Client mon' ( NoContentVerb method) Source # |
|
( HasClient m a, HasClient m b) => HasClient m (a :<|> b) Source # |
A client querying function for
type MyApi = "books" :> Get '[JSON] [Book] -- GET /books :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books myApi :: Proxy MyApi myApi = Proxy getAllBooks :: ClientM [Book] postNewBook :: Book -> ClientM Book (getAllBooks :<|> postNewBook) = client myApi |
Defined in Servant.Client.Core.HasClient |
|
( RunClient m, TypeError ( NoInstanceForSub ( HasClient m) ty) :: Constraint ) => HasClient m (ty :> sub) Source # | |
Defined in Servant.Client.Core.HasClient |
|
( RunClient m, TypeError ( PartialApplication HasClient arr) :: Constraint ) => HasClient m (arr :> sub) Source # | |
Defined in Servant.Client.Core.HasClient |
|
HasClient m api => HasClient m ( BasicAuth realm usr :> api) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( BasicAuth realm usr :> api) -> Request -> Client m ( BasicAuth realm usr :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( BasicAuth realm usr :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( BasicAuth realm usr :> api) -> Client mon' ( BasicAuth realm usr :> api) Source # |
|
( AtLeastOneFragment api, FragmentUnique ( Fragment a :> api), HasClient m api) => HasClient m ( Fragment a :> api) Source # |
Ignore
Example: type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooks :: ClientM [Book] getBooks = client myApi -- then you can just use "getBooksBy" to query that endpoint. -- 'getBooks' for all books. |
Defined in Servant.Client.Core.HasClient |
|
HasClient m api => HasClient m ( AuthProtect tag :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( AuthProtect tag :> api) Source # clientWithRoute :: Proxy m -> Proxy ( AuthProtect tag :> api) -> Request -> Client m ( AuthProtect tag :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( AuthProtect tag :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( AuthProtect tag :> api) -> Client mon' ( AuthProtect tag :> api) Source # |
|
HasClient m subapi => HasClient m ( WithNamedContext name context subapi) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( WithNamedContext name context subapi) Source # clientWithRoute :: Proxy m -> Proxy ( WithNamedContext name context subapi) -> Request -> Client m ( WithNamedContext name context subapi) Source # hoistClientMonad :: Proxy m -> Proxy ( WithNamedContext name context subapi) -> ( forall x. mon x -> mon' x) -> Client mon ( WithNamedContext name context subapi) -> Client mon' ( WithNamedContext name context subapi) Source # |
|
HasClient m api => HasClient m ( IsSecure :> api) Source # | |
Defined in Servant.Client.Core.HasClient |
|
HasClient m api => HasClient m ( RemoteHost :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( RemoteHost :> api) Source # clientWithRoute :: Proxy m -> Proxy ( RemoteHost :> api) -> Request -> Client m ( RemoteHost :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( RemoteHost :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( RemoteHost :> api) -> Client mon' ( RemoteHost :> api) Source # |
|
HasClient m api => HasClient m ( Vault :> api) Source # | |
Defined in Servant.Client.Core.HasClient |
|
( KnownSymbol path, HasClient m api) => HasClient m (path :> api) Source # |
Make the querying function append
|
Defined in Servant.Client.Core.HasClient |
|
( HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) => HasClient m ( StreamBody' mods framing ctype a :> api) Source # | |
Defined in Servant.Client.Core.HasClient type Client m ( StreamBody' mods framing ctype a :> api) Source # clientWithRoute :: Proxy m -> Proxy ( StreamBody' mods framing ctype a :> api) -> Request -> Client m ( StreamBody' mods framing ctype a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( StreamBody' mods framing ctype a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( StreamBody' mods framing ctype a :> api) -> Client mon' ( StreamBody' mods framing ctype a :> api) Source # |
|
( MimeRender ct a, HasClient m api) => HasClient m ( ReqBody' mods (ct ': cts) a :> api) Source # |
If you use a
All you need is for your type to have a
Example: type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book myApi :: Proxy MyApi myApi = Proxy addBook :: Book -> ClientM Book addBook = client myApi -- then you can just use "addBook" to query that endpoint |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( ReqBody' mods (ct ': cts) a :> api) -> Request -> Client m ( ReqBody' mods (ct ': cts) a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( ReqBody' mods (ct ': cts) a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( ReqBody' mods (ct ': cts) a :> api) -> Client mon' ( ReqBody' mods (ct ': cts) a :> api) Source # |
|
( KnownSymbol sym, HasClient m api) => HasClient m ( QueryFlag sym :> api) Source # |
If you use a
If you give
Otherwise, this function will insert a value-less query string
parameter under the name associated to your
Example: type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooks :: Bool -> ClientM [Book] getBooks = client myApi -- then you can just use "getBooks" to query that endpoint. -- 'getBooksBy False' for all books -- 'getBooksBy True' to only get _already published_ books |
Defined in Servant.Client.Core.HasClient |
|
( KnownSymbol sym, ToHttpApiData a, HasClient m api) => HasClient m ( QueryParams sym a :> api) Source # |
If you use a
If you give an empty list, nothing will be added to the query string. Otherwise, this function will take care of inserting a textual representation of your values in the query string, under the same query string parameter name.
You can control how values for your type are turned into
text by specifying a
Example: type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooksBy :: [Text] -> ClientM [Book] getBooksBy = client myApi -- then you can just use "getBooksBy" to query that endpoint. -- 'getBooksBy []' for all books -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]' -- to get all books by Asimov and Heinlein |
Defined in Servant.Client.Core.HasClient type Client m ( QueryParams sym a :> api) Source # clientWithRoute :: Proxy m -> Proxy ( QueryParams sym a :> api) -> Request -> Client m ( QueryParams sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( QueryParams sym a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( QueryParams sym a :> api) -> Client mon' ( QueryParams sym a :> api) Source # |
|
( KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI ( FoldRequired mods)) => HasClient m ( QueryParam' mods sym a :> api) Source # |
If you use a
If you give Nothing, nothing will be added to the query string.
If you give a non-
You can control how values for your type are turned into
text by specifying a
Example: type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book] myApi :: Proxy MyApi myApi = Proxy getBooksBy :: Maybe Text -> ClientM [Book] getBooksBy = client myApi -- 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 |
Defined in Servant.Client.Core.HasClient type Client m ( QueryParam' mods sym a :> api) Source # clientWithRoute :: Proxy m -> Proxy ( QueryParam' mods sym a :> api) -> Request -> Client m ( QueryParam' mods sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( QueryParam' mods sym a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( QueryParam' mods sym a :> api) -> Client mon' ( QueryParam' mods sym a :> api) Source # |
|
HasClient m api => HasClient m ( Description desc :> api) Source # |
Ignore
|
Defined in Servant.Client.Core.HasClient type Client m ( Description desc :> api) Source # clientWithRoute :: Proxy m -> Proxy ( Description desc :> api) -> Request -> Client m ( Description desc :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( Description desc :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( Description desc :> api) -> Client mon' ( Description desc :> api) Source # |
|
HasClient m api => HasClient m ( Summary desc :> api) Source # |
Ignore
|
Defined in Servant.Client.Core.HasClient |
|
HasClient m api => HasClient m ( HttpVersion :> api) Source # |
Using a
|
Defined in Servant.Client.Core.HasClient type Client m ( HttpVersion :> api) Source # clientWithRoute :: Proxy m -> Proxy ( HttpVersion :> api) -> Request -> Client m ( HttpVersion :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( HttpVersion :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( HttpVersion :> api) -> Client mon' ( HttpVersion :> api) Source # |
|
( KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI ( FoldRequired mods)) => HasClient m ( Header' mods sym a :> api) Source # |
If you use a
That function will take care of encoding this argument as Text in the request headers.
All you need is for your type to have a
Example: newtype Referer = Referer { referrer :: Text } deriving (Eq, Show, Generic, ToHttpApiData) -- GET /view-my-referer type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer myApi :: Proxy MyApi myApi = Proxy viewReferer :: Maybe Referer -> ClientM Book viewReferer = client myApi -- then you can just use "viewRefer" to query that endpoint -- specifying Nothing or e.g Just "http://haskell.org/" as arguments |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Header' mods sym a :> api) -> Request -> Client m ( Header' mods sym a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( Header' mods sym a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( Header' mods sym a :> api) -> Client mon' ( Header' mods sym a :> api) Source # |
|
( RunClient m, contentTypes ~ (contentType ': otherContentTypes), as ~ (a ': as'), AllMime contentTypes, ReflectMethod method, All (UnrenderResponse contentTypes) as, All HasStatus as, HasStatuses as', Unique ( Statuses as)) => HasClient m ( UVerb method contentTypes as) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( UVerb method contentTypes as) -> Request -> Client m ( UVerb method contentTypes as) Source # hoistClientMonad :: Proxy m -> Proxy ( UVerb method contentTypes as) -> ( forall x. mon x -> mon' x) -> Client mon ( UVerb method contentTypes as) -> Client mon' ( UVerb method contentTypes as) Source # |
|
( KnownSymbol capture, ToHttpApiData a, HasClient m sublayout) => HasClient m ( CaptureAll capture a :> sublayout) Source # |
If you use a
You can control how these values are turned into text by specifying
a
Example: type MyAPI = "src" :> CaptureAll Text -> Get '[JSON] SourceFile myApi :: Proxy myApi = Proxy getSourceFile :: [Text] -> ClientM SourceFile getSourceFile = client myApi -- then you can use "getSourceFile" to query that endpoint |
Defined in Servant.Client.Core.HasClient type Client m ( CaptureAll capture a :> sublayout) Source # clientWithRoute :: Proxy m -> Proxy ( CaptureAll capture a :> sublayout) -> Request -> Client m ( CaptureAll capture a :> sublayout) Source # hoistClientMonad :: Proxy m -> Proxy ( CaptureAll capture a :> sublayout) -> ( forall x. mon x -> mon' x) -> Client mon ( CaptureAll capture a :> sublayout) -> Client mon' ( CaptureAll capture a :> sublayout) Source # |
|
( KnownSymbol capture, ToHttpApiData a, HasClient m api) => HasClient m ( Capture' mods capture a :> api) Source # |
If you use a
You can control how values for this type are turned into
text by specifying a
Example: type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book myApi :: Proxy MyApi myApi = Proxy getBook :: Text -> ClientM Book getBook = client myApi -- then you can just use "getBook" to query that endpoint |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Capture' mods capture a :> api) -> Request -> Client m ( Capture' mods capture a :> api) Source # hoistClientMonad :: Proxy m -> Proxy ( Capture' mods capture a :> api) -> ( forall x. mon x -> mon' x) -> Client mon ( Capture' mods capture a :> api) -> Client mon' ( Capture' mods capture a :> api) Source # |
|
( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status) => HasClient m ( Verb method status cts ( Headers ls NoContent )) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Verb method status cts ( Headers ls NoContent )) -> Request -> Client m ( Verb method status cts ( Headers ls NoContent )) Source # hoistClientMonad :: Proxy m -> Proxy ( Verb method status cts ( Headers ls NoContent )) -> ( forall x. mon x -> mon' x) -> Client mon ( Verb method status cts ( Headers ls NoContent )) -> Client mon' ( Verb method status cts ( Headers ls NoContent )) Source # |
|
( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status, ReflectMethod method, cts' ~ (ct ': cts)) => HasClient m ( Verb method status cts' ( Headers ls a)) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Verb method status cts' ( Headers ls a)) -> Request -> Client m ( Verb method status cts' ( Headers ls a)) Source # hoistClientMonad :: Proxy m -> Proxy ( Verb method status cts' ( Headers ls a)) -> ( forall x. mon x -> mon' x) -> Client mon ( Verb method status cts' ( Headers ls a)) -> Client mon' ( Verb method status cts' ( Headers ls a)) Source # |
|
( RunClient m, ReflectMethod method, KnownNat status) => HasClient m ( Verb method status cts NoContent ) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Verb method status cts NoContent ) -> Request -> Client m ( Verb method status cts NoContent ) Source # hoistClientMonad :: Proxy m -> Proxy ( Verb method status cts NoContent ) -> ( forall x. mon x -> mon' x) -> Client mon ( Verb method status cts NoContent ) -> Client mon' ( Verb method status cts NoContent ) Source # |
|
( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), KnownNat status) => HasClient m ( Verb method status cts' a) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Verb method status cts' a) -> Request -> Client m ( Verb method status cts' a) Source # hoistClientMonad :: Proxy m -> Proxy ( Verb method status cts' a) -> ( forall x. mon x -> mon' x) -> Client mon ( Verb method status cts' a) -> Client mon' ( Verb method status cts' a) Source # |
|
( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a, BuildHeadersTo hs) => HasClient m ( Stream method status framing ct ( Headers hs a)) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Stream method status framing ct ( Headers hs a)) -> Request -> Client m ( Stream method status framing ct ( Headers hs a)) Source # hoistClientMonad :: Proxy m -> Proxy ( Stream method status framing ct ( Headers hs a)) -> ( forall x. mon x -> mon' x) -> Client mon ( Stream method status framing ct ( Headers hs a)) -> Client mon' ( Stream method status framing ct ( Headers hs a)) Source # |
|
( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a) => HasClient m ( Stream method status framing ct a) Source # | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy ( Stream method status framing ct a) -> Request -> Client m ( Stream method status framing ct a) Source # hoistClientMonad :: Proxy m -> Proxy ( Stream method status framing ct a) -> ( forall x. mon x -> mon' x) -> Client mon ( Stream method status framing ct a) -> Client mon' ( Stream method status framing ct a) Source # |
foldMapUnion :: forall c a (as :: [ Type ]). All c as => Proxy c -> ( forall x. c x => x -> a) -> Union as -> a Source #
Convenience function to apply a function to an unknown union element using a type class. All elements of the union must have instances in the type class, and the function is applied unconditionally.
See also:
matchUnion
.
matchUnion :: forall a (as :: [ Type ]). IsMember a as => Union as -> Maybe a Source #
Convenience function to extract a union element using
cast
, ie. return the value if the
selected type happens to be the actual type of the union in this value, or
Nothing
otherwise.
See also:
foldMapUnion
.
Request
data RequestF body path Source #
Request | |
|
Instances
data RequestBody Source #
The request body. R replica of the
http-client
RequestBody
.
Instances
Authentication
mkAuthenticatedRequest :: AuthClientData a -> ( AuthClientData a -> Request -> Request ) -> AuthenticatedRequest a Source #
Handy helper to avoid wrapping datatypes in tuples everywhere.
NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
basicAuthReq :: BasicAuthData -> Request -> Request Source #
Authenticate a request using Basic Authentication
newtype AuthenticatedRequest a Source #
For better type inference and to avoid usage of a data family, we newtype
wrap the combination of some
AuthClientData
and a function to add authentication
data to a request
NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
AuthenticatedRequest | |
|
type family AuthClientData a :: * Source #
For a resource protected by authentication (e.g. AuthProtect), we need to provide the client with some data used to add authentication data to a request
NOTE: THIS API IS EXPERIMENTAL AND SUBJECT TO CHANGE
Generic Client
data ClientError Source #
A type representing possible errors in a request
Note that this type substantially changed in 0.12.
FailureResponse ( RequestF () ( BaseUrl , ByteString )) Response |
The server returned an error response including the
failing request.
|
DecodeFailure Text Response |
The body could not be decoded at the expected type |
UnsupportedContentType MediaType Response |
The content-type of the response is not supported |
InvalidContentTypeHeader Response |
The content-type header is invalid |
ConnectionError SomeException |
There was a connection error, and no response was received |
Instances
data EmptyClient Source #
Singleton type representing a client for an empty API.
Instances
Bounded EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient |
|
Enum EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient succ :: EmptyClient -> EmptyClient Source # pred :: EmptyClient -> EmptyClient Source # toEnum :: Int -> EmptyClient Source # fromEnum :: EmptyClient -> Int Source # enumFrom :: EmptyClient -> [ EmptyClient ] Source # enumFromThen :: EmptyClient -> EmptyClient -> [ EmptyClient ] Source # enumFromTo :: EmptyClient -> EmptyClient -> [ EmptyClient ] Source # enumFromThenTo :: EmptyClient -> EmptyClient -> EmptyClient -> [ EmptyClient ] Source # |
|
Eq EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient (==) :: EmptyClient -> EmptyClient -> Bool Source # (/=) :: EmptyClient -> EmptyClient -> Bool Source # |
|
Show EmptyClient Source # | |
Defined in Servant.Client.Core.HasClient |
Response
type Response = ResponseF ByteString Source #
Instances
class Monad m => RunClient m where Source #
runRequestAcceptStatus :: Maybe [ Status ] -> Request -> m Response Source #
How to make a request, with an optional list of status codes to not throw exceptions for (default: [200..299]).
throwClientError :: ClientError -> m a Source #
Instances
ClientF ~ f => RunClient ( Free f) Source # | |
Defined in Servant.Client.Core.RunClient runRequestAcceptStatus :: Maybe [ Status ] -> Request -> Free f Response Source # throwClientError :: ClientError -> Free f a Source # |
BaseUrl
Simple data type to represent the target of HTTP requests for servant's automatically-generated clients.
BaseUrl | |
|
Instances
Eq BaseUrl Source # | |
Data BaseUrl Source # | |
Defined in Servant.Client.Core.BaseUrl gfoldl :: ( forall d b. Data d => c (d -> b) -> d -> c b) -> ( forall g. g -> c g) -> BaseUrl -> c BaseUrl Source # gunfold :: ( forall b r. Data b => c (b -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c BaseUrl Source # toConstr :: BaseUrl -> Constr Source # dataTypeOf :: BaseUrl -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c BaseUrl ) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c BaseUrl ) Source # gmapT :: ( forall b. Data b => b -> b) -> BaseUrl -> BaseUrl Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> BaseUrl -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> BaseUrl -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> BaseUrl -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> BaseUrl -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> BaseUrl -> m BaseUrl Source # |
|
Ord BaseUrl Source # | |
Defined in Servant.Client.Core.BaseUrl |
|
Show BaseUrl Source # | |
Generic BaseUrl Source # | |
ToJSON BaseUrl Source # |
|
ToJSONKey BaseUrl Source # |
|
Defined in Servant.Client.Core.BaseUrl |
|
FromJSON BaseUrl Source # |
|
FromJSONKey BaseUrl Source # | |
Defined in Servant.Client.Core.BaseUrl |
|
NFData BaseUrl Source # | |
Defined in Servant.Client.Core.BaseUrl |
|
Lift BaseUrl Source # | |
type Rep BaseUrl Source # | |
Defined in Servant.Client.Core.BaseUrl
type
Rep
BaseUrl
=
D1
('
MetaData
"BaseUrl" "Servant.Client.Core.BaseUrl" "servant-client-core-0.19-DAS79QGMO4DL64AFO0JBqz" '
False
) (
C1
('
MetaCons
"BaseUrl" '
PrefixI
'
True
) ((
S1
('
MetaSel
('
Just
"baseUrlScheme") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
Scheme
)
:*:
S1
('
MetaSel
('
Just
"baseUrlHost") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
String
))
:*:
(
S1
('
MetaSel
('
Just
"baseUrlPort") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
Int
)
:*:
S1
('
MetaSel
('
Just
"baseUrlPath") '
NoSourceUnpackedness
'
NoSourceStrictness
'
DecidedLazy
) (
Rec0
String
))))
|
URI scheme to use
Instances
Eq Scheme Source # | |
Data Scheme Source # | |
Defined in Servant.Client.Core.BaseUrl gfoldl :: ( forall d b. Data d => c (d -> b) -> d -> c b) -> ( forall g. g -> c g) -> Scheme -> c Scheme Source # gunfold :: ( forall b r. Data b => c (b -> r) -> c r) -> ( forall r. r -> c r) -> Constr -> c Scheme Source # toConstr :: Scheme -> Constr Source # dataTypeOf :: Scheme -> DataType Source # dataCast1 :: Typeable t => ( forall d. Data d => c (t d)) -> Maybe (c Scheme ) Source # dataCast2 :: Typeable t => ( forall d e. ( Data d, Data e) => c (t d e)) -> Maybe (c Scheme ) Source # gmapT :: ( forall b. Data b => b -> b) -> Scheme -> Scheme Source # gmapQl :: (r -> r' -> r) -> r -> ( forall d. Data d => d -> r') -> Scheme -> r Source # gmapQr :: forall r r'. (r' -> r -> r) -> r -> ( forall d. Data d => d -> r') -> Scheme -> r Source # gmapQ :: ( forall d. Data d => d -> u) -> Scheme -> [u] Source # gmapQi :: Int -> ( forall d. Data d => d -> u) -> Scheme -> u Source # gmapM :: Monad m => ( forall d. Data d => d -> m d) -> Scheme -> m Scheme Source # gmapMp :: MonadPlus m => ( forall d. Data d => d -> m d) -> Scheme -> m Scheme Source # gmapMo :: MonadPlus m => ( forall d. Data d => d -> m d) -> Scheme -> m Scheme Source # |
|
Ord Scheme Source # | |
Show Scheme Source # | |
Generic Scheme Source # | |
Lift Scheme Source # | |
type Rep Scheme Source # | |
Defined in Servant.Client.Core.BaseUrl |
showBaseUrl :: BaseUrl -> String Source #
>>>
showBaseUrl <$> parseBaseUrl "api.example.com"
"http://api.example.com"
parseBaseUrl :: MonadThrow m => String -> m BaseUrl Source #
>>>
parseBaseUrl "api.example.com"
BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}
Note: trailing slash is removed
>>>
parseBaseUrl "api.example.com/"
BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}
>>>
parseBaseUrl "api.example.com/dir/"
BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = "/dir"}
newtype InvalidBaseUrlException Source #
Instances
Streaming
class RunClient m => RunStreamingClient m where Source #
withStreamingRequest :: Request -> ( StreamingResponse -> IO a) -> m a Source #
type StreamingResponse = ResponseF ( SourceIO ByteString ) Source #
Writing HasClient instances
These functions need not be re-exported by backend libraries.
addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request Source #
:: Text |
param name |
-> Maybe ByteString |
param value |
-> Request | |
-> Request |
setRequestBodyLBS :: ByteString -> MediaType -> Request -> Request Source #
Set body and media type of the request being constructed.
The body is set to the given bytestring using the
RequestBodyLBS
constructor.
Since: 0.12
setRequestBody :: RequestBody -> MediaType -> Request -> Request Source #
Set body and media type of the request being constructed.
Since: 0.12