{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
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)
class (MapRequest a) => ToClient a where
toClient :: Server m -> a
clientArity :: Int
data ClientConfig = ClientConfig
{ ClientConfig -> Int
port :: Int
, ClientConfig -> Manager
manager :: Http.Manager
}
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
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
(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
(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
(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}
type ClientOr a = Client' (Either BL.ByteString a)
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)
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 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
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"