{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Fetch.Http
  ( httpRequest,
  )
where

import Data.Aeson (FromJSON, ToJSON, encode)
import qualified Data.ByteString.Char8 as L
import Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.Map as M
import Data.Morpheus.Client.Fetch.GQLClient (Header, Headers)
import Data.Morpheus.Client.Fetch.RequestType
  ( Request,
    RequestType (RequestArgs),
    decodeResponse,
    toRequest,
  )
import Data.Morpheus.Client.Fetch.Types (GQLClientResult)
import qualified Data.Text as T
import Network.HTTP.Req
  ( POST (..),
    ReqBodyLbs (ReqBodyLbs),
    defaultHttpConfig,
    header,
    lbsResponse,
    req,
    responseBody,
    runReq,
    useURI,
  )
import qualified Network.HTTP.Req as R (Option)
import Relude hiding (ByteString)
import Text.URI (URI)

withHeader :: Header -> R.Option scheme
withHeader :: forall (scheme :: Scheme). Header -> Option scheme
withHeader (Text
k, Text
v) = forall (scheme :: Scheme).
ByteString -> ByteString -> Option scheme
header (String -> ByteString
L.pack forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
k) (String -> ByteString
L.pack forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
v)

setHeaders :: Headers -> R.Option scheme
setHeaders :: forall (scheme :: Scheme). Headers -> Option scheme
setHeaders = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall (scheme :: Scheme). Header -> Option scheme
withHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList

post :: URI -> ByteString -> Headers -> IO ByteString
post :: URI -> ByteString -> Headers -> IO ByteString
post URI
uri ByteString
body Headers
headers = case forall (scheme0 :: Scheme) (scheme1 :: Scheme).
URI
-> Maybe
     (Either (Url 'Http, Option scheme0) (Url 'Https, Option scheme1))
useURI URI
uri of
  Maybe
  (Either (Url 'Http, Option 'Http) (Url 'Https, Option 'Https))
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Invalid Endpoint: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show URI
uri forall a. Semigroup a => a -> a -> a
<> String
"!")
  (Just (Left (Url 'Http
u, Option 'Http
o))) -> forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req POST
POST Url 'Http
u (ByteString -> ReqBodyLbs
ReqBodyLbs ByteString
body) Proxy LbsResponse
lbsResponse (Option 'Http
o forall a. Semigroup a => a -> a -> a
<> forall (scheme :: Scheme). Headers -> Option scheme
setHeaders Headers
headers))
  (Just (Right (Url 'Https
u, Option 'Https
o))) -> forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig (forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req POST
POST Url 'Https
u (ByteString -> ReqBodyLbs
ReqBodyLbs ByteString
body) Proxy LbsResponse
lbsResponse (Option 'Https
o forall a. Semigroup a => a -> a -> a
<> forall (scheme :: Scheme). Headers -> Option scheme
setHeaders Headers
headers))

httpRequest :: (FromJSON a, RequestType a, ToJSON (RequestArgs a)) => URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest :: forall a.
(FromJSON a, RequestType a, ToJSON (RequestArgs a)) =>
URI -> Request a -> Headers -> IO (GQLClientResult a)
httpRequest URI
uri Request a
r Headers
h = forall a. FromJSON a => ByteString -> Either (FetchError a) a
decodeResponse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> URI -> ByteString -> Headers -> IO ByteString
post URI
uri (forall a. ToJSON a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a.
(RequestType a, ToJSON (RequestArgs a)) =>
Request a -> GQLRequest
toRequest Request a
r) Headers
h