{-# LANGUAGE UndecidableInstances #-}

module Hasura.Backends.DataConnector.Agent.Client
  ( AgentClientContext (..),
    AgentClientT,
    runAgentClientT,
  )
where

import Control.Exception (try)
import Control.Lens ((&~), (.=))
import Hasura.Backends.DataConnector.Logging (logAgentRequest, logClientError)
import Hasura.Base.Error
import Hasura.HTTP qualified
import Hasura.Logging (Hasura, Logger)
import Hasura.Prelude
import Hasura.Tracing (MonadTrace, tracedHttpRequest)
import Network.HTTP.Client (Manager)
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.Transformable qualified as TransformableHTTP
import Network.HTTP.Types.Status (Status)
import Servant.Client
import Servant.Client.Core (Request, RunClient (..))
import Servant.Client.Internal.HttpClient (clientResponseToResponse, mkFailureResponse)

data AgentClientContext = AgentClientContext
  { AgentClientContext -> Logger Hasura
_accLogger :: Logger Hasura,
    AgentClientContext -> BaseUrl
_accBaseUrl :: BaseUrl,
    AgentClientContext -> Manager
_accHttpManager :: Manager,
    AgentClientContext -> Maybe Int
_accResponseTimeout :: Maybe Int
  }

newtype AgentClientT m a = AgentClientT (ReaderT AgentClientContext m a)
  deriving newtype (a -> AgentClientT m b -> AgentClientT m a
(a -> b) -> AgentClientT m a -> AgentClientT m b
(forall a b. (a -> b) -> AgentClientT m a -> AgentClientT m b)
-> (forall a b. a -> AgentClientT m b -> AgentClientT m a)
-> Functor (AgentClientT m)
forall a b. a -> AgentClientT m b -> AgentClientT m a
forall a b. (a -> b) -> AgentClientT m a -> AgentClientT m b
forall (m :: * -> *) a b.
Functor m =>
a -> AgentClientT m b -> AgentClientT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AgentClientT m a -> AgentClientT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AgentClientT m b -> AgentClientT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> AgentClientT m b -> AgentClientT m a
fmap :: (a -> b) -> AgentClientT m a -> AgentClientT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AgentClientT m a -> AgentClientT m b
Functor, Functor (AgentClientT m)
a -> AgentClientT m a
Functor (AgentClientT m)
-> (forall a. a -> AgentClientT m a)
-> (forall a b.
    AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b)
-> (forall a b c.
    (a -> b -> c)
    -> AgentClientT m a -> AgentClientT m b -> AgentClientT m c)
-> (forall a b.
    AgentClientT m a -> AgentClientT m b -> AgentClientT m b)
-> (forall a b.
    AgentClientT m a -> AgentClientT m b -> AgentClientT m a)
-> Applicative (AgentClientT m)
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
forall a. a -> AgentClientT m a
forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
forall a b.
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
forall a b c.
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m 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 (m :: * -> *). Applicative m => Functor (AgentClientT m)
forall (m :: * -> *) a. Applicative m => a -> AgentClientT m a
forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
<* :: AgentClientT m a -> AgentClientT m b -> AgentClientT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
*> :: AgentClientT m a -> AgentClientT m b -> AgentClientT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
liftA2 :: (a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
<*> :: AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
pure :: a -> AgentClientT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> AgentClientT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (AgentClientT m)
Applicative, Applicative (AgentClientT m)
a -> AgentClientT m a
Applicative (AgentClientT m)
-> (forall a b.
    AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b)
-> (forall a b.
    AgentClientT m a -> AgentClientT m b -> AgentClientT m b)
-> (forall a. a -> AgentClientT m a)
-> Monad (AgentClientT m)
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
forall a. a -> AgentClientT m a
forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
forall a b.
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
forall (m :: * -> *). Monad m => Applicative (AgentClientT m)
forall (m :: * -> *) a. Monad m => a -> AgentClientT m a
forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m 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 :: a -> AgentClientT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> AgentClientT m a
>> :: AgentClientT m a -> AgentClientT m b -> AgentClientT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
>>= :: AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (AgentClientT m)
Monad, MonadError e, Monad (AgentClientT m)
AgentClientT m TraceContext
AgentClientT m Reporter
Monad (AgentClientT m)
-> (forall a. Text -> AgentClientT m a -> AgentClientT m a)
-> AgentClientT m TraceContext
-> AgentClientT m Reporter
-> (TracingMetadata -> AgentClientT m ())
-> MonadTrace (AgentClientT m)
TracingMetadata -> AgentClientT m ()
Text -> AgentClientT m a -> AgentClientT m a
forall a. Text -> AgentClientT m a -> AgentClientT m a
forall (m :: * -> *).
Monad m
-> (forall a. Text -> m a -> m a)
-> m TraceContext
-> m Reporter
-> (TracingMetadata -> m ())
-> MonadTrace m
forall (m :: * -> *). MonadTrace m => Monad (AgentClientT m)
forall (m :: * -> *). MonadTrace m => AgentClientT m TraceContext
forall (m :: * -> *). MonadTrace m => AgentClientT m Reporter
forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> AgentClientT m ()
forall (m :: * -> *) a.
MonadTrace m =>
Text -> AgentClientT m a -> AgentClientT m a
attachMetadata :: TracingMetadata -> AgentClientT m ()
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TracingMetadata -> AgentClientT m ()
currentReporter :: AgentClientT m Reporter
$ccurrentReporter :: forall (m :: * -> *). MonadTrace m => AgentClientT m Reporter
currentContext :: AgentClientT m TraceContext
$ccurrentContext :: forall (m :: * -> *). MonadTrace m => AgentClientT m TraceContext
trace :: Text -> AgentClientT m a -> AgentClientT m a
$ctrace :: forall (m :: * -> *) a.
MonadTrace m =>
Text -> AgentClientT m a -> AgentClientT m a
$cp1MonadTrace :: forall (m :: * -> *). MonadTrace m => Monad (AgentClientT m)
MonadTrace, Monad (AgentClientT m)
Monad (AgentClientT m)
-> (forall a. IO a -> AgentClientT m a) -> MonadIO (AgentClientT m)
IO a -> AgentClientT m a
forall a. IO a -> AgentClientT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (AgentClientT m)
forall (m :: * -> *) a. MonadIO m => IO a -> AgentClientT m a
liftIO :: IO a -> AgentClientT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> AgentClientT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (AgentClientT m)
MonadIO)

runAgentClientT :: AgentClientT m a -> AgentClientContext -> m a
runAgentClientT :: AgentClientT m a -> AgentClientContext -> m a
runAgentClientT (AgentClientT ReaderT AgentClientContext m a
action) AgentClientContext
ctx = ReaderT AgentClientContext m a -> AgentClientContext -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT AgentClientContext m a
action AgentClientContext
ctx

askClientContext :: Monad m => AgentClientT m AgentClientContext
askClientContext :: AgentClientT m AgentClientContext
askClientContext = ReaderT AgentClientContext m AgentClientContext
-> AgentClientT m AgentClientContext
forall (m :: * -> *) a.
ReaderT AgentClientContext m a -> AgentClientT m a
AgentClientT ReaderT AgentClientContext m AgentClientContext
forall r (m :: * -> *). MonadReader r m => m r
ask

instance (MonadIO m, MonadTrace m, MonadError QErr m) => RunClient (AgentClientT m) where
  runRequestAcceptStatus :: Maybe [Status] -> Request -> AgentClientT m Response
runRequestAcceptStatus = Maybe [Status] -> Request -> AgentClientT m Response
forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
Maybe [Status] -> Request -> AgentClientT m Response
runRequestAcceptStatus'
  throwClientError :: ClientError -> AgentClientT m a
throwClientError = ClientError -> AgentClientT m a
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m, MonadError QErr m) =>
ClientError -> AgentClientT m a
throwClientError'

runRequestAcceptStatus' :: (MonadIO m, MonadTrace m, MonadError QErr m) => Maybe [Status] -> Request -> (AgentClientT m) Response
runRequestAcceptStatus' :: Maybe [Status] -> Request -> AgentClientT m Response
runRequestAcceptStatus' Maybe [Status]
acceptStatus Request
req = do
  AgentClientContext {Maybe Int
Logger Hasura
Manager
BaseUrl
_accResponseTimeout :: Maybe Int
_accHttpManager :: Manager
_accBaseUrl :: BaseUrl
_accLogger :: Logger Hasura
_accResponseTimeout :: AgentClientContext -> Maybe Int
_accHttpManager :: AgentClientContext -> Manager
_accBaseUrl :: AgentClientContext -> BaseUrl
_accLogger :: AgentClientContext -> Logger Hasura
..} <- AgentClientT m AgentClientContext
forall (m :: * -> *). Monad m => AgentClientT m AgentClientContext
askClientContext
  let req' :: Request
req' = BaseUrl -> Request -> Request
defaultMakeClientRequest BaseUrl
_accBaseUrl Request
req

  Request
transformableReq <-
    Request -> Either Text Request
TransformableHTTP.tryFromClientRequest Request
req'
      Either Text Request
-> (Text -> AgentClientT m Request) -> AgentClientT m Request
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (\Text
err -> Text -> AgentClientT m Request
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> AgentClientT m Request) -> Text -> AgentClientT m Request
forall a b. (a -> b) -> a -> b
$ Text
"Error in Data Connector backend: Could not create request. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
err)

  -- Set the response timeout explicitly if it is provided
  let transformableReq' :: Request
