-- | Schema parsers for stored procedures.
module Hasura.StoredProcedure.Schema (defaultBuildStoredProcedureRootFields) where

import Data.Has (Has (getter))
import Data.HashMap.Strict qualified as HashMap
import Hasura.GraphQL.Schema.Backend
  ( BackendLogicalModelSelectSchema (..),
    MonadBuildSchema,
  )
import Hasura.GraphQL.Schema.Common
  ( SchemaT,
    retrieve,
  )
import Hasura.GraphQL.Schema.Parser qualified as P
import Hasura.LogicalModel.Schema (buildLogicalModelIR, buildLogicalModelPermissions, logicalModelSelectionList)
import Hasura.LogicalModelResolver.Schema (argumentsSchema)
import Hasura.Prelude
import Hasura.RQL.IR.Root (RemoteRelationshipField)
import Hasura.RQL.IR.Select (QueryDB (QDBMultipleRows))
import Hasura.RQL.IR.Select qualified as IR
import Hasura.RQL.IR.Value (Provenance (FromInternal), UnpreparedValue (UVParameter))
import Hasura.RQL.Types.Column qualified as Column
import Hasura.RQL.Types.Metadata.Object qualified as MO
import Hasura.RQL.Types.Relationships.Local (Nullable (..))
import Hasura.RQL.Types.Schema.Options qualified as Options
import Hasura.RQL.Types.Source
  ( SourceInfo (_siCustomization, _siName),
  )
import Hasura.RQL.Types.SourceCustomization
  ( ResolvedSourceCustomization (_rscNamingConvention),
  )
import Hasura.SQL.AnyBackend (mkAnyBackend)
import Hasura.StoredProcedure.Cache (StoredProcedureInfo (..))
import Hasura.StoredProcedure.IR (StoredProcedure (..))
import Hasura.StoredProcedure.Metadata (ArgumentName (..))
import Hasura.StoredProcedure.Types (NullableScalarType (..))
import Language.GraphQL.Draft.Syntax qualified as G

defaultBuildStoredProcedureRootFields ::
  forall b r m n.
  ( MonadBuildSchema b r m n,
    BackendLogicalModelSelectSchema b
  ) =>
  StoredProcedureInfo b ->
  SchemaT
    r
    m
    (Maybe (P.FieldParser n (QueryDB b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultBuildStoredProcedureRootFields :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendLogicalModelSelectSchema b) =>
StoredProcedureInfo b
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
defaultBuildStoredProcedureRootFields StoredProcedureInfo {Maybe Text
HashMap ArgumentName (NullableScalarType b)
Name
FunctionName b
StoredProcedureConfig
LogicalModelInfo b
_spiStoredProcedure :: FunctionName b
_spiGraphqlName :: Name
_spiConfig :: StoredProcedureConfig
_spiReturns :: LogicalModelInfo b
_spiArguments :: HashMap ArgumentName (NullableScalarType b)
_spiDescription :: Maybe Text
_spiStoredProcedure :: forall (b :: BackendType). StoredProcedureInfo b -> FunctionName b
_spiGraphqlName :: forall (b :: BackendType). StoredProcedureInfo b -> Name
_spiConfig :: forall (b :: BackendType).
StoredProcedureInfo b -> StoredProcedureConfig
_spiReturns :: forall (b :: BackendType).
StoredProcedureInfo b -> LogicalModelInfo b
_spiArguments :: forall (b :: BackendType).
StoredProcedureInfo b
-> HashMap ArgumentName (NullableScalarType b)
_spiDescription :: forall (b :: BackendType). StoredProcedureInfo b -> Maybe Text
..} = MaybeT
  (SchemaT r m)
  (FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (SchemaT r m)
   (FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
 -> SchemaT
      r
      m
      (Maybe
         (FieldParser
            n
            (QueryDB
               b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> SchemaT
     r
     m
     (Maybe
        (FieldParser
           n
           (QueryDB
              b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
forall a b. (a -> b) -> a -> b
$ do
  let fieldName :: Name
fieldName = Name
_spiGraphqlName

  InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
storedProcedureArgsParser <-
    forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
storedProcedureArgumentsSchema @b @r @m @n Name
fieldName HashMap ArgumentName (NullableScalarType b)
_spiArguments

  SourceInfo b
sourceInfo :: SourceInfo b <- (r -> SourceInfo b) -> MaybeT (SchemaT r m) (SourceInfo b)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> SourceInfo b
forall a t. Has a t => t -> a
getter

  let sourceName :: SourceName
sourceName = SourceInfo b -> SourceName
forall (b :: BackendType). SourceInfo b -> SourceName
_siName SourceInfo b
sourceInfo
      tCase :: NamingCase
tCase = ResolvedSourceCustomization -> NamingCase
_rscNamingConvention (ResolvedSourceCustomization -> NamingCase)
-> ResolvedSourceCustomization -> NamingCase
forall a b. (a -> b) -> a -> b
$ SourceInfo b -> ResolvedSourceCustomization
forall (b :: BackendType).
SourceInfo b -> ResolvedSourceCustomization
_siCustomization SourceInfo b
sourceInfo
      description :: Maybe Description
description = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
_spiDescription

  StringifyNumbers
stringifyNumbers <- (SchemaOptions -> StringifyNumbers)
-> MaybeT (SchemaT r m) StringifyNumbers
forall r (m :: * -> *) a b.
(MonadReader r m, Has a r) =>
(a -> b) -> m b
retrieve SchemaOptions -> StringifyNumbers
Options.soStringifyNumbers

  TablePermG b (UnpreparedValue b)
logicalModelPermissions <-
    SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT
      (SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
 -> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b)))
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
-> MaybeT (SchemaT r m) (TablePermG b (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
LogicalModelInfo b
-> SchemaT r m (Maybe (TablePermG b (UnpreparedValue b)))
buildLogicalModelPermissions @b @r @m @n LogicalModelInfo b
_spiReturns

  Parser 'Output n (AnnotatedFields b)
selectionListParser <- SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
 -> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b)))
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
-> MaybeT (SchemaT r m) (Parser 'Output n (AnnotatedFields b))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(MonadBuildSchema b r m n, BackendLogicalModelSelectSchema b) =>
Nullable
-> LogicalModelInfo b
-> SchemaT r m (Maybe (Parser 'Output n (AnnotatedFields b)))
logicalModelSelectionList @b @r @m @n Nullable
NotNullable LogicalModelInfo b
_spiReturns
  InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
logicalModelsArgsParser <- SchemaT
  r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (SchemaT
   r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
 -> MaybeT
      (SchemaT r m)
      (InputFieldsParser n (SelectArgsG b (UnpreparedValue b))))
-> SchemaT
     r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
(BackendLogicalModelSelectSchema b,
 MonadBuildSourceSchema b r m n) =>
LogicalModelInfo b
-> SchemaT
     r m (InputFieldsParser n (SelectArgsG b (UnpreparedValue b)))
logicalModelArguments @b @r @m @n LogicalModelInfo b
_spiReturns

  let arguments :: HashMap ArgumentName (ColumnValue b)
-> HashMap ArgumentName (ScalarType b, UnpreparedValue b)
arguments HashMap ArgumentName (ColumnValue b)
spArgs =
        (ArgumentName
 -> ColumnValue b -> (ScalarType b, UnpreparedValue b))
-> HashMap ArgumentName (ColumnValue b)
-> HashMap ArgumentName (ScalarType b, UnpreparedValue b)
forall k v1 v2. (k -> v1 -> v2) -> HashMap k v1 -> HashMap k v2
HashMap.mapWithKey
          ( \(ArgumentName Text
name) ColumnValue b
val ->
              case ColumnValue b -> ColumnType b
forall (b :: BackendType). ColumnValue b -> ColumnType b
Column.cvType ColumnValue b
val of
                Column.ColumnScalar ScalarType b
st ->
                  (ScalarType b
st, Provenance -> ColumnValue b -> UnpreparedValue b
forall (b :: BackendType).
Provenance -> ColumnValue b -> UnpreparedValue b
UVParameter (Text -> Provenance
FromInternal Text
name) ColumnValue b
val)
                Column.ColumnEnumReference {} ->
                  -- should not happen
                  [Char] -> (ScalarType b, UnpreparedValue b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Enums are unsupported in stored procedures."
          )
          HashMap ArgumentName (ColumnValue b)
spArgs

  let sourceObj :: MetadataObjId
sourceObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MO.MOSourceObjId
          SourceName
sourceName
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). FunctionName b -> SourceMetadataObjId b
MO.SMOStoredProcedure @b FunctionName b
_spiStoredProcedure)

  FieldParser
  n
  (QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a. a -> MaybeT (SchemaT r m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> MaybeT
      (SchemaT r m)
      (FieldParser
         n
         (QueryDB
            b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> MaybeT
     (SchemaT r m)
     (FieldParser
        n
        (QueryDB
           b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
forall a b. (a -> b) -> a -> b
$ MetadataObjId
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (m :: * -> *) origin a.
origin -> FieldParser origin m a -> FieldParser origin m a
P.setFieldParserOrigin MetadataObjId
sourceObj
    (FieldParser
   n
   (QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
 -> FieldParser
      n
      (QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall a b. (a -> b) -> a -> b
$ Name
-> Maybe Description
-> InputFieldsParser
     MetadataObjId
     n
     (SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b))
-> Parser 'Output n (AnnotatedFields b)
-> FieldParser
     MetadataObjId
     n
     ((SelectArgsG b (UnpreparedValue b),
       HashMap ArgumentName (ColumnValue b)),
      AnnotatedFields b)
forall (m :: * -> *) origin a b.
MonadParse m =>
Name
-> Maybe Description
-> InputFieldsParser origin m a
-> Parser origin 'Output m b
-> FieldParser origin m (a, b)
P.subselection
      Name
fieldName
      Maybe Description
description
      ( (,)
          (SelectArgsG b (UnpreparedValue b)
 -> HashMap ArgumentName (ColumnValue b)
 -> (SelectArgsG b (UnpreparedValue b),
     HashMap ArgumentName (ColumnValue b)))
-> InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
-> InputFieldsParser
     MetadataObjId
     n
     (HashMap ArgumentName (ColumnValue b)
      -> (SelectArgsG b (UnpreparedValue b),
          HashMap ArgumentName (ColumnValue b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputFieldsParser n (SelectArgsG b (UnpreparedValue b))
logicalModelsArgsParser
          InputFieldsParser
  MetadataObjId
  n
  (HashMap ArgumentName (ColumnValue b)
   -> (SelectArgsG b (UnpreparedValue b),
       HashMap ArgumentName (ColumnValue b)))
-> InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
-> InputFieldsParser
     MetadataObjId
     n
     (SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b))
forall a b.
InputFieldsParser MetadataObjId n (a -> b)
-> InputFieldsParser MetadataObjId n a
-> InputFieldsParser MetadataObjId n b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InputFieldsParser n (HashMap ArgumentName (ColumnValue b))
storedProcedureArgsParser
      )
      Parser 'Output n (AnnotatedFields b)
selectionListParser
    FieldParser
  MetadataObjId
  n
  ((SelectArgsG b (UnpreparedValue b),
    HashMap ArgumentName (ColumnValue b)),
   AnnotatedFields b)
-> (((SelectArgsG b (UnpreparedValue b),
      HashMap ArgumentName (ColumnValue b)),
     AnnotatedFields b)
    -> QueryDB
         b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> FieldParser
     n
     (QueryDB
        b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \((SelectArgsG b (UnpreparedValue b)
lmArgs, HashMap ArgumentName (ColumnValue b)
spArgs), AnnotatedFields b
fields) ->
      AnnSimpleSelectG
  b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall (b :: BackendType) r v.
AnnSimpleSelectG b r v -> QueryDB b r v
QDBMultipleRows
        (AnnSimpleSelectG
   b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
 -> QueryDB
      b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b))
-> AnnSimpleSelectG
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
-> QueryDB
     b (RemoteRelationshipField UnpreparedValue) (UnpreparedValue b)
forall a b. (a -> b) -> a -> b
$ IR.AnnSelectG
          { $sel:_asnFields:AnnSelectG :: AnnotatedFields b
IR._asnFields = AnnotatedFields b
fields,
            $sel:_asnFrom:AnnSelectG :: SelectFromG b (UnpreparedValue b)
IR._asnFrom =
              StoredProcedure b (UnpreparedValue b)
-> SelectFromG b (UnpreparedValue b)
forall (b :: BackendType) v. StoredProcedure b v -> SelectFromG b v
IR.FromStoredProcedure
                StoredProcedure
                  { spStoredProcedure :: FunctionName b
spStoredProcedure = FunctionName b
_spiStoredProcedure,
                    spGraphqlName :: Name
spGraphqlName = Name
_spiGraphqlName,
                    spArgs :: HashMap ArgumentName (ScalarType b, UnpreparedValue b)
spArgs = HashMap ArgumentName (ColumnValue b)
-> HashMap ArgumentName (ScalarType b, UnpreparedValue b)
forall {b :: BackendType}.
HashMap ArgumentName (ColumnValue b)
-> HashMap ArgumentName (ScalarType b, UnpreparedValue b)
arguments HashMap ArgumentName (ColumnValue b)
spArgs,
                    spLogicalModel :: LogicalModel b
spLogicalModel = LogicalModelInfo b -> LogicalModel b
forall (b :: BackendType). LogicalModelInfo b -> LogicalModel b
buildLogicalModelIR LogicalModelInfo b
_spiReturns
                  },
            $sel:_asnPerm:AnnSelectG :: TablePermG b (UnpreparedValue b)
IR._asnPerm = TablePermG b (UnpreparedValue b)
logicalModelPermissions,
            $sel:_asnArgs:AnnSelectG :: SelectArgsG b (UnpreparedValue b)
IR._asnArgs = SelectArgsG b (UnpreparedValue b)
lmArgs,
            $sel:_asnStrfyNum:AnnSelectG :: StringifyNumbers
IR._asnStrfyNum = StringifyNumbers
stringifyNumbers,
            $sel:_asnNamingConvention:AnnSelectG :: Maybe NamingCase
IR._asnNamingConvention = NamingCase -> Maybe NamingCase
forall a. a -> Maybe a
Just NamingCase
tCase
          }

storedProcedureArgumentsSchema ::
  forall b r m n.
  (MonadBuildSchema b r m n) =>
  G.Name ->
  HashMap ArgumentName (NullableScalarType b) ->
  MaybeT (SchemaT r m) (P.InputFieldsParser n (HashMap ArgumentName (Column.ColumnValue b)))
storedProcedureArgumentsSchema :: forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
storedProcedureArgumentsSchema = Text
-> Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
forall (b :: BackendType) r (m :: * -> *) (n :: * -> *).
MonadBuildSchema b r m n =>
Text
-> Name
-> HashMap ArgumentName (NullableScalarType b)
-> MaybeT
     (SchemaT r m)
     (InputFieldsParser n (HashMap ArgumentName (ColumnValue b)))
argumentsSchema Text
"Stored Procedure"