Safe Haskell | None |
---|---|
Language | Haskell2010 |
Helper for querying the server from client side code using a derived client. This module exists to save you from having to use CPP yourself.
Synopsis
- runXHR :: ClientM a -> JSM a
- runXHR' :: ClientM a -> ClientEnv -> JSM a
- runXHRe :: ClientM a -> ClientEnv -> JSM (Either ClientError a)
- getClientEnv :: JSM ClientEnv
- data InvalidBaseUrlException
- data Scheme
- showBaseUrl :: BaseUrl -> String
- parseBaseUrl :: MonadThrow m => String -> m BaseUrl
- type StreamingResponse = ResponseF (SourceIO ByteString)
- type Response = ResponseF ByteString
- data ResponseF a = Response {}
- data ClientError
- data EmptyClient = EmptyClient
- class RunClient m => HasClient (m :: Type -> Type) api where
- data BaseUrl = BaseUrl {}
- withStreamingRequestJSM :: Maybe AbortController -> Request -> (StreamingResponse -> JSM a) -> ClientM a
- runClientM :: ClientM a -> ClientEnv -> JSM (Either ClientError a)
- client :: HasClient ClientM api => Proxy api -> Client ClientM api
- newtype ClientEnv = ClientEnv {}
- newtype ClientM a = ClientM {
- runClientM' :: ReaderT ClientEnv (ExceptT ClientError JSM) a
Documentation
runXHR' :: ClientM a -> ClientEnv -> JSM a Source #
Run the ClientM from Servant as an XHR request with a customized base URL.
data InvalidBaseUrlException Source #
Instances
Show InvalidBaseUrlException | |
Defined in Servant.Client.Core.BaseUrl | |
Exception InvalidBaseUrlException | |
URI scheme to use
Instances
Eq Scheme | |
Data Scheme | |
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 :: (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 | |
Defined in Servant.Client.Core.BaseUrl | |
Show Scheme | |
Generic Scheme | |
Lift Scheme | |
type Rep Scheme | |
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"}
type StreamingResponse = ResponseF (SourceIO ByteString) Source #
type Response = ResponseF ByteString Source #
Instances
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 | |
Defined in Servant.Client.Core.HasClient | |
Enum EmptyClient | |
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 | |
Defined in Servant.Client.Core.HasClient (==) :: EmptyClient -> EmptyClient -> Bool Source # (/=) :: EmptyClient -> EmptyClient -> Bool Source # | |
Show EmptyClient | |
Defined in Servant.Client.Core.HasClient |
class RunClient m => HasClient (m :: Type -> Type) 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 => HasClient m Raw | Pick a |
RunClient m => HasClient m EmptyAPI | 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 |
(HasClient m a, HasClient m b) => HasClient m (a :<|> b) | 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 | |
HasClient m subapi => HasClient m (WithNamedContext name context subapi) | |
Defined in Servant.Client.Core.HasClient type Client m (WithNamedContext name context subapi) :: Type 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 # | |
(KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (QueryParam' mods sym a :> api) | 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 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 # | |
(KnownSymbol sym, ToHttpApiData a, HasClient m api) => HasClient m (QueryParams sym a :> api) | 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 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, HasClient m api) => HasClient m (QueryFlag sym :> api) | 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 | |
(MimeRender ct a, HasClient m api) => HasClient m (ReqBody' mods (ct ': cts) a :> api) | 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 # | |
(HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a) => HasClient m (StreamBody' mods framing ctype a :> api) | |
Defined in Servant.Client.Core.HasClient 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 # | |
(KnownSymbol path, HasClient m api) => HasClient m (path :> api) | Make the querying function append |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (Vault :> api) | |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (RemoteHost :> api) | |
Defined in Servant.Client.Core.HasClient 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 # | |
(KnownSymbol capture, ToHttpApiData a, HasClient m api) => HasClient m (Capture' mods capture a :> api) | 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 # | |
(KnownSymbol capture, ToHttpApiData a, HasClient m sublayout) => HasClient m (CaptureAll capture a :> sublayout) | 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 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 sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (Header' mods sym a :> api) | 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 # | |
HasClient m api => HasClient m (HttpVersion :> api) | Using a |
Defined in Servant.Client.Core.HasClient 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 # | |
HasClient m api => HasClient m (Summary desc :> api) | Ignore |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (Description desc :> api) | Ignore |
Defined in Servant.Client.Core.HasClient 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 (IsSecure :> api) | |
Defined in Servant.Client.Core.HasClient | |
HasClient m api => HasClient m (AuthProtect tag :> api) | |
Defined in Servant.Client.Core.HasClient 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 api => HasClient m (BasicAuth realm usr :> api) | |
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 # | |
(RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)) => HasClient m (Verb method status cts' a) | |
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 # | |
(RunClient m, ReflectMethod method) => HasClient m (Verb method status cts NoContent) | |
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, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)) => HasClient m (Verb method status cts' (Headers ls a)) | |
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, BuildHeadersTo ls, ReflectMethod method) => HasClient m (Verb method status cts (Headers ls NoContent)) | |
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 # | |
(RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a) => HasClient m (Stream method status framing ct a) | |
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 # |
Simple data type to represent the target of HTTP requests for servant's automatically-generated clients.
BaseUrl | |
|
Instances
Eq BaseUrl | |
Data BaseUrl | |
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 :: (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 | |
Defined in Servant.Client.Core.BaseUrl | |
Show BaseUrl | |
Generic BaseUrl | |
Lift BaseUrl | |
NFData BaseUrl | |
Defined in Servant.Client.Core.BaseUrl | |
ToJSON BaseUrl |
|
ToJSONKey BaseUrl |
|
Defined in Servant.Client.Core.BaseUrl | |
FromJSON BaseUrl |
|
FromJSONKey BaseUrl | |
type Rep BaseUrl | |
Defined in Servant.Client.Core.BaseUrl type Rep BaseUrl = D1 (MetaData "BaseUrl" "Servant.Client.Core.BaseUrl" "servant-client-core-0.16-G73kHISuefHHMQ5tSmiWmL" 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)))) |
withStreamingRequestJSM :: Maybe AbortController -> Request -> (StreamingResponse -> JSM a) -> ClientM a Source #
A variation on Servant.Client.Core.withStreamingRequest
where the continuation / callback
passed as the second argument is in the JSM monad as opposed to the IO monad.
Executes the given request and passes the response data stream to the provided continuation / callback.
runClientM :: ClientM a -> ClientEnv -> JSM (Either ClientError a) Source #