{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hasura.Backends.DataConnector.Adapter.Transport () where

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

import Control.Exception.Safe (throwIO)
import Data.Aeson qualified as J
import Data.Text.Extended ((<>>))
import Hasura.Backends.DataConnector.Adapter.Execute ()
import Hasura.Backends.DataConnector.Adapter.Types (SourceConfig (..))
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), AgentClientT, runAgentClientT)
import Hasura.Backends.DataConnector.IR.Query qualified as IR.Q
import Hasura.Backends.DataConnector.Plan qualified as DC
import Hasura.Base.Error (Code (NotSupported), QErr, throw400)
import Hasura.EncJSON (EncJSON)
import Hasura.GraphQL.Execute.Backend (DBStepInfo (..))
import Hasura.GraphQL.Logging qualified as HGL
import Hasura.GraphQL.Namespace (RootFieldAlias)
import Hasura.GraphQL.Transport.Backend (BackendTransport (..))
import Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
import Hasura.Logging (Hasura, Logger, nullLogger)
import Hasura.Prelude
import Hasura.SQL.Backend (BackendType (DataConnector))
import Hasura.Server.Types (RequestId)
import Hasura.Session (UserInfo)
import Hasura.Tracing qualified as Tracing

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

instance BackendTransport 'DataConnector where
  runDBQuery :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig 'DataConnector