transformableReq' =
        Request
transformableReq Request -> State Request (Maybe ()) -> Request
forall s a. s -> State s a -> s
&~ do
          Maybe Int
-> (Int -> StateT Request Identity ()) -> State Request (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe Int
_accResponseTimeout \Int
x -> (ResponseTimeout -> Identity ResponseTimeout)
-> Request -> Identity Request
Lens' Request ResponseTimeout
TransformableHTTP.timeout ((ResponseTimeout -> Identity ResponseTimeout)
 -> Request -> Identity Request)
-> ResponseTimeout -> StateT Request Identity ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> ResponseTimeout
HTTP.responseTimeoutMicro Int
x

  (Request
tracedReq, Either HttpException (Response ByteString)
responseOrException) <- Request
-> (Request
    -> AgentClientT
         m (Request, Either HttpException (Response ByteString)))
-> AgentClientT
     m (Request, Either HttpException (Response ByteString))
forall (m :: * -> *) a.
MonadTrace m =>
Request -> (Request -> m a) -> m a
tracedHttpRequest Request
transformableReq' (\Request
tracedReq -> (Either HttpException (Response ByteString)
 -> (Request, Either HttpException (Response ByteString)))
-> AgentClientT m (Either HttpException (Response ByteString))
-> AgentClientT
     m (Request, Either HttpException (Response ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Request
tracedReq,) (AgentClientT m (Either HttpException (Response ByteString))
 -> AgentClientT
      m (Request, Either HttpException (Response ByteString)))
-> (IO (Response ByteString)
    -> AgentClientT m (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> AgentClientT
     m (Request, Either HttpException (Response ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either HttpException (Response ByteString))
-> AgentClientT m (Either HttpException (Response ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HttpException (Response ByteString))
 -> AgentClientT m (Either HttpException (Response ByteString)))
-> (IO (Response ByteString)
    -> IO (Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> AgentClientT m (Either HttpException (Response ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Exception HttpException =>
IO a -> IO (Either HttpException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @HTTP.HttpException (IO (Response ByteString)
 -> AgentClientT
      m (Request, Either HttpException (Response ByteString)))
-> IO (Response ByteString)
-> AgentClientT
     m (Request, Either HttpException (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
TransformableHTTP.performRequest Request
tracedReq Manager
_accHttpManager)
  Logger Hasura
-> Request
-> Either HttpException (Response ByteString)
-> AgentClientT m ()
forall (m :: * -> *).
(MonadIO m, MonadTrace m) =>
Logger Hasura
-> Request -> Either HttpException (Response ByteString) -> m ()
logAgentRequest Logger Hasura
_accLogger Request
tracedReq Either HttpException (Response ByteString)
responseOrException
  case Either HttpException (Response ByteString)
responseOrException of
    Left HttpException
ex ->
      Text -> AgentClientT m Response
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> AgentClientT m Response)
-> Text -> AgentClientT m Response
forall a b. (a -> b) -> a -> b
$ Text
"Error in Data Connector backend: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HttpException -> Text
Hasura.HTTP.serializeHTTPExceptionMessage (HttpException -> HttpException
Hasura.HTTP.HttpException HttpException
ex)
    Right Response ByteString
response -> do
      let status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
TransformableHTTP.responseStatus Response ByteString
response
          servantResponse :: Response
servantResponse = (ByteString -> ByteString) -> Response ByteString -> Response
forall a b. (a -> b) -> Response a -> ResponseF b
clientResponseToResponse ByteString -> ByteString
forall a. a -> a
id Response ByteString
response
          goodStatus :: Bool
goodStatus = case Maybe [Status]
acceptStatus of
            Maybe [Status]
Nothing -> Status -> Bool
TransformableHTTP.statusIsSuccessful Status
status
            Just [Status]
good -> Status
status Status -> [Status] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
good
      if Bool
goodStatus
        then Response -> AgentClientT m Response
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> AgentClientT m Response)
-> Response -> AgentClientT m Response
forall a b. (a -> b) -> a -> b
$ Response
servantResponse
        else ClientError -> AgentClientT m Response
forall (m :: * -> *) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> AgentClientT m Response)
-> ClientError -> AgentClientT m Response
forall a b. (a -> b) -> a -> b
$ BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
_accBaseUrl Request
req Response
servantResponse

throwClientError' :: (MonadIO m, MonadTrace m, MonadError QErr m) => ClientError -> (AgentClientT m) a
throwClientError' :: ClientError -> AgentClientT m a
throwClientError' ClientError
err = do
  AgentClientContext {Maybe Int
Logger Hasura
Manager
BaseUrl
_accResponseTimeout :: Maybe Int
_accHttpManager :: Manager
_accBaseUrl :: BaseUrl
_accLogger :: Logger Hasura
_accResponseTimeout :: AgentClientContext -> Maybe Int
_accHttpManager :: AgentClientContext -> Manager
_accBaseUrl :: AgentClientContext -> BaseUrl
_accLogger :: AgentClientContext -> Logger Hasura
..} <- AgentClientT m AgentClientContext
forall (m :: * -> *). Monad m => AgentClientT m AgentClientContext
askClientContext
  Logger Hasura -> ClientError -> AgentClientT m ()
forall (m :: * -> *).
(MonadIO m, MonadTrace m) =>
Logger Hasura -> ClientError -> m ()
logClientError Logger Hasura
_accLogger ClientError
err
  Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> AgentClientT m a) -> Text -> AgentClientT m a
forall a b. (a -> b) -> a -> b
$ Text
"Error in Data Connector backend: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ClientError -> Text
Hasura.HTTP.serializeServantClientErrorMessage ClientError
err