module Hasura.GraphQL.Execute.RemoteJoin.Source
(
makeSourceJoinCall,
SourceJoinCall (..),
buildSourceJoinCall,
buildJoinIndex,
)
where
import Data.Aeson qualified as J
import Data.Aeson.Key qualified as K
import Data.Aeson.KeyMap qualified as KM
import Data.Aeson.Ordered qualified as AO
import Data.Aeson.Ordered qualified as JO
import Data.Bifunctor (bimap)
import Data.ByteString.Lazy qualified as BL
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.IntMap.Strict qualified as IntMap
import Data.List.NonEmpty qualified as NE
import Data.Scientific qualified as Scientific
import Data.Text qualified as T
import Data.Text.Extended ((<<>), (<>>))
import Data.Text.Read qualified as TR
import Hasura.Base.Error
import Hasura.GraphQL.Execute.Backend qualified as EB
import Hasura.GraphQL.Execute.Instances ()
import Hasura.GraphQL.Execute.RemoteJoin.Types
import Hasura.GraphQL.Namespace
import Hasura.GraphQL.Transport.Instances ()
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Session
import Hasura.Tracing (MonadTrace)
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP
makeSourceJoinCall ::
(MonadQueryTags m, MonadError QErr m, MonadTrace m, MonadIO m) =>
(AB.AnyBackend SourceJoinCall -> m BL.ByteString) ->
UserInfo ->
AB.AnyBackend RemoteSourceJoin ->
FieldName ->
IntMap.IntMap JoinArgument ->
[HTTP.Header] ->
Maybe G.Name ->
m (Maybe (IntMap.IntMap AO.Value))
makeSourceJoinCall :: forall (m :: * -> *).
(MonadQueryTags m, MonadError QErr m, MonadTrace m, MonadIO m) =>
(AnyBackend SourceJoinCall -> m ByteString)
-> UserInfo
-> AnyBackend RemoteSourceJoin
-> FieldName
-> IntMap JoinArgument
-> [Header]
-> Maybe Name
-> m (Maybe (IntMap Value))
makeSourceJoinCall AnyBackend SourceJoinCall -> m ByteString
networkFunction UserInfo
userInfo AnyBackend RemoteSourceJoin
remoteSourceJoin FieldName
jaFieldName IntMap JoinArgument
joinArguments [Header]
reqHeaders Maybe Name
operationName =
Text -> m (Maybe (IntMap Value)) -> m (Maybe (IntMap Value))
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan (Text
"Remote join to data source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" for field " Text -> FieldName -> Text
forall t. ToTxt t => Text -> t -> Text
<>> FieldName
jaFieldName) do
Maybe (AnyBackend SourceJoinCall)
maybeSourceCall <-
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @EB.BackendExecute AnyBackend RemoteSourceJoin
remoteSourceJoin
((forall (b :: BackendType).
BackendExecute b =>
RemoteSourceJoin b -> m (Maybe (AnyBackend SourceJoinCall)))
-> m (Maybe (AnyBackend SourceJoinCall)))
-> (forall (b :: BackendType).
BackendExecute b =>
RemoteSourceJoin b -> m (Maybe (AnyBackend SourceJoinCall)))
-> m (Maybe (AnyBackend SourceJoinCall))
forall a b. (a -> b) -> a -> b
$ UserInfo
-> FieldName
-> IntMap JoinArgument
-> [Header]
-> Maybe Name
-> RemoteSourceJoin b
-> m (Maybe (AnyBackend SourceJoinCall))
forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadQueryTags m, MonadError QErr m,
MonadTrace m, MonadIO m) =>
UserInfo
-> FieldName
-> IntMap JoinArgument
-> [Header]
-> Maybe Name
-> RemoteSourceJoin b
-> m (Maybe (AnyBackend SourceJoinCall))
buildSourceJoinCall UserInfo
userInfo FieldName
jaFieldName IntMap JoinArgument
joinArguments [Header]
reqHeaders Maybe Name
operationName
Maybe (AnyBackend SourceJoinCall)
-> (AnyBackend SourceJoinCall -> m (IntMap Value))
-> m (Maybe (IntMap Value))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (AnyBackend SourceJoinCall)
maybeSourceCall \AnyBackend SourceJoinCall
sourceCall -> do
ByteString
sourceResponse <- AnyBackend SourceJoinCall -> m ByteString
networkFunction AnyBackend SourceJoinCall
sourceCall
Text -> m (IntMap Value) -> m (IntMap Value)
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"Build remote join index"
(m (IntMap Value) -> m (IntMap Value))
-> m (IntMap Value) -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$ ByteString -> m (IntMap Value)
forall (m :: * -> *).
MonadError QErr m =>
ByteString -> m (IntMap Value)
buildJoinIndex ByteString
sourceResponse
where
sourceName :: SourceName
sourceName :: SourceName
sourceName = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend RemoteSourceJoin
remoteSourceJoin RemoteSourceJoin b -> SourceName
forall (b :: BackendType).
Backend b =>
RemoteSourceJoin b -> SourceName
forall (b :: BackendType). RemoteSourceJoin b -> SourceName
_rsjSource
data SourceJoinCall b = SourceJoinCall
{ forall (b :: BackendType). SourceJoinCall b -> RootFieldAlias
_sjcRootFieldAlias :: RootFieldAlias,
forall (b :: BackendType). SourceJoinCall b -> SourceConfig b
_sjcSourceConfig :: SourceConfig b,
forall (b :: BackendType). SourceJoinCall b -> DBStepInfo b
_sjcStepInfo :: EB.DBStepInfo b
}
buildSourceJoinCall ::
forall b m.
(EB.BackendExecute b, MonadQueryTags m, MonadError QErr m, MonadTrace m, MonadIO m) =>
UserInfo ->
FieldName ->
IntMap.IntMap JoinArgument ->
[HTTP.Header] ->
Maybe G.Name ->
RemoteSourceJoin b ->
m (Maybe (AB.AnyBackend SourceJoinCall))
buildSourceJoinCall :: forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadQueryTags m, MonadError QErr m,
MonadTrace m, MonadIO m) =>
UserInfo
-> FieldName
-> IntMap JoinArgument
-> [Header]
-> Maybe Name
-> RemoteSourceJoin b
-> m (Maybe (AnyBackend SourceJoinCall))
buildSourceJoinCall UserInfo
userInfo FieldName
jaFieldName IntMap JoinArgument
joinArguments [Header]
reqHeaders Maybe Name
operationName RemoteSourceJoin b
remoteSourceJoin = do
Text
-> m (Maybe (AnyBackend SourceJoinCall))
-> m (Maybe (AnyBackend SourceJoinCall))
forall (m :: * -> *) a.
(MonadIO m, MonadTrace m) =>
Text -> m a -> m a
Tracing.newSpan Text
"Resolve execution step for remote join field" do
let rows :: [KeyMap Value]
rows =
IntMap JoinArgument -> [(Key, JoinArgument)]
forall a. IntMap a -> [(Key, a)]
IntMap.toList IntMap JoinArgument
joinArguments [(Key, JoinArgument)]
-> ((Key, JoinArgument) -> KeyMap Value) -> [KeyMap Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Key
argumentId, JoinArgument
argument) ->
Key -> Value -> KeyMap Value -> KeyMap Value
forall v. Key -> v -> KeyMap v -> KeyMap v
KM.insert Key
"__argument_id__" (Key -> Value
forall a. ToJSON a => a -> Value
J.toJSON Key
argumentId)
(KeyMap Value -> KeyMap Value) -> KeyMap Value -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ [(Key, Value)] -> KeyMap Value
forall v. [(Key, v)] -> KeyMap v
KM.fromList
([(Key, Value)] -> KeyMap Value) -> [(Key, Value)] -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ ((FieldName, Value) -> (Key, Value))
-> [(FieldName, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map ((FieldName -> Key)
-> (Value -> Value) -> (FieldName, Value) -> (Key, Value)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Key
K.fromText (Text -> Key) -> (FieldName -> Text) -> FieldName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Text
getFieldNameTxt) Value -> Value
JO.fromOrdered)
([(FieldName, Value)] -> [(Key, Value)])
-> [(FieldName, Value)] -> [(Key, Value)]
forall a b. (a -> b) -> a -> b
$ HashMap FieldName Value -> [(FieldName, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList
(HashMap FieldName Value -> [(FieldName, Value)])
-> HashMap FieldName Value -> [(FieldName, Value)]
forall a b. (a -> b) -> a -> b
$ JoinArgument -> HashMap FieldName Value
unJoinArgument JoinArgument
argument
rowSchema :: HashMap FieldName (Column b, ScalarType b)
rowSchema = ((JoinColumnAlias, (Column b, ScalarType b))
-> (Column b, ScalarType b))
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
-> HashMap FieldName (Column b, ScalarType b)
forall a b. (a -> b) -> HashMap FieldName a -> HashMap FieldName b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (JoinColumnAlias, (Column b, ScalarType b))
-> (Column b, ScalarType b)
forall a b. (a, b) -> b
snd (RemoteSourceJoin b
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
forall (b :: BackendType).
RemoteSourceJoin b
-> HashMap FieldName (JoinColumnAlias, (Column b, ScalarType b))
_rsjJoinColumns RemoteSourceJoin b
remoteSourceJoin)
Maybe (NonEmpty (KeyMap Value))
-> (NonEmpty (KeyMap Value) -> m (AnyBackend SourceJoinCall))
-> m (Maybe (AnyBackend SourceJoinCall))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([KeyMap Value] -> Maybe (NonEmpty (KeyMap Value))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [KeyMap Value]
rows) ((NonEmpty (KeyMap Value) -> m (AnyBackend SourceJoinCall))
-> m (Maybe (AnyBackend SourceJoinCall)))
-> (NonEmpty (KeyMap Value) -> m (AnyBackend SourceJoinCall))
-> m (Maybe (AnyBackend SourceJoinCall))
forall a b. (a -> b) -> a -> b
$ \NonEmpty (KeyMap Value)
nonEmptyRows -> do
let sourceConfig :: SourceConfig b
sourceConfig = RemoteSourceJoin b -> SourceConfig b
forall (b :: BackendType). RemoteSourceJoin b -> SourceConfig b
_rsjSourceConfig RemoteSourceJoin b
remoteSourceJoin
forall (b :: BackendType) (m :: * -> *).
(HasSourceConfiguration b, MonadTrace m) =>
SourceConfig b -> m ()
Tracing.attachSourceConfigAttributes @b SourceConfig b
sourceConfig
DBStepInfo b
stepInfo <-
UserInfo
-> SourceName
-> SourceConfig b
-> NonEmpty (KeyMap Value)
-> HashMap FieldName (Column b, ScalarType b)
-> FieldName
-> (FieldName, SourceRelationshipSelection b Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo b)
forall (b :: BackendType) (m :: * -> *).
(BackendExecute b, MonadError QErr m, MonadQueryTags m) =>
UserInfo
-> SourceName
-> SourceConfig b
-> NonEmpty (KeyMap Value)
-> HashMap FieldName (Column b, ScalarType b)
-> FieldName
-> (FieldName, SourceRelationshipSelection b Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo b)
forall (m :: * -> *).
(MonadError QErr m, MonadQueryTags m) =>
UserInfo
-> SourceName
-> SourceConfig b
-> NonEmpty (KeyMap Value)
-> HashMap FieldName (Column b, ScalarType b)
-> FieldName
-> (FieldName, SourceRelationshipSelection b Void UnpreparedValue)
-> [Header]
-> Maybe Name
-> StringifyNumbers
-> m (DBStepInfo b)
EB.mkDBRemoteRelationshipPlan
UserInfo
userInfo
(RemoteSourceJoin b -> SourceName
forall (b :: BackendType). RemoteSourceJoin b -> SourceName
_rsjSource RemoteSourceJoin b
remoteSourceJoin)
SourceConfig b
sourceConfig
NonEmpty (KeyMap Value)
nonEmptyRows
HashMap FieldName (Column b, ScalarType b)
rowSchema
(Text -> FieldName
FieldName Text
"__argument_id__")
(Text -> FieldName
FieldName Text
"f", RemoteSourceJoin b
-> SourceRelationshipSelection b Void UnpreparedValue
forall (b :: BackendType).
RemoteSourceJoin b
-> SourceRelationshipSelection b Void UnpreparedValue
_rsjRelationship RemoteSourceJoin b
remoteSourceJoin)
[Header]
reqHeaders
Maybe Name
operationName
(RemoteSourceJoin b -> StringifyNumbers
forall (b :: BackendType). RemoteSourceJoin b -> StringifyNumbers
_rsjStringifyNum RemoteSourceJoin b
remoteSourceJoin)
Name
fieldName <-
Text -> Maybe Name
G.mkName (FieldName -> Text
getFieldNameTxt FieldName
jaFieldName)
Maybe Name -> m Name -> m Name
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Text -> m Name
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FieldName -> Text
getFieldNameTxt FieldName
jaFieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is not a valid GraphQL name")
let rootFieldAlias :: RootFieldAlias
rootFieldAlias = Name -> RootFieldAlias
mkUnNamespacedRootFieldAlias Name
fieldName
AnyBackend SourceJoinCall -> m (AnyBackend SourceJoinCall)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(AnyBackend SourceJoinCall -> m (AnyBackend SourceJoinCall))
-> AnyBackend SourceJoinCall -> m (AnyBackend SourceJoinCall)
forall a b. (a -> b) -> a -> b
$ SourceJoinCall b -> AnyBackend SourceJoinCall
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
(SourceJoinCall b -> AnyBackend SourceJoinCall)
-> SourceJoinCall b -> AnyBackend SourceJoinCall
forall a b. (a -> b) -> a -> b
$ RootFieldAlias
-> SourceConfig b -> DBStepInfo b -> SourceJoinCall b
forall (b :: BackendType).
RootFieldAlias
-> SourceConfig b -> DBStepInfo b -> SourceJoinCall b
SourceJoinCall RootFieldAlias
rootFieldAlias SourceConfig b
sourceConfig DBStepInfo b
stepInfo
buildJoinIndex :: (MonadError QErr m) => BL.ByteString -> m (IntMap.IntMap JO.Value)
buildJoinIndex :: forall (m :: * -> *).
MonadError QErr m =>
ByteString -> m (IntMap Value)
buildJoinIndex ByteString
response = do
Value
json <-
ByteString -> Either String Value
JO.eitherDecode ByteString
response Either String Value -> (String -> m Value) -> m Value
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \String
err ->
Text -> m Value
forall (m :: * -> *) a. QErrM m => Text -> m a
throwInvalidJsonErr (Text -> m Value) -> Text -> m Value
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
case Value
json of
JO.Array Array
arr -> ([(Key, Value)] -> IntMap Value)
-> m [(Key, Value)] -> m (IntMap Value)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Key, Value)] -> IntMap Value
forall a. [(Key, a)] -> IntMap a
IntMap.fromList (m [(Key, Value)] -> m (IntMap Value))
-> m [(Key, Value)] -> m (IntMap Value)
forall a b. (a -> b) -> a -> b
$ [Value] -> (Value -> m (Key, Value)) -> m [(Key, Value)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Array -> [Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
arr) \case
JO.Object Object
obj -> do
Value
argumentResult <-
Text -> Object -> Maybe Value
JO.lookup Text
"f" Object
obj
Maybe Value -> m Value -> m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` m Value
forall {a}. m a
throwMissingRelationshipDataErr
Value
argumentIdValue <-
Text -> Object -> Maybe Value
JO.lookup Text
"__argument_id__" Object
obj
Maybe Value -> m Value -> m Value
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` m Value
forall {a}. m a
throwMissingArgumentIdErr
Key
argumentId <-
case Value
argumentIdValue of
JO.Number Scientific
n ->
Scientific -> Maybe Key
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
n
Maybe Key -> m Key -> m Key
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` m Key
forall {a}. m a
throwInvalidArgumentIdValueErr
JO.String Text
s ->
Text -> Maybe Key
forall {a}. Integral a => Text -> Maybe a
intFromText Text
s
Maybe Key -> m Key -> m Key
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` m Key
forall {a}. m a
throwInvalidArgumentIdValueErr
Value
_ -> m Key
forall {a}. m a
throwInvalidArgumentIdValueErr
(Key, Value) -> m (Key, Value)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
argumentId, Value
argumentResult)
Value
_ -> m (Key, Value)
forall {a}. m a
throwNoNestedObjectErr
Value
_ -> m (IntMap Value)
forall {a}. m a
throwNoListOfObjectsErr
where
intFromText :: Text -> Maybe a
intFromText Text
txt = case Reader a
forall a. Integral a => Reader a
TR.decimal Text
txt of
Right (a
i, Text
"") -> a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
i
Either String (a, Text)
_ -> Maybe a
forall a. Maybe a
Nothing
throwInvalidJsonErr :: Text -> m a
throwInvalidJsonErr Text
errMsg =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
(Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"failed to decode JSON response from the source: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
errMsg
throwMissingRelationshipDataErr :: m a
throwMissingRelationshipDataErr =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
(Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"cannot find relationship data (aliased as 'f') within the source \
\response"
throwMissingArgumentIdErr :: m a
throwMissingArgumentIdErr =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
(Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"cannot find '__argument_id__' within the source response"
throwInvalidArgumentIdValueErr :: m a
throwInvalidArgumentIdValueErr =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 (Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"expected 'argument_id' to get parsed as backend integer type"
throwNoNestedObjectErr :: m a
throwNoNestedObjectErr =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
(Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"expected an object one level deep in the remote schema's response, \
\but found an array/scalar value instead"
throwNoListOfObjectsErr :: m a
throwNoListOfObjectsErr =
Text -> m a
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500
(Text -> m a) -> Text -> m a
forall a b. (a -> b) -> a -> b
$ Text
"expected a list of objects in the remote schema's response, but found \
\an object/scalar value instead"