{-# LANGUAGE UndecidableInstances #-}

module Hasura.Backends.DataConnector.Agent.Client
  ( AgentLicenseKey (..),
    AgentClientContext (..),
    AgentClientT,
    runAgentClientT,
    capabilities,
    schema,
    query,
    explain,
    mutation,
  )
where

--------------------------------------------------------------------------------

import Control.Exception (try)
import Control.Lens ((%=), (&~), (.=))
import Data.ByteString (ByteString)
import Data.Text.Extended (toTxt)
import Hasura.Backends.DataConnector.API qualified as API
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.RQL.Types.Common qualified as RQL
import Hasura.Tracing (MonadTrace, traceHTTPRequest)
import Network.HTTP.Client.Transformable qualified as HTTP
import Network.HTTP.Types.Status (Status)
import Servant.Client
import Servant.Client.Core (Request, RunClient (..))
import Servant.Client.Generic (genericClient)
import Servant.Client.Internal.HttpClient (clientResponseToResponse, mkFailureResponse)

-------------------------------------------------------------------------------rs

-- | Auth Key provided to the GDC Agent in 'Request' headers.
newtype AgentLicenseKey = AgentLicenseKey {AgentLicenseKey -> ByteString
unAgentLicenseKey :: ByteString}

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

newtype AgentClientT m a = AgentClientT (ReaderT AgentClientContext m a)
  deriving newtype ((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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> AgentClientT m a -> AgentClientT m b
fmap :: forall a b. (a -> b) -> AgentClientT m a -> AgentClientT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> AgentClientT m b -> AgentClientT m a
<$ :: forall a b. a -> AgentClientT m b -> AgentClientT m a
Functor, Functor (AgentClientT m)
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)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> AgentClientT m a
pure :: forall a. a -> AgentClientT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
<*> :: forall a b.
AgentClientT m (a -> b) -> AgentClientT m a -> AgentClientT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> AgentClientT m a -> AgentClientT m b -> AgentClientT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
*> :: forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
<* :: forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m a
Applicative, Applicative (AgentClientT m)
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)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
>>= :: forall a b.
AgentClientT m a -> (a -> AgentClientT m b) -> AgentClientT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
>> :: forall a b.
AgentClientT m a -> AgentClientT m b -> AgentClientT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> AgentClientT m a
return :: forall a. a -> AgentClientT m a
Monad, MonadError e, Monad (AgentClientT m)
AgentClientT m (Maybe TraceContext)
Monad (AgentClientT m)
-> (forall a.
    TraceContext
    -> SamplingPolicy -> Text -> AgentClientT m a -> AgentClientT m a)
-> (forall a.
    SpanId -> Text -> AgentClientT m a -> AgentClientT m a)
-> AgentClientT m (Maybe TraceContext)
-> (TraceMetadata -> AgentClientT m ())
-> MonadTrace (AgentClientT m)
TraceMetadata -> AgentClientT m ()
forall a. SpanId -> Text -> AgentClientT m a -> AgentClientT m a
forall a.
TraceContext
-> SamplingPolicy -> Text -> AgentClientT m a -> AgentClientT m a
forall (m :: * -> *).
Monad m
-> (forall a. TraceContext -> SamplingPolicy -> Text -> m a -> m a)
-> (forall a. SpanId -> Text -> m a -> m a)
-> m (Maybe TraceContext)
-> (TraceMetadata -> m ())
-> MonadTrace m
forall {m :: * -> *}. MonadTrace m => Monad (AgentClientT m)
forall (m :: * -> *).
MonadTrace m =>
AgentClientT m (Maybe TraceContext)
forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> AgentClientT m ()
forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> AgentClientT m a -> AgentClientT m a
forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> AgentClientT m a -> AgentClientT m a
$cnewTraceWith :: forall (m :: * -> *) a.
MonadTrace m =>
TraceContext
-> SamplingPolicy -> Text -> AgentClientT m a -> AgentClientT m a
newTraceWith :: forall a.
TraceContext
-> SamplingPolicy -> Text -> AgentClientT m a -> AgentClientT m a
$cnewSpanWith :: forall (m :: * -> *) a.
MonadTrace m =>
SpanId -> Text -> AgentClientT m a -> AgentClientT m a
newSpanWith :: forall a. SpanId -> Text -> AgentClientT m a -> AgentClientT m a
$ccurrentContext :: forall (m :: * -> *).
MonadTrace m =>
AgentClientT m (Maybe TraceContext)
currentContext :: AgentClientT m (Maybe TraceContext)
$cattachMetadata :: forall (m :: * -> *).
MonadTrace m =>
TraceMetadata -> AgentClientT m ()
attachMetadata :: TraceMetadata -> AgentClientT m ()
MonadTrace, Monad (AgentClientT m)
Monad (AgentClientT m)
-> (forall a. IO a -> AgentClientT m a) -> MonadIO (AgentClientT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> AgentClientT m a
liftIO :: forall a. IO a -> AgentClientT m a
MonadIO)

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

  -- Set the response timeout explicitly if it is provided
  let transformableReq' :: Request
transformableReq' =
        Request
transformableReq Request -> State Request () -> Request
forall s a. s -> State s a -> s
&~ do
          Maybe Int -> (Int -> State Request ()) -> State Request ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Int
_accResponseTimeout \Int
x -> (ResponseTimeout -> Identity ResponseTimeout)
-> Request -> Identity Request
Lens' Request ResponseTimeout
HTTP.timeout ((ResponseTimeout -> Identity ResponseTimeout)
 -> Request -> Identity Request)
-> ResponseTimeout -> State Request ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int -> ResponseTimeout
HTTP.responseTimeoutMicro Int
x
          ([Header] -> Identity [Header]) -> Request -> Identity Request
Lens' Request [Header]
HTTP.headers
            (([Header] -> Identity [Header]) -> Request -> Identity Request)
-> ([Header] -> [Header]) -> State Request ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= \[Header]
headers -> [Header]
-> (AgentLicenseKey -> [Header])
-> Maybe AgentLicenseKey
-> [Header]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Header]
headers (\(AgentLicenseKey ByteString
key) -> (HeaderName
"X-Hasura-License", ByteString
key) Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
headers) Maybe AgentLicenseKey
_accAgentLicenseKey

  (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.
(MonadIO m, MonadTrace m) =>
Request -> (Request -> m a) -> m a
traceHTTPRequest 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 a b. (a -> b) -> AgentClientT m a -> AgentClientT m b
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 a. IO a -> AgentClientT m a
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 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)
HTTP.httpLbs 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 -> QErr -> AgentClientT m Response
forall a. QErr -> AgentClientT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> AgentClientT m Response)
-> QErr -> AgentClientT m Response
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err500 Code
ConnectionNotEstablished (Text
"Error communicating with data connector agent: " 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
HTTP.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
HTTP.statusIsSuccessful Status
status
            Just [Status]
good -> Status
status Status -> [Status] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
good
      if Bool
goodStatus
        then Response -> AgentClientT m Response
forall a. a -> AgentClientT m a
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 a. ClientError -> AgentClientT m a
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' :: forall (m :: * -> *) a.
(MonadIO m, MonadTrace m, MonadError QErr m) =>
ClientError -> AgentClientT m a
throwClientError' ClientError
err = do
  AgentClientContext {Maybe Int
Maybe AgentLicenseKey
Manager
BaseUrl
Logger Hasura
_accLogger :: AgentClientContext -> Logger Hasura
_accBaseUrl :: AgentClientContext -> BaseUrl
_accHttpManager :: AgentClientContext -> Manager
_accResponseTimeout :: AgentClientContext -> Maybe Int
_accAgentLicenseKey :: AgentClientContext -> Maybe AgentLicenseKey
_accLogger :: Logger Hasura
_accBaseUrl :: BaseUrl
_accHttpManager :: Manager
_accResponseTimeout :: Maybe Int
_accAgentLicenseKey :: Maybe AgentLicenseKey
..} <- 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
  case ClientError
err of
    FailureResponse RequestF () (BaseUrl, ByteString)
_ Response
r | Response -> Status
forall a. ResponseF a -> Status
responseStatusCode Response
r Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
HTTP.status401 -> Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw401 Text
"EE License Key Required."
    ClientError
_ -> 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

-------------------------------------------------------------------------------

capabilities :: (MonadIO m, MonadTrace m, MonadError QErr m) => AgentClientT m API.CapabilitiesResponse
capabilities :: forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
AgentClientT m CapabilitiesResponse
capabilities = do
  Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m CapabilitiesResponse
capabilitiesGuard (Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]
 -> AgentClientT m CapabilitiesResponse)
-> AgentClientT
     m (Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400])
-> AgentClientT m CapabilitiesResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient @API.Routes Routes (AsClientT (AgentClientT m))
-> (Routes (AsClientT (AgentClientT m))
    -> AgentClientT
         m (Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]))
-> AgentClientT
     m (Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400])
forall a b. a -> (a -> b) -> b
// Routes (AsClientT (AgentClientT m))
-> AsClientT (AgentClientT m)
   :- ("capabilities"
       :> UVerb
            'GET
            '[JSON]
            '[CapabilitiesResponse, ErrorResponse, ErrorResponse400])
Routes (AsClientT (AgentClientT m))
-> AgentClientT
     m (Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400])
forall config mode.
RoutesG config mode
-> mode
   :- ("capabilities"
       :> UVerb
            'GET
            '[JSON]
            '[CapabilitiesResponse, ErrorResponse, ErrorResponse400])
API._capabilities)
  where
    errorAction :: ErrorResponse -> m a
errorAction ErrorResponse
e = Code -> Text -> Value -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (ErrorResponseType -> Code
mapErrorType (ErrorResponseType -> Code) -> ErrorResponseType -> Code
forall a b. (a -> b) -> a -> b
$ ErrorResponse -> ErrorResponseType
API._crType ErrorResponse
e) (ErrorResponse -> Text
API._crMessage ErrorResponse
e) (ErrorResponse -> Value
API._crDetails ErrorResponse
e)
    defaultAction :: AgentClientT m a
defaultAction = Code -> Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DataConnectorError Text
"Unexpected data connector capabilities response - Unexpected Type"
    capabilitiesGuard :: Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m CapabilitiesResponse
capabilitiesGuard = AgentClientT m CapabilitiesResponse
-> (CapabilitiesResponse -> AgentClientT m CapabilitiesResponse)
-> (ErrorResponse -> AgentClientT m CapabilitiesResponse)
-> Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m CapabilitiesResponse
forall a.
a
-> (CapabilitiesResponse -> a)
-> (ErrorResponse -> a)
-> Union '[CapabilitiesResponse, ErrorResponse, ErrorResponse400]
-> a
API.capabilitiesCase AgentClientT m CapabilitiesResponse
forall {a}. AgentClientT m a
defaultAction CapabilitiesResponse -> AgentClientT m CapabilitiesResponse
forall a. a -> AgentClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorResponse -> AgentClientT m CapabilitiesResponse
forall {m :: * -> *} {a}. MonadError QErr m => ErrorResponse -> m a
errorAction

schema :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> AgentClientT m API.SchemaResponse
schema :: forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
SourceName -> Config -> AgentClientT m SchemaResponse
schema SourceName
sourceName Config
config = do
  Union '[SchemaResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m SchemaResponse
schemaGuard (Union '[SchemaResponse, ErrorResponse, ErrorResponse400]
 -> AgentClientT m SchemaResponse)
-> AgentClientT
     m (Union '[SchemaResponse, ErrorResponse, ErrorResponse400])
-> AgentClientT m SchemaResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (RoutesG Config (AsClientT (AgentClientT m))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient RoutesG Config (AsClientT (AgentClientT m))
-> (RoutesG Config (AsClientT (AgentClientT m))
    -> Text
    -> Config
    -> AgentClientT
         m (Union '[SchemaResponse, ErrorResponse, ErrorResponse400]))
-> Text
-> Config
-> AgentClientT
     m (Union '[SchemaResponse, ErrorResponse, ErrorResponse400])
forall a b. a -> (a -> b) -> b
// RoutesG Config (AsClientT (AgentClientT m))
-> AsClientT (AgentClientT m)
   :- ("schema"
       :> (SourceNameHeader Required
           :> (ConfigHeader Config Required
               :> UVerb
                    'GET '[JSON] '[SchemaResponse, ErrorResponse, ErrorResponse400])))
RoutesG Config (AsClientT (AgentClientT m))
-> Text
-> Config
-> AgentClientT
     m (Union '[SchemaResponse, ErrorResponse, ErrorResponse400])
forall config mode. RoutesG config mode -> mode :- SchemaApi config
API._schema) (SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
sourceName) Config
config
  where
    errorAction :: ErrorResponse -> m a
errorAction ErrorResponse
e = Code -> Text -> Value -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (ErrorResponseType -> Code
mapErrorType (ErrorResponseType -> Code) -> ErrorResponseType -> Code
forall a b. (a -> b) -> a -> b
$ ErrorResponse -> ErrorResponseType
API._crType ErrorResponse
e) (ErrorResponse -> Text
API._crMessage ErrorResponse
e) (ErrorResponse -> Value
API._crDetails ErrorResponse
e)
    defaultAction :: AgentClientT m a
defaultAction = Code -> Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DataConnectorError Text
"Unexpected data connector schema response - Unexpected Type"
    schemaGuard :: Union '[SchemaResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m SchemaResponse
schemaGuard = AgentClientT m SchemaResponse
-> (SchemaResponse -> AgentClientT m SchemaResponse)
-> (ErrorResponse -> AgentClientT m SchemaResponse)
-> Union '[SchemaResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m SchemaResponse
forall a.
a
-> (SchemaResponse -> a)
-> (ErrorResponse -> a)
-> Union '[SchemaResponse, ErrorResponse, ErrorResponse400]
-> a
API.schemaCase AgentClientT m SchemaResponse
forall {a}. AgentClientT m a
defaultAction SchemaResponse -> AgentClientT m SchemaResponse
forall a. a -> AgentClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorResponse -> AgentClientT m SchemaResponse
forall {m :: * -> *} {a}. MonadError QErr m => ErrorResponse -> m a
errorAction

query :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.QueryRequest -> AgentClientT m API.QueryResponse
query :: forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
SourceName
-> Config -> QueryRequest -> AgentClientT m QueryResponse
query SourceName
sourceName Config
config QueryRequest
queryRequest = do
  Union '[QueryResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m QueryResponse
queryGuard (Union '[QueryResponse, ErrorResponse, ErrorResponse400]
 -> AgentClientT m QueryResponse)
-> AgentClientT
     m (Union '[QueryResponse, ErrorResponse, ErrorResponse400])
-> AgentClientT m QueryResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (RoutesG Config (AsClientT (AgentClientT m))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient RoutesG Config (AsClientT (AgentClientT m))
-> (RoutesG Config (AsClientT (AgentClientT m))
    -> Text
    -> Config
    -> QueryRequest
    -> AgentClientT
         m (Union '[QueryResponse, ErrorResponse, ErrorResponse400]))
-> Text
-> Config
-> QueryRequest
-> AgentClientT
     m (Union '[QueryResponse, ErrorResponse, ErrorResponse400])
forall a b. a -> (a -> b) -> b
// RoutesG Config (AsClientT (AgentClientT m))
-> AsClientT (AgentClientT m)
   :- ("query"
       :> (SourceNameHeader Required
           :> (ConfigHeader Config Required
               :> (ReqBody '[JSON] QueryRequest
                   :> UVerb
                        'POST '[JSON] '[QueryResponse, ErrorResponse, ErrorResponse400]))))
RoutesG Config (AsClientT (AgentClientT m))
-> Text
-> Config
-> QueryRequest
-> AgentClientT
     m (Union '[QueryResponse, ErrorResponse, ErrorResponse400])
forall config mode. RoutesG config mode -> mode :- QueryApi config
API._query) (SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
sourceName) Config
config QueryRequest
queryRequest
  where
    errorAction :: ErrorResponse -> m a
errorAction ErrorResponse
e = Code -> Text -> Value -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (ErrorResponseType -> Code
mapErrorType (ErrorResponseType -> Code) -> ErrorResponseType -> Code
forall a b. (a -> b) -> a -> b
$ ErrorResponse -> ErrorResponseType
API._crType ErrorResponse
e) (ErrorResponse -> Text
API._crMessage ErrorResponse
e) (ErrorResponse -> Value
API._crDetails ErrorResponse
e)
    defaultAction :: AgentClientT m a
defaultAction = Code -> Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DataConnectorError Text
"Unexpected data connector query response - Unexpected Type"
    queryGuard :: Union '[QueryResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m QueryResponse
queryGuard = AgentClientT m QueryResponse
-> (QueryResponse -> AgentClientT m QueryResponse)
-> (ErrorResponse -> AgentClientT m QueryResponse)
-> Union '[QueryResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m QueryResponse
forall a.
a
-> (QueryResponse -> a)
-> (ErrorResponse -> a)
-> Union '[QueryResponse, ErrorResponse, ErrorResponse400]
-> a
API.queryCase AgentClientT m QueryResponse
forall {a}. AgentClientT m a
defaultAction QueryResponse -> AgentClientT m QueryResponse
forall a. a -> AgentClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorResponse -> AgentClientT m QueryResponse
forall {m :: * -> *} {a}. MonadError QErr m => ErrorResponse -> m a
errorAction

explain :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.QueryRequest -> AgentClientT m API.ExplainResponse
explain :: forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
SourceName
-> Config -> QueryRequest -> AgentClientT m ExplainResponse
explain SourceName
sourceName Config
config QueryRequest
queryRequest = do
  (RoutesG Config (AsClientT (AgentClientT m))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient RoutesG Config (AsClientT (AgentClientT m))
-> (RoutesG Config (AsClientT (AgentClientT m))
    -> Text
    -> Config
    -> QueryRequest
    -> AgentClientT m ExplainResponse)
-> Text
-> Config
-> QueryRequest
-> AgentClientT m ExplainResponse
forall a b. a -> (a -> b) -> b
// RoutesG Config (AsClientT (AgentClientT m))
-> AsClientT (AgentClientT m)
   :- ("explain"
       :> (SourceNameHeader Required
           :> (ConfigHeader Config Required
               :> (ReqBody '[JSON] QueryRequest
                   :> Post '[JSON] ExplainResponse))))
RoutesG Config (AsClientT (AgentClientT m))
-> Text -> Config -> QueryRequest -> AgentClientT m ExplainResponse
forall config mode.
RoutesG config mode -> mode :- ExplainApi config
API._explain) (SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
sourceName) Config
config QueryRequest
queryRequest

mutation :: (MonadIO m, MonadTrace m, MonadError QErr m) => RQL.SourceName -> API.Config -> API.MutationRequest -> AgentClientT m API.MutationResponse
mutation :: forall (m :: * -> *).
(MonadIO m, MonadTrace m, MonadError QErr m) =>
SourceName
-> Config -> MutationRequest -> AgentClientT m MutationResponse
mutation SourceName
sourceName Config
config MutationRequest
mutationRequest = do
  Union '[MutationResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m MutationResponse
mutationGuard (Union '[MutationResponse, ErrorResponse, ErrorResponse400]
 -> AgentClientT m MutationResponse)
-> AgentClientT
     m (Union '[MutationResponse, ErrorResponse, ErrorResponse400])
-> AgentClientT m MutationResponse
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (RoutesG Config (AsClientT (AgentClientT m))
forall (routes :: * -> *) (m :: * -> *).
(HasClient m (ToServantApi routes),
 GenericServant routes (AsClientT m),
 Client m (ToServantApi routes) ~ ToServant routes (AsClientT m)) =>
routes (AsClientT m)
genericClient RoutesG Config (AsClientT (AgentClientT m))
-> (RoutesG Config (AsClientT (AgentClientT m))
    -> Text
    -> Config
    -> MutationRequest
    -> AgentClientT
         m (Union '[MutationResponse, ErrorResponse, ErrorResponse400]))
-> Text
-> Config
-> MutationRequest
-> AgentClientT
     m (Union '[MutationResponse, ErrorResponse, ErrorResponse400])
forall a b. a -> (a -> b) -> b
// RoutesG Config (AsClientT (AgentClientT m))
-> AsClientT (AgentClientT m)
   :- ("mutation"
       :> (SourceNameHeader Required
           :> (ConfigHeader Config Required
               :> (ReqBody '[JSON] MutationRequest
                   :> UVerb
                        'POST
                        '[JSON]
                        '[MutationResponse, ErrorResponse, ErrorResponse400]))))
RoutesG Config (AsClientT (AgentClientT m))
-> Text
-> Config
-> MutationRequest
-> AgentClientT
     m (Union '[MutationResponse, ErrorResponse, ErrorResponse400])
forall config mode.
RoutesG config mode -> mode :- MutationApi config
API._mutation) (SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
sourceName) Config
config MutationRequest
mutationRequest
  where
    errorAction :: ErrorResponse -> m a
errorAction ErrorResponse
e = Code -> Text -> Value -> m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (ErrorResponseType -> Code
mapErrorType (ErrorResponseType -> Code) -> ErrorResponseType -> Code
forall a b. (a -> b) -> a -> b
$ ErrorResponse -> ErrorResponseType
API._crType ErrorResponse
e) (ErrorResponse -> Text
API._crMessage ErrorResponse
e) (ErrorResponse -> Value
API._crDetails ErrorResponse
e)
    defaultAction :: AgentClientT m a
defaultAction = Code -> Text -> AgentClientT m a
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
DataConnectorError Text
"Unexpected data connector mutation response - Unexpected Type"
    mutationGuard :: Union '[MutationResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m MutationResponse
mutationGuard = AgentClientT m MutationResponse
-> (MutationResponse -> AgentClientT m MutationResponse)
-> (ErrorResponse -> AgentClientT m MutationResponse)
-> Union '[MutationResponse, ErrorResponse, ErrorResponse400]
-> AgentClientT m MutationResponse
forall a.
a
-> (MutationResponse -> a)
-> (ErrorResponse -> a)
-> Union '[MutationResponse, ErrorResponse, ErrorResponse400]
-> a
API.mutationCase AgentClientT m MutationResponse
forall {a}. AgentClientT m a
defaultAction MutationResponse -> AgentClientT m MutationResponse
forall a. a -> AgentClientT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorResponse -> AgentClientT m MutationResponse
forall {m :: * -> *} {a}. MonadError QErr m => ErrorResponse -> m a
errorAction

mapErrorType :: API.ErrorResponseType -> Code
mapErrorType :: ErrorResponseType -> Code
mapErrorType = \case
  ErrorResponseType
API.UncaughtError -> Code
DataConnectorError
  ErrorResponseType
API.MutationConstraintViolation -> Code
ConstraintViolation
  ErrorResponseType
API.MutationPermissionCheckFailure -> Code
PermissionError