{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Functions to create http-clients from the same code as server or API schema
module Mig.Client (
  ToClient (..),
  Client (..),
  ClientConfig (..),
  runClient,
  (:|) (..),
  FromClient (..),
  getRespOrValue,
  Client' (..),
  runClient',
  MonadIO (..),
  ClientOr,
) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Bifunctor
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.Kind
import Data.Map.Strict qualified as Map
import Data.Proxy
import Data.String
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import GHC.TypeLits
import Network.HTTP.Client qualified as Http
import Network.HTTP.Media.RenderHeader (RenderHeader (..))
import Network.HTTP.Types.Header (HeaderName)
import Network.HTTP.Types.Method
import Network.HTTP.Types.Status
import Web.HttpApiData

import Mig.Core

instance (ToClient a, ToClient b) => ToClient (a :| b) where
  toClient :: forall (m :: * -> *). Server m -> a :| b
toClient Server m
api = a
a forall a b. a -> b -> a :| b
:| b
b
    where
      (a
a, b
b) = forall a (m :: * -> *). ToClient a => Server m -> a
toClient Server m
api

  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @(a, b)

class MapRequest a where
  mapRequest :: (Http.Request -> Http.Request) -> (a -> a)
  mapCapture :: (CaptureMap -> CaptureMap) -> (a -> a)

instance MapRequest (Client a) where
  mapRequest :: (Request -> Request) -> Client a -> Client a
mapRequest Request -> Request
f (Client ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
a) = forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client (\ClientConfig
conf CaptureMap
capt -> ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
a ClientConfig
conf CaptureMap
capt forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
f)
  mapCapture :: (CaptureMap -> CaptureMap) -> Client a -> Client a
mapCapture CaptureMap -> CaptureMap
f (Client ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
a) = forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client (\ClientConfig
conf CaptureMap
capt Request
req -> ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
a ClientConfig
conf (CaptureMap -> CaptureMap
f CaptureMap
capt) Request
req)

instance MapRequest (Send method Client a) where
  mapRequest :: (Request -> Request)
-> Send method Client a -> Send method Client a
mapRequest Request -> Request
f (Send Client a
client) = forall {k} {k1} (method :: k) (m :: k1 -> *) (a :: k1).
m a -> Send method m a
Send (forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f Client a
client)
  mapCapture :: (CaptureMap -> CaptureMap)
-> Send method Client a -> Send method Client a
mapCapture CaptureMap -> CaptureMap
f (Send Client a
client) = forall {k} {k1} (method :: k) (m :: k1 -> *) (a :: k1).
m a -> Send method m a
Send (forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f Client a
client)

instance (MapRequest b) => MapRequest (a -> b) where
  mapRequest :: (Request -> Request) -> (a -> b) -> a -> b
mapRequest Request -> Request
f a -> b
a = forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
a
  mapCapture :: (CaptureMap -> CaptureMap) -> (a -> b) -> a -> b
mapCapture CaptureMap -> CaptureMap
f a -> b
a = forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
a

instance (MapRequest a, MapRequest b) => MapRequest (a, b) where
  mapRequest :: (Request -> Request) -> (a, b) -> (a, b)
mapRequest Request -> Request
f (a
a, b
b) = (forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f a
a, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f b
b)
  mapCapture :: (CaptureMap -> CaptureMap) -> (a, b) -> (a, b)
mapCapture CaptureMap -> CaptureMap
f (a
a, b
b) = (forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f a
a, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f b
b)

instance (MapRequest a, MapRequest b) => MapRequest (a :| b) where
  mapRequest :: (Request -> Request) -> (a :| b) -> a :| b
mapRequest Request -> Request
f (a
a :| b
b) = (forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f a
a forall a b. a -> b -> a :| b
:| forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f b
b)
  mapCapture :: (CaptureMap -> CaptureMap) -> (a :| b) -> a :| b
mapCapture CaptureMap -> CaptureMap
f (a
a :| b
b) = (forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f a
a forall a b. a -> b -> a :| b
:| forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f b
b)

instance (MapRequest a, MapRequest b, MapRequest c) => MapRequest (a, b, c) where
  mapRequest :: (Request -> Request) -> (a, b, c) -> (a, b, c)
mapRequest Request -> Request
f (a
a, b
b, c
c) = (forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f a
a, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f b
b, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f c
c)
  mapCapture :: (CaptureMap -> CaptureMap) -> (a, b, c) -> (a, b, c)
mapCapture CaptureMap -> CaptureMap
f (a
a, b
b, c
c) = (forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f a
a, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f b
b, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f c
c)

instance (MapRequest a, MapRequest b, MapRequest c, MapRequest d) => MapRequest (a, b, c, d) where
  mapRequest :: (Request -> Request) -> (a, b, c, d) -> (a, b, c, d)
mapRequest Request -> Request
f (a
a, b
b, c
c, d
d) = (forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f a
a, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f b
b, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f c
c, forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest Request -> Request
f d
d)
  mapCapture :: (CaptureMap -> CaptureMap) -> (a, b, c, d) -> (a, b, c, d)
mapCapture CaptureMap -> CaptureMap
f (a
a, b
b, c
c, d
d) = (forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f a
a, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f b
b, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f c
c, forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture CaptureMap -> CaptureMap
f d
d)

{-| Creates http-client from server definition.

The result adapts to decalred types. It creates so many client functions as
the arity of the tuple in the result. The server can have more handlers than in the result
Routes from result definition and server definition are matched in the same order as they are declared.

The type of the client is derived from the type signature of the result. The information
on paths for handlers is derived from server definition.

To use the same code for both client and server it is convenient to declare
signatures for handlers as type synonyms parameterized by server monad.
And in the server implementation monad is going to be something IO-based but
in client handlers it will be `Client`-monad.

For example for a server:

> type Hello m = Capture "name" Text -> Get m (Resp Text)
> type Add m = Query "a" Int -> Query "b" Int -> Get m (Resp Int)
>
> server :: Server IO
> server = "api" /.
>   mconcat
>    [ "hello" /. helloHandler
>    , "add" /. addHandler
>    ]
>
> helloHandler :: Hello IO
> helloHandler (Capture name) = Send $ pure $ ok $ "Hello " <> name
>
> addHandler :: Add IO
> addHandler (Query a) (Query b) = Send $ pure $ ok (a + b)

We can define the client and reuse type signatures that we have defined in the server code:

> helloClient :: Hello Client
> addClient :: Add Client
>
> helloClient :| addClient = toClient server

If there is no definition for server. For example if we write implementation for
some external server or API provided by third party we can use recursive definition in the server.
For example if there is no haskell implementation for the server in the previous example. But we
know the API of the application we can define client with recursive definition:

> type Hello m = Capture "name" Text -> Get m (Resp Text)
> type Add m = Query "a" Int -> Query "b" Int -> Get m (Resp Int)
>
> helloClient :: Hello Client
> addClient :: Add Client
>
> helloClient :| addClient = toClient server
>
> server :: Server Client
> server = "api" /.
>   mconcat
>    [ "hello" /. helloClient
>    , "add" /. addClient
>    ]

The code does not get stuck into recursion loop because implementation of the route handlers
is not needed to create client functions. The function @toClient@ takes into account
only type-signatures of the handlers and paths.
-}
class (MapRequest a) => ToClient a where
  -- | converts to client function
  toClient :: Server m -> a

  -- | how many routes client has
  clientArity :: Int

-- | Config to run the clients
data ClientConfig = ClientConfig
  { ClientConfig -> Int
port :: Int
  -- ^ port to connect to
  , ClientConfig -> Manager
manager :: Http.Manager
  -- ^ HTTP-manager
  }

-- | The client monad. All errors are unified to Lazy.ByteString.
newtype Client a = Client (ClientConfig -> CaptureMap -> Http.Request -> IO (RespOr AnyMedia BL.ByteString a))
  deriving (forall a b. a -> Client b -> Client a
forall a b. (a -> b) -> Client a -> Client b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Client b -> Client a
$c<$ :: forall a b. a -> Client b -> Client a
fmap :: forall a b. (a -> b) -> Client a -> Client b
$cfmap :: forall a b. (a -> b) -> Client a -> Client b
Functor)

instance Applicative Client where
  pure :: forall a. a -> Client a
pure a
a = forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> RespOr AnyMedia ByteString a
pureResp a
a
  <*> :: forall a b. Client (a -> b) -> Client a -> Client b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

pureResp :: a -> RespOr AnyMedia BL.ByteString a
pureResp :: forall a. a -> RespOr AnyMedia ByteString a
pureResp a
a = forall ty err a.
Either (Resp ty err) (Resp ty a) -> RespOr ty err a
RespOr forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp Status
ok200 [] (forall a. a -> Maybe a
Just a
a)

instance Monad Client where
  (Client ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
ma) >>= :: forall a b. Client a -> (a -> Client b) -> Client b
>>= a -> Client b
mf = forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client forall a b. (a -> b) -> a -> b
$ \ClientConfig
config CaptureMap
captureValues Request
req -> do
    RespOr Either (Resp AnyMedia ByteString) (Resp AnyMedia a)
eResp <- ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
ma ClientConfig
config CaptureMap
captureValues Request
req
    case Either (Resp AnyMedia ByteString) (Resp AnyMedia a)
eResp of
      Right Resp AnyMedia a
resp -> case Resp AnyMedia a
resp.body of
        Just a
body -> case a -> Client b
mf a
body of
          Client ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString b)
run -> ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString b)
run ClientConfig
config CaptureMap
captureValues Request
req
        Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ty err a.
Either (Resp ty err) (Resp ty a) -> RespOr ty err a
RespOr forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp Resp AnyMedia a
resp.status Resp AnyMedia a
resp.headers forall a. Maybe a
Nothing)
      Left Resp AnyMedia ByteString
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall ty err a.
Either (Resp ty err) (Resp ty a) -> RespOr ty err a
RespOr forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Resp AnyMedia ByteString
err)

instance MonadIO Client where
  liftIO :: forall a. IO a -> Client a
liftIO IO a
act = forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client forall a b. (a -> b) -> a -> b
$ \ClientConfig
_ CaptureMap
_ Request
_ -> forall a. a -> RespOr AnyMedia ByteString a
pureResp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act

-- | Runs client. It calls client handler and fetches the result.
runClient :: ClientConfig -> Client a -> IO (RespOr AnyMedia BL.ByteString a)
runClient :: forall a.
ClientConfig -> Client a -> IO (RespOr AnyMedia ByteString a)
runClient ClientConfig
config (Client ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
act) = ClientConfig
-> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a)
act ClientConfig
config forall a. Monoid a => a
mempty Request
Http.defaultRequest

instance (IsMethod method, FromReqBody (RespMedia a) (RespBody a), IsResp a) => ToClient (Send method Client a) where
  toClient :: forall (m :: * -> *). Server m -> Send method Client a
toClient Server m
api =
    forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (ByteString -> Request -> Request
setRequestMethod (forall {k} (a :: k). IsMethod a => ByteString
toMethod @method)) forall a b. (a -> b) -> a -> b
$
      forall {k} {k1} (method :: k) (m :: k1 -> *) (a :: k1).
m a -> Send method m a
Send forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IsResp a => RespBody a -> a
ok forall a b. (a -> b) -> a -> b
$
          forall {k} (media :: k) a. FromReqBody media a => Path -> Client a
httpSend @(RespMedia a) @(RespBody a) (forall (m :: * -> *). Server m -> Path
getHeadPath forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Api (Route m) -> Server m
Server forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Api (Route m) -> Api (Route m)
fillCaptures forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Server m -> Api (Route m)
unServer Server m
api)

  clientArity :: Int
clientArity = Int
1

instance (ToClient a, ToClient b) => ToClient (a, b) where
  toClient :: forall (m :: * -> *). Server m -> (a, b)
toClient (Server Api (Route m)
api) = (forall a (m :: * -> *). ToClient a => Server m -> a
toClient (forall (m :: * -> *). Api (Route m) -> Server m
Server Api (Route m)
apiA), forall a (m :: * -> *). ToClient a => Server m -> a
toClient (forall (m :: * -> *). Api (Route m) -> Server m
Server Api (Route m)
apiB))
    where
      (Api (Route m)
apiA, Api (Route m)
apiB) = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. [(Path, a)] -> Api a
fromFlatApi forall a. [(Path, a)] -> Api a
fromFlatApi forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> ([a], [a])
Prelude.splitAt (forall a. ToClient a => Int
clientArity @a) (forall a. Api a -> [(Path, a)]
flatApi Api (Route m)
api)

  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @a forall a. Num a => a -> a -> a
+ forall a. ToClient a => Int
clientArity @b

instance (ToClient a, ToClient b, ToClient c) => ToClient (a, b, c) where
  toClient :: forall (m :: * -> *). Server m -> (a, b, c)
toClient Server m
api = (a
a, b
b, c
c)
    where
      (a
a, (b
b, c
c)) = forall a (m :: * -> *). ToClient a => Server m -> a
toClient Server m
api

  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @(a, (b, c))

instance (ToClient a, ToClient b, ToClient c, ToClient d) => ToClient (a, b, c, d) where
  toClient :: forall (m :: * -> *). Server m -> (a, b, c, d)
toClient Server m
api = (a
a, b
b, c
c, d
d)
    where
      (a
a, (b
b, c
c, d
d)) = forall a (m :: * -> *). ToClient a => Server m -> a
toClient Server m
api

  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @(a, (b, c, d))

getHeadPath :: Server m -> Path
getHeadPath :: forall (m :: * -> *). Server m -> Path
getHeadPath (Server Api (Route m)
api) = case forall a. Api a -> [(Path, a)]
flatApi Api (Route m)
api of
  (Path
pathHead, Route m
_) : [(Path, Route m)]
_ -> Path
pathHead
  [(Path, Route m)]
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Not enought methods. API is empty"

setRequestMethod :: Method -> Http.Request -> Http.Request
setRequestMethod :: ByteString -> Request -> Request
setRequestMethod ByteString
m Request
req = Request
req{method :: ByteString
Http.method = ByteString
m}

instance (KnownSymbol sym, ToHttpApiData a, ToClient b) => ToClient (Header sym a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Header sym a -> b
toClient Server m
api = \Header sym a
header -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Header sym a -> Request -> Request
addHeader Header sym a
header) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (KnownSymbol sym, ToHttpApiData a, ToClient b) => ToClient (OptionalHeader sym a -> b) where
  toClient :: forall (m :: * -> *). Server m -> OptionalHeader sym a -> b
toClient Server m
api = \OptionalHeader sym a
header -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
OptionalHeader sym a -> Request -> Request
addOptionalHeader OptionalHeader sym a
header) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (KnownSymbol sym, ToHttpApiData a, ToClient b) => ToClient (Query sym a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Query sym a -> b
toClient Server m
api = \Query sym a
query -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Query sym a -> Request -> Request
addQuery Query sym a
query) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (KnownSymbol sym, ToClient b) => ToClient (QueryFlag sym -> b) where
  toClient :: forall (m :: * -> *). Server m -> QueryFlag sym -> b
toClient Server m
api = \(QueryFlag Bool
flag) -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Query sym a -> Request -> Request
addQuery @sym @Bool (forall (sym :: Symbol) a. a -> Query sym a
Query Bool
flag)) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (KnownSymbol sym, ToHttpApiData a, ToClient b) => ToClient (Optional sym a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Optional sym a -> b
toClient Server m
api = \Optional sym a
query -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Optional sym a -> Request -> Request
addOptional Optional sym a
query) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (KnownSymbol sym, ToHttpApiData a, ToClient b) => ToClient (Capture sym a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Capture sym a -> b
toClient Server m
api = \Capture sym a
capture -> forall a. MapRequest a => (CaptureMap -> CaptureMap) -> a -> a
mapCapture (forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Capture sym a -> CaptureMap -> CaptureMap
addCapture Capture sym a
capture) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (ToRespBody media a, ToClient b) => ToClient (Body media a -> b) where
  toClient :: forall (m :: * -> *). Server m -> Body media a -> b
toClient Server m
api = \(Body a
body) -> forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest (forall {k} (media :: k) a.
ToRespBody media a =>
a -> Request -> Request
addBody @media a
body) forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (ToClient b) => ToClient (PathInfo -> b) where
  toClient :: forall (m :: * -> *). Server m -> PathInfo -> b
toClient Server m
api = \(PathInfo [Text]
_path) -> forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (ToClient b) => ToClient (IsSecure -> b) where
  toClient :: forall (m :: * -> *). Server m -> IsSecure -> b
toClient Server m
api = \(IsSecure Bool
_val) -> forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (ToClient b) => ToClient (RawRequest -> b) where
  toClient :: forall (m :: * -> *). Server m -> RawRequest -> b
toClient Server m
api = \(RawRequest Request
_val) -> forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

instance (ToClient b) => ToClient (RawResponse -> b) where
  toClient :: forall (m :: * -> *). Server m -> RawResponse -> b
toClient Server m
api = \(RawResponse Maybe Response
_val) -> forall a (m :: * -> *). ToClient a => Server m -> a
toClient @b Server m
api
  clientArity :: Int
clientArity = forall a. ToClient a => Int
clientArity @b

addQuery :: forall sym a. (KnownSymbol sym, ToHttpApiData a) => Query sym a -> Http.Request -> Http.Request
addQuery :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Query sym a -> Request -> Request
addQuery (Query a
a) Request
req = Request
req{queryString :: ByteString
Http.queryString = ByteString
str}
  where
    str :: ByteString
str =
      if ByteString -> Bool
B.null (Request -> ByteString
Http.queryString Request
req)
        then ByteString
param
        else Request -> ByteString
Http.queryString Request
req forall a. Semigroup a => a -> a -> a
<> ByteString
"&" forall a. Semigroup a => a -> a -> a
<> ByteString
param

    param :: ByteString
param = forall a. IsString a => [Char] -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym)) forall a. Semigroup a => a -> a -> a
<> ByteString
"=" forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
Text.encodeUtf8 (forall a. ToHttpApiData a => a -> Text
toUrlPiece a
a)

addOptional :: forall sym a. (KnownSymbol sym, ToHttpApiData a) => Optional sym a -> Http.Request -> Http.Request
addOptional :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Optional sym a -> Request -> Request
addOptional (Optional Maybe a
mVal) = case Maybe a
mVal of
  Maybe a
Nothing -> forall a. a -> a
id
  Just a
val -> forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Query sym a -> Request -> Request
addQuery @sym (forall (sym :: Symbol) a. a -> Query sym a
Query a
val)

addHeader :: forall sym a. (KnownSymbol sym, ToHttpApiData a) => Header sym a -> Http.Request -> Http.Request
addHeader :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Header sym a -> Request -> Request
addHeader (Header a
a) = (HeaderName, ByteString) -> Request -> Request
addRequestHeader (forall a. IsString a => [Char] -> a
fromString forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym), forall a. ToHttpApiData a => a -> ByteString
toHeader a
a)

addOptionalHeader :: forall sym a. (KnownSymbol sym, ToHttpApiData a) => OptionalHeader sym a -> Http.Request -> Http.Request
addOptionalHeader :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
OptionalHeader sym a -> Request -> Request
addOptionalHeader (OptionalHeader Maybe a
ma) = case Maybe a
ma of
  Maybe a
Nothing -> forall a. a -> a
id
  Just a
a -> forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Header sym a -> Request -> Request
addHeader @sym (forall (sym :: Symbol) a. a -> Header sym a
Header a
a)

addCapture :: forall sym a. (KnownSymbol sym, ToHttpApiData a) => Capture sym a -> CaptureMap -> CaptureMap
addCapture :: forall (sym :: Symbol) a.
(KnownSymbol sym, ToHttpApiData a) =>
Capture sym a -> CaptureMap -> CaptureMap
addCapture (Capture a
a) =
  forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (forall a. IsString a => [Char] -> a
fromString (forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
Proxy @sym))) (forall a. ToHttpApiData a => a -> Text
toUrlPiece a
a)

addBody :: forall media a. (ToRespBody media a) => a -> Http.Request -> Http.Request
addBody :: forall {k} (media :: k) a.
ToRespBody media a =>
a -> Request -> Request
addBody a
body Request
req =
  (HeaderName, ByteString) -> Request -> Request
addRequestHeader (HeaderName
"Content-Type", forall h. RenderHeader h => h -> ByteString
renderHeader (forall {k} (a :: k). ToMediaType a => MediaType
toMediaType @media)) forall a b. (a -> b) -> a -> b
$
    Request
req{requestBody :: RequestBody
Http.requestBody = ByteString -> RequestBody
Http.RequestBodyLBS (forall {k} (ty :: k) b. ToRespBody ty b => b -> ByteString
toRespBody @media a
body)}

addRequestHeader :: (HeaderName, ByteString) -> Http.Request -> Http.Request
addRequestHeader :: (HeaderName, ByteString) -> Request -> Request
addRequestHeader (HeaderName, ByteString)
header Request
req = Request
req{requestHeaders :: ResponseHeaders
Http.requestHeaders = (HeaderName, ByteString)
header forall a. a -> [a] -> [a]
: Request -> ResponseHeaders
Http.requestHeaders Request
req}

pathToString :: CaptureMap -> Path -> ByteString
pathToString :: CaptureMap -> Path -> ByteString
pathToString CaptureMap
captureValues (Path [PathItem]
path) = case [PathItem]
path of
  [] -> forall a. Monoid a => a
mempty
  PathItem
item : [PathItem]
rest -> forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Path -> ByteString
rec ([PathItem] -> Path
Path [PathItem]
rest) forall a b. (a -> b) -> a -> b
$ case PathItem
item of
    StaticPath Text
p -> Text
p
    CapturePath Text
p ->
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
p CaptureMap
captureValues of
        Just Text
val -> Text
val
        Maybe Text
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"No value for capture: " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
Text.unpack Text
p
  where
    rec :: Text -> Path -> ByteString
rec Text
a Path
rest = Text -> ByteString
Text.encodeUtf8 Text
a forall a. Semigroup a => a -> a -> a
<> ByteString
"/" forall a. Semigroup a => a -> a -> a
<> CaptureMap -> Path -> ByteString
pathToString CaptureMap
captureValues Path
rest

httpSend :: forall media a. (FromReqBody media a) => Path -> Client a
httpSend :: forall {k} (media :: k) a. FromReqBody media a => Path -> Client a
httpSend Path
path =
  forall a. MapRequest a => (Request -> Request) -> a -> a
mapRequest ((HeaderName, ByteString) -> Request -> Request
addRequestHeader (HeaderName
"Accept", forall h. RenderHeader h => h -> ByteString
renderHeader forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). ToMediaType a => MediaType
toMediaType @media)) forall a b. (a -> b) -> a -> b
$
    forall a.
(ClientConfig
 -> CaptureMap -> Request -> IO (RespOr AnyMedia ByteString a))
-> Client a
Client forall a b. (a -> b) -> a -> b
$ \ClientConfig
config CaptureMap
captureValues Request
req ->
      Response ByteString -> RespOr AnyMedia ByteString a
toSend forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
Http.httpLbs (CaptureMap -> Path -> Request -> Request
setRoute CaptureMap
captureValues Path
path forall a b. (a -> b) -> a -> b
$ Int -> Request -> Request
setPort ClientConfig
config.port Request
req) ClientConfig
config.manager
  where
    toSend :: Http.Response BL.ByteString -> RespOr AnyMedia BL.ByteString a
    toSend :: Response ByteString -> RespOr AnyMedia ByteString a
toSend Response ByteString
resp =
      forall ty err a.
Either (Resp ty err) (Resp ty a) -> RespOr ty err a
RespOr forall a b. (a -> b) -> a -> b
$ case forall {k} (ty :: k) b.
FromReqBody ty b =>
ByteString -> Either Text b
fromReqBody @media forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
Http.responseBody Response ByteString
resp of
        Right a
body -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall val. val -> Resp AnyMedia val
toResp a
body
        Left Text
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall val. val -> Resp AnyMedia val
toResp forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
Http.responseBody Response ByteString
resp
      where
        toResp :: val -> Resp AnyMedia val
        toResp :: forall val. val -> Resp AnyMedia val
toResp = forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp (forall body. Response body -> Status
Http.responseStatus Response ByteString
resp) (forall body. Response body -> ResponseHeaders
Http.responseHeaders Response ByteString
resp) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

setPort :: Int -> Http.Request -> Http.Request
setPort :: Int -> Request -> Request
setPort Int
port Request
req = Request
req{port :: Int
Http.port = Int
port}

setRoute :: CaptureMap -> Path -> Http.Request -> Http.Request
setRoute :: CaptureMap -> Path -> Request -> Request
setRoute CaptureMap
captureValues Path
path Request
req = Request
req{path :: ByteString
Http.path = CaptureMap -> Path -> ByteString
pathToString CaptureMap
captureValues Path
path}

----------------------------------------------------------
-- from response

-- | Helper type-synonym for convenience
type ClientOr a = Client' (Either BL.ByteString a)

{-| ClientConfig in @ReaderT IO@ monad. It encapsulates typical execution
of client functions
-}
newtype Client' a = Client' (ReaderT ClientConfig IO a)
  deriving (forall a b. a -> Client' b -> Client' a
forall a b. (a -> b) -> Client' a -> Client' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Client' b -> Client' a
$c<$ :: forall a b. a -> Client' b -> Client' a
fmap :: forall a b. (a -> b) -> Client' a -> Client' b
$cfmap :: forall a b. (a -> b) -> Client' a -> Client' b
Functor, Functor Client'
forall a. a -> Client' a
forall a b. Client' a -> Client' b -> Client' a
forall a b. Client' a -> Client' b -> Client' b
forall a b. Client' (a -> b) -> Client' a -> Client' b
forall a b c. (a -> b -> c) -> Client' a -> Client' b -> Client' c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Client' a -> Client' b -> Client' a
$c<* :: forall a b. Client' a -> Client' b -> Client' a
*> :: forall a b. Client' a -> Client' b -> Client' b
$c*> :: forall a b. Client' a -> Client' b -> Client' b
liftA2 :: forall a b c. (a -> b -> c) -> Client' a -> Client' b -> Client' c
$cliftA2 :: forall a b c. (a -> b -> c) -> Client' a -> Client' b -> Client' c
<*> :: forall a b. Client' (a -> b) -> Client' a -> Client' b
$c<*> :: forall a b. Client' (a -> b) -> Client' a -> Client' b
pure :: forall a. a -> Client' a
$cpure :: forall a. a -> Client' a
Applicative, Applicative Client'
forall a. a -> Client' a
forall a b. Client' a -> Client' b -> Client' b
forall a b. Client' a -> (a -> Client' b) -> Client' b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Client' a
$creturn :: forall a. a -> Client' a
>> :: forall a b. Client' a -> Client' b -> Client' b
$c>> :: forall a b. Client' a -> Client' b -> Client' b
>>= :: forall a b. Client' a -> (a -> Client' b) -> Client' b
$c>>= :: forall a b. Client' a -> (a -> Client' b) -> Client' b
Monad, MonadReader ClientConfig, Monad Client'
forall a. IO a -> Client' a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> Client' a
$cliftIO :: forall a. IO a -> Client' a
MonadIO)

-- | Runs the client call
runClient' :: ClientConfig -> Client' a -> IO a
runClient' :: forall a. ClientConfig -> Client' a -> IO a
runClient' ClientConfig
config (Client' ReaderT ClientConfig IO a
act) = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT ClientConfig IO a
act ClientConfig
config

{-| Class to strip away all newtype wrappers that serve for API-definition.
For example it converts the types signature for client function:

> Capture "foo" Text -> Header "bar" Int -> Get Client (Resp a)

to the version without HTTP-newtype wrappers:

> Text -> Int -> Client' (Resp a)

The instances are defined for all HTTP-newtype wrappers.
Also we can use function @getRespOrValue@ if we do not need
the http information of response.
-}
class FromClient a where
  type ClientResult a :: Type
  fromClient :: a -> ClientResult a

instance (ToRespBody (RespMedia a) (RespError a), IsResp a) => FromClient (Send method Client a) where
  type ClientResult (Send method Client a) = Client' (RespOr (RespMedia a) BL.ByteString (RespBody a))
  fromClient :: Send method Client a -> ClientResult (Send method Client a)
fromClient Send method Client a
f = forall a. ReaderT ClientConfig IO a -> Client' a
Client' forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall {k} a (method :: k).
(ToRespBody (RespMedia a) (RespError a), IsResp a) =>
ClientConfig
-> Send method Client a
-> IO (RespOr (RespMedia a) ByteString (RespBody a))
fromSendClient Send method Client a
f

instance (FromClient b) => FromClient (Body media a -> b) where
  type ClientResult (Body media a -> b) = a -> ClientResult b
  fromClient :: (Body media a -> b) -> ClientResult (Body media a -> b)
fromClient Body media a -> b
f a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (Body media a -> b
f (forall {k} (media :: k) a. a -> Body media a
Body a
arg))

instance (FromClient b) => FromClient (Capture sym a -> b) where
  type ClientResult (Capture sym a -> b) = a -> ClientResult b
  fromClient :: (Capture sym a -> b) -> ClientResult (Capture sym a -> b)
fromClient Capture sym a -> b
f a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (Capture sym a -> b
f (forall (sym :: Symbol) a. a -> Capture sym a
Capture a
arg))

instance (FromClient b) => FromClient (Query sym a -> b) where
  type ClientResult (Query sym a -> b) = a -> ClientResult b
  fromClient :: (Query sym a -> b) -> ClientResult (Query sym a -> b)
fromClient Query sym a -> b
f a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (Query sym a -> b
f (forall (sym :: Symbol) a. a -> Query sym a
Query a
arg))

instance (FromClient b) => FromClient (QueryFlag a -> b) where
  type ClientResult (QueryFlag a -> b) = Bool -> ClientResult b
  fromClient :: (QueryFlag a -> b) -> ClientResult (QueryFlag a -> b)
fromClient QueryFlag a -> b
f Bool
arg = forall a. FromClient a => a -> ClientResult a
fromClient (QueryFlag a -> b
f (forall (sym :: Symbol). Bool -> QueryFlag sym
QueryFlag Bool
arg))

instance (FromClient b) => FromClient (Optional sym a -> b) where
  type ClientResult (Optional sym a -> b) = Maybe a -> ClientResult b
  fromClient :: (Optional sym a -> b) -> ClientResult (Optional sym a -> b)
fromClient Optional sym a -> b
f Maybe a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (Optional sym a -> b
f (forall (sym :: Symbol) a. Maybe a -> Optional sym a
Optional Maybe a
arg))

instance (FromClient b) => FromClient (Header sym a -> b) where
  type ClientResult (Header sym a -> b) = a -> ClientResult b
  fromClient :: (Header sym a -> b) -> ClientResult (Header sym a -> b)
fromClient Header sym a -> b
f a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (Header sym a -> b
f (forall (sym :: Symbol) a. a -> Header sym a
Header a
arg))

instance (FromClient b) => FromClient (OptionalHeader sym a -> b) where
  type ClientResult (OptionalHeader sym a -> b) = Maybe a -> ClientResult b
  fromClient :: (OptionalHeader sym a -> b)
-> ClientResult (OptionalHeader sym a -> b)
fromClient OptionalHeader sym a -> b
f Maybe a
arg = forall a. FromClient a => a -> ClientResult a
fromClient (OptionalHeader sym a -> b
f (forall (sym :: Symbol) a. Maybe a -> OptionalHeader sym a
OptionalHeader Maybe a
arg))

instance (FromClient b) => FromClient (PathInfo -> b) where
  type ClientResult (PathInfo -> b) = ClientResult b
  fromClient :: (PathInfo -> b) -> ClientResult (PathInfo -> b)
fromClient PathInfo -> b
f = forall a. FromClient a => a -> ClientResult a
fromClient @b (PathInfo -> b
f forall a b. (a -> b) -> a -> b
$ [Text] -> PathInfo
PathInfo [])

instance (FromClient b) => FromClient (IsSecure -> b) where
  type ClientResult (IsSecure -> b) = ClientResult b
  fromClient :: (IsSecure -> b) -> ClientResult (IsSecure -> b)
fromClient IsSecure -> b
f = forall a. FromClient a => a -> ClientResult a
fromClient @b (IsSecure -> b
f (Bool -> IsSecure
IsSecure Bool
True))

instance (FromClient b) => FromClient (RawRequest -> b) where
  type ClientResult (RawRequest -> b) = ClientResult b
  fromClient :: (RawRequest -> b) -> ClientResult (RawRequest -> b)
fromClient RawRequest -> b
f = forall a. FromClient a => a -> ClientResult a
fromClient @b (RawRequest -> b
f forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"no request")

instance (FromClient b) => FromClient (RawResponse -> b) where
  type ClientResult (RawResponse -> b) = ClientResult b
  fromClient :: (RawResponse -> b) -> ClientResult (RawResponse -> b)
fromClient RawResponse -> b
f = forall a. FromClient a => a -> ClientResult a
fromClient @b (RawResponse -> b
f forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => [Char] -> a
error [Char]
"no response")

fromSendClient ::
  forall a method.
  (ToRespBody (RespMedia a) (RespError a), IsResp a) =>
  ClientConfig ->
  Send method Client a ->
  IO (RespOr (RespMedia a) BL.ByteString (RespBody a))
fromSendClient :: forall {k} a (method :: k).
(ToRespBody (RespMedia a) (RespError a), IsResp a) =>
ClientConfig
-> Send method Client a
-> IO (RespOr (RespMedia a) ByteString (RespBody a))
fromSendClient ClientConfig
config (Send Client a
client) =
  forall a.
(ToRespBody (RespMedia a) (RespError a), IsResp a) =>
RespOr AnyMedia ByteString a
-> RespOr (RespMedia a) ByteString (RespBody a)
joinRespOr @a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ClientConfig -> Client a -> IO (RespOr AnyMedia ByteString a)
runClient ClientConfig
config Client a
client

joinRespOr :: forall a. (ToRespBody (RespMedia a) (RespError a), IsResp a) => RespOr AnyMedia BL.ByteString a -> RespOr (RespMedia a) BL.ByteString (RespBody a)
joinRespOr :: forall a.
(ToRespBody (RespMedia a) (RespError a), IsResp a) =>
RespOr AnyMedia ByteString a
-> RespOr (RespMedia a) ByteString (RespBody a)
joinRespOr (RespOr Either (Resp AnyMedia ByteString) (Resp AnyMedia a)
eResp) = forall ty err a.
Either (Resp ty err) (Resp ty a) -> RespOr ty err a
RespOr forall a b. (a -> b) -> a -> b
$ case Either (Resp AnyMedia ByteString) (Resp AnyMedia a)
eResp of
  Right Resp AnyMedia a
resp -> case Resp AnyMedia a
resp.body of
    Just a
result ->
      if forall a. IsResp a => a -> Status
getStatus a
result forall a. Eq a => a -> a -> Bool
== Status
ok200
        then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp (forall a. IsResp a => a -> Status
getStatus a
result) (forall a. IsResp a => a -> ResponseHeaders
getHeaders a
result) (forall a. IsResp a => a -> Maybe (RespBody a)
getRespBody a
result)
        else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp (forall a. IsResp a => a -> Status
getStatus a
result) (forall a. IsResp a => a -> ResponseHeaders
getHeaders a
result) (forall {k} (ty :: k) b. ToRespBody ty b => b -> ByteString
toRespBody @(RespMedia a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsResp a => a -> Maybe (RespError a)
getRespError a
result)
    Maybe a
Nothing -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp Resp AnyMedia a
resp.status Resp AnyMedia a
resp.headers forall a. Maybe a
Nothing
  Left Resp AnyMedia ByteString
resp -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall media a.
Status -> ResponseHeaders -> Maybe a -> Resp media a
Resp Resp AnyMedia ByteString
resp.status Resp AnyMedia ByteString
resp.headers Resp AnyMedia ByteString
resp.body

{-| If we need only value from the server and not HTTP-info (status, or headers)
we can omit that data with this function
-}
getRespOrValue :: RespOr media BL.ByteString a -> Either BL.ByteString a
getRespOrValue :: forall media a. RespOr media ByteString a -> Either ByteString a
getRespOrValue (RespOr Either (Resp media ByteString) (Resp media a)
eResp) = case Either (Resp media ByteString) (Resp media a)
eResp of
  Right Resp media a
resp -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either ByteString b
noContentValue forall a b. b -> Either a b
Right Resp media a
resp.body
  Left Resp media ByteString
resp -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {b}. Either ByteString b
noContentValue forall a b. a -> Either a b
Left Resp media ByteString
resp.body
  where
    noContentValue :: Either ByteString b
noContentValue = forall a b. a -> Either a b
Left ByteString
"No content in the response"