Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- class RunClient m => HasClient (m :: Type -> Type) api where
- data JordanQuery' (baseStr :: Symbol) (options :: [Type]) a
- data ReportingRequestBody a
Documentation
class RunClient m => HasClient (m :: Type -> Type) api where #
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 #
hoistClientMonad :: Proxy m -> Proxy api -> (forall x. mon x -> mon' x) -> Client mon api -> Client mon' api #
Instances
(RunClient m, TypeError (NoInstanceFor (HasClient m api)) :: Constraint) => HasClient m api | |
Defined in Servant.Client.Core.HasClient | |
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 |
(forall (n :: Type -> Type). GClient api n, HasClient m (ToServantApi api), RunClient m) => HasClient m (NamedRoutes api) | |
Defined in Servant.Client.Core.HasClient type Client m (NamedRoutes api) # clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api) # hoistClientMonad :: Proxy m -> Proxy (NamedRoutes api) -> (forall x. mon x -> mon' x) -> Client mon (NamedRoutes api) -> Client mon' (NamedRoutes api) # | |
(RunClient m, ReflectMethod method) => HasClient m (NoContentVerb method) | |
Defined in Servant.Client.Core.HasClient type Client m (NoContentVerb method) # clientWithRoute :: Proxy m -> Proxy (NoContentVerb method) -> Request -> Client m (NoContentVerb method) # hoistClientMonad :: Proxy m -> Proxy (NoContentVerb method) -> (forall x. mon x -> mon' x) -> Client mon (NoContentVerb method) -> Client mon' (NoContentVerb method) # | |
(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 |
(KnownSymbol sym, ToJSON a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (JordanQuery' sym mods a :> api) Source # | Note: this instances assumes that the Jordan.FromJSON and Jordan.ToJSON instances match. |
Defined in Jordan.Servant.Client.Query type Client m (JordanQuery' sym mods a :> api) # clientWithRoute :: Proxy m -> Proxy (JordanQuery' sym mods a :> api) -> Request -> Client m (JordanQuery' sym mods a :> api) # hoistClientMonad :: Proxy m -> Proxy (JordanQuery' sym mods a :> api) -> (forall x. mon x -> mon' x) -> Client mon (JordanQuery' sym mods a :> api) -> Client mon' (JordanQuery' sym mods a :> api) # | |
(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) # 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) # | |
(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 type Client m (StreamBody' mods framing ctype a :> api) # clientWithRoute :: Proxy m -> Proxy (StreamBody' mods framing ctype a :> api) -> Request -> Client m (StreamBody' mods framing ctype a :> api) # 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) # | |
(KnownSymbol path, HasClient m api) => HasClient m (path :> api) | Make the querying function append |
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 type Client m (RemoteHost :> api) # clientWithRoute :: Proxy m -> Proxy (RemoteHost :> api) -> Request -> Client m (RemoteHost :> api) # hoistClientMonad :: Proxy m -> Proxy (RemoteHost :> api) -> (forall x. mon x -> mon' x) -> Client mon (RemoteHost :> api) -> Client mon' (RemoteHost :> api) # | |
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 type Client m (AuthProtect tag :> api) # clientWithRoute :: Proxy m -> Proxy (AuthProtect tag :> api) -> Request -> Client m (AuthProtect tag :> api) # hoistClientMonad :: Proxy m -> Proxy (AuthProtect tag :> api) -> (forall x. mon x -> mon' x) -> Client mon (AuthProtect tag :> api) -> Client mon' (AuthProtect tag :> api) # | |
(AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api) => HasClient m (Fragment a :> api) | 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 | |
(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) # 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) # | |
(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 type Client m (CaptureAll capture a :> sublayout) # clientWithRoute :: Proxy m -> Proxy (CaptureAll capture a :> sublayout) -> Request -> Client m (CaptureAll capture a :> sublayout) # 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) # | |
(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 | |
HasClient m api => HasClient m (HttpVersion :> api) | Using a |
Defined in Servant.Client.Core.HasClient type Client m (HttpVersion :> api) # clientWithRoute :: Proxy m -> Proxy (HttpVersion :> api) -> Request -> Client m (HttpVersion :> api) # hoistClientMonad :: Proxy m -> Proxy (HttpVersion :> api) -> (forall x. mon x -> mon' x) -> Client mon (HttpVersion :> api) -> Client mon' (HttpVersion :> api) # | |
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 type Client m (Description desc :> api) # clientWithRoute :: Proxy m -> Proxy (Description desc :> api) -> Request -> Client m (Description desc :> api) # hoistClientMonad :: Proxy m -> Proxy (Description desc :> api) -> (forall x. mon x -> mon' x) -> Client mon (Description desc :> api) -> Client mon' (Description desc :> api) # | |
(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 type Client m (QueryParam' mods sym a :> api) # clientWithRoute :: Proxy m -> Proxy (QueryParam' mods sym a :> api) -> Request -> Client m (QueryParam' mods sym a :> api) # 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) # | |
(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 type Client m (QueryParams sym a :> api) # clientWithRoute :: Proxy m -> Proxy (QueryParams sym a :> api) -> Request -> Client m (QueryParams sym a :> api) # 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) # | |
(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 | |
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) # 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) # | |
(RunClient m, TypeError (PartialApplication HasClient arr) :: Constraint) => HasClient m (arr :> sub) | |
(RunClient m, TypeError (NoInstanceForSub (HasClient m) ty) :: Constraint) => HasClient m (ty :> sub) | |
(ToJSON a, HasClient m api) => HasClient m (ReportingRequestBody a :> api) Source # | Note: This instance assumes that the |
Defined in Jordan.Servant.Client type Client m (ReportingRequestBody a :> api) # clientWithRoute :: Proxy m -> Proxy (ReportingRequestBody a :> api) -> Request -> Client m (ReportingRequestBody a :> api) # hoistClientMonad :: Proxy m -> Proxy (ReportingRequestBody a :> api) -> (forall x. mon x -> mon' x) -> Client mon (ReportingRequestBody a :> api) -> Client mon' (ReportingRequestBody a :> api) # | |
HasClient m subapi => HasClient m (WithNamedContext name context subapi) | |
Defined in Servant.Client.Core.HasClient type Client m (WithNamedContext name context subapi) # clientWithRoute :: Proxy m -> Proxy (WithNamedContext name context subapi) -> Request -> Client m (WithNamedContext name context subapi) # 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) # | |
(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) | |
Defined in Servant.Client.Core.HasClient clientWithRoute :: Proxy m -> Proxy (UVerb method contentTypes as) -> Request -> Client m (UVerb method contentTypes as) # 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) # | |
(RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), KnownNat status) => HasClient m (Verb method status cts' a) | |
Defined in Servant.Client.Core.HasClient | |
(RunClient m, ReflectMethod method, KnownNat status) => 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) # 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) # | |
(RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status, 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)) # 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)) # | |
(RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status) => 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)) # 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)) # | |
(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) # 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) # | |
(RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, FramingUnrender framing, FromSourceIO chunk a, BuildHeadersTo hs) => HasClient m (Stream method status framing ct (Headers hs a)) | |
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)) # 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)) # |
data JordanQuery' (baseStr :: Symbol) (options :: [Type]) a #
A query argument at some key, that will be parsed via Jordan. If the query needs to contain nested data, it will all be nested under the same key.
We do not support lenient queries as figuring out what to return in the case where the Jordan parser would have parsed nested keys is too difficult.
Note: this type *does not* have a HasLink
instance, because unfortunately Servant is way too restrictive of what it exports,
making such an instance impossible to write. I will open up a PR against Servant to fix this soon.
Instances
(KnownSymbol sym, ToJSON a, HasClient m api, SBoolI (FoldRequired mods)) => HasClient m (JordanQuery' sym mods a :> api) Source # | Note: this instances assumes that the Jordan.FromJSON and Jordan.ToJSON instances match. |
Defined in Jordan.Servant.Client.Query type Client m (JordanQuery' sym mods a :> api) # clientWithRoute :: Proxy m -> Proxy (JordanQuery' sym mods a :> api) -> Request -> Client m (JordanQuery' sym mods a :> api) # hoistClientMonad :: Proxy m -> Proxy (JordanQuery' sym mods a :> api) -> (forall x. mon x -> mon' x) -> Client mon (JordanQuery' sym mods a :> api) -> Client mon' (JordanQuery' sym mods a :> api) # | |
type Client m (JordanQuery' sym mods a :> api) Source # | |
Defined in Jordan.Servant.Client.Query |
data ReportingRequestBody a #
A parameter for use with Servant, which lets you parse the request body or report parse errors to the user. It is different from using the existing ReqBody param from Servant in that it will give a detailed report of why the format of the request body was wrong if need be.
This will use parseJSONReporting
for its work.
This is generally a little slower than direct attoparsec parsing, but avoids us having to parse twice.
Instances
Orphan instances
(ToJSON a, HasClient m api) => HasClient m (ReportingRequestBody a :> api) Source # | Note: This instance assumes that the |
type Client m (ReportingRequestBody a :> api) # clientWithRoute :: Proxy m -> Proxy (ReportingRequestBody a :> api) -> Request -> Client m (ReportingRequestBody a :> api) # hoistClientMonad :: Proxy m -> Proxy (ReportingRequestBody a :> api) -> (forall x. mon x -> mon' x) -> Client mon (ReportingRequestBody a :> api) -> Client mon' (ReportingRequestBody a :> api) # |