module Hasura.Server.Rest
  ( runCustomEndpoint,
    RestRequest (..),
  )
where

import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson hiding (json)
import Data.Aeson qualified as J
import Data.Align qualified as Align
import Data.Environment qualified as Env
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.Text qualified as T
import Data.Text.Encoding qualified as T
import Data.Text.Extended
import Data.These (These (..))
import Hasura.Backends.DataConnector.Agent.Client (AgentLicenseKey)
import Hasura.Base.Error
import Hasura.CredentialCache
import Hasura.EncJSON
import Hasura.GraphQL.Execute qualified as E
import Hasura.GraphQL.Logging (MonadExecutionLog, MonadQueryLog)
import Hasura.GraphQL.ParameterizedQueryHash
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.GraphQL.Transport.HTTP qualified as GH
import Hasura.GraphQL.Transport.HTTP.Protocol
import Hasura.HTTP
import Hasura.Logging qualified as L
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.QueryTags
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.SchemaCache
import Hasura.Server.Init qualified as Init
import Hasura.Server.Limits
import Hasura.Server.Logging
import Hasura.Server.Name qualified as Name
import Hasura.Server.Prometheus (PrometheusMetrics)
import Hasura.Server.Types
import Hasura.Services
import Hasura.Session
import Hasura.Tracing qualified as Tracing
import Language.GraphQL.Draft.Syntax qualified as G
import Network.HTTP.Types qualified as HTTP
import Network.Wai.Extended qualified as Wai

-- Note: There may be a better way of constructing this when building the Endpoint datastructure.
parseVariableNames :: EndpointMetadata GQLQueryWithText -> [Text]
parseVariableNames :: EndpointMetadata GQLQueryWithText -> [Text]
parseVariableNames EndpointMetadata GQLQueryWithText
queryx =
  (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (Text -> Text -> Maybe Text
T.stripPrefix Text
":") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') (EndpointUrl -> Text
forall a. ToTxt a => a -> Text
toTxt (EndpointUrl -> Text) -> EndpointUrl -> Text
forall a b. (a -> b) -> a -> b
$ EndpointMetadata GQLQueryWithText -> EndpointUrl
forall query. EndpointMetadata query -> EndpointUrl
_ceUrl EndpointMetadata GQLQueryWithText
queryx)

-- Given a list of expected variables and the parsed vars from the path,
-- return a map of variable names to `These expected parsed`.
alignVars :: [G.VariableDefinition] -> [(Text, Either Text Value)] -> HashMap G.Name (These G.VariableDefinition (Either Text Value))
alignVars :: [VariableDefinition]
-> [(Text, Either Text Value)]
-> HashMap Name (These VariableDefinition (Either Text Value))
alignVars [VariableDefinition]
defVars [(Text, Either Text Value)]
parseVars =
  HashMap Name VariableDefinition
-> HashMap Name (Either Text Value)
-> HashMap Name (These VariableDefinition (Either Text Value))
forall a b.
HashMap Name a -> HashMap Name b -> HashMap Name (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
Align.align
    ([(Name, VariableDefinition)] -> HashMap Name VariableDefinition
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((VariableDefinition -> (Name, VariableDefinition))
-> [VariableDefinition] -> [(Name, VariableDefinition)]
forall a b. (a -> b) -> [a] -> [b]
map (\VariableDefinition
v -> (VariableDefinition -> Name
G._vdName VariableDefinition
v, VariableDefinition
v)) [VariableDefinition]
defVars))
    ([(Name, Either Text Value)] -> HashMap Name (Either Text Value)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (((Text, Either Text Value) -> Maybe (Name, Either Text Value))
-> [(Text, Either Text Value)] -> [(Name, Either Text Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (\(Text
k, Either Text Value
v) -> (,Either Text Value
v) (Name -> (Name, Either Text Value))
-> Maybe Name -> Maybe (Name, Either Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Name
G.mkName Text
k) [(Text, Either Text Value)]
parseVars))

-- | `resolveVar` is responsible for decoding variables sent via REST request.
-- These can either be via body (represented by Right) or via query-param or URL param (represented by Left).
-- A variable can be expected, unexpected, or missing (represented by These, This, and That).
resolveVar :: G.Name -> These G.VariableDefinition (Either Text J.Value) -> Either Text (Maybe Value)
resolveVar :: Name
-> These VariableDefinition (Either Text Value)
-> Either Text (Maybe Value)
resolveVar Name
_ (This VariableDefinition
_expectedVar) = Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right Maybe Value
forall a. Maybe a
Nothing -- If a variable is expected but missing, assign a missing value `Nothing` to it for resolution in query execution. This allows Null defaulting.
resolveVar Name
varName (That Either Text Value
_providedVar) = Text -> Either Text (Maybe Value)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe Value))
-> Text -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Text
"Unexpected variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. ToTxt a => a -> Text
toTxt @G.Name Name
varName -- If a variable is unexpected but present, throw an error.
resolveVar Name
_varName (These VariableDefinition
_expectedVar (Right Value
bodyVar)) = Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
bodyVar) -- Variables sent via body can be passed through to execution without parsing.
resolveVar Name
varName (These VariableDefinition
expectedVar (Left Text
l)) =
  case VariableDefinition -> GType
G._vdType VariableDefinition
expectedVar of
    G.TypeList Nullability
_ GType
_ -> Text -> Either Text (Maybe Value)
forall a b. a -> Either a b
Left (Text -> Either Text (Maybe Value))
-> Text -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Text
"List variables are not currently supported in URL or Query parameters. (Variable " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. ToTxt a => a -> Text
toTxt @G.Name Name
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", with value " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    G.TypeNamed (G.Nullability Bool
nullable) Name
typeName
      | Name
typeName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
GName._Boolean Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
l -> Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right (Maybe Value -> Either Text (Maybe Value))
-> Maybe Value -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
J.Bool Bool
True -- Booleans indicated true by a standalone key.
      | Bool
nullable Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
l -> Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right Maybe Value
forall a. Maybe a
Nothing -- Missing value, but nullable variable sets value to null.
      | Bool
otherwise -> case ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decodeStrict (Text -> ByteString
T.encodeUtf8 Text
l) of -- We special case parsing of bools and numbers and pass the rest through as literal strings.
          Just v :: Value
v@(J.Bool Bool
_) | Name
typeName Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
Name._Bool, Name
GName._Boolean] -> Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right (Maybe Value -> Either Text (Maybe Value))
-> Maybe Value -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
          Just v :: Value
v@(J.Number Scientific
_) | Name
typeName Name -> [Name] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Name
GName._Int, Name
GName._Float, Name
Name._Number, Name
Name._Double, Name
Name._float8, Name
Name._numeric] -> Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right (Maybe Value -> Either Text (Maybe Value))
-> Maybe Value -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
          Maybe Value
_ -> Maybe Value -> Either Text (Maybe Value)
forall a b. b -> Either a b
Right (Maybe Value -> Either Text (Maybe Value))
-> Maybe Value -> Either Text (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
J.String Text
l

mkPassthroughRequest :: EndpointMetadata GQLQueryWithText -> VariableValues -> GQLReq GQLQueryText
mkPassthroughRequest :: EndpointMetadata GQLQueryWithText
-> VariableValues -> GQLReq GQLQueryText
mkPassthroughRequest EndpointMetadata GQLQueryWithText
queryx VariableValues
resolvedVariables =
  Maybe OperationName
-> GQLQueryText -> Maybe VariableValues -> GQLReq GQLQueryText
forall a.
Maybe OperationName -> a -> Maybe VariableValues -> GQLReq a
GQLReq
    Maybe OperationName
forall a. Maybe a
Nothing
    (Text -> GQLQueryText
GQLQueryText (Text -> GQLQueryText) -> Text -> GQLQueryText
forall a b. (a -> b) -> a -> b
$ GQLQueryWithText -> Text
getGQLQueryText (EndpointDef GQLQueryWithText -> GQLQueryWithText
forall query. EndpointDef query -> query
_edQuery (EndpointMetadata GQLQueryWithText -> EndpointDef GQLQueryWithText
forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition EndpointMetadata GQLQueryWithText
queryx)))
    (VariableValues -> Maybe VariableValues
forall a. a -> Maybe a
Just VariableValues
resolvedVariables)

data RestRequest method = RestRequest
  { -- | Remainder of the url path after `api/rest`
    forall method. RestRequest method -> Text
reqPath :: Text,
    forall method. RestRequest method -> method
reqMethod :: method, -- EndpointMethod

    -- | URL Query/Request Body Arguments
    forall method. RestRequest method -> [(Text, Either Text Value)]
reqArgs :: [(Text, Either Text J.Value)]
  }
  deriving ((forall a b. (a -> b) -> RestRequest a -> RestRequest b)
-> (forall a b. a -> RestRequest b -> RestRequest a)
-> Functor RestRequest
forall a b. a -> RestRequest b -> RestRequest a
forall a b. (a -> b) -> RestRequest a -> RestRequest b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> RestRequest a -> RestRequest b
fmap :: forall a b. (a -> b) -> RestRequest a -> RestRequest b
$c<$ :: forall a b. a -> RestRequest b -> RestRequest a
<$ :: forall a b. a -> RestRequest b -> RestRequest a
Functor, (forall m. Monoid m => RestRequest m -> m)
-> (forall m a. Monoid m => (a -> m) -> RestRequest a -> m)
-> (forall m a. Monoid m => (a -> m) -> RestRequest a -> m)
-> (forall a b. (a -> b -> b) -> b -> RestRequest a -> b)
-> (forall a b. (a -> b -> b) -> b -> RestRequest a -> b)
-> (forall b a. (b -> a -> b) -> b -> RestRequest a -> b)
-> (forall b a. (b -> a -> b) -> b -> RestRequest a -> b)
-> (forall a. (a -> a -> a) -> RestRequest a -> a)
-> (forall a. (a -> a -> a) -> RestRequest a -> a)
-> (forall a. RestRequest a -> [a])
-> (forall a. RestRequest a -> Bool)
-> (forall a. RestRequest a -> Int)
-> (forall a. Eq a => a -> RestRequest a -> Bool)
-> (forall a. Ord a => RestRequest a -> a)
-> (forall a. Ord a => RestRequest a -> a)
-> (forall a. Num a => RestRequest a -> a)
-> (forall a. Num a => RestRequest a -> a)
-> Foldable RestRequest
forall a. Eq a => a -> RestRequest a -> Bool
forall a. Num a => RestRequest a -> a
forall a. Ord a => RestRequest a -> a
forall m. Monoid m => RestRequest m -> m
forall a. RestRequest a -> Bool
forall a. RestRequest a -> Int
forall a. RestRequest a -> [a]
forall a. (a -> a -> a) -> RestRequest a -> a
forall m a. Monoid m => (a -> m) -> RestRequest a -> m
forall b a. (b -> a -> b) -> b -> RestRequest a -> b
forall a b. (a -> b -> b) -> b -> RestRequest a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => RestRequest m -> m
fold :: forall m. Monoid m => RestRequest m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> RestRequest a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> RestRequest a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> RestRequest a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> RestRequest a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> RestRequest a -> b
foldr :: forall a b. (a -> b -> b) -> b -> RestRequest a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> RestRequest a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> RestRequest a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> RestRequest a -> b
foldl :: forall b a. (b -> a -> b) -> b -> RestRequest a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> RestRequest a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> RestRequest a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> RestRequest a -> a
foldr1 :: forall a. (a -> a -> a) -> RestRequest a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> RestRequest a -> a
foldl1 :: forall a. (a -> a -> a) -> RestRequest a -> a
$ctoList :: forall a. RestRequest a -> [a]
toList :: forall a. RestRequest a -> [a]
$cnull :: forall a. RestRequest a -> Bool
null :: forall a. RestRequest a -> Bool
$clength :: forall a. RestRequest a -> Int
length :: forall a. RestRequest a -> Int
$celem :: forall a. Eq a => a -> RestRequest a -> Bool
elem :: forall a. Eq a => a -> RestRequest a -> Bool
$cmaximum :: forall a. Ord a => RestRequest a -> a
maximum :: forall a. Ord a => RestRequest a -> a
$cminimum :: forall a. Ord a => RestRequest a -> a
minimum :: forall a. Ord a => RestRequest a -> a
$csum :: forall a. Num a => RestRequest a -> a
sum :: forall a. Num a => RestRequest a -> a
$cproduct :: forall a. Num a => RestRequest a -> a
product :: forall a. Num a => RestRequest a -> a
Foldable, Functor RestRequest
Foldable RestRequest
Functor RestRequest
-> Foldable RestRequest
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> RestRequest a -> f (RestRequest b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    RestRequest (f a) -> f (RestRequest a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> RestRequest a -> m (RestRequest b))
-> (forall (m :: * -> *) a.
    Monad m =>
    RestRequest (m a) -> m (RestRequest a))
-> Traversable RestRequest
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
RestRequest (m a) -> m (RestRequest a)
forall (f :: * -> *) a.
Applicative f =>
RestRequest (f a) -> f (RestRequest a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RestRequest a -> m (RestRequest b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RestRequest a -> f (RestRequest b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RestRequest a -> f (RestRequest b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> RestRequest a -> f (RestRequest b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
RestRequest (f a) -> f (RestRequest a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
RestRequest (f a) -> f (RestRequest a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RestRequest a -> m (RestRequest b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> RestRequest a -> m (RestRequest b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
RestRequest (m a) -> m (RestRequest a)
sequence :: forall (m :: * -> *) a.
Monad m =>
RestRequest (m a) -> m (RestRequest a)
Traversable)

-- | Implements all the custom endpoints by looking up the
-- path/methods in the endpoint trie and delegating to the graphql
-- handler.
runCustomEndpoint ::
  forall m.
  ( MonadIO m,
    MonadError QErr m,
    Tracing.MonadTrace m,
    MonadBaseControl IO m,
    E.MonadGQLExecutionCheck m,
    MonadQueryLog m,
    MonadExecutionLog m,
    GH.MonadExecuteQuery m,
    MonadMetadataStorage m,
    MonadQueryTags m,
    HasResourceLimits m,
    ProvidesNetwork m
  ) =>
  Env.Environment ->
  SQLGenCtx ->
  SchemaCache ->
  Init.AllowListStatus ->
  ReadOnlyMode ->
  PrometheusMetrics ->
  L.Logger L.Hasura ->
  Maybe (CredentialCache AgentLicenseKey) ->
  RequestId ->
  UserInfo ->
  [HTTP.Header] ->
  Wai.IpAddress ->
  RestRequest EndpointMethod ->
  EndpointTrie GQLQueryWithText ->
  m (HttpLogGraphQLInfo, HttpResponse EncJSON)
runCustomEndpoint :: forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadTrace m, MonadBaseControl IO m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadExecuteQuery m, MonadMetadataStorage m, MonadQueryTags m,
 HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> [Header]
-> IpAddress
-> RestRequest EndpointMethod
-> EndpointTrie GQLQueryWithText
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
runCustomEndpoint Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
requestId UserInfo
userInfo [Header]
reqHeaders IpAddress
ipAddress RestRequest {[(Text, Either Text Value)]
Text
EndpointMethod
reqPath :: forall method. RestRequest method -> Text
reqMethod :: forall method. RestRequest method -> method
reqArgs :: forall method. RestRequest method -> [(Text, Either Text Value)]
reqPath :: Text
reqMethod :: EndpointMethod
reqArgs :: [(Text, Either Text Value)]
..} EndpointTrie GQLQueryWithText
endpoints = do
  -- First match the path to an endpoint.
  case EndpointMethod
-> [Text]
-> EndpointTrie GQLQueryWithText
-> MatchResult
     Text EndpointMethod (EndpointMetadata GQLQueryWithText)
forall k a v.
(Hashable k, Hashable a) =>
k -> [a] -> MultiMapPathTrie a k v -> MatchResult a k v
matchPath EndpointMethod
reqMethod ((Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Text
reqPath) EndpointTrie GQLQueryWithText
endpoints of
    MatchFound (EndpointMetadata GQLQueryWithText
queryx :: EndpointMetadata GQLQueryWithText) [Text]
matches ->
      let definitions :: [ExecutableDefinition Name]
definitions =
            EndpointMetadata GQLQueryWithText
queryx
              EndpointMetadata GQLQueryWithText
-> (EndpointMetadata GQLQueryWithText
    -> EndpointDef GQLQueryWithText)
-> EndpointDef GQLQueryWithText
forall a b. a -> (a -> b) -> b
& EndpointMetadata GQLQueryWithText -> EndpointDef GQLQueryWithText
forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition
              EndpointDef GQLQueryWithText
-> (EndpointDef GQLQueryWithText -> GQLQueryWithText)
-> GQLQueryWithText
forall a b. a -> (a -> b) -> b
& EndpointDef GQLQueryWithText -> GQLQueryWithText
forall query. EndpointDef query -> query
_edQuery
              GQLQueryWithText -> (GQLQueryWithText -> GQLQuery) -> GQLQuery
forall a b. a -> (a -> b) -> b
& GQLQueryWithText -> GQLQuery
getGQLQuery
              GQLQuery
-> (GQLQuery -> ExecutableDocument Name) -> ExecutableDocument Name
forall a b. a -> (a -> b) -> b
& GQLQuery -> ExecutableDocument Name
unGQLQuery
              ExecutableDocument Name
-> (ExecutableDocument Name -> [ExecutableDefinition Name])
-> [ExecutableDefinition Name]
forall a b. a -> (a -> b) -> b
& ExecutableDocument Name -> [ExecutableDefinition Name]
forall var. ExecutableDocument var -> [ExecutableDefinition var]
G.getExecutableDefinitions
       in -- Next, pattern match on the query definition to extract the
          -- (hopefully single) ExecutableDefinitionOperation structure, so that
          -- we can get hold of the list of query variables.
          case [ExecutableDefinition Name]
definitions of
            [G.ExecutableDefinitionOperation (G.OperationDefinitionTyped TypedOperationDefinition FragmentSpread Name
typedDef)] -> do
              -- Perform a join between the expected variables and the provided variables.
              -- If there is a mismatch, throw an error. Also, check that the provided
              -- values are compatible with the expected types.
              let expectedVariables :: [VariableDefinition]
expectedVariables = TypedOperationDefinition FragmentSpread Name
-> [VariableDefinition]
forall (frag :: * -> *) var.
TypedOperationDefinition frag var -> [VariableDefinition]
G._todVariableDefinitions TypedOperationDefinition FragmentSpread Name
typedDef
              let joinedVars :: Either Text (HashMap Name (Maybe Value))
joinedVars = (Name
 -> These VariableDefinition (Either Text Value)
 -> Either Text (Maybe Value))
-> HashMap Name (These VariableDefinition (Either Text Value))
-> Either Text (HashMap Name (Maybe Value))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HashMap.traverseWithKey Name
-> These VariableDefinition (Either Text Value)
-> Either Text (Maybe Value)
resolveVar ([VariableDefinition]
-> [(Text, Either Text Value)]
-> HashMap Name (These VariableDefinition (Either Text Value))
alignVars [VariableDefinition]
expectedVariables ([(Text, Either Text Value)]
reqArgs [(Text, Either Text Value)]
-> [(Text, Either Text Value)] -> [(Text, Either Text Value)]
forall a. [a] -> [a] -> [a]
++ [Text] -> [Either Text Value] -> [(Text, Either Text Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip (EndpointMetadata GQLQueryWithText -> [Text]
parseVariableNames EndpointMetadata GQLQueryWithText
queryx) ((Text -> Either Text Value) -> [Text] -> [Either Text Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either Text Value
forall a b. a -> Either a b
Left [Text]
matches)))

              HashMap Name (Maybe Value)
resolvedVariablesMaybe <- Either Text (HashMap Name (Maybe Value))
joinedVars Either Text (HashMap Name (Maybe Value))
-> (Text -> m (HashMap Name (Maybe Value)))
-> m (HashMap Name (Maybe Value))
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` Code -> Text -> m (HashMap Name (Maybe Value))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
BadRequest

              let resolvedVariables :: VariableValues
resolvedVariables = HashMap Name (Maybe Value) -> VariableValues
forall a. HashMap Name (Maybe a) -> HashMap Name a
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes HashMap Name (Maybe Value)
resolvedVariablesMaybe

              -- Construct a graphql query by pairing the resolved variables
              -- with the query string from the schema cache, and pass it
              -- through to the /v1/graphql endpoint.
              (HttpLogGraphQLInfo
httpLoggingMetadata, HttpResponse (Maybe GQResponse)
handlerResp) <- do
                (GQLQueryOperationSuccessLog
gqlOperationLog, HttpResponse (Maybe GQResponse, EncJSON)
resp) <- Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReq GQLQueryText
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadError QErr m,
 MonadGQLExecutionCheck m, MonadQueryLog m, MonadExecutionLog m,
 MonadTrace m, MonadExecuteQuery m, MonadMetadataStorage m,
 MonadQueryTags m, HasResourceLimits m, ProvidesNetwork m) =>
Environment
-> SQLGenCtx
-> SchemaCache
-> AllowListStatus
-> ReadOnlyMode
-> PrometheusMetrics
-> Logger Hasura
-> Maybe (CredentialCache AgentLicenseKey)
-> RequestId
-> UserInfo
-> IpAddress
-> [Header]
-> GraphQLQueryType
-> GQLReq GQLQueryText
-> m (GQLQueryOperationSuccessLog,
      HttpResponse (Maybe GQResponse, EncJSON))
GH.runGQ Environment
env SQLGenCtx
sqlGenCtx SchemaCache
sc AllowListStatus
enableAL ReadOnlyMode
readOnlyMode PrometheusMetrics
prometheusMetrics Logger Hasura
logger Maybe (CredentialCache AgentLicenseKey)
agentLicenseKey RequestId
requestId UserInfo
userInfo IpAddress
ipAddress [Header]
reqHeaders GraphQLQueryType
E.QueryHasura (EndpointMetadata GQLQueryWithText
-> VariableValues -> GQLReq GQLQueryText
mkPassthroughRequest EndpointMetadata GQLQueryWithText
queryx VariableValues
resolvedVariables)
                let httpLoggingGQInfo :: HttpLogGraphQLInfo
httpLoggingGQInfo = (RequestMode
-> Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
-> CommonHttpLogMetadata
CommonHttpLogMetadata RequestMode
RequestModeNonBatchable Maybe (GQLBatchedReqs GQLBatchQueryOperationLog)
forall a. Maybe a
Nothing, (ParameterizedQueryHash -> ParameterizedQueryHashList
PQHSetSingleton (GQLQueryOperationSuccessLog -> ParameterizedQueryHash
gqolParameterizedQueryHash GQLQueryOperationSuccessLog
gqlOperationLog)))
                (HttpLogGraphQLInfo, HttpResponse (Maybe GQResponse))
-> m (HttpLogGraphQLInfo, HttpResponse (Maybe GQResponse))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (HttpLogGraphQLInfo
httpLoggingGQInfo, (Maybe GQResponse, EncJSON) -> Maybe GQResponse
forall a b. (a, b) -> a
fst ((Maybe GQResponse, EncJSON) -> Maybe GQResponse)
-> HttpResponse (Maybe GQResponse, EncJSON)
-> HttpResponse (Maybe GQResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HttpResponse (Maybe GQResponse, EncJSON)
resp)
              case HttpResponse (Maybe GQResponse) -> Maybe (HttpResponse GQResponse)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a.
Monad m =>
HttpResponse (m a) -> m (HttpResponse a)
sequence HttpResponse (Maybe GQResponse)
handlerResp of
                Just HttpResponse GQResponse
resp -> (HttpLogGraphQLInfo, HttpResponse EncJSON)
-> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpLogGraphQLInfo
httpLoggingMetadata, (GQResponse -> EncJSON)
-> HttpResponse GQResponse -> HttpResponse EncJSON
forall a b. (a -> b) -> HttpResponse a -> HttpResponse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GQResponse -> EncJSON
encodeHTTPResp HttpResponse GQResponse
resp)
                -- a Nothing value here indicates a failure to parse the cached request from redis.
                -- TODO: Do we need an additional log message here?
                Maybe (HttpResponse GQResponse)
Nothing -> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"An unexpected error occurred while fetching the data from the cache"

            -- Note: This fallthrough is required for runtime scenarios where the endpoint is ambiguous, such as:
            --       Endpoints /:a/b + /a/:b = Request /a/b - Invalid, but checked at runtime.
            [ExecutableDefinition Name]
_ -> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"A stored query should contain exactly one definition"
    MatchResult Text EndpointMethod (EndpointMetadata GQLQueryWithText)
MatchNotFound -> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw404 Text
"Endpoint not found"
    MatchMissingKey NonEmpty EndpointMethod
allowedMethods -> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw405 (Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON))
-> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall a b. (a -> b) -> a -> b
$ Text
"Allowed methods: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty EndpointMethod -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated NonEmpty EndpointMethod
allowedMethods
    MatchResult Text EndpointMethod (EndpointMetadata GQLQueryWithText)
MatchAmbiguous -> Text -> m (HttpLogGraphQLInfo, HttpResponse EncJSON)
forall (m :: * -> *) a. QErrM m => Text -> m a
throw500 Text
"Multiple endpoints match request"