mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
212 lines
5.6 KiB
Haskell
212 lines
5.6 KiB
Haskell
|
{-# LANGUAGE UndecidableInstances #-}
|
||
|
|
||
|
-- | Metadata V1 commands (and their types) for handling user-specified custom
|
||
|
-- SQL fragments.
|
||
|
module Hasura.RQL.DDL.CustomSQL
|
||
|
( GetCustomSQL (..),
|
||
|
TrackCustomSQL (..),
|
||
|
UntrackCustomSQL (..),
|
||
|
runGetCustomSQL,
|
||
|
runTrackCustomSQL,
|
||
|
runUntrackCustomSQL,
|
||
|
dropCustomSQLInMetadata,
|
||
|
)
|
||
|
where
|
||
|
|
||
|
import Control.Lens ((^?))
|
||
|
import Data.Aeson
|
||
|
import Data.HashMap.Strict.InsOrd qualified as OMap
|
||
|
import Hasura.Base.Error
|
||
|
import Hasura.CustomSQL
|
||
|
import Hasura.EncJSON
|
||
|
import Hasura.Prelude
|
||
|
import Hasura.RQL.Types.Backend (Backend, TableName)
|
||
|
import Hasura.RQL.Types.Common (SourceName, successMsg)
|
||
|
import Hasura.RQL.Types.Metadata
|
||
|
import Hasura.RQL.Types.Metadata.Backend
|
||
|
import Hasura.RQL.Types.Metadata.Object
|
||
|
import Hasura.RQL.Types.SchemaCache.Build
|
||
|
import Hasura.SQL.AnyBackend qualified as AB
|
||
|
import Hasura.SQL.Backend
|
||
|
import Hasura.Server.Types (HasServerConfigCtx (..), ServerConfigCtx (..))
|
||
|
import Language.GraphQL.Draft.Syntax qualified as G
|
||
|
|
||
|
---------------------------------
|
||
|
|
||
|
data GetCustomSQL (b :: BackendType) = GetCustomSQL
|
||
|
{ gcsSource :: SourceName
|
||
|
}
|
||
|
|
||
|
deriving instance Backend b => Show (GetCustomSQL b)
|
||
|
|
||
|
deriving instance Backend b => Eq (GetCustomSQL b)
|
||
|
|
||
|
instance Backend b => FromJSON (GetCustomSQL b) where
|
||
|
parseJSON = withObject "GetCustomSQL" $ \o -> do
|
||
|
gcsSource <- o .: "source"
|
||
|
pure GetCustomSQL {..}
|
||
|
|
||
|
instance Backend b => ToJSON (GetCustomSQL b) where
|
||
|
toJSON GetCustomSQL {..} =
|
||
|
object
|
||
|
[ "source" .= gcsSource
|
||
|
]
|
||
|
|
||
|
runGetCustomSQL ::
|
||
|
forall b m.
|
||
|
( BackendMetadata b,
|
||
|
MetadataM m,
|
||
|
HasServerConfigCtx m,
|
||
|
MonadIO m,
|
||
|
MonadError QErr m
|
||
|
) =>
|
||
|
GetCustomSQL b ->
|
||
|
m EncJSON
|
||
|
runGetCustomSQL q = do
|
||
|
throwIfFeatureDisabled
|
||
|
|
||
|
metadata <- getMetadata
|
||
|
|
||
|
let customSQL :: Maybe (CustomSQLFields b)
|
||
|
customSQL = metadata ^? metaSources . ix (gcsSource q) . toSourceMetadata . smCustomSQL
|
||
|
|
||
|
pure (encJFromJValue customSQL)
|
||
|
|
||
|
----------------------------------
|
||
|
|
||
|
data TrackCustomSQL (b :: BackendType) = TrackCustomSQL
|
||
|
{ tcsSource :: SourceName,
|
||
|
tcsType :: Text,
|
||
|
tcsRootFieldName :: G.Name,
|
||
|
tcsSql :: Text,
|
||
|
tcsParameters :: NonEmpty CustomSQLParameter,
|
||
|
tcsReturns :: TableName b
|
||
|
}
|
||
|
|
||
|
deriving instance Backend b => Show (TrackCustomSQL b)
|
||
|
|
||
|
deriving instance Backend b => Eq (TrackCustomSQL b)
|
||
|
|
||
|
instance Backend b => FromJSON (TrackCustomSQL b) where
|
||
|
parseJSON = withObject "TrackCustomSQL" $ \o -> do
|
||
|
tcsSource <- o .: "source"
|
||
|
tcsType <- o .: "type"
|
||
|
tcsRootFieldName <- o .: "root_field_name"
|
||
|
tcsSql <- o .: "sql"
|
||
|
tcsParameters <- o .: "parameters"
|
||
|
tcsReturns <- o .: "returns"
|
||
|
pure TrackCustomSQL {..}
|
||
|
|
||
|
instance Backend b => ToJSON (TrackCustomSQL b) where
|
||
|
toJSON TrackCustomSQL {..} =
|
||
|
object
|
||
|
[ "source" .= tcsSource,
|
||
|
"type" .= tcsType,
|
||
|
"root_field_name" .= tcsRootFieldName,
|
||
|
"sql" .= tcsSql,
|
||
|
"parameters" .= tcsParameters,
|
||
|
"returns" .= tcsReturns
|
||
|
]
|
||
|
|
||
|
runTrackCustomSQL ::
|
||
|
forall b m.
|
||
|
( BackendMetadata b,
|
||
|
CacheRWM m,
|
||
|
MetadataM m,
|
||
|
MonadError QErr m,
|
||
|
HasServerConfigCtx m,
|
||
|
MonadIO m
|
||
|
) =>
|
||
|
TrackCustomSQL b ->
|
||
|
m EncJSON
|
||
|
runTrackCustomSQL q = do
|
||
|
throwIfFeatureDisabled
|
||
|
|
||
|
let metadataObj =
|
||
|
MOSourceObjId source $
|
||
|
AB.mkAnyBackend $
|
||
|
SMOCustomSQL @b fieldName
|
||
|
metadata =
|
||
|
CustomSQLMetadata
|
||
|
{ _csmType = tcsType q,
|
||
|
_csmRootFieldName = tcsRootFieldName q,
|
||
|
_csmSql = tcsSql q,
|
||
|
_csmParameters = tcsParameters q,
|
||
|
_csmReturns = tcsReturns q
|
||
|
}
|
||
|
|
||
|
buildSchemaCacheFor metadataObj $
|
||
|
MetadataModifier $
|
||
|
(metaSources . ix source . toSourceMetadata @b . smCustomSQL)
|
||
|
%~ OMap.insert fieldName metadata
|
||
|
|
||
|
pure successMsg
|
||
|
where
|
||
|
source = tcsSource q
|
||
|
fieldName = tcsRootFieldName q
|
||
|
|
||
|
---------------------------------
|
||
|
|
||
|
data UntrackCustomSQL (b :: BackendType) = UntrackCustomSQL
|
||
|
{ utcsSource :: SourceName,
|
||
|
utcsRootFieldName :: G.Name
|
||
|
}
|
||
|
|
||
|
deriving instance Backend b => Show (UntrackCustomSQL b)
|
||
|
|
||
|
deriving instance Backend b => Eq (UntrackCustomSQL b)
|
||
|
|
||
|
instance Backend b => FromJSON (UntrackCustomSQL b) where
|
||
|
parseJSON = withObject "UntrackCustomSQL" $ \o -> do
|
||
|
utcsSource <- o .: "source"
|
||
|
utcsRootFieldName <- o .: "root_field_name"
|
||
|
pure UntrackCustomSQL {..}
|
||
|
|
||
|
instance Backend b => ToJSON (UntrackCustomSQL b) where
|
||
|
toJSON UntrackCustomSQL {..} =
|
||
|
object
|
||
|
[ "source" .= utcsSource,
|
||
|
"root_field_name" .= utcsRootFieldName
|
||
|
]
|
||
|
|
||
|
runUntrackCustomSQL ::
|
||
|
forall b m.
|
||
|
( BackendMetadata b,
|
||
|
MonadError QErr m,
|
||
|
CacheRWM m,
|
||
|
MetadataM m,
|
||
|
HasServerConfigCtx m,
|
||
|
MonadIO m
|
||
|
) =>
|
||
|
UntrackCustomSQL b ->
|
||
|
m EncJSON
|
||
|
runUntrackCustomSQL q = do
|
||
|
throwIfFeatureDisabled
|
||
|
|
||
|
let metadataObj =
|
||
|
MOSourceObjId source $
|
||
|
AB.mkAnyBackend $
|
||
|
SMOCustomSQL @b fieldName
|
||
|
|
||
|
buildSchemaCacheFor metadataObj $
|
||
|
dropCustomSQLInMetadata @b source (fieldName :: G.Name)
|
||
|
|
||
|
pure successMsg
|
||
|
where
|
||
|
source = utcsSource q
|
||
|
fieldName = utcsRootFieldName q
|
||
|
|
||
|
dropCustomSQLInMetadata :: forall b. BackendMetadata b => SourceName -> G.Name -> MetadataModifier
|
||
|
dropCustomSQLInMetadata source rootFieldName =
|
||
|
MetadataModifier $
|
||
|
metaSources . ix source . toSourceMetadata @b . smCustomSQL %~ OMap.delete rootFieldName
|
||
|
|
||
|
-- | check feature flag is enabled before carrying out any actions
|
||
|
throwIfFeatureDisabled :: (HasServerConfigCtx m, MonadIO m, MonadError QErr m) => m ()
|
||
|
throwIfFeatureDisabled = do
|
||
|
configCtx <- askServerConfigCtx
|
||
|
|
||
|
enableCustomSQL <- liftIO (_sccUsePQNP configCtx)
|
||
|
|
||
|
unless enableCustomSQL (throw500 "CustomSQL is disabled!")
|