-> ExecutionMonad 'DataConnector EncJSON
-> Maybe (PreparedQuery 'DataConnector)
-> m (DiffTime, EncJSON)
runDBQuery = RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig 'DataConnector
-> ExecutionMonad 'DataConnector EncJSON
-> Maybe (PreparedQuery 'DataConnector)
-> m (DiffTime, EncJSON)
forall (m :: * -> *) a.
(MonadIO m, MonadError QErr m, MonadTrace m, MonadQueryLog m) =>
RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> Maybe QueryRequest
-> m (DiffTime, a)
runDBQuery'
  runDBQueryExplain :: DBStepInfo 'DataConnector -> m EncJSON
runDBQueryExplain = DBStepInfo 'DataConnector -> m EncJSON
forall (m :: * -> *).
(MonadIO m, MonadError QErr m) =>
DBStepInfo 'DataConnector -> m EncJSON
runDBQueryExplain'
  runDBMutation :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig 'DataConnector
-> ExecutionMonad 'DataConnector EncJSON
-> Maybe (PreparedQuery 'DataConnector)
-> m (DiffTime, EncJSON)
runDBMutation RequestId
_ GQLReqUnparsed
_ RootFieldAlias
_ UserInfo
_ Logger Hasura
_ SourceConfig 'DataConnector
_ ExecutionMonad 'DataConnector EncJSON
_ Maybe (PreparedQuery 'DataConnector)
_ =
    Code -> Text -> m (DiffTime, EncJSON)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"runDBMutation: not implemented for the Data Connector backend."
  runDBStreamingSubscription :: SourceConfig 'DataConnector
-> MultiplexedQuery 'DataConnector
-> [(CohortId, CohortVariables)]
-> m (DiffTime,
      Either QErr [(CohortId, ByteString, CursorVariableValues)])
runDBStreamingSubscription SourceConfig 'DataConnector
_ MultiplexedQuery 'DataConnector
_ [(CohortId, CohortVariables)]
_ =
    IO
  (DiffTime,
   Either QErr [(CohortId, ByteString, CursorVariableValues)])
-> m (DiffTime,
      Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (DiffTime,
    Either QErr [(CohortId, ByteString, CursorVariableValues)])
 -> m (DiffTime,
       Either QErr [(CohortId, ByteString, CursorVariableValues)]))
-> (IOError
    -> IO
         (DiffTime,
          Either QErr [(CohortId, ByteString, CursorVariableValues)]))
-> IOError
-> m (DiffTime,
      Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError
-> IO
     (DiffTime,
      Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOError
 -> m (DiffTime,
       Either QErr [(CohortId, ByteString, CursorVariableValues)]))
-> IOError
-> m (DiffTime,
      Either QErr [(CohortId, ByteString, CursorVariableValues)])
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"runDBStreamingSubscription: not implemented for the Data Connector backend."
  runDBSubscription :: SourceConfig 'DataConnector
-> MultiplexedQuery 'DataConnector
-> [(CohortId, CohortVariables)]
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
runDBSubscription SourceConfig 'DataConnector
_ MultiplexedQuery 'DataConnector
_ [(CohortId, CohortVariables)]
_ =
    IO (DiffTime, Either QErr [(CohortId, ByteString)])
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (DiffTime, Either QErr [(CohortId, ByteString)])
 -> m (DiffTime, Either QErr [(CohortId, ByteString)]))
-> (IOError -> IO (DiffTime, Either QErr [(CohortId, ByteString)]))
-> IOError
-> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOError -> IO (DiffTime, Either QErr [(CohortId, ByteString)])
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOError -> m (DiffTime, Either QErr [(CohortId, ByteString)]))
-> IOError -> m (DiffTime, Either QErr [(CohortId, ByteString)])
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError String
"runDBSubscription: not implemented for the Data Connector backend."

runDBQuery' ::
  ( MonadIO m,
    MonadError QErr m,
    Tracing.MonadTrace m,
    HGL.MonadQueryLog m
  ) =>
  RequestId ->
  GQLReqUnparsed ->
  RootFieldAlias ->
  UserInfo ->
  Logger Hasura ->
  SourceConfig ->
  AgentClientT (Tracing.TraceT (ExceptT QErr IO)) a ->
  Maybe IR.Q.QueryRequest ->
  m (DiffTime, a)
runDBQuery' :: RequestId
-> GQLReqUnparsed
-> RootFieldAlias
-> UserInfo
-> Logger Hasura
-> SourceConfig
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> Maybe QueryRequest
-> m (DiffTime, a)
runDBQuery' RequestId
requestId GQLReqUnparsed
query RootFieldAlias
fieldName UserInfo
_userInfo Logger Hasura
logger SourceConfig {Maybe Int
Maybe Text
SchemaResponse
Capabilities
Config
Manager
BaseUrl
DataConnectorName
_scDataConnectorName :: SourceConfig -> DataConnectorName
_scTimeoutMicroseconds :: SourceConfig -> Maybe Int
_scManager :: SourceConfig -> Manager
_scSchema :: SourceConfig -> SchemaResponse
_scCapabilities :: SourceConfig -> Capabilities
_scTemplate :: SourceConfig -> Maybe Text
_scConfig :: SourceConfig -> Config
_scEndpoint :: SourceConfig -> BaseUrl
_scDataConnectorName :: DataConnectorName
_scTimeoutMicroseconds :: Maybe Int
_scManager :: Manager
_scSchema :: SchemaResponse
_scCapabilities :: Capabilities
_scTemplate :: Maybe Text
_scConfig :: Config
_scEndpoint :: BaseUrl
..} AgentClientT (TraceT (ExceptT QErr IO)) a
action Maybe QueryRequest
queryRequest = do
  m () -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Logger Hasura -> QueryLog -> m ()
forall (m :: * -> *).
MonadQueryLog m =>
Logger Hasura -> QueryLog -> m ()
HGL.logQueryLog Logger Hasura
logger (QueryLog -> m ()) -> QueryLog -> m ()
forall a b. (a -> b) -> a -> b
$ GQLReqUnparsed
-> RootFieldAlias -> Maybe QueryRequest -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
query RootFieldAlias
fieldName Maybe QueryRequest
queryRequest RequestId
requestId
  m a -> m (DiffTime, a)
forall (m :: * -> *) a. MonadIO m => m a -> m (DiffTime, a)
withElapsedTime
    (m a -> m (DiffTime, a))
-> (AgentClientT (TraceT (ExceptT QErr IO)) a -> m a)
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> m (DiffTime, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m a -> m a
forall (m :: * -> *) a. MonadTrace m => Text -> m a -> m a
Tracing.trace (Text
"Data Connector backend query for root field " Text -> RootFieldAlias -> Text
forall t. ToTxt t => Text -> t -> Text
<>> RootFieldAlias
fieldName)
    (m a -> m a)
-> (AgentClientT (TraceT (ExceptT QErr IO)) a -> m a)
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExceptT QErr IO (a, TracingMetadata) -> m (a, TracingMetadata))
-> TraceT (ExceptT QErr IO) a -> m a
forall (n :: * -> *) (m :: * -> *) a b.
MonadTrace n =>
(m (a, TracingMetadata) -> n (b, TracingMetadata))
-> TraceT m a -> n b
Tracing.interpTraceT (m (Either QErr (a, TracingMetadata)) -> m (a, TracingMetadata)
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr (a, TracingMetadata)) -> m (a, TracingMetadata))
-> (ExceptT QErr IO (a, TracingMetadata)
    -> m (Either QErr (a, TracingMetadata)))
-> ExceptT QErr IO (a, TracingMetadata)
-> m (a, TracingMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either QErr (a, TracingMetadata))
-> m (Either QErr (a, TracingMetadata))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either QErr (a, TracingMetadata))
 -> m (Either QErr (a, TracingMetadata)))
-> (ExceptT QErr IO (a, TracingMetadata)
    -> IO (Either QErr (a, TracingMetadata)))
-> ExceptT QErr IO (a, TracingMetadata)
-> m (Either QErr (a, TracingMetadata))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr IO (a, TracingMetadata)
-> IO (Either QErr (a, TracingMetadata))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT)
    (TraceT (ExceptT QErr IO) a -> m a)
-> (AgentClientT (TraceT (ExceptT QErr IO)) a
    -> TraceT (ExceptT QErr IO) a)
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClientT (TraceT (ExceptT QErr IO)) a
 -> AgentClientContext -> TraceT (ExceptT QErr IO) a)
-> AgentClientContext
-> AgentClientT (TraceT (ExceptT QErr IO)) a
-> TraceT (ExceptT QErr IO) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClientT (TraceT (ExceptT QErr IO)) a
-> AgentClientContext -> TraceT (ExceptT QErr IO) a
forall (m :: * -> *) a.
AgentClientT m a -> AgentClientContext -> m a
runAgentClientT (Logger Hasura
-> BaseUrl -> Manager -> Maybe Int -> AgentClientContext
AgentClientContext Logger Hasura
logger BaseUrl
_scEndpoint Manager
_scManager Maybe Int
_scTimeoutMicroseconds)
    (AgentClientT (TraceT (ExceptT QErr IO)) a -> m (DiffTime, a))
-> AgentClientT (TraceT (ExceptT QErr IO)) a -> m (DiffTime, a)
forall a b. (a -> b) -> a -> b
$ AgentClientT (TraceT (ExceptT QErr IO)) a
action

mkQueryLog ::
  GQLReqUnparsed ->
  RootFieldAlias ->
  Maybe IR.Q.QueryRequest ->
  RequestId ->
  HGL.QueryLog
mkQueryLog :: GQLReqUnparsed
-> RootFieldAlias -> Maybe QueryRequest -> RequestId -> QueryLog
mkQueryLog GQLReqUnparsed
gqlQuery RootFieldAlias
fieldName Maybe QueryRequest
maybeQuery RequestId
requestId =
  GQLReqUnparsed
-> Maybe (RootFieldAlias, GeneratedQuery)
-> RequestId
-> QueryLogKind
-> QueryLog
HGL.QueryLog
    GQLReqUnparsed
gqlQuery
    ((\QueryRequest
query -> (RootFieldAlias
fieldName, Text -> Value -> GeneratedQuery
HGL.GeneratedQuery (QueryRequest -> Text
DC.renderQuery QueryRequest
query) Value
J.Null)) (QueryRequest -> (RootFieldAlias, GeneratedQuery))
-> Maybe QueryRequest -> Maybe (RootFieldAlias, GeneratedQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe QueryRequest
maybeQuery)
    RequestId
requestId
    QueryLogKind
HGL.QueryLogKindDatabase

runDBQueryExplain' ::
  (MonadIO m, MonadError QErr m) =>
  DBStepInfo 'DataConnector ->
  m EncJSON
runDBQueryExplain' :: DBStepInfo 'DataConnector -> m EncJSON
runDBQueryExplain' (DBStepInfo SourceName
_ SourceConfig {..} Maybe (PreparedQuery 'DataConnector)
_ ExecutionMonad 'DataConnector EncJSON
action) =
  m (Either QErr EncJSON) -> m EncJSON
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr EncJSON) -> m EncJSON)
-> (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
    -> m (Either QErr EncJSON))
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either QErr EncJSON) -> m (Either QErr EncJSON)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
    (IO (Either QErr EncJSON) -> m (Either QErr EncJSON))
-> (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
    -> IO (Either QErr EncJSON))
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> m (Either QErr EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT QErr IO EncJSON -> IO (Either QErr EncJSON)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT QErr IO EncJSON -> IO (Either QErr EncJSON))
-> (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
    -> ExceptT QErr IO EncJSON)
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> IO (Either QErr EncJSON)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reporter
-> Text
-> TraceT (ExceptT QErr IO) EncJSON
-> ExceptT QErr IO EncJSON
forall (m :: * -> *) a.
MonadIO m =>
Reporter -> Text -> TraceT m a -> m a
Tracing.runTraceTWithReporter Reporter
Tracing.noReporter Text
"explain"
    (TraceT (ExceptT QErr IO) EncJSON -> ExceptT QErr IO EncJSON)
-> (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
    -> TraceT (ExceptT QErr IO) EncJSON)
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> ExceptT QErr IO EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
 -> AgentClientContext -> TraceT (ExceptT QErr IO) EncJSON)
-> AgentClientContext
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> TraceT (ExceptT QErr IO) EncJSON
forall a b c. (a -> b -> c) -> b -> a -> c
flip AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
-> AgentClientContext -> TraceT (ExceptT QErr IO) EncJSON
forall (m :: * -> *) a.
AgentClientT m a -> AgentClientContext -> m a
runAgentClientT (Logger Hasura
-> BaseUrl -> Manager -> Maybe Int -> AgentClientContext
AgentClientContext Logger Hasura
nullLogger BaseUrl
_scEndpoint Manager
_scManager Maybe Int
_scTimeoutMicroseconds)
    (AgentClientT (TraceT (ExceptT QErr IO)) EncJSON -> m EncJSON)
-> AgentClientT (TraceT (ExceptT QErr IO)) EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ AgentClientT (TraceT (ExceptT QErr IO)) EncJSON
ExecutionMonad 'DataConnector EncJSON
action