{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module Servant.Client.Core.HasClient (
    clientIn,
    HasClient (..),
    EmptyClient (..),
    foldMapUnion,
    matchUnion,
    ) where

import           Prelude ()
import           Prelude.Compat

import           Control.Arrow
                 (left, (+++))
import           Control.Monad
                 (unless)
import qualified Data.ByteString.Lazy                     as BL
import           Data.Either
                 (partitionEithers)
import           Data.Foldable
                 (toList)
import           Data.List
                 (foldl')
import           Data.Sequence
                 (fromList)
import qualified Data.Text                       as T
import           Network.HTTP.Media
                 (MediaType, matches, parseAccept, (//))
import qualified Data.Sequence as Seq
import           Data.SOP.BasicFunctors
                 (I (I), (:.:) (Comp))
import           Data.SOP.Constraint
                 (All)
import           Data.SOP.NP
                 (NP (..), cpure_NP)
import           Data.SOP.NS
                 (NS (S))
import           Data.String
                 (fromString)
import           Data.Text
                 (Text, pack)
import           Data.Proxy
                 (Proxy (Proxy))
import           GHC.TypeLits
                 (KnownSymbol, symbolVal)
import           Network.HTTP.Types
                 (Status)
import qualified Network.HTTP.Types                       as H
import           Servant.API
                 ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
                 BuildHeadersTo (..), Capture', CaptureAll, Description,
                 EmptyAPI, FramingRender (..), FramingUnrender (..),
                 FromSourceIO (..), Header', Headers (..), HttpVersion,
                 IsSecure, MimeRender (mimeRender),
                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,
                 ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext,
                 contentType, getHeadersHList, getResponse, toQueryParam,
                 toUrlPiece)
import           Servant.API.ContentTypes
                 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
import           Servant.API.Modifiers
                 (FoldRequired, RequiredArgument, foldRequiredArgument)
import           Servant.API.UVerb
                 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)

import           Servant.Client.Core.Auth
import           Servant.Client.Core.BasicAuth
import           Servant.Client.Core.ClientError
import           Servant.Client.Core.Request
import           Servant.Client.Core.Response
import           Servant.Client.Core.RunClient

-- * Accessing APIs as a Client

-- | '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
clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
clientIn :: Proxy api -> Proxy m -> Client m api
clientIn Proxy api
p Proxy m
pm = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm Proxy api
p Request
defaultRequest


-- | 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.
class RunClient m => HasClient m api where
  type Client (m :: * -> *) (api :: *) :: *
  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


-- | A client querying function for @a ':<|>' b@ will actually hand you
--   one function for querying @a@ and another one for querying @b@,
--   stitching them together with ':<|>', which really is just like a pair.
--
-- > 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
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 m -> Proxy (a :<|> b) -> Request -> Client m (a :<|> b)
clientWithRoute Proxy m
pm Proxy (a :<|> b)
Proxy Request
req =
    Proxy m -> Proxy a -> Request -> Client m a
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) Request
req Client m a -> Client m b -> Client m a :<|> Client m b
forall a b. a -> b -> a :<|> b
:<|>
    Proxy m -> Proxy b -> Request -> Client m b
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) Request
req

  hoistClientMonad :: Proxy m
-> Proxy (a :<|> b)
-> (forall x. mon x -> mon' x)
-> Client mon (a :<|> b)
-> Client mon' (a :<|> b)
hoistClientMonad Proxy m
pm Proxy (a :<|> b)
_ forall x. mon x -> mon' x
f (ca :<|> cb) =
    Proxy m
-> Proxy a
-> (forall x. mon x -> mon' x)
-> Client mon a
-> Client mon' a
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) forall x. mon x -> mon' x
f Client mon a
ca Client mon' a -> Client mon' b -> Client mon' a :<|> Client mon' b
forall a b. a -> b -> a :<|> b
:<|>
    Proxy m
-> Proxy b
-> (forall x. mon x -> mon' x)
-> Client mon b
-> Client mon' b
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) forall x. mon x -> mon' x
f Client mon b
cb

-- | Singleton type representing a client for an empty API.
data EmptyClient = EmptyClient deriving (EmptyClient -> EmptyClient -> Bool
(EmptyClient -> EmptyClient -> Bool)
-> (EmptyClient -> EmptyClient -> Bool) -> Eq EmptyClient
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyClient -> EmptyClient -> Bool
$c/= :: EmptyClient -> EmptyClient -> Bool
== :: EmptyClient -> EmptyClient -> Bool
$c== :: EmptyClient -> EmptyClient -> Bool
Eq, Int -> EmptyClient -> ShowS
[EmptyClient] -> ShowS
EmptyClient -> String
(Int -> EmptyClient -> ShowS)
-> (EmptyClient -> String)
-> ([EmptyClient] -> ShowS)
-> Show EmptyClient
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyClient] -> ShowS
$cshowList :: [EmptyClient] -> ShowS
show :: EmptyClient -> String
$cshow :: EmptyClient -> String
showsPrec :: Int -> EmptyClient -> ShowS
$cshowsPrec :: Int -> EmptyClient -> ShowS
Show, EmptyClient
EmptyClient -> EmptyClient -> Bounded EmptyClient
forall a. a -> a -> Bounded a
maxBound :: EmptyClient
$cmaxBound :: EmptyClient
minBound :: EmptyClient
$cminBound :: EmptyClient
Bounded, Int -> EmptyClient
EmptyClient -> Int
EmptyClient -> [EmptyClient]
EmptyClient -> EmptyClient
EmptyClient -> EmptyClient -> [EmptyClient]
EmptyClient -> EmptyClient -> EmptyClient -> [EmptyClient]
(EmptyClient -> EmptyClient)
-> (EmptyClient -> EmptyClient)
-> (Int -> EmptyClient)
-> (EmptyClient -> Int)
-> (EmptyClient -> [EmptyClient])
-> (EmptyClient -> EmptyClient -> [EmptyClient])
-> (EmptyClient -> EmptyClient -> [EmptyClient])
-> (EmptyClient -> EmptyClient -> EmptyClient -> [EmptyClient])
-> Enum EmptyClient
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EmptyClient -> EmptyClient -> EmptyClient -> [EmptyClient]
$cenumFromThenTo :: EmptyClient -> EmptyClient -> EmptyClient -> [EmptyClient]
enumFromTo :: EmptyClient -> EmptyClient -> [EmptyClient]
$cenumFromTo :: EmptyClient -> EmptyClient -> [EmptyClient]
enumFromThen :: EmptyClient -> EmptyClient -> [EmptyClient]
$cenumFromThen :: EmptyClient -> EmptyClient -> [EmptyClient]
enumFrom :: EmptyClient -> [EmptyClient]
$cenumFrom :: EmptyClient -> [EmptyClient]
fromEnum :: EmptyClient -> Int
$cfromEnum :: EmptyClient -> Int
toEnum :: Int -> EmptyClient
$ctoEnum :: Int -> EmptyClient
pred :: EmptyClient -> EmptyClient
$cpred :: EmptyClient -> EmptyClient
succ :: EmptyClient -> EmptyClient
$csucc :: EmptyClient -> EmptyClient
Enum)

-- | The client for 'EmptyAPI' is simply 'EmptyClient'.
--
-- > type MyAPI = "books" :> Get '[JSON] [Book] -- GET /books
-- >         :<|> "nothing" :> EmptyAPI
-- >
-- > myApi :: Proxy MyApi
-- > myApi = Proxy
-- >
-- > getAllBooks :: ClientM [Book]
-- > (getAllBooks :<|> EmptyClient) = client myApi
instance RunClient m => HasClient m EmptyAPI where
  type Client m EmptyAPI = EmptyClient
  clientWithRoute :: Proxy m -> Proxy EmptyAPI -> Request -> Client m EmptyAPI
clientWithRoute Proxy m
_pm Proxy EmptyAPI
Proxy Request
_ = EmptyClient
Client m EmptyAPI
EmptyClient
  hoistClientMonad :: Proxy m
-> Proxy EmptyAPI
-> (forall x. mon x -> mon' x)
-> Client mon EmptyAPI
-> Client mon' EmptyAPI
hoistClientMonad Proxy m
_ Proxy EmptyAPI
_ forall x. mon x -> mon' x
_ Client mon EmptyAPI
EmptyClient = EmptyClient
Client mon' EmptyAPI
EmptyClient

-- | If you use a 'Capture' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'Capture'.
-- That function will take care of inserting a textual representation
-- of this value at the right place in the request path.
--
-- You can control how values for this type are turned into
-- text by specifying a 'ToHttpApiData' instance for your type.
--
-- 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
instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
      => HasClient m (Capture' mods capture a :> api) where

  type Client m (Capture' mods capture a :> api) =
    a -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (Capture' mods capture a :> api)
-> Request
-> Client m (Capture' mods capture a :> api)
clientWithRoute Proxy m
pm Proxy (Capture' mods capture a :> api)
Proxy Request
req a
val =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
                    (Text -> Request -> Request
appendToPath Text
p Request
req)

    where p :: Text
p = (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece a
val)

  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)
hoistClientMonad Proxy m
pm Proxy (Capture' mods capture a :> api)
_ forall x. mon x -> mon' x
f Client mon (Capture' mods capture a :> api)
cl = \a
a ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (Capture' mods capture a :> api)
a -> Client mon api
cl a
a)

-- | If you use a 'CaptureAll' in one of your endpoints in your API,
-- the corresponding querying function will automatically take an
-- additional argument of a list of the type specified by your
-- 'CaptureAll'. That function will take care of inserting a textual
-- representation of this value at the right place in the request
-- path.
--
-- You can control how these values are turned into text by specifying
-- a 'ToHttpApiData' instance of your type.
--
-- 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
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 m
-> Proxy (CaptureAll capture a :> sublayout)
-> Request
-> Client m (CaptureAll capture a :> sublayout)
clientWithRoute Proxy m
pm Proxy (CaptureAll capture a :> sublayout)
Proxy Request
req [a]
vals =
    Proxy m -> Proxy sublayout -> Request -> Client m sublayout
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout)
                    ((Request -> Text -> Request) -> Request -> [Text] -> Request
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((Text -> Request -> Request) -> Request -> Text -> Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Request -> Request
appendToPath) Request
req [Text]
ps)

    where ps :: [Text]
ps = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Text
forall a. ToHttpApiData a => a -> Text
toUrlPiece) [a]
vals

  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)
hoistClientMonad Proxy m
pm Proxy (CaptureAll capture a :> sublayout)
_ forall x. mon x -> mon' x
f Client mon (CaptureAll capture a :> sublayout)
cl = \[a]
as ->
    Proxy m
-> Proxy sublayout
-> (forall x. mon x -> mon' x)
-> Client mon sublayout
-> Client mon' sublayout
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) forall x. mon x -> mon' x
f (Client mon (CaptureAll capture a :> sublayout)
[a] -> Client mon sublayout
cl [a]
as)

instance {-# OVERLAPPABLE #-}
  -- Note [Non-Empty Content Types]
  ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
  ) => HasClient m (Verb method status cts' a) where
  type Client m (Verb method status cts' a) = m a
  clientWithRoute :: Proxy m
-> Proxy (Verb method status cts' a)
-> Request
-> Client m (Verb method status cts' a)
clientWithRoute Proxy m
_pm Proxy (Verb method status cts' a)
Proxy Request
req = do
    Response
response <- Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req
      { requestAccept :: Seq MediaType
requestAccept = [MediaType] -> Seq MediaType
forall a. [a] -> Seq a
fromList ([MediaType] -> Seq MediaType) -> [MediaType] -> Seq MediaType
forall a b. (a -> b) -> a -> b
$ NonEmpty MediaType -> [MediaType]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty MediaType
accept
      , requestMethod :: Method
requestMethod = Method
method
      }
    Response
response Response -> Proxy ct -> m a
forall k (ct :: k) a (m :: * -> *).
(MimeUnrender ct a, RunClient m) =>
Response -> Proxy ct -> m a
`decodedAs` (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)
    where
      accept :: NonEmpty MediaType
accept = Proxy ct -> NonEmpty MediaType
forall k (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)
      method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)

  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)
hoistClientMonad Proxy m
_ Proxy (Verb method status cts' a)
_ forall x. mon x -> mon' x
f Client mon (Verb method status cts' a)
ma = mon a -> mon' a
forall x. mon x -> mon' x
f mon a
Client mon (Verb method status cts' a)
ma

instance {-# OVERLAPPING #-}
  ( RunClient m, ReflectMethod method
  ) => HasClient m (Verb method status cts NoContent) where
  type Client m (Verb method status cts NoContent)
    = m NoContent
  clientWithRoute :: Proxy m
-> Proxy (Verb method status cts NoContent)
-> Request
-> Client m (Verb method status cts NoContent)
clientWithRoute Proxy m
_pm Proxy (Verb method status cts NoContent)
Proxy Request
req = do
    Response
_response <- Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req { requestMethod :: Method
requestMethod = Method
method }
    NoContent -> m NoContent
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
      where method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)

  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)
hoistClientMonad Proxy m
_ Proxy (Verb method status cts NoContent)
_ forall x. mon x -> mon' x
f Client mon (Verb method status cts NoContent)
ma = mon NoContent -> mon' NoContent
forall x. mon x -> mon' x
f mon NoContent
Client mon (Verb method status cts NoContent)
ma

instance (RunClient m, ReflectMethod method) =>
         HasClient m (NoContentVerb method) where
  type Client m (NoContentVerb method)
    = m NoContent
  clientWithRoute :: Proxy m
-> Proxy (NoContentVerb method)
-> Request
-> Client m (NoContentVerb method)
clientWithRoute Proxy m
_pm Proxy (NoContentVerb method)
Proxy Request
req = do
    Response
_response <- Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req { requestMethod :: Method
requestMethod = Method
method }
    NoContent -> m NoContent
forall (m :: * -> *) a. Monad m => a -> m a
return NoContent
NoContent
      where method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)

  hoistClientMonad :: Proxy m
-> Proxy (NoContentVerb method)
-> (forall x. mon x -> mon' x)
-> Client mon (NoContentVerb method)
-> Client mon' (NoContentVerb method)
hoistClientMonad Proxy m
_ Proxy (NoContentVerb method)
_ forall x. mon x -> mon' x
f Client mon (NoContentVerb method)
ma = mon NoContent -> mon' NoContent
forall x. mon x -> mon' x
f mon NoContent
Client mon (NoContentVerb method)
ma

instance {-# OVERLAPPING #-}
  -- Note [Non-Empty Content Types]
  ( RunClient m, 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 m
-> Proxy (Verb method status cts' (Headers ls a))
-> Request
-> Client m (Verb method status cts' (Headers ls a))
clientWithRoute Proxy m
_pm Proxy (Verb method status cts' (Headers ls a))
Proxy Request
req = do
    Response
response <- Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req
       { requestMethod :: Method
requestMethod = Method
method
       , requestAccept :: Seq MediaType
requestAccept = [MediaType] -> Seq MediaType
forall a. [a] -> Seq a
fromList ([MediaType] -> Seq MediaType) -> [MediaType] -> Seq MediaType
forall a b. (a -> b) -> a -> b
$ NonEmpty MediaType -> [MediaType]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty MediaType
accept
       }
    a
val <- Response
response Response -> Proxy ct -> m a
forall k (ct :: k) a (m :: * -> *).
(MimeUnrender ct a, RunClient m) =>
Response -> Proxy ct -> m a
`decodedAs` (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)
    Headers ls a -> m (Headers ls a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Headers ls a -> m (Headers ls a))
-> Headers ls a -> m (Headers ls a)
forall a b. (a -> b) -> a -> b
$ Headers :: forall (ls :: [*]) a. a -> HList ls -> Headers ls a
Headers { getResponse :: a
getResponse = a
val
                     , getHeadersHList :: HList ls
getHeadersHList = [Header] -> HList ls
forall (hs :: [*]). BuildHeadersTo hs => [Header] -> HList hs
buildHeadersTo ([Header] -> HList ls)
-> (Seq Header -> [Header]) -> Seq Header -> HList ls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Header -> [Header]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Header -> HList ls) -> Seq Header -> HList ls
forall a b. (a -> b) -> a -> b
$ Response -> Seq Header
forall a. ResponseF a -> Seq Header
responseHeaders Response
response
                     }
      where method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
            accept :: NonEmpty MediaType
accept = Proxy ct -> NonEmpty MediaType
forall k (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)

  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))
hoistClientMonad Proxy m
_ Proxy (Verb method status cts' (Headers ls a))
_ forall x. mon x -> mon' x
f Client mon (Verb method status cts' (Headers ls a))
ma = mon (Headers ls a) -> mon' (Headers ls a)
forall x. mon x -> mon' x
f mon (Headers ls a)
Client mon (Verb method status cts' (Headers ls a))
ma

instance {-# OVERLAPPING #-}
  ( RunClient m, 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 m
-> Proxy (Verb method status cts (Headers ls NoContent))
-> Request
-> Client m (Verb method status cts (Headers ls NoContent))
clientWithRoute Proxy m
_pm Proxy (Verb method status cts (Headers ls NoContent))
Proxy Request
req = do
    let method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
    Response
response <- Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req { requestMethod :: Method
requestMethod = Method
method }
    Headers ls NoContent -> m (Headers ls NoContent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Headers ls NoContent -> m (Headers ls NoContent))
-> Headers ls NoContent -> m (Headers ls NoContent)
forall a b. (a -> b) -> a -> b
$ Headers :: forall (ls :: [*]) a. a -> HList ls -> Headers ls a
Headers { getResponse :: NoContent
getResponse = NoContent
NoContent
                     , getHeadersHList :: HList ls
getHeadersHList = [Header] -> HList ls
forall (hs :: [*]). BuildHeadersTo hs => [Header] -> HList hs
buildHeadersTo ([Header] -> HList ls)
-> (Seq Header -> [Header]) -> Seq Header -> HList ls
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Header -> [Header]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Header -> HList ls) -> Seq Header -> HList ls
forall a b. (a -> b) -> a -> b
$ Response -> Seq Header
forall a. ResponseF a -> Seq Header
responseHeaders Response
response
                     }

  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))
hoistClientMonad Proxy m
_ Proxy (Verb method status cts (Headers ls NoContent))
_ forall x. mon x -> mon' x
f Client mon (Verb method status cts (Headers ls NoContent))
ma = mon (Headers ls NoContent) -> mon' (Headers ls NoContent)
forall x. mon x -> mon' x
f mon (Headers ls NoContent)
Client mon (Verb method status cts (Headers ls NoContent))
ma

data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
  deriving (ClientParseError -> ClientParseError -> Bool
(ClientParseError -> ClientParseError -> Bool)
-> (ClientParseError -> ClientParseError -> Bool)
-> Eq ClientParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientParseError -> ClientParseError -> Bool
$c/= :: ClientParseError -> ClientParseError -> Bool
== :: ClientParseError -> ClientParseError -> Bool
$c== :: ClientParseError -> ClientParseError -> Bool
Eq, Int -> ClientParseError -> ShowS
[ClientParseError] -> ShowS
ClientParseError -> String
(Int -> ClientParseError -> ShowS)
-> (ClientParseError -> String)
-> ([ClientParseError] -> ShowS)
-> Show ClientParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientParseError] -> ShowS
$cshowList :: [ClientParseError] -> ShowS
show :: ClientParseError -> String
$cshow :: ClientParseError -> String
showsPrec :: Int -> ClientParseError -> ShowS
$cshowsPrec :: Int -> ClientParseError -> ShowS
Show)

instance {-# OVERLAPPING #-}
  ( RunClient m,
    contentTypes ~ (contentType ': otherContentTypes),
    -- ('otherContentTypes' should be '_', but even -XPartialTypeSignatures does not seem
    -- allow this in instance types as of 8.8.3.)
    as ~ (a ': as'),
    AllMime contentTypes,
    ReflectMethod method,
    All (AllMimeUnrender contentTypes) as,
    All HasStatus as, HasStatuses as',
    Unique (Statuses as)
  ) =>
  HasClient m (UVerb method contentTypes as)
  where
  type Client m (UVerb method contentTypes as) = m (Union as)

  clientWithRoute :: Proxy m
-> Proxy (UVerb method contentTypes as)
-> Request
-> Client m (UVerb method contentTypes as)
clientWithRoute Proxy m
_ Proxy (UVerb method contentTypes as)
_ Request
request = do
    let accept :: Seq MediaType
accept = [MediaType] -> Seq MediaType
forall a. [a] -> Seq a
Seq.fromList ([MediaType] -> Seq MediaType)
-> (Proxy contentTypes -> [MediaType])
-> Proxy contentTypes
-> Seq MediaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy contentTypes -> [MediaType]
forall (list :: [*]). AllMime list => Proxy list -> [MediaType]
allMime (Proxy contentTypes -> Seq MediaType)
-> Proxy contentTypes -> Seq MediaType
forall a b. (a -> b) -> a -> b
$ Proxy contentTypes
forall k (t :: k). Proxy t
Proxy @contentTypes
        -- offering to accept all mime types listed in the api gives best compatibility.  eg.,
        -- we might not own the server implementation, and the server may choose to support
        -- only part of the api.

        method :: Method
method = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method -> Method) -> Proxy method -> Method
forall a b. (a -> b) -> a -> b
$ Proxy method
forall k (t :: k). Proxy t
Proxy @method
        acceptStatus :: [Status]
acceptStatus = Proxy as -> [Status]
forall (as :: [*]). HasStatuses as => Proxy as -> [Status]
statuses (Proxy as
forall k (t :: k). Proxy t
Proxy @as)
    Response
response <- Maybe [Status] -> Request -> m Response
forall (m :: * -> *).
RunClient m =>
Maybe [Status] -> Request -> m Response
runRequestAcceptStatus ([Status] -> Maybe [Status]
forall a. a -> Maybe a
Just [Status]
acceptStatus) Request
request {requestMethod :: Method
requestMethod = Method
method, requestAccept :: Seq MediaType
requestAccept = Seq MediaType
accept}
    MediaType
responseContentType <- Response -> m MediaType
forall (m :: * -> *). RunClient m => Response -> m MediaType
checkContentTypeHeader Response
response
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((MediaType -> Bool) -> Seq MediaType -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MediaType -> MediaType -> Bool
forall a. Accept a => a -> a -> Bool
matches MediaType
responseContentType) Seq MediaType
accept) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      ClientError -> m ()
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> m ()) -> ClientError -> m ()
forall a b. (a -> b) -> a -> b
$ MediaType -> Response -> ClientError
UnsupportedContentType MediaType
responseContentType Response
response

    let status :: Status
status = Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
response
        body :: ByteString
body = Response -> ByteString
forall a. ResponseF a -> a
responseBody Response
response
        res :: Either [ClientParseError] (Union (a : as'))
res = Status
-> NP ([] :.: Either (MediaType, String)) (a : as')
-> Either [ClientParseError] (Union (a : as'))
forall (xs :: [*]).
All HasStatus xs =>
Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
tryParsers Status
status (NP ([] :.: Either (MediaType, String)) (a : as')
 -> Either [ClientParseError] (Union (a : as')))
-> NP ([] :.: Either (MediaType, String)) (a : as')
-> Either [ClientParseError] (Union (a : as'))
forall a b. (a -> b) -> a -> b
$ Proxy contentTypes
-> ByteString -> NP ([] :.: Either (MediaType, String)) (a : as')
forall (cts :: [*]) (xs :: [*]).
All (AllMimeUnrender cts) xs =>
Proxy cts
-> ByteString -> NP ([] :.: Either (MediaType, String)) xs
mimeUnrenders (Proxy contentTypes
forall k (t :: k). Proxy t
Proxy @contentTypes) ByteString
body
    case Either [ClientParseError] (Union (a : as'))
res of
      Left [ClientParseError]
errors -> ClientError -> m (Union (a : as'))
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> m (Union (a : as')))
-> ClientError -> m (Union (a : as'))
forall a b. (a -> b) -> a -> b
$ Text -> Response -> ClientError
DecodeFailure (String -> Text
T.pack ([ClientParseError] -> String
forall a. Show a => a -> String
show [ClientParseError]
errors)) Response
response
      Right Union (a : as')
x -> Union (a : as') -> m (Union (a : as'))
forall (m :: * -> *) a. Monad m => a -> m a
return Union (a : as')
x
    where
      -- | Given a list of parsers of 'mkres', returns the first one that succeeds and all the
      -- failures it encountered along the way
      -- TODO; better name, rewrite haddocs.
      tryParsers :: forall xs. All HasStatus xs => Status -> NP ([] :.: Either (MediaType, String)) xs -> Either [ClientParseError] (Union xs)
      tryParsers :: Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
tryParsers Status
_ NP ([] :.: Either (MediaType, String)) xs
Nil = [ClientParseError] -> Either [ClientParseError] (Union xs)
forall a b. a -> Either a b
Left [ClientParseError
ClientNoMatchingStatus]
      tryParsers Status
status (Comp [Either (MediaType, String) x]
x :* NP ([] :.: Either (MediaType, String)) xs
xs)
        | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== (:.:) [] (Either (MediaType, String)) x -> Status
forall a (proxy :: * -> *). HasStatus a => proxy a -> Status
statusOf ([Either (MediaType, String) x]
-> (:.:) [] (Either (MediaType, String)) x
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp [Either (MediaType, String) x]
x) =
          case [Either (MediaType, String) x] -> ([(MediaType, String)], [x])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either (MediaType, String) x]
x of
            ([(MediaType, String)]
err', []) -> (((MediaType, String) -> ClientParseError)
-> [(MediaType, String)] -> [ClientParseError]
forall a b. (a -> b) -> [a] -> [b]
map ((MediaType -> String -> ClientParseError)
-> (MediaType, String) -> ClientParseError
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MediaType -> String -> ClientParseError
ClientParseError) [(MediaType, String)]
err' [ClientParseError] -> [ClientParseError] -> [ClientParseError]
forall a. [a] -> [a] -> [a]
++) ([ClientParseError] -> [ClientParseError])
-> (Union xs -> NS I (x : xs))
-> Either [ClientParseError] (Union xs)
-> Either [ClientParseError] (NS I (x : xs))
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Union xs -> NS I (x : xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (Either [ClientParseError] (Union xs)
 -> Either [ClientParseError] (Union xs))
-> Either [ClientParseError] (Union xs)
-> Either [ClientParseError] (Union xs)
forall a b. (a -> b) -> a -> b
$ Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
forall (xs :: [*]).
All HasStatus xs =>
Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
tryParsers Status
status NP ([] :.: Either (MediaType, String)) xs
xs
            ([(MediaType, String)]
_, (x
res : [x]
_)) -> Union xs -> Either [ClientParseError] (Union xs)
forall a b. b -> Either a b
Right (Union xs -> Either [ClientParseError] (Union xs))
-> (x -> Union xs) -> x -> Either [ClientParseError] (Union xs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. I x -> Union xs
forall k (x :: k) (xs :: [k]) (f :: k -> *).
UElem x xs =>
f x -> NS f xs
inject (I x -> Union xs) -> (x -> I x) -> x -> Union xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> I x
forall a. a -> I a
I (x -> Either [ClientParseError] (Union xs))
-> x -> Either [ClientParseError] (Union xs)
forall a b. (a -> b) -> a -> b
$ x
res
        | Bool
otherwise = -- no reason to parse in the first place. This ain't the one we're looking for
          (ClientParseError
ClientStatusMismatch ClientParseError -> [ClientParseError] -> [ClientParseError]
forall a. a -> [a] -> [a]
:) ([ClientParseError] -> [ClientParseError])
-> (Union xs -> NS I (x : xs))
-> Either [ClientParseError] (Union xs)
-> Either [ClientParseError] (NS I (x : xs))
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
+++ Union xs -> NS I (x : xs)
forall k (a :: k -> *) (xs :: [k]) (x :: k).
NS a xs -> NS a (x : xs)
S (Either [ClientParseError] (Union xs)
 -> Either [ClientParseError] (Union xs))
-> Either [ClientParseError] (Union xs)
-> Either [ClientParseError] (Union xs)
forall a b. (a -> b) -> a -> b
$ Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
forall (xs :: [*]).
All HasStatus xs =>
Status
-> NP ([] :.: Either (MediaType, String)) xs
-> Either [ClientParseError] (Union xs)
tryParsers Status
status NP ([] :.: Either (MediaType, String)) xs
xs

      -- | Given a list of types, parses the given response body as each type
      mimeUnrenders ::
        forall cts xs.
        All (AllMimeUnrender cts) xs =>
        Proxy cts ->
        BL.ByteString ->
        NP ([] :.: Either (MediaType, String)) xs
      mimeUnrenders :: Proxy cts
-> ByteString -> NP ([] :.: Either (MediaType, String)) xs
mimeUnrenders Proxy cts
ctp ByteString
body = Proxy (AllMimeUnrender cts)
-> (forall a.
    AllMimeUnrender cts a =>
    (:.:) [] (Either (MediaType, String)) a)
-> NP ([] :.: Either (MediaType, String)) xs
forall k (c :: k -> Constraint) (xs :: [k])
       (proxy :: (k -> Constraint) -> *) (f :: k -> *).
All c xs =>
proxy c -> (forall (a :: k). c a => f a) -> NP f xs
cpure_NP
        (Proxy (AllMimeUnrender cts)
forall k (t :: k). Proxy t
Proxy @(AllMimeUnrender cts))
        ([Either (MediaType, String) a]
-> (:.:) [] (Either (MediaType, String)) a
forall l k (f :: l -> *) (g :: k -> l) (p :: k).
f (g p) -> (:.:) f g p
Comp ([Either (MediaType, String) a]
 -> (:.:) [] (Either (MediaType, String)) a)
-> (Proxy cts -> [Either (MediaType, String) a])
-> Proxy cts
-> (:.:) [] (Either (MediaType, String)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((MediaType, ByteString -> Either String a)
 -> Either (MediaType, String) a)
-> [(MediaType, ByteString -> Either String a)]
-> [Either (MediaType, String) a]
forall a b. (a -> b) -> [a] -> [b]
map (\(MediaType
mediaType, ByteString -> Either String a
parser) -> (String -> (MediaType, String))
-> Either String a -> Either (MediaType, String) a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((,) MediaType
mediaType) (ByteString -> Either String a
parser ByteString
body)) ([(MediaType, ByteString -> Either String a)]
 -> [Either (MediaType, String) a])
-> (Proxy cts -> [(MediaType, ByteString -> Either String a)])
-> Proxy cts
-> [Either (MediaType, String) a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy cts -> [(MediaType, ByteString -> Either String a)]
forall (list :: [*]) a.
AllMimeUnrender list a =>
Proxy list -> [(MediaType, ByteString -> Either String a)]
allMimeUnrender (Proxy cts -> (:.:) [] (Either (MediaType, String)) a)
-> Proxy cts -> (:.:) [] (Either (MediaType, String)) a
forall a b. (a -> b) -> a -> b
$ Proxy cts
ctp)

  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)
hoistClientMonad Proxy m
_ Proxy (UVerb method contentTypes as)
_ forall x. mon x -> mon' x
nt Client mon (UVerb method contentTypes as)
s = mon (Union (a : as')) -> mon' (Union (a : as'))
forall x. mon x -> mon' x
nt mon (Union (a : as'))
Client mon (UVerb method contentTypes as)
s

instance {-# OVERLAPPABLE #-}
  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
    FramingUnrender framing, FromSourceIO chunk a
  ) => HasClient m (Stream method status framing ct a) where

  type Client m (Stream method status framing ct a) = m 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)
hoistClientMonad Proxy m
_ Proxy (Stream method status framing ct a)
_ forall x. mon x -> mon' x
f Client mon (Stream method status framing ct a)
ma = mon a -> mon' a
forall x. mon x -> mon' x
f mon a
Client mon (Stream method status framing ct a)
ma

  clientWithRoute :: Proxy m
-> Proxy (Stream method status framing ct a)
-> Request
-> Client m (Stream method status framing ct a)
clientWithRoute Proxy m
_pm Proxy (Stream method status framing ct a)
Proxy Request
req = Request -> (StreamingResponse -> IO a) -> m a
forall (m :: * -> *) a.
RunStreamingClient m =>
Request -> (StreamingResponse -> IO a) -> m a
withStreamingRequest Request
req' ((StreamingResponse -> IO a) -> m a)
-> (StreamingResponse -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \StreamingResponse
gres -> do
      let mimeUnrender' :: ByteString -> Either String chunk
mimeUnrender'    = Proxy ct -> ByteString -> Either String chunk
forall k (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
          framingUnrender' :: SourceT IO Method -> SourceT IO chunk
framingUnrender' = Proxy framing
-> (ByteString -> Either String chunk)
-> SourceT IO Method
-> SourceT IO chunk
forall k (strategy :: k) (m :: * -> *) a.
(FramingUnrender strategy, Monad m) =>
Proxy strategy
-> (ByteString -> Either String a)
-> SourceT m Method
-> SourceT m a
framingUnrender (Proxy framing
forall k (t :: k). Proxy t
Proxy :: Proxy framing) ByteString -> Either String chunk
mimeUnrender'
      a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ SourceT IO chunk -> a
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> a
fromSourceIO (SourceT IO chunk -> a) -> SourceT IO chunk -> a
forall a b. (a -> b) -> a -> b
$ SourceT IO Method -> SourceT IO chunk
framingUnrender' (SourceT IO Method -> SourceT IO chunk)
-> SourceT IO Method -> SourceT IO chunk
forall a b. (a -> b) -> a -> b
$ StreamingResponse -> SourceT IO Method
forall a. ResponseF a -> a
responseBody StreamingResponse
gres
    where
      req' :: Request
req' = Request
req
          { requestAccept :: Seq MediaType
requestAccept = [MediaType] -> Seq MediaType
forall a. [a] -> Seq a
fromList [Proxy ct -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)]
          , requestMethod :: Method
requestMethod = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
          }

instance {-# OVERLAPPING #-}
  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
    FramingUnrender framing, FromSourceIO chunk a,
    BuildHeadersTo hs
  ) => HasClient m (Stream method status framing ct (Headers hs a)) where

  type Client m (Stream method status framing ct (Headers hs a)) = m (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))
hoistClientMonad Proxy m
_ Proxy (Stream method status framing ct (Headers hs a))
_ forall x. mon x -> mon' x
f Client mon (Stream method status framing ct (Headers hs a))
ma = mon (Headers hs a) -> mon' (Headers hs a)
forall x. mon x -> mon' x
f mon (Headers hs a)
Client mon (Stream method status framing ct (Headers hs a))
ma

  clientWithRoute :: Proxy m
-> Proxy (Stream method status framing ct (Headers hs a))
-> Request
-> Client m (Stream method status framing ct (Headers hs a))
clientWithRoute Proxy m
_pm Proxy (Stream method status framing ct (Headers hs a))
Proxy Request
req = Request
-> (StreamingResponse -> IO (Headers hs a)) -> m (Headers hs a)
forall (m :: * -> *) a.
RunStreamingClient m =>
Request -> (StreamingResponse -> IO a) -> m a
withStreamingRequest Request
req' ((StreamingResponse -> IO (Headers hs a)) -> m (Headers hs a))
-> (StreamingResponse -> IO (Headers hs a)) -> m (Headers hs a)
forall a b. (a -> b) -> a -> b
$ \StreamingResponse
gres -> do
      let mimeUnrender' :: ByteString -> Either String chunk
mimeUnrender'    = Proxy ct -> ByteString -> Either String chunk
forall k (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
          framingUnrender' :: SourceT IO Method -> SourceT IO chunk
framingUnrender' = Proxy framing
-> (ByteString -> Either String chunk)
-> SourceT IO Method
-> SourceT IO chunk
forall k (strategy :: k) (m :: * -> *) a.
(FramingUnrender strategy, Monad m) =>
Proxy strategy
-> (ByteString -> Either String a)
-> SourceT m Method
-> SourceT m a
framingUnrender (Proxy framing
forall k (t :: k). Proxy t
Proxy :: Proxy framing) ByteString -> Either String chunk
mimeUnrender'
          val :: a
val = SourceT IO chunk -> a
forall chunk a. FromSourceIO chunk a => SourceIO chunk -> a
fromSourceIO (SourceT IO chunk -> a) -> SourceT IO chunk -> a
forall a b. (a -> b) -> a -> b
$ SourceT IO Method -> SourceT IO chunk
framingUnrender' (SourceT IO Method -> SourceT IO chunk)
-> SourceT IO Method -> SourceT IO chunk
forall a b. (a -> b) -> a -> b
$ StreamingResponse -> SourceT IO Method
forall a. ResponseF a -> a
responseBody StreamingResponse
gres
      Headers hs a -> IO (Headers hs a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Headers hs a -> IO (Headers hs a))
-> Headers hs a -> IO (Headers hs a)
forall a b. (a -> b) -> a -> b
$ Headers :: forall (ls :: [*]) a. a -> HList ls -> Headers ls a
Headers
        { getResponse :: a
getResponse = a
val
        , getHeadersHList :: HList hs
getHeadersHList = [Header] -> HList hs
forall (hs :: [*]). BuildHeadersTo hs => [Header] -> HList hs
buildHeadersTo ([Header] -> HList hs)
-> (Seq Header -> [Header]) -> Seq Header -> HList hs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Header -> [Header]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Header -> HList hs) -> Seq Header -> HList hs
forall a b. (a -> b) -> a -> b
$ StreamingResponse -> Seq Header
forall a. ResponseF a -> Seq Header
responseHeaders StreamingResponse
gres
        }

    where
      req' :: Request
req' = Request
req
          { requestAccept :: Seq MediaType
requestAccept = [MediaType] -> Seq MediaType
forall a. [a] -> Seq a
fromList [Proxy ct -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType (Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct)]
          , requestMethod :: Method
requestMethod = Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod (Proxy method
forall k (t :: k). Proxy t
Proxy :: Proxy method)
          }

-- | If you use a 'Header' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'Header',
-- wrapped in Maybe.
--
-- 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 'ToHttpApiData' instance.
--
-- 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
instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
      => HasClient m (Header' mods sym a :> api) where

  type Client m (Header' mods sym a :> api) =
    RequiredArgument mods a -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (Header' mods sym a :> api)
-> Request
-> Client m (Header' mods sym a :> api)
clientWithRoute Proxy m
pm Proxy (Header' mods sym a :> api)
Proxy Request
req If (FoldRequired mods) a (Maybe a)
mval =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$ Proxy mods
-> (a -> Request)
-> (Maybe a -> Request)
-> If (FoldRequired mods) a (Maybe a)
-> Request
forall (mods :: [*]) a r.
SBoolI (FoldRequired mods) =>
Proxy mods
-> (a -> r) -> (Maybe a -> r) -> RequiredArgument mods a -> r
foldRequiredArgument
      (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods) a -> Request
add (Request -> (a -> Request) -> Maybe a -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request
req a -> Request
add) If (FoldRequired mods) a (Maybe a)
mval
    where
      hname :: HeaderName
hname = String -> HeaderName
forall a. IsString a => String -> a
fromString (String -> HeaderName) -> String -> HeaderName
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

      add :: a -> Request
      add :: a -> Request
add a
value = HeaderName -> a -> Request -> Request
forall a. ToHttpApiData a => HeaderName -> a -> Request -> Request
addHeader HeaderName
hname a
value Request
req

  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)
hoistClientMonad Proxy m
pm Proxy (Header' mods sym a :> api)
_ forall x. mon x -> mon' x
f Client mon (Header' mods sym a :> api)
cl = \If (FoldRequired mods) a (Maybe a)
arg ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (Header' mods sym a :> api)
If (FoldRequired mods) a (Maybe a) -> Client mon api
cl If (FoldRequired mods) a (Maybe a)
arg)

-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
-- functions.
instance HasClient m api
  => HasClient m (HttpVersion :> api) where

  type Client m (HttpVersion :> api) =
    Client m api

  clientWithRoute :: Proxy m
-> Proxy (HttpVersion :> api)
-> Request
-> Client m (HttpVersion :> api)
clientWithRoute Proxy m
pm Proxy (HttpVersion :> api)
Proxy =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)

  hoistClientMonad :: Proxy m
-> Proxy (HttpVersion :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (HttpVersion :> api)
-> Client mon' (HttpVersion :> api)
hoistClientMonad Proxy m
pm Proxy (HttpVersion :> api)
_ forall x. mon x -> mon' x
f Client mon (HttpVersion :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (HttpVersion :> api)
cl

-- | Ignore @'Summary'@ in client functions.
instance HasClient m api => HasClient m (Summary desc :> api) where
  type Client m (Summary desc :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (Summary desc :> api)
-> Request
-> Client m (Summary desc :> api)
clientWithRoute Proxy m
pm Proxy (Summary desc :> api)
_ = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)

  hoistClientMonad :: Proxy m
-> Proxy (Summary desc :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (Summary desc :> api)
-> Client mon' (Summary desc :> api)
hoistClientMonad Proxy m
pm Proxy (Summary desc :> api)
_ forall x. mon x -> mon' x
f Client mon (Summary desc :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (Summary desc :> api)
cl

-- | Ignore @'Description'@ in client functions.
instance HasClient m api => HasClient m (Description desc :> api) where
  type Client m (Description desc :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (Description desc :> api)
-> Request
-> Client m (Description desc :> api)
clientWithRoute Proxy m
pm Proxy (Description desc :> api)
_ = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)

  hoistClientMonad :: Proxy m
-> Proxy (Description desc :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (Description desc :> api)
-> Client mon' (Description desc :> api)
hoistClientMonad Proxy m
pm Proxy (Description desc :> api)
_ forall x. mon x -> mon' x
f Client mon (Description desc :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (Description desc :> api)
cl

-- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'QueryParam',
-- enclosed in Maybe.
--
-- If you give Nothing, nothing will be added to the query string.
--
-- If you give a non-'Nothing' value, this function will take care
-- of inserting a textual representation of this value in the query string.
--
-- You can control how values for your type are turned into
-- text by specifying a 'ToHttpApiData' instance for your type.
--
-- 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
instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods))
      => HasClient m (QueryParam' mods sym a :> api) where

  type Client m (QueryParam' mods sym a :> api) =
    RequiredArgument mods a -> Client m api

  -- if mparam = Nothing, we don't add it to the query string
  clientWithRoute :: Proxy m
-> Proxy (QueryParam' mods sym a :> api)
-> Request
-> Client m (QueryParam' mods sym a :> api)
clientWithRoute Proxy m
pm Proxy (QueryParam' mods sym a :> api)
Proxy Request
req If (FoldRequired mods) a (Maybe a)
mparam =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$ Proxy mods
-> (a -> Request)
-> (Maybe a -> Request)
-> If (FoldRequired mods) a (Maybe a)
-> Request
forall (mods :: [*]) a r.
SBoolI (FoldRequired mods) =>
Proxy mods
-> (a -> r) -> (Maybe a -> r) -> RequiredArgument mods a -> r
foldRequiredArgument
      (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods) a -> Request
add (Request -> (a -> Request) -> Maybe a -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request
req a -> Request
add) If (FoldRequired mods) a (Maybe a)
mparam
    where
      add :: a -> Request
      add :: a -> Request
add a
param = Text -> Maybe Text -> Request -> Request
appendToQueryString Text
pname (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam a
param) Request
req

      pname :: Text
      pname :: Text
pname  = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

  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)
hoistClientMonad Proxy m
pm Proxy (QueryParam' mods sym a :> api)
_ forall x. mon x -> mon' x
f Client mon (QueryParam' mods sym a :> api)
cl = \If (FoldRequired mods) a (Maybe a)
arg ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (QueryParam' mods sym a :> api)
If (FoldRequired mods) a (Maybe a) -> Client mon api
cl If (FoldRequired mods) a (Maybe a)
arg)

-- | If you use a 'QueryParams' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument, a list of values of the type specified
-- by your 'QueryParams'.
--
-- 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 'ToHttpApiData' instance for your type.
--
-- 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
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 m
-> Proxy (QueryParams sym a :> api)
-> Request
-> Client m (QueryParams sym a :> api)
clientWithRoute Proxy m
pm Proxy (QueryParams sym a :> api)
Proxy Request
req [a]
paramlist =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
                    ((Request -> Maybe Text -> Request)
-> Request -> [Maybe Text] -> Request
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\ Request
req' -> Request -> (Text -> Request) -> Maybe Text -> Request
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Request
req' ((Maybe Text -> Request -> Request)
-> Request -> Maybe Text -> Request
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Maybe Text -> Request -> Request
appendToQueryString Text
pname) Request
req' (Maybe Text -> Request) -> (Text -> Maybe Text) -> Text -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just))
                            Request
req
                            [Maybe Text]
paramlist'
                    )

    where pname :: Text
pname = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
          paramlist' :: [Maybe Text]
paramlist' = (a -> Maybe Text) -> [a] -> [Maybe Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (a -> Text) -> a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam) [a]
paramlist

  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)
hoistClientMonad Proxy m
pm Proxy (QueryParams sym a :> api)
_ forall x. mon x -> mon' x
f Client mon (QueryParams sym a :> api)
cl = \[a]
as ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (QueryParams sym a :> api)
[a] -> Client mon api
cl [a]
as)

-- | If you use a 'QueryFlag' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional 'Bool' argument.
--
-- If you give 'False', nothing will be added to the query string.
--
-- Otherwise, this function will insert a value-less query string
-- parameter under the name associated to your 'QueryFlag'.
--
-- 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
instance (KnownSymbol sym, HasClient m api)
      => HasClient m (QueryFlag sym :> api) where

  type Client m (QueryFlag sym :> api) =
    Bool -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (QueryFlag sym :> api)
-> Request
-> Client m (QueryFlag sym :> api)
clientWithRoute Proxy m
pm Proxy (QueryFlag sym :> api)
Proxy Request
req Bool
flag =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
                    (if Bool
flag
                       then Text -> Maybe Text -> Request -> Request
appendToQueryString Text
paramname Maybe Text
forall a. Maybe a
Nothing Request
req
                       else Request
req
                    )

    where paramname :: Text
paramname = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)

  hoistClientMonad :: Proxy m
-> Proxy (QueryFlag sym :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (QueryFlag sym :> api)
-> Client mon' (QueryFlag sym :> api)
hoistClientMonad Proxy m
pm Proxy (QueryFlag sym :> api)
_ forall x. mon x -> mon' x
f Client mon (QueryFlag sym :> api)
cl = \Bool
b ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (QueryFlag sym :> api)
Bool -> Client mon api
cl Bool
b)

-- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the full `Response`.
instance RunClient m => HasClient m Raw where
  type Client m Raw
    = H.Method ->  m Response

  clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
  clientWithRoute :: Proxy m -> Proxy Raw -> Request -> Client m Raw
clientWithRoute Proxy m
_pm Proxy Raw
Proxy Request
req Method
httpMethod = do
    Request -> m Response
forall (m :: * -> *). RunClient m => Request -> m Response
runRequest Request
req { requestMethod :: Method
requestMethod = Method
httpMethod }

  hoistClientMonad :: Proxy m
-> Proxy Raw
-> (forall x. mon x -> mon' x)
-> Client mon Raw
-> Client mon' Raw
hoistClientMonad Proxy m
_ Proxy Raw
_ forall x. mon x -> mon' x
f Client mon Raw
cl = \Method
meth -> mon Response -> mon' Response
forall x. mon x -> mon' x
f (Client mon Raw
Method -> mon Response
cl Method
meth)

-- | If you use a 'ReqBody' in one of your endpoints in your API,
-- the corresponding querying function will automatically take
-- an additional argument of the type specified by your 'ReqBody'.
-- That function will take care of encoding this argument as JSON and
-- of using it as the request body.
--
-- All you need is for your type to have a 'ToJSON' instance.
--
-- 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
instance (MimeRender ct a, HasClient m api)
      => HasClient m (ReqBody' mods (ct ': cts) a :> api) where

  type Client m (ReqBody' mods (ct ': cts) a :> api) =
    a -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (ReqBody' mods (ct : cts) a :> api)
-> Request
-> Client m (ReqBody' mods (ct : cts) a :> api)
clientWithRoute Proxy m
pm Proxy (ReqBody' mods (ct : cts) a :> api)
Proxy Request
req a
body =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
                    (let ctProxy :: Proxy ct
ctProxy = Proxy ct
forall k (t :: k). Proxy t
Proxy :: Proxy ct
                     in ByteString -> MediaType -> Request -> Request
setRequestBodyLBS (Proxy ct -> a -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy ct
ctProxy a
body)
                                          -- We use first contentType from the Accept list
                                          (Proxy ct -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType Proxy ct
ctProxy)
                                          Request
req
                    )

  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)
hoistClientMonad Proxy m
pm Proxy (ReqBody' mods (ct : cts) a :> api)
_ forall x. mon x -> mon' x
f Client mon (ReqBody' mods (ct : cts) a :> api)
cl = \a
a ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (ReqBody' mods (ct : cts) a :> api)
a -> Client mon api
cl a
a)

instance
    ( HasClient m api, MimeRender ctype chunk, FramingRender framing, ToSourceIO chunk a
    ) => HasClient m (StreamBody' mods framing ctype a :> api)
  where

    type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m 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)
hoistClientMonad Proxy m
pm Proxy (StreamBody' mods framing ctype a :> api)
_ forall x. mon x -> mon' x
f Client mon (StreamBody' mods framing ctype a :> api)
cl = \a
a ->
      Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (StreamBody' mods framing ctype a :> api)
a -> Client mon api
cl a
a)

    clientWithRoute :: Proxy m
-> Proxy (StreamBody' mods framing ctype a :> api)
-> Request
-> Client m (StreamBody' mods framing ctype a :> api)
clientWithRoute Proxy m
pm Proxy (StreamBody' mods framing ctype a :> api)
Proxy Request
req a
body
        = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
        (Request -> Client m api) -> Request -> Client m api
forall a b. (a -> b) -> a -> b
$ RequestBody -> MediaType -> Request -> Request
setRequestBody (SourceIO ByteString -> RequestBody
RequestBodySource SourceIO ByteString
sourceIO) (Proxy ctype -> MediaType
forall k (ctype :: k). Accept ctype => Proxy ctype -> MediaType
contentType Proxy ctype
ctypeP) Request
req
      where
        ctypeP :: Proxy ctype
ctypeP   = Proxy ctype
forall k (t :: k). Proxy t
Proxy :: Proxy ctype
        framingP :: Proxy framing
framingP = Proxy framing
forall k (t :: k). Proxy t
Proxy :: Proxy framing

        sourceIO :: SourceIO ByteString
sourceIO = Proxy framing
-> (chunk -> ByteString) -> SourceT IO chunk -> SourceIO ByteString
forall k (strategy :: k) (m :: * -> *) a.
(FramingRender strategy, Monad m) =>
Proxy strategy
-> (a -> ByteString) -> SourceT m a -> SourceT m ByteString
framingRender
            Proxy framing
framingP
            (Proxy ctype -> chunk -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy ctype
ctypeP :: chunk -> BL.ByteString)
            (a -> SourceT IO chunk
forall chunk a. ToSourceIO chunk a => a -> SourceIO chunk
toSourceIO a
body)

-- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
  type Client m (path :> api) = Client m api

  clientWithRoute :: Proxy m -> Proxy (path :> api) -> Request -> Client m (path :> api)
clientWithRoute Proxy m
pm Proxy (path :> api)
Proxy Request
req =
     Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)
                     (Text -> Request -> Request
appendToPath Text
p Request
req)

    where p :: Text
p = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path
forall k (t :: k). Proxy t
Proxy :: Proxy path)

  hoistClientMonad :: Proxy m
-> Proxy (path :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (path :> api)
-> Client mon' (path :> api)
hoistClientMonad Proxy m
pm Proxy (path :> api)
_ forall x. mon x -> mon' x
f Client mon (path :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (path :> api)
cl

instance HasClient m api => HasClient m (Vault :> api) where
  type Client m (Vault :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (Vault :> api) -> Request -> Client m (Vault :> api)
clientWithRoute Proxy m
pm Proxy (Vault :> api)
Proxy Request
req =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Request
req

  hoistClientMonad :: Proxy m
-> Proxy (Vault :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (Vault :> api)
-> Client mon' (Vault :> api)
hoistClientMonad Proxy m
pm Proxy (Vault :> api)
_ forall x. mon x -> mon' x
f Client mon (Vault :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (Vault :> api)
cl

instance HasClient m api => HasClient m (RemoteHost :> api) where
  type Client m (RemoteHost :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (RemoteHost :> api)
-> Request
-> Client m (RemoteHost :> api)
clientWithRoute Proxy m
pm Proxy (RemoteHost :> api)
Proxy Request
req =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Request
req

  hoistClientMonad :: Proxy m
-> Proxy (RemoteHost :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (RemoteHost :> api)
-> Client mon' (RemoteHost :> api)
hoistClientMonad Proxy m
pm Proxy (RemoteHost :> api)
_ forall x. mon x -> mon' x
f Client mon (RemoteHost :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (RemoteHost :> api)
cl

instance HasClient m api => HasClient m (IsSecure :> api) where
  type Client m (IsSecure :> api) = Client m api

  clientWithRoute :: Proxy m
-> Proxy (IsSecure :> api) -> Request -> Client m (IsSecure :> api)
clientWithRoute Proxy m
pm Proxy (IsSecure :> api)
Proxy Request
req =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Request
req

  hoistClientMonad :: Proxy m
-> Proxy (IsSecure :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (IsSecure :> api)
-> Client mon' (IsSecure :> api)
hoistClientMonad Proxy m
pm Proxy (IsSecure :> api)
_ forall x. mon x -> mon' x
f Client mon (IsSecure :> api)
cl = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f Client mon api
Client mon (IsSecure :> api)
cl

instance HasClient m subapi =>
  HasClient m (WithNamedContext name context subapi) where

  type Client m (WithNamedContext name context subapi) = Client m subapi
  clientWithRoute :: Proxy m
-> Proxy (WithNamedContext name context subapi)
-> Request
-> Client m (WithNamedContext name context subapi)
clientWithRoute Proxy m
pm Proxy (WithNamedContext name context subapi)
Proxy = Proxy m -> Proxy subapi -> Request -> Client m subapi
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy subapi
forall k (t :: k). Proxy t
Proxy :: Proxy 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)
hoistClientMonad Proxy m
pm Proxy (WithNamedContext name context subapi)
_ forall x. mon x -> mon' x
f Client mon (WithNamedContext name context subapi)
cl = Proxy m
-> Proxy subapi
-> (forall x. mon x -> mon' x)
-> Client mon subapi
-> Client mon' subapi
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy subapi
forall k (t :: k). Proxy t
Proxy :: Proxy subapi) forall x. mon x -> mon' x
f Client mon subapi
Client mon (WithNamedContext name context subapi)
cl

instance ( HasClient m api
         ) => HasClient m (AuthProtect tag :> api) where
  type Client m (AuthProtect tag :> api)
    = AuthenticatedRequest (AuthProtect tag) -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (AuthProtect tag :> api)
-> Request
-> Client m (AuthProtect tag :> api)
clientWithRoute Proxy m
pm Proxy (AuthProtect tag :> api)
Proxy Request
req (AuthenticatedRequest (AuthClientData (AuthProtect tag)
val,AuthClientData (AuthProtect tag) -> Request -> Request
func)) =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (AuthClientData (AuthProtect tag) -> Request -> Request
func AuthClientData (AuthProtect tag)
val Request
req)

  hoistClientMonad :: Proxy m
-> Proxy (AuthProtect tag :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (AuthProtect tag :> api)
-> Client mon' (AuthProtect tag :> api)
hoistClientMonad Proxy m
pm Proxy (AuthProtect tag :> api)
_ forall x. mon x -> mon' x
f Client mon (AuthProtect tag :> api)
cl = \AuthenticatedRequest (AuthProtect tag)
authreq ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (AuthProtect tag :> api)
AuthenticatedRequest (AuthProtect tag) -> Client mon api
cl AuthenticatedRequest (AuthProtect tag)
authreq)

-- * Basic Authentication

instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
  type Client m (BasicAuth realm usr :> api) = BasicAuthData -> Client m api

  clientWithRoute :: Proxy m
-> Proxy (BasicAuth realm usr :> api)
-> Request
-> Client m (BasicAuth realm usr :> api)
clientWithRoute Proxy m
pm Proxy (BasicAuth realm usr :> api)
Proxy Request
req BasicAuthData
val =
    Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) (BasicAuthData -> Request -> Request
basicAuthReq BasicAuthData
val Request
req)

  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)
hoistClientMonad Proxy m
pm Proxy (BasicAuth realm usr :> api)
_ forall x. mon x -> mon' x
f Client mon (BasicAuth realm usr :> api)
cl = \BasicAuthData
bauth ->
    Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
pm (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) forall x. mon x -> mon' x
f (Client mon (BasicAuth realm usr :> api)
BasicAuthData -> Client mon api
cl BasicAuthData
bauth)



{- Note [Non-Empty Content Types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Rather than have

   instance (..., cts' ~ (ct ': cts)) => ... cts' ...

It may seem to make more sense to have:

   instance (...) => ... (ct ': cts) ...

But this means that if another instance exists that does *not* require
non-empty lists, but is otherwise more specific, no instance will be overall
more specific. This in turn generally means adding yet another instance (one
for empty and one for non-empty lists).
-}

-------------------------------------------------------------------------------
-- helpers
-------------------------------------------------------------------------------

checkContentTypeHeader :: RunClient m => Response -> m MediaType
checkContentTypeHeader :: Response -> m MediaType
checkContentTypeHeader Response
response =
  case HeaderName -> [Header] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Content-Type" ([Header] -> Maybe Method) -> [Header] -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Seq Header -> [Header]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Header -> [Header]) -> Seq Header -> [Header]
forall a b. (a -> b) -> a -> b
$ Response -> Seq Header
forall a. ResponseF a -> Seq Header
responseHeaders Response
response of
    Maybe Method
Nothing -> MediaType -> m MediaType
forall (m :: * -> *) a. Monad m => a -> m a
return (MediaType -> m MediaType) -> MediaType -> m MediaType
forall a b. (a -> b) -> a -> b
$ Method
"application"Method -> Method -> MediaType
//Method
"octet-stream"
    Just Method
t -> case Method -> Maybe MediaType
forall a. Accept a => Method -> Maybe a
parseAccept Method
t of
      Maybe MediaType
Nothing -> ClientError -> m MediaType
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> m MediaType) -> ClientError -> m MediaType
forall a b. (a -> b) -> a -> b
$ Response -> ClientError
InvalidContentTypeHeader Response
response
      Just MediaType
t' -> MediaType -> m MediaType
forall (m :: * -> *) a. Monad m => a -> m a
return MediaType
t'

decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
  => Response -> Proxy ct -> m a
decodedAs :: Response -> Proxy ct -> m a
decodedAs Response
response Proxy ct
ct = do
  MediaType
responseContentType <- Response -> m MediaType
forall (m :: * -> *). RunClient m => Response -> m MediaType
checkContentTypeHeader Response
response
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((MediaType -> Bool) -> [MediaType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MediaType -> MediaType -> Bool
forall a. Accept a => a -> a -> Bool
matches MediaType
responseContentType) [MediaType]
accept) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    ClientError -> m ()
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> m ()) -> ClientError -> m ()
forall a b. (a -> b) -> a -> b
$ MediaType -> Response -> ClientError
UnsupportedContentType MediaType
responseContentType Response
response
  case Proxy ct -> ByteString -> Either String a
forall k (ctype :: k) a.
MimeUnrender ctype a =>
Proxy ctype -> ByteString -> Either String a
mimeUnrender Proxy ct
ct (ByteString -> Either String a) -> ByteString -> Either String a
forall a b. (a -> b) -> a -> b
$ Response -> ByteString
forall a. ResponseF a -> a
responseBody Response
response of
    Left String
err -> ClientError -> m a
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> m a) -> ClientError -> m a
forall a b. (a -> b) -> a -> b
$ Text -> Response -> ClientError
DecodeFailure (String -> Text
T.pack String
err) Response
response
    Right a
val -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
  where
    accept :: [MediaType]
accept = NonEmpty MediaType -> [MediaType]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty MediaType -> [MediaType])
-> NonEmpty MediaType -> [MediaType]
forall a b. (a -> b) -> a -> b
$ Proxy ct -> NonEmpty MediaType
forall k (ctype :: k).
Accept ctype =>
Proxy ctype -> NonEmpty MediaType
contentTypes Proxy ct
ct