Clean metadata arguments

## Description

Thanks to #1664, the Metadata API types no longer require a `ToJSON` instance. This PR follows up with a cleanup of the types of the arguments to the metadata API:
- whenever possible, it moves those argument types to where they're used (RQL.DDL.*)
- it removes all unrequired instances (mostly `ToJSON`)

This PR does not attempt to do it for _all_ such argument types. For some of the metadata operations, the type used to describe the argument to the API and used to represent the value in the metadata are one and the same (like for `CreateEndpoint`). Sometimes, the two types are intertwined in complex ways (`RemoteRelationship` and `RemoteRelationshipDef`). In the spirit of only doing uncontroversial cleaning work, this PR only moves types that are not used outside of RQL.DDL.

Furthermore, this is a small step towards separating the different types all jumbled together in RQL.Types.

## Notes

This PR also improves several `FromJSON` instances to make use of `withObject`, and to use a human readable string instead of a type name in error messages whenever possible. For instance:
- before: `expected Object for Object, but encountered X`
  after: `expected Object for add computed field, but encountered X`
- before: `Expecting an object for update query`
  after: `expected Object for update query, but encountered X`

This PR also renames `CreateFunctionPermission` to `FunctionPermissionArgument`, to remove the quite surprising `type DropFunctionPermission = CreateFunctionPermission`.

This PR also deletes some dead code, mostly in RQL.DML.

This PR also moves a PG-specific source resolving function from DDL.Schema.Source to the only place where it is used: App.hs.

https://github.com/hasura/graphql-engine-mono/pull/1844

GitOrigin-RevId: a594521194bb7fe6a111b02a9e099896f9fed59c
This commit is contained in:
Antoine Leblanc 2021-07-27 11:41:42 +01:00 committed by hasura-bot
parent 00902e322e
commit cc6c86aeab
28 changed files with 478 additions and 670 deletions

View File

@ -3,28 +3,7 @@
module Main where
import Control.Applicative
import Control.Exception
import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
import Data.Int (Int64)
import Data.Text.Conversions (convertText)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Hasura.App
import Hasura.Logging (Hasura, LogLevel (..),
defaultEnabledEngineLogTypes)
import Hasura.Metadata.Class
import Hasura.Prelude
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.Types
import Hasura.Server.Init
import Hasura.Server.Migrate (downgradeCatalog)
import Hasura.Server.Types (MaintenanceMode (..))
import Hasura.Server.Version
import Hasura.Server.Version.TH
import qualified Control.Concurrent.Extended as C
import qualified Data.ByteString.Char8 as BC
@ -32,12 +11,33 @@ import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.Environment as Env
import qualified Database.PG.Query as Q
import qualified Hasura.GC as GC
import qualified Hasura.Tracing as Tracing
import qualified System.Exit as Sys
import qualified System.Metrics as EKG
import qualified System.Posix.Signals as Signals
import Control.Exception
import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
import Data.Int (Int64)
import Data.Text.Conversions (convertText)
import Data.Time.Clock (getCurrentTime)
import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Hasura.GC as GC
import qualified Hasura.Tracing as Tracing
import Hasura.App
import Hasura.Logging (Hasura, LogLevel (..),
defaultEnabledEngineLogTypes)
import Hasura.Metadata.Class
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.Types
import Hasura.Server.Init
import Hasura.Server.Migrate (downgradeCatalog)
import Hasura.Server.Types (MaintenanceMode (..))
import Hasura.Server.Version
import Hasura.Server.Version.TH
main :: IO ()
main = do

View File

@ -70,7 +70,6 @@ import Hasura.Metadata.Class
import Hasura.RQL.DDL.Schema.Cache
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Catalog
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.Types
import Hasura.RQL.Types.Run
import Hasura.Server.API.Query (requiresAdmin, runQueryM)
@ -1012,3 +1011,21 @@ telemetryNotice =
"Help us improve Hasura! The graphql-engine server collects anonymized "
<> "usage stats which allows us to keep improving Hasura at warp speed. "
<> "To read more or opt-out, visit https://hasura.io/docs/latest/graphql/core/guides/telemetry.html"
mkPgSourceResolver :: Q.PGLogger -> SourceResolver
mkPgSourceResolver pgLogger _ config = runExceptT do
env <- lift Env.getEnvironment
let PostgresSourceConnInfo urlConf poolSettings allowPrepare isoLevel _ = _pccConnectionInfo config
-- If the user does not provide values for the pool settings, then use the default values
let (maxConns, idleTimeout, retries) = getDefaultPGPoolSettingIfNotExists poolSettings defaultPostgresPoolSettings
urlText <- resolveUrlConf env urlConf
let connInfo = Q.ConnInfo retries $ Q.CDDatabaseURI $ txtToBs urlText
connParams = Q.defaultConnParams{ Q.cpIdleTime = idleTimeout
, Q.cpConns = maxConns
, Q.cpAllowPrepare = allowPrepare
, Q.cpMbLifetime = _ppsConnectionLifetime =<< poolSettings
, Q.cpTimeout = _ppsPoolTimeout =<< poolSettings
}
pgPool <- liftIO $ Q.initPGPool connInfo connParams pgLogger
let pgExecCtx = mkPGExecCtx isoLevel pgPool
pure $ PGSourceConfig pgExecCtx connInfo Nothing mempty

View File

@ -1,6 +1,5 @@
module Hasura.Backends.BigQuery.DDL
( buildComputedFieldInfo
, buildRemoteFieldInfo
, fetchAndValidateEnumValues
, createTableEventTrigger
, buildEventTriggerInfo
@ -30,7 +29,6 @@ import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.RemoteRelationship
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
@ -52,15 +50,6 @@ buildComputedFieldInfo
buildComputedFieldInfo _ _ _ _ _ _ =
throw400 NotSupported "Computed fields aren't supported for BigQuery sources"
buildRemoteFieldInfo
:: (MonadError QErr m)
=> RemoteRelationship 'BigQuery
-> [ColumnInfo 'BigQuery]
-> RemoteSchemaMap
-> m (RemoteFieldInfo 'BigQuery, [SchemaDependency])
buildRemoteFieldInfo _ _ _ =
throw400 NotSupported "Remote joins aren't supported for BigQuery sources"
fetchAndValidateEnumValues
:: (Monad m)
=> SourceConfig 'BigQuery

View File

@ -1,5 +1,5 @@
module Hasura.RQL.DDL.Action
( CreateAction
( CreateAction(..)
, runCreateAction
, resolveAction
@ -10,7 +10,7 @@ module Hasura.RQL.DDL.Action
, runDropAction
, dropActionInMetadata
, CreateActionPermission
, CreateActionPermission(..)
, runCreateActionPermission
, DropActionPermission
@ -48,6 +48,14 @@ getActionInfo actionName = do
onNothing (Map.lookup actionName actionMap) $
throw400 NotExists $ "action with name " <> actionName <<> " does not exist"
data CreateAction
= CreateAction
{ _caName :: !ActionName
, _caDefinition :: !ActionDefinitionInput
, _caComment :: !(Maybe Text)
}
$(J.deriveJSON hasuraJSON ''CreateAction)
runCreateAction
:: (QErrM m , CacheRWM m, MetadataM m)
=> CreateAction -> m EncJSON
@ -120,6 +128,14 @@ resolveAction env AnnotatedCustomTypes{..} ActionDefinition{..} allScalars = do
, outputObject
)
data UpdateAction
= UpdateAction
{ _uaName :: !ActionName
, _uaDefinition :: !ActionDefinitionInput
, _uaComment :: !(Maybe Text)
}
$(J.deriveFromJSON hasuraJSON ''UpdateAction)
runUpdateAction
:: forall m. ( QErrM m , CacheRWM m, MetadataM m)
=> UpdateAction -> m EncJSON
@ -179,6 +195,15 @@ newtype ActionMetadataField
= ActionMetadataField { unActionMetadataField :: Text }
deriving (Show, Eq, J.FromJSON, J.ToJSON)
data CreateActionPermission
= CreateActionPermission
{ _capAction :: !ActionName
, _capRole :: !RoleName
, _capDefinition :: !(Maybe J.Value)
, _capComment :: !(Maybe Text)
}
$(J.deriveFromJSON hasuraJSON ''CreateActionPermission)
runCreateActionPermission
:: (QErrM m , CacheRWM m, MetadataM m)
=> CreateActionPermission -> m EncJSON

View File

@ -21,7 +21,6 @@ import qualified Hasura.SQL.AnyBackend as AB
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Deps
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types
@ -34,16 +33,13 @@ data AddComputedField b
, _afcName :: !ComputedFieldName
, _afcDefinition :: !(ComputedFieldDefinition b)
, _afcComment :: !(Maybe Text)
} deriving (Generic)
deriving instance (Backend b) => Show (AddComputedField b)
deriving instance (Backend b) => Eq (AddComputedField b)
instance (Backend b) => NFData (AddComputedField b)
instance (Backend b) => Cacheable (AddComputedField b)
} deriving stock (Generic)
instance (Backend b) => ToJSON (AddComputedField b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (AddComputedField b) where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "add computed field" $ \o ->
AddComputedField
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
@ -79,14 +75,10 @@ data DropComputedField b
, _dccTable :: !(TableName b)
, _dccName :: !ComputedFieldName
, _dccCascade :: !Bool
} deriving (Generic)
deriving instance (Backend b) => Show (DropComputedField b)
deriving instance (Backend b) => Eq (DropComputedField b)
instance (Backend b) => ToJSON (DropComputedField b) where
toJSON = genericToJSON hasuraJSON
}
instance (Backend b) => FromJSON (DropComputedField b) where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "drop computed field" $ \o ->
DropComputedField
<$> o .:? "source" .!= defaultSource
<*> o .: "table"

View File

@ -6,6 +6,7 @@ module Hasura.RQL.DDL.EventTrigger
, dropEventTriggerInMetadata
, RedeliverEventQuery
, runRedeliverEvent
, InvokeEventTriggerQuery
, runInvokeEventTrigger
-- TODO(from master): review
, archiveEvents
@ -14,25 +15,123 @@ module Hasura.RQL.DDL.EventTrigger
import Hasura.Prelude
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Database.PG.Query as Q
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Text.Regex.TDFA as TDFA
import Control.Lens ((.~))
import Control.Lens ((.~))
import Data.Aeson
import Data.Text.Extended
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.Tracing as Tracing
import qualified Hasura.Backends.Postgres.DDL.Table as PG
import qualified Hasura.Backends.Postgres.SQL.Types as PG
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.Tracing as Tracing
import Hasura.Backends.Postgres.DDL.Table
import Hasura.Backends.Postgres.Execute.Types
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.RQL.Types
import Hasura.Session
data CreateEventTriggerQuery (b :: BackendType)
= CreateEventTriggerQuery
{ _cetqSource :: !SourceName
, _cetqName :: !TriggerName
, _cetqTable :: !(TableName b)
, _cetqInsert :: !(Maybe SubscribeOpSpec)
, _cetqUpdate :: !(Maybe SubscribeOpSpec)
, _cetqDelete :: !(Maybe SubscribeOpSpec)
, _cetqEnableManual :: !(Maybe Bool)
, _cetqRetryConf :: !(Maybe RetryConf)
, _cetqWebhook :: !(Maybe InputWebhook)
, _cetqWebhookFromEnv :: !(Maybe Text)
, _cetqHeaders :: !(Maybe [HeaderConf])
, _cetqReplace :: !Bool
}
instance Backend b => FromJSON (CreateEventTriggerQuery b) where
parseJSON = withObject "create event trigger" \o -> do
sourceName <- o .:? "source" .!= defaultSource
name <- o .: "name"
table <- o .: "table"
insert <- o .:? "insert"
update <- o .:? "update"
delete <- o .:? "delete"
enableManual <- o .:? "enable_manual" .!= False
retryConf <- o .:? "retry_conf"
webhook <- o .:? "webhook"
webhookFromEnv <- o .:? "webhook_from_env"
headers <- o .:? "headers"
replace <- o .:? "replace" .!= False
let regex = "^[A-Za-z]+[A-Za-z0-9_\\-]*$" :: LBS.ByteString
compiledRegex = TDFA.makeRegex regex :: TDFA.Regex
isMatch = TDFA.match compiledRegex . T.unpack $ triggerNameToTxt name
unless isMatch $
fail "only alphanumeric and underscore and hyphens allowed for name"
unless (T.length (triggerNameToTxt name) <= maxTriggerNameLength) $
fail "event trigger name can be at most 42 characters"
unless (any isJust [insert, update, delete] || enableManual) $
fail "atleast one amongst insert/update/delete/enable_manual spec must be provided"
case (webhook, webhookFromEnv) of
(Just _, Nothing) -> return ()
(Nothing, Just _) -> return ()
(Just _, Just _) -> fail "only one of webhook or webhook_from_env should be given"
_ -> fail "must provide webhook or webhook_from_env"
mapM_ checkEmptyCols [insert, update, delete]
return $ CreateEventTriggerQuery sourceName name table insert update delete (Just enableManual) retryConf webhook webhookFromEnv headers replace
where
checkEmptyCols spec
= case spec of
Just (SubscribeOpSpec (SubCArray cols) _) -> when (null cols) (fail "found empty column specification")
Just (SubscribeOpSpec _ (Just (SubCArray cols)) ) -> when (null cols) (fail "found empty payload specification")
_ -> return ()
data DeleteEventTriggerQuery (b :: BackendType)
= DeleteEventTriggerQuery
{ _detqSource :: !SourceName
, _detqName :: !TriggerName
}
instance FromJSON (DeleteEventTriggerQuery b) where
parseJSON = withObject "delete event trigger" $ \o ->
DeleteEventTriggerQuery
<$> o .:? "source" .!= defaultSource
<*> o .: "name"
data RedeliverEventQuery (b :: BackendType)
= RedeliverEventQuery
{ _rdeqEventId :: !EventId
, _rdeqSource :: !SourceName
}
instance FromJSON (RedeliverEventQuery b) where
parseJSON = withObject "redeliver event trigger" $ \o ->
RedeliverEventQuery
<$> o .: "event_id"
<*> o .:? "source" .!= defaultSource
data InvokeEventTriggerQuery (b :: BackendType)
= InvokeEventTriggerQuery
{ _ietqName :: !TriggerName
, _ietqSource :: !SourceName
, _ietqPayload :: !Value
}
instance Backend b => FromJSON (InvokeEventTriggerQuery b) where
parseJSON = withObject "invoke event trigger" $ \o ->
InvokeEventTriggerQuery
<$> o .: "name"
<*> o .:? "source" .!= defaultSource
<*> o .: "payload"
archiveEvents :: TriggerName -> Q.TxE QErr ()
archiveEvents trn =
Q.unitQE defaultTxErrorHandler [Q.sql|
@ -99,8 +198,8 @@ createEventTriggerQueryMetadata
-> m (TableCoreInfo ('Postgres pgKind), EventTriggerConf)
createEventTriggerQueryMetadata q = do
(tableCoreInfo, replace, triggerConf) <- resolveEventTriggerQuery q
let table = cetqTable q
source = cetqSource q
let table = _cetqTable q
source = _cetqSource q
triggerName = etcName triggerConf
metadataObj =
MOSourceObjId source
@ -143,7 +242,7 @@ runDeleteEventTriggerQuery (DeleteEventTriggerQuery source name) = do
$ tableMetadataSetter @('Postgres pgKind) source table %~ dropEventTriggerInMetadata name
liftEitherM $ liftIO $ runPgSourceWriteTx (_siConfiguration sourceInfo) $ do
delTriggerQ name
PG.delTriggerQ name
archiveEvents name
pure successMsg
@ -167,11 +266,11 @@ runRedeliverEvent (RedeliverEventQuery eventId source) = do
pure successMsg
insertManualEvent
:: QualifiedTable
:: PG.QualifiedTable
-> TriggerName
-> Value
-> Q.TxE QErr EventId
insertManualEvent (QualifiedObject sn tn) trn rowData = do
insertManualEvent (PG.QualifiedObject sn tn) trn rowData = do
runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql|
SELECT hdb_catalog.insert_event_log($1, $2, $3, $4, $5)
|] (sn, tn, trn, (tshow MANUAL), Q.AltJ rowData) False
@ -214,14 +313,14 @@ runInvokeEventTrigger (InvokeEventTriggerQuery name source payload) = do
getEventTriggerDef
:: TriggerName
-> Q.TxE QErr (QualifiedTable, EventTriggerConf)
-> Q.TxE QErr (PG.QualifiedTable, EventTriggerConf)
getEventTriggerDef triggerName = do
(sn, tn, Q.AltJ etc) <- Q.getRow <$> Q.withQE defaultTxErrorHandler
[Q.sql|
SELECT e.schema_name, e.table_name, e.configuration::json
FROM hdb_catalog.event_triggers e where e.name = $1
|] (Identity triggerName) False
return (QualifiedObject sn tn, etc)
return (PG.QualifiedObject sn tn, etc)
askTabInfoFromTrigger
:: (QErrM m, CacheRM m)
@ -243,3 +342,12 @@ askEventTriggerInfo sourceName trn = do
HM.lookup trn etim `onNothing` throw400 NotExists errMsg
where
errMsg = "event trigger " <> triggerNameToTxt trn <<> " does not exist"
-- This change helps us create functions for the event triggers
-- without the function name being truncated by PG, since PG allows
-- for only 63 chars for identifiers.
-- Reasoning for the 42 characters:
-- 63 - (notify_hasura_) - (_INSERT | _UPDATE | _DELETE)
maxTriggerNameLength :: Int
maxTriggerNameLength = 42

View File

@ -372,14 +372,10 @@ data SetPermComment b
, apRole :: !RoleName
, apPermission :: !PermType
, apComment :: !(Maybe Text)
} deriving (Generic)
deriving instance (Backend b) => Show (SetPermComment b)
deriving instance (Backend b) => Eq (SetPermComment b)
instance (Backend b) => ToJSON (SetPermComment b) where
toJSON = genericToJSON hasuraJSON
}
instance (Backend b) => FromJSON (SetPermComment b) where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "set permission comment" $ \o ->
SetPermComment
<$> o .:? "source" .!= defaultSource
<*> o .: "table"

View File

@ -6,7 +6,6 @@ import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import Control.Lens hiding ((.=))
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Kind (Type)
import Data.Text.Extended
@ -64,7 +63,7 @@ askPermInfo tabInfo roleName pa =
newtype CreatePerm a b = CreatePerm (WithTable b (PermDef (a b)))
deriving newtype (Show, Eq, FromJSON, ToJSON)
deriving newtype (FromJSON)
data CreatePermP1Res a
= CreatePermP1Res
@ -107,14 +106,10 @@ data DropPerm (a :: BackendType -> Type) b
{ dipSource :: !SourceName
, dipTable :: !(TableName b)
, dipRole :: !RoleName
} deriving (Generic)
deriving instance (Backend b) => Show (DropPerm a b)
deriving instance (Backend b) => Eq (DropPerm a b)
instance (Backend b) => ToJSON (DropPerm a b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
}
instance (Backend b) => FromJSON (DropPerm a b) where
parseJSON = withObject "DropPerm" $ \o ->
parseJSON = withObject "drop permission" $ \o ->
DropPerm
<$> o .:? "source" .!= defaultSource
<*> o .: "table"

View File

@ -1,11 +1,15 @@
module Hasura.RQL.DDL.Relationship
( runCreateRelationship
( CreateArrRel(..)
, CreateObjRel(..)
, runCreateRelationship
, objRelP2Setup
, arrRelP2Setup
, DropRel
, runDropRel
, dropRelationshipInMetadata
, SetRelComment
, runSetRelComment
)
where
@ -30,10 +34,21 @@ import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types
--------------------------------------------------------------------------------
-- Create local relationship
newtype CreateArrRel b = CreateArrRel { unCreateArrRel :: WithTable b (ArrRelDef b) }
deriving newtype (FromJSON)
newtype CreateObjRel b = CreateObjRel { unCreateObjRel :: WithTable b (ObjRelDef b) }
deriving newtype (FromJSON)
runCreateRelationship
:: forall m b a
. (MonadError QErr m, CacheRWM m, ToJSON a, MetadataM m, Backend b, BackendMetadata b)
=> RelType -> WithTable b (RelDef a) -> m EncJSON
=> RelType
-> WithTable b (RelDef a)
-> m EncJSON
runCreateRelationship relType (WithTable source tableName relDef) = do
let relName = _rdName relDef
-- Check if any field with relationship name already exists in the table
@ -73,41 +88,6 @@ runCreateRelationship relType (WithTable source tableName relDef) = do
$ tableMetadataSetter @b source tableName %~ addRelationshipToMetadata
pure successMsg
runDropRel
:: forall b m
. (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b)
=> DropRel b -> m EncJSON
runDropRel (DropRel source qt rn cascade) = do
depObjs <- collectDependencies
withNewInconsistentObjsCheck do
metadataModifiers <- traverse purgeRelDep depObjs
buildSchemaCache $ MetadataModifier $
tableMetadataSetter @b source qt %~
dropRelationshipInMetadata rn . foldr (.) id metadataModifiers
pure successMsg
where
collectDependencies = do
tabInfo <- askTableCoreInfo @b source qt
void $ askRelType (_tciFieldInfoMap tabInfo) rn ""
sc <- askSchemaCache
let depObjs = getDependentObjs
sc
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITableObj @b qt
$ TORel rn)
when (depObjs /= [] && not cascade) $ reportDeps depObjs
pure depObjs
dropRelationshipInMetadata
:: RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata relName =
-- Since the name of a relationship is unique in a table, the relationship
-- with given name may present in either array or object relationships but
-- not in both.
(tmObjectRelationships %~ OMap.delete relName)
. (tmArrayRelationships %~ OMap.delete relName)
objRelP2Setup
:: forall b m
. (QErrM m, Backend b)
@ -220,6 +200,19 @@ mkFkeyRel relType io source rn sourceTable remoteTable remoteColumns foreignKeys
reverseHM :: Eq y => Hashable y => HashMap x y -> HashMap y x
reverseHM = HM.fromList . fmap swap . HM.toList
getRequiredFkey
:: (QErrM m, Backend b)
=> NonEmpty (Column b)
-> [ForeignKey b]
-> m (ForeignKey b)
getRequiredFkey cols fkeys =
case filteredFkeys of
[k] -> return k
[] -> throw400 ConstraintError "no foreign constraint exists on the given column"
_ -> throw400 ConstraintError "more than one foreign key constraint exists on the given column"
where
filteredFkeys = filter ((== HS.fromList (toList cols)) . HM.keysSet . _fkColumnMapping) fkeys
drUsingColumnDep
:: forall b
. Backend b
@ -235,6 +228,61 @@ drUsingColumnDep source qt col =
$ TOCol @b col)
DRUsingColumn
--------------------------------------------------------------------------------
-- Drop local relationship
data DropRel b
= DropRel
{ _drSource :: !SourceName
, _drTable :: !(TableName b)
, _drRelationship :: !RelName
, _drCascade :: !Bool
}
instance (Backend b) => FromJSON (DropRel b) where
parseJSON = withObject "drop relationship" $ \o ->
DropRel
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "relationship"
<*> o .:? "cascade" .!= False
runDropRel
:: forall b m
. (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b)
=> DropRel b -> m EncJSON
runDropRel (DropRel source qt rn cascade) = do
depObjs <- collectDependencies
withNewInconsistentObjsCheck do
metadataModifiers <- traverse purgeRelDep depObjs
buildSchemaCache $ MetadataModifier $
tableMetadataSetter @b source qt %~
dropRelationshipInMetadata rn . foldr (.) id metadataModifiers
pure successMsg
where
collectDependencies = do
tabInfo <- askTableCoreInfo @b source qt
void $ askRelType (_tciFieldInfoMap tabInfo) rn ""
sc <- askSchemaCache
let depObjs = getDependentObjs
sc
(SOSourceObj source
$ AB.mkAnyBackend
$ SOITableObj @b qt
$ TORel rn)
when (depObjs /= [] && not cascade) $ reportDeps depObjs
pure depObjs
dropRelationshipInMetadata
:: RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata relName =
-- Since the name of a relationship is unique in a table, the relationship
-- with given name may present in either array or object relationships but
-- not in both.
(tmObjectRelationships %~ OMap.delete relName)
. (tmArrayRelationships %~ OMap.delete relName)
purgeRelDep
:: forall b m
. QErrM m
@ -246,10 +294,33 @@ purgeRelDep (SOSourceObj _ exists)
purgeRelDep d = throw500 $ "unexpected dependency of relationship : "
<> reportSchemaObj d
--------------------------------------------------------------------------------
-- Set local relationship comment
data SetRelComment b
= SetRelComment
{ arSource :: !SourceName
, arTable :: !(TableName b)
, arRelationship :: !RelName
, arComment :: !(Maybe Text)
} deriving (Generic)
deriving instance (Backend b) => Show (SetRelComment b)
deriving instance (Backend b) => Eq (SetRelComment b)
instance (Backend b) => FromJSON (SetRelComment b) where
parseJSON = withObject "set relationship comment" $ \o ->
SetRelComment
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "relationship"
<*> o .:? "comment"
runSetRelComment
:: forall m b
. (CacheRWM m, MonadError QErr m, MetadataM m, BackendMetadata b)
=> SetRelComment b -> m EncJSON
=> SetRelComment b
-> m EncJSON
runSetRelComment defn = do
tabInfo <- askTableCoreInfo @b source qt
relType <- riType <$> askRelType (_tciFieldInfoMap tabInfo) rn ""
@ -265,16 +336,3 @@ runSetRelComment defn = do
pure successMsg
where
SetRelComment source qt rn comment = defn
getRequiredFkey
:: (QErrM m, Backend b)
=> NonEmpty (Column b)
-> [ForeignKey b]
-> m (ForeignKey b)
getRequiredFkey cols fkeys =
case filteredFkeys of
[k] -> return k
[] -> throw400 ConstraintError "no foreign constraint exists on the given column"
_ -> throw400 ConstraintError "more than one foreign key constraint exists on the given column"
where
filteredFkeys = filter ((== HS.fromList (toList cols)) . HM.keysSet . _fkColumnMapping) fkeys

View File

@ -1,11 +1,13 @@
module Hasura.RQL.DDL.Relationship.Rename
(runRenameRel)
where
( RenameRel
, runRenameRel
) where
import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import Data.Aeson
import Data.Text.Extended
import Hasura.Base.Error
@ -14,6 +16,22 @@ import Hasura.RQL.DDL.Schema (renameRelationshipInMetadata)
import Hasura.RQL.Types
data RenameRel b
= RenameRel
{ _rrSource :: !SourceName
, _rrTable :: !(TableName b)
, _rrName :: !RelName
, _rrNewName :: !RelName
}
instance (Backend b) => FromJSON (RenameRel b) where
parseJSON = withObject "rename relationship" $ \o ->
RenameRel
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
<*> o .: "new_name"
renameRelP2
:: forall b m
. (QErrM m, CacheRM m, BackendMetadata b)

View File

@ -2,6 +2,7 @@ module Hasura.RQL.DDL.RemoteRelationship
( runCreateRemoteRelationship
, runDeleteRemoteRelationship
, runUpdateRemoteRelationship
, DeleteRemoteRelationship
, dropRemoteRelationshipInMetadata
, PartiallyResolvedSource(..)
, buildRemoteFieldInfo
@ -14,6 +15,7 @@ import qualified Data.HashMap.Strict as Map
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.HashSet as S
import Data.Aeson
import Data.Text.Extended
import qualified Hasura.SQL.AnyBackend as AB
@ -62,12 +64,26 @@ runUpdateRemoteRelationship RemoteRelationship {..} = do
%~ OMap.insert _rtrName metadata
pure successMsg
data DeleteRemoteRelationship (b :: BackendType)
= DeleteRemoteRelationship
{ _drrSource :: !SourceName
, _drrTable :: !(TableName b)
, _drrName :: !RemoteRelationshipName
}
instance Backend b => FromJSON (DeleteRemoteRelationship b) where
parseJSON = withObject "delete remote relationship" $ \o ->
DeleteRemoteRelationship
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
runDeleteRemoteRelationship
:: forall b m
. (BackendMetadata b, MonadError QErr m, CacheRWM m, MetadataM m)
=> DeleteRemoteRelationship b
-> m EncJSON
runDeleteRemoteRelationship (DeleteRemoteRelationship source table relName)= do
runDeleteRemoteRelationship (DeleteRemoteRelationship source table relName) = do
fieldInfoMap <- askFieldInfoMap @b source table
void $ askRemoteRel fieldInfoMap relName
let metadataObj = MOSourceObjId source

View File

@ -21,11 +21,7 @@ import Hasura.SQL.Tag
import Hasura.Session
newtype TrackFunction b
= TrackFunction
{ tfName :: FunctionName b }
deriving instance (Backend b) => Show (TrackFunction b)
deriving instance (Backend b) => Eq (TrackFunction b)
newtype TrackFunction b = TrackFunction { tfName :: FunctionName b }
deriving instance (Backend b) => FromJSON (TrackFunction b)
deriving instance (Backend b) => ToJSON (TrackFunction b)
@ -41,7 +37,7 @@ trackFunctionP1
trackFunctionP1 sourceName qf = do
rawSchemaCache <- askSchemaCache
unless (isJust $ AB.unpackAnyBackend @b =<< Map.lookup sourceName (scSources rawSchemaCache)) $
throw400 NotExists $ sourceName <<> " is not a known " <> (reify $ backendTag @b) <<> " source"
throw400 NotExists $ sourceName <<> " is not a known " <> reify (backendTag @b) <<> " source"
when (isJust $ unsafeFunctionInfo @b sourceName qf $ scSources rawSchemaCache) $
throw400 AlreadyTracked $ "function already tracked : " <>> qf
let qt = functionToTable @b qf
@ -81,6 +77,22 @@ runTrackFunc (TrackFunction qf) = do
trackFunctionP1 @b defaultSource qf
trackFunctionP2 @b defaultSource qf emptyFunctionConfig
-- | JSON API payload for v2 of 'track_function':
--
-- https://hasura.io/docs/latest/graphql/core/api-reference/schema-metadata-api/custom-functions.html#track-function-v2
data TrackFunctionV2 (b :: BackendType) = TrackFunctionV2
{ _tfv2Source :: !SourceName
, _tfv2Function :: !(FunctionName b)
, _tfv2Configuration :: !FunctionConfig
}
instance Backend b => FromJSON (TrackFunctionV2 b) where
parseJSON = withObject "track function" $ \o ->
TrackFunctionV2
<$> o .:? "source" .!= defaultSource
<*> o .: "function"
<*> o .:? "configuration" .!= emptyFunctionConfig
runTrackFunctionV2
:: forall b m
. (BackendMetadata b, QErrM m, CacheRWM m, MetadataM m)
@ -93,15 +105,10 @@ runTrackFunctionV2 (TrackFunctionV2 source qf config) = do
-- | JSON API payload for 'untrack_function':
--
-- https://hasura.io/docs/latest/graphql/core/api-reference/schema-metadata-api/custom-functions.html#untrack-function
data UnTrackFunction b
= UnTrackFunction
data UnTrackFunction b = UnTrackFunction
{ _utfFunction :: !(FunctionName b)
, _utfSource :: !SourceName
} deriving (Generic)
deriving instance (Backend b) => Show (UnTrackFunction b)
deriving instance (Backend b) => Eq (UnTrackFunction b)
instance (Backend b) => ToJSON (UnTrackFunction b) where
toJSON = genericToJSON hasuraJSON
}
instance (Backend b) => FromJSON (UnTrackFunction b) where
-- Following was the previous implementation, which while seems to be correct,
@ -186,21 +193,16 @@ is started with
to false (by default, it's set to true).
-}
data CreateFunctionPermission b
= CreateFunctionPermission
data FunctionPermissionArgument b = FunctionPermissionArgument
{ _afpFunction :: !(FunctionName b)
, _afpSource :: !SourceName
, _afpRole :: !RoleName
} deriving (Generic)
deriving instance (Backend b) => Show (CreateFunctionPermission b)
deriving instance (Backend b) => Eq (CreateFunctionPermission b)
instance (Backend b) => ToJSON (CreateFunctionPermission b) where
toJSON = genericToJSON hasuraJSON
}
instance (Backend b) => FromJSON (CreateFunctionPermission b) where
instance (Backend b) => FromJSON (FunctionPermissionArgument b) where
parseJSON v =
flip (withObject "CreateFunctionPermission") v $ \o ->
CreateFunctionPermission
flip (withObject "function permission") v $ \o ->
FunctionPermissionArgument
<$> o .: "function"
<*> o .:? "source" .!= defaultSource
<*> o .: "role"
@ -212,9 +214,9 @@ runCreateFunctionPermission
, MetadataM m
, BackendMetadata b
)
=> CreateFunctionPermission b
=> FunctionPermissionArgument b
-> m EncJSON
runCreateFunctionPermission (CreateFunctionPermission functionName source role) = do
runCreateFunctionPermission (FunctionPermissionArgument functionName source role) = do
sourceCache <- scSources <$> askSchemaCache
functionInfo <- askFunctionInfo @b source functionName
when (role `elem` _fiPermissions functionInfo) $
@ -247,8 +249,6 @@ dropFunctionPermissionInMetadata
dropFunctionPermissionInMetadata source function role = MetadataModifier $
metaSources.ix source.toSourceMetadata.(smFunctions @b).ix function.fmPermissions %~ filter ((/=) role . _fpmRole)
type DropFunctionPermission = CreateFunctionPermission
runDropFunctionPermission
:: forall m b
. ( CacheRWM m
@ -256,9 +256,9 @@ runDropFunctionPermission
, MetadataM m
, BackendMetadata b
)
=> DropFunctionPermission b
=> FunctionPermissionArgument b
-> m EncJSON
runDropFunctionPermission (CreateFunctionPermission functionName source role) = do
runDropFunctionPermission (FunctionPermissionArgument functionName source role) = do
functionInfo <- askFunctionInfo @b source functionName
unless (role `elem` _fiPermissions functionInfo) $
throw400 NotExists $

View File

@ -22,6 +22,7 @@ import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.Eventing.ScheduledTrigger
import Hasura.RQL.DDL.Action
import Hasura.RQL.DDL.ComputedField
import Hasura.RQL.DDL.Permission
import Hasura.RQL.Types

View File

@ -2,18 +2,17 @@ module Hasura.RQL.DDL.Schema.Source where
import Hasura.Prelude
import qualified Data.Environment as Env
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Database.PG.Query as Q
import qualified Data.HashMap.Strict as HM
import qualified Data.HashMap.Strict.InsOrd as OMap
import Control.Lens (at, (.~), (^.))
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Lens (at, (.~), (^.))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.TH
import Data.Text.Extended
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.SQL.AnyBackend as AB
import Hasura.Backends.Postgres.Connection
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.RQL.DDL.Deps
@ -21,29 +20,28 @@ import Hasura.RQL.DDL.Schema.Common
import Hasura.RQL.Types
mkPgSourceResolver :: Q.PGLogger -> SourceResolver
mkPgSourceResolver pgLogger _ config = runExceptT do
env <- lift Env.getEnvironment
let PostgresSourceConnInfo urlConf poolSettings allowPrepare isoLevel _ = _pccConnectionInfo config
-- If the user does not provide values for the pool settings, then use the default values
let (maxConns, idleTimeout, retries) = getDefaultPGPoolSettingIfNotExists poolSettings defaultPostgresPoolSettings
urlText <- resolveUrlConf env urlConf
let connInfo = Q.ConnInfo retries $ Q.CDDatabaseURI $ txtToBs urlText
connParams = Q.defaultConnParams{ Q.cpIdleTime = idleTimeout
, Q.cpConns = maxConns
, Q.cpAllowPrepare = allowPrepare
, Q.cpMbLifetime = _ppsConnectionLifetime =<< poolSettings
, Q.cpTimeout = _ppsPoolTimeout =<< poolSettings
}
pgPool <- liftIO $ Q.initPGPool connInfo connParams pgLogger
let pgExecCtx = mkPGExecCtx isoLevel pgPool
pure $ PGSourceConfig pgExecCtx connInfo Nothing mempty
--------------------------------------------------------------------------------
-- Add source
data AddSource b
= AddSource
{ _asName :: !SourceName
, _asConfiguration :: !(SourceConnConfiguration b)
, _asReplaceConfiguration :: !Bool
}
instance (Backend b) => FromJSON (AddSource b) where
parseJSON = withObject "add source" $ \o ->
AddSource
<$> o .: "name"
<*> o .: "configuration"
<*> o .:? "replace_configuration" .!= False
--- Metadata APIs related
runAddSource
:: forall m b
. (MonadError QErr m, CacheRWM m, MetadataM m, BackendMetadata b)
=> AddSource b -> m EncJSON
=> AddSource b
-> m EncJSON
runAddSource (AddSource name sourceConfig replaceConfiguration) = do
sources <- scSources <$> askSchemaCache
@ -58,6 +56,17 @@ runAddSource (AddSource name sourceConfig replaceConfiguration) = do
buildSchemaCacheFor (MOSource name) metadataModifier
pure successMsg
--------------------------------------------------------------------------------
-- Rename source
data RenameSource
= RenameSource
{ _rmName :: !SourceName
, _rmNewName :: !SourceName
}
$(deriveFromJSON hasuraJSON ''RenameSource)
runRenameSource
:: forall m
. (MonadError QErr m, CacheRWM m, MetadataM m)
@ -97,6 +106,20 @@ runRenameSource RenameSource {..} = do
renameSource :: forall b. SourceName -> SourceMetadata b -> SourceMetadata b
renameSource newName metadata = metadata { _smName = newName }
--------------------------------------------------------------------------------
-- Drop source
data DropSource
= DropSource
{ _dsName :: !SourceName
, _dsCascade :: !Bool
} deriving (Show, Eq)
instance FromJSON DropSource where
parseJSON = withObject "drop source" $ \o ->
DropSource <$> o .: "name" <*> o .:? "cascade" .!= False
runDropSource
:: forall m. (MonadError QErr m, CacheRWM m, MonadIO m, MonadBaseControl IO m, MetadataM m)
=> DropSource -> m EncJSON

View File

@ -38,7 +38,6 @@ import Control.Arrow.Extended
import Control.Lens.Extended hiding ((.=))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson
import Data.Aeson.TH
import Data.Text.Extended
import qualified Hasura.Incremental as Inc
@ -68,29 +67,23 @@ deriving instance (Backend b) => Show (TrackTable b)
deriving instance (Backend b) => Eq (TrackTable b)
instance (Backend b) => FromJSON (TrackTable b) where
parseJSON v = withOptions <|> withoutOptions
parseJSON v = withOptions v <|> withoutOptions
where
withOptions = flip (withObject "TrackTable") v $ \o -> TrackTable
withOptions = withObject "track table" \o -> TrackTable
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .:? "is_enum" .!= False
withoutOptions = TrackTable defaultSource <$> parseJSON v <*> pure False
instance (Backend b) => ToJSON (TrackTable b) where
toJSON (TrackTable source name isEnum)
| isEnum = object [ "source" .= source, "table" .= name, "is_enum" .= isEnum ]
| otherwise = toJSON name
data SetTableIsEnum
= SetTableIsEnum
{ stieSource :: !SourceName
, stieTable :: !QualifiedTable
, stieIsEnum :: !Bool
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON ''SetTableIsEnum)
instance FromJSON SetTableIsEnum where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "set table is enum" $ \o ->
SetTableIsEnum
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
@ -101,14 +94,12 @@ data UntrackTable b =
{ utSource :: !SourceName
, utTable :: !(TableName b)
, utCascade :: !Bool
} deriving (Generic)
}
deriving instance (Backend b) => Show (UntrackTable b)
deriving instance (Backend b) => Eq (UntrackTable b)
instance (Backend b) => ToJSON (UntrackTable b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
instance (Backend b) => FromJSON (UntrackTable b) where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "untrack table" $ \o ->
UntrackTable
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
@ -223,12 +214,10 @@ data TrackTableV2 b
= TrackTableV2
{ ttv2Table :: !(TrackTable b)
, ttv2Configuration :: !(TableConfig b)
} deriving (Show, Eq, Generic)
instance (Backend b) => ToJSON (TrackTableV2 b) where
toJSON = genericToJSON hasuraJSON
} deriving (Show, Eq)
instance (Backend b) => FromJSON (TrackTableV2 b) where
parseJSON = withObject "Object" $ \o -> do
parseJSON = withObject "track table" $ \o -> do
table <- parseJSON $ Object o
configuration <- o .:? "configuration" .!= emptyTableConfig
pure $ TrackTableV2 table configuration
@ -256,13 +245,10 @@ data SetTableCustomization b
{ _stcSource :: !SourceName
, _stcTable :: !(TableName b)
, _stcConfiguration :: !(TableConfig b)
} deriving (Show, Eq, Generic)
instance (Backend b) => ToJSON (SetTableCustomization b) where
toJSON = genericToJSON hasuraJSON
} deriving (Show, Eq)
instance (Backend b) => FromJSON (SetTableCustomization b) where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "set table customization" $ \o ->
SetTableCustomization
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
@ -275,10 +261,9 @@ data SetTableCustomFields
, _stcfCustomRootFields :: !TableCustomRootFields
, _stcfCustomColumnNames :: !(CustomColumnNames ('Postgres 'Vanilla))
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON ''SetTableCustomFields)
instance FromJSON SetTableCustomFields where
parseJSON = withObject "SetTableCustomFields" $ \o ->
parseJSON = withObject "set table custom fields" $ \o ->
SetTableCustomFields
<$> o .:? "source" .!= defaultSource
<*> o .: "table"

View File

@ -11,7 +11,6 @@ import qualified Data.Sequence as DS
import qualified Database.PG.Query as Q
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson.Types
import Data.Text.Extended
import qualified Hasura.Backends.Postgres.SQL.DML as S
@ -41,27 +40,6 @@ data ExtCol (b :: BackendType)
= ECSimple !(Column b)
| ECRel !RelName !(Maybe RelName) !(SelectQExt b)
instance Backend b => ToJSON (ExtCol b) where
toJSON (ECSimple s) = toJSON s
toJSON (ECRel rn mrn selq) =
object $ [ "name" .= rn
, "alias" .= mrn
] ++ selectGToPairs selq
instance Backend b => FromJSON (ExtCol b) where
parseJSON v@(Object o) =
ECRel
<$> o .: "name"
<*> o .:? "alias"
<*> parseJSON v
parseJSON v@(String _) =
ECSimple <$> parseJSON v
parseJSON _ =
fail $ mconcat
[ "A column should either be a string or an "
, "object (relationship)"
]
convSelCol
:: (UserInfoM m, QErrM m, TableInfoRM ('Postgres 'Vanilla) m)
=> FieldInfoMap (FieldInfo ('Postgres 'Vanilla))
@ -313,7 +291,6 @@ convSelectQuery
)
=> SessVarBldr ('Postgres 'Vanilla) m
-> ValueParser ('Postgres 'Vanilla) m S.SQLExp
-- -> (ColumnType ('Postgres 'Vanilla) -> Value -> m S.SQLExp)
-> SelectQuery
-> m (AnnSimpleSelect ('Postgres 'Vanilla))
convSelectQuery sessVarBldr prepArgBuilder (DMLQuery _ qt selQ) = do

View File

@ -5,7 +5,6 @@ module Hasura.RQL.DML.Types
, getSourceDMLQuery
, SelectG(..)
, selectGToPairs
, Wildcard(..)
, SelCol(..)
@ -20,8 +19,6 @@ module Hasura.RQL.DML.Types
, ConflictAction(..)
, ConstraintOn(..)
, InsertTxConflictCtx(..)
, UpdVals
, UpdateQuery(..)
@ -54,7 +51,7 @@ import Hasura.SQL.Backend
newtype OrderByExp
= OrderByExp { getOrderByItems :: [OrderByItem ('Postgres 'Vanilla)] }
deriving (Show, Eq, ToJSON)
deriving (Show, Eq)
instance FromJSON OrderByExp where
parseJSON = \case
@ -91,13 +88,11 @@ data DMLQuery a
deriving (Show, Eq)
instance (FromJSON a) => FromJSON (DMLQuery a) where
parseJSON o@(Object v) =
parseJSON = withObject "query" \o ->
DMLQuery
<$> v .:? "source" .!= defaultSource
<*> v .: "table"
<*> parseJSON o
parseJSON _ =
fail "Expected an object for query"
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> parseJSON (Object o)
getSourceDMLQuery :: forall a. DMLQuery a -> SourceName
getSourceDMLQuery (DMLQuery source _ _) = source
@ -111,27 +106,13 @@ data SelectG a b c
, sqOffset :: !(Maybe c) -- Offset
} deriving (Show, Eq)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''SelectG)
selectGToPairs :: (KeyValue kv, ToJSON a, ToJSON b, ToJSON c)
=> SelectG a b c -> [kv]
selectGToPairs (SelectG selCols mWh mOb mLt mOf) =
[ "columns" .= selCols
, "where" .= mWh
, "order_by" .= mOb
, "limit" .= mLt
, "offset" .= mOf
]
$(deriveFromJSON hasuraJSON{omitNothingFields=True} ''SelectG)
data Wildcard
= Star
| StarDot !Wildcard
deriving (Show, Eq, Ord)
wcToText :: Wildcard -> Text
wcToText Star = "*"
wcToText (StarDot wc) = "*." <> wcToText wc
parseWildcard :: AT.Parser Wildcard
parseWildcard =
fromList <$> ((starParser `AT.sepBy1` AT.char '.') <* AT.endOfInput)
@ -162,24 +143,12 @@ instance FromJSON SelCol where
, "object (relationship)"
]
instance ToJSON SelCol where
toJSON (SCStar wc) = String $ wcToText wc
toJSON (SCExtSimple s) = toJSON s
toJSON (SCExtRel rn mrn selq) =
object $ [ "name" .= rn
, "alias" .= mrn
] ++ selectGToPairs selq
type SelectQ = SelectG SelCol (BoolExp ('Postgres 'Vanilla)) Int
type SelectQT = SelectG SelCol (BoolExp ('Postgres 'Vanilla)) Value
type SelectQuery = DMLQuery SelectQ
type SelectQueryT = DMLQuery SelectQT
instance ToJSON a => ToJSON (DMLQuery (SelectG SelCol (BoolExp ('Postgres 'Vanilla)) a)) where
toJSON (DMLQuery src qt selQ) =
object $ ["source" .= src, "table" .= qt] <> selectGToPairs selQ
type InsObj b = ColumnValues b Value
data ConflictAction
@ -190,15 +159,10 @@ data ConflictAction
instance FromJSON ConflictAction where
parseJSON (String "ignore") = return CAIgnore
parseJSON (String "update") = return CAUpdate
parseJSON _ =
fail "Expecting 'ignore' or 'update'"
instance ToJSON ConflictAction where
toJSON CAUpdate = String "update"
toJSON CAIgnore = String "ignore"
parseJSON _ = fail "Expecting 'ignore' or 'update'"
newtype ConstraintOn
= ConstraintOn {getPGCols :: [PGCol]} deriving (Show, Eq, ToJSON)
= ConstraintOn {getPGCols :: [PGCol]} deriving (Show, Eq)
instance FromJSON ConstraintOn where
parseJSON v@(String _) =
@ -215,7 +179,7 @@ data OnConflict
, ocAction :: !ConflictAction
} deriving (Show, Eq)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''OnConflict)
$(deriveFromJSON hasuraJSON{omitNothingFields=True} ''OnConflict)
data InsertQuery
= InsertQuery
@ -226,10 +190,8 @@ data InsertQuery
, iqReturning :: !(Maybe [PGCol])
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''InsertQuery)
instance FromJSON InsertQuery where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "insert query" $ \o ->
InsertQuery
<$> o .: "table"
<*> o .:? "source" .!= defaultSource
@ -237,14 +199,6 @@ instance FromJSON InsertQuery where
<*> o .:? "on_conflict"
<*> o .:? "returning"
data InsertTxConflictCtx
= InsertTxConflictCtx
{ itcAction :: !ConflictAction
, itcConstraint :: !(Maybe ConstraintName)
, itcSetExpression :: !(Maybe Text)
} deriving (Show, Eq)
$(deriveJSON hasuraJSON{omitNothingFields=True} ''InsertTxConflictCtx)
type UpdVals b = ColumnValues b Value
data UpdateQuery
@ -260,7 +214,7 @@ data UpdateQuery
} deriving (Show, Eq)
instance FromJSON UpdateQuery where
parseJSON (Object o) =
parseJSON = withObject "update query" \o ->
UpdateQuery
<$> o .: "table"
<*> o .:? "source" .!= defaultSource
@ -270,20 +224,6 @@ instance FromJSON UpdateQuery where
<*> (o .:? "$mul" .!= M.empty)
<*> o .:? "$default" .!= []
<*> o .:? "returning"
parseJSON _ =
fail "Expecting an object for update query"
instance ToJSON UpdateQuery where
toJSON (UpdateQuery tn src wc setE incE mulE defE ret) =
object [ "table" .= tn
, "source" .= src
, "where" .= wc
, "$set" .= setE
, "$inc" .= incE
, "$mul" .= mulE
, "$default" .= defE
, "returning" .= ret
]
data DeleteQuery
= DeleteQuery
@ -293,10 +233,8 @@ data DeleteQuery
, doReturning :: !(Maybe [PGCol]) -- columns returning
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''DeleteQuery)
instance FromJSON DeleteQuery where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "delete query" $ \o ->
DeleteQuery
<$> o .: "table"
<*> o .:? "source" .!= defaultSource
@ -311,10 +249,8 @@ data CountQuery
, cqWhere :: !(Maybe (BoolExp ('Postgres 'Vanilla)))
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''CountQuery)
instance FromJSON CountQuery where
parseJSON = withObject "Object" $ \o ->
parseJSON = withObject "count query" $ \o ->
CountQuery
<$> o .: "table"
<*> o .:? "source" .!= defaultSource
@ -330,7 +266,7 @@ data QueryT
| QTBulk ![QueryT]
deriving (Show, Eq)
$(deriveJSON
$(deriveFromJSON
defaultOptions { constructorTagModifier = snakeCase . drop 2
, sumEncoding = TaggedObject "type" "args"
}

View File

@ -17,8 +17,6 @@ module Hasura.RQL.Types.Action
, adTimeout
, ActionType(..)
, _ActionMutation
, CreateAction(..)
, UpdateAction(..)
, ActionDefinitionInput
, InputWebhook(..)
@ -38,7 +36,6 @@ module Hasura.RQL.Types.Action
, ActionPermissionInfo(..)
, ActionPermissionMap
, CreateActionPermission(..)
, ActionMetadata(..)
, amName
@ -229,34 +226,6 @@ $(makeLenses ''ActionInfo)
type ActionDefinitionInput =
ActionDefinition (ArgumentDefinition GraphQLType) InputWebhook
data CreateAction
= CreateAction
{ _caName :: !ActionName
, _caDefinition :: !ActionDefinitionInput
, _caComment :: !(Maybe Text)
} deriving (Show, Eq, Generic)
instance NFData CreateAction
instance Cacheable CreateAction
$(J.deriveJSON hasuraJSON ''CreateAction)
data UpdateAction
= UpdateAction
{ _uaName :: !ActionName
, _uaDefinition :: !ActionDefinitionInput
, _uaComment :: !(Maybe Text)
} deriving (Show, Eq)
$(J.deriveJSON hasuraJSON ''UpdateAction)
data CreateActionPermission
= CreateActionPermission
{ _capAction :: !ActionName
, _capRole :: !RoleName
, _capDefinition :: !(Maybe J.Value)
, _capComment :: !(Maybe Text)
} deriving (Show, Eq, Generic)
instance NFData CreateActionPermission
instance Cacheable CreateActionPermission
$(J.deriveJSON hasuraJSON ''CreateActionPermission)
-- representation of action permission metadata
data ActionPermissionMetadata

View File

@ -1,6 +1,5 @@
module Hasura.RQL.Types.EventTrigger
( CreateEventTriggerQuery(..)
, SubscribeOpSpec(..)
( SubscribeOpSpec(..)
, SubscribeColumns(..)
, TriggerName(..)
, triggerNameToTxt
@ -9,12 +8,6 @@ module Hasura.RQL.Types.EventTrigger
, TriggerOpsDef(..)
, EventTriggerConf(..)
, RetryConf(..)
, DeleteEventTriggerQuery(..)
, RedeliverEventQuery(..)
, InvokeEventTriggerQuery(..)
-- , HeaderConf(..)
-- , HeaderValue(..)
-- , HeaderName
, EventHeaderInfo(..)
, WebhookConf(..)
, WebhookConfInfo(..)
@ -28,10 +21,7 @@ module Hasura.RQL.Types.EventTrigger
import Hasura.Prelude
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Text.Regex.TDFA as TDFA
import Data.Aeson
import Data.Aeson.TH
@ -42,19 +32,9 @@ import qualified Hasura.Backends.Postgres.SQL.Types as PG
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common (InputWebhook, SourceName, defaultSource)
import Hasura.SQL.Backend
import Hasura.RQL.Types.Common (InputWebhook)
-- This change helps us create functions for the event triggers
-- without the function name being truncated by PG, since PG allows
-- for only 63 chars for identifiers.
-- Reasoning for the 42 characters:
-- 63 - (notify_hasura_) - (_INSERT | _UPDATE | _DELETE)
maxTriggerNameLength :: Int
maxTriggerNameLength = 42
-- | Unique name for event trigger.
newtype TriggerName = TriggerName { unTriggerName :: NonEmptyText }
deriving (Show, Eq, Ord, Hashable, ToTxt, FromJSON, ToJSON, ToJSONKey
@ -151,66 +131,6 @@ data WebhookConfInfo
instance NFData WebhookConfInfo
$(deriveToJSON hasuraJSON{omitNothingFields=True} ''WebhookConfInfo)
data CreateEventTriggerQuery (b :: BackendType)
= CreateEventTriggerQuery
{ cetqSource :: !SourceName
, cetqName :: !TriggerName
, cetqTable :: !(TableName b)
, cetqInsert :: !(Maybe SubscribeOpSpec)
, cetqUpdate :: !(Maybe SubscribeOpSpec)
, cetqDelete :: !(Maybe SubscribeOpSpec)
, cetqEnableManual :: !(Maybe Bool)
, cetqRetryConf :: !(Maybe RetryConf)
, cetqWebhook :: !(Maybe InputWebhook)
, cetqWebhookFromEnv :: !(Maybe Text)
, cetqHeaders :: !(Maybe [HeaderConf])
, cetqReplace :: !Bool
} deriving (Generic)
deriving instance (Backend b) => Show (CreateEventTriggerQuery b)
deriving instance (Backend b) => Eq (CreateEventTriggerQuery b)
instance Backend b => FromJSON (CreateEventTriggerQuery b) where
parseJSON (Object o) = do
sourceName <- o .:? "source" .!= defaultSource
name <- o .: "name"
table <- o .: "table"
insert <- o .:? "insert"
update <- o .:? "update"
delete <- o .:? "delete"
enableManual <- o .:? "enable_manual" .!= False
retryConf <- o .:? "retry_conf"
webhook <- o .:? "webhook"
webhookFromEnv <- o .:? "webhook_from_env"
headers <- o .:? "headers"
replace <- o .:? "replace" .!= False
let regex = "^[A-Za-z]+[A-Za-z0-9_\\-]*$" :: LBS.ByteString
compiledRegex = TDFA.makeRegex regex :: TDFA.Regex
isMatch = TDFA.match compiledRegex . T.unpack $ triggerNameToTxt name
unless isMatch $
fail "only alphanumeric and underscore and hyphens allowed for name"
unless (T.length (triggerNameToTxt name) <= maxTriggerNameLength) $
fail "event trigger name can be at most 42 characters"
unless (any isJust [insert, update, delete] || enableManual) $
fail "atleast one amongst insert/update/delete/enable_manual spec must be provided"
case (webhook, webhookFromEnv) of
(Just _, Nothing) -> return ()
(Nothing, Just _) -> return ()
(Just _, Just _) -> fail "only one of webhook or webhook_from_env should be given"
_ -> fail "must provide webhook or webhook_from_env"
mapM_ checkEmptyCols [insert, update, delete]
return $ CreateEventTriggerQuery sourceName name table insert update delete (Just enableManual) retryConf webhook webhookFromEnv headers replace
where
checkEmptyCols spec
= case spec of
Just (SubscribeOpSpec (SubCArray cols) _) -> when (null cols) (fail "found empty column specification")
Just (SubscribeOpSpec _ (Just (SubCArray cols)) ) -> when (null cols) (fail "found empty payload specification")
_ -> return ()
parseJSON _ = fail "expecting an object"
instance Backend b => ToJSON (CreateEventTriggerQuery b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
-- | The table operations on which the event trigger will be invoked.
data TriggerOpsDef
= TriggerOpsDef
@ -223,24 +143,6 @@ instance NFData TriggerOpsDef
instance Cacheable TriggerOpsDef
$(deriveJSON hasuraJSON{omitNothingFields=True} ''TriggerOpsDef)
data DeleteEventTriggerQuery (b :: BackendType)
= DeleteEventTriggerQuery
{ detqSource :: !SourceName
, detqName :: !TriggerName
} deriving (Generic)
deriving instance (Backend b) => Show (DeleteEventTriggerQuery b)
deriving instance (Backend b) => Eq (DeleteEventTriggerQuery b)
instance Backend b => FromJSON (DeleteEventTriggerQuery b) where
parseJSON = withObject "Object" $ \o ->
DeleteEventTriggerQuery
<$> o .:? "source" .!= defaultSource
<*> o .: "name"
instance Backend b => ToJSON (DeleteEventTriggerQuery b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
data EventTriggerConf
= EventTriggerConf
{ etcName :: !TriggerName
@ -254,44 +156,6 @@ instance Cacheable EventTriggerConf
$(deriveJSON hasuraJSON{omitNothingFields=True} ''EventTriggerConf)
data RedeliverEventQuery (b :: BackendType)
= RedeliverEventQuery
{ rdeqEventId :: !EventId
, rdeqSource :: !SourceName
} deriving (Generic)
deriving instance (Backend b) => Show (RedeliverEventQuery b)
deriving instance (Backend b) => Eq (RedeliverEventQuery b)
instance Backend b => FromJSON (RedeliverEventQuery b) where
parseJSON = withObject "Object" $ \o ->
RedeliverEventQuery
<$> o .: "event_id"
<*> o .:? "source" .!= defaultSource
instance Backend b => ToJSON (RedeliverEventQuery b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
data InvokeEventTriggerQuery (b :: BackendType)
= InvokeEventTriggerQuery
{ ietqName :: !TriggerName
, ietqSource :: !SourceName
, ietqPayload :: !Value
} deriving (Generic)
deriving instance (Backend b) => Show (InvokeEventTriggerQuery b)
deriving instance (Backend b) => Eq (InvokeEventTriggerQuery b)
instance Backend b => FromJSON (InvokeEventTriggerQuery b) where
parseJSON = withObject "Object" $ \o ->
InvokeEventTriggerQuery
<$> o .: "name"
<*> o .:? "source" .!= defaultSource
<*> o .: "payload"
instance Backend b => ToJSON (InvokeEventTriggerQuery b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}
data RecreateEventTriggers
= RETRecreate
| RETDoNothing

View File

@ -140,28 +140,6 @@ emptyFunctionConfig :: FunctionConfig
emptyFunctionConfig = FunctionConfig Nothing Nothing
-- | JSON API payload for v2 of 'track_function':
--
-- https://hasura.io/docs/latest/graphql/core/api-reference/schema-metadata-api/custom-functions.html#track-function-v2
data TrackFunctionV2 (b :: BackendType)
= TrackFunctionV2
{ _tfv2Source :: !SourceName
, _tfv2Function :: !(FunctionName b)
, _tfv2Configuration :: !FunctionConfig
} deriving (Generic)
deriving instance Backend b => Show (TrackFunctionV2 b)
deriving instance Backend b => Eq (TrackFunctionV2 b)
instance Backend b => ToJSON (TrackFunctionV2 b) where
toJSON = genericToJSON hasuraJSON
instance Backend b => FromJSON (TrackFunctionV2 b) where
parseJSON = withObject "Object" $ \o ->
TrackFunctionV2
<$> o .:? "source" .!= defaultSource
<*> o .: "function"
<*> o .:? "configuration" .!= emptyFunctionConfig
-- Lists are used to model overloaded functions.
type DBFunctionsMetadata b = HashMap (FunctionName b) [RawFunctionInfo b]

View File

@ -191,73 +191,10 @@ instance (Backend b) => FromJSON (ArrRelUsingFKeyOn b) where
type ArrRelUsing b = RelUsing b (ArrRelUsingFKeyOn b)
type ArrRelDef b = RelDef (ArrRelUsing b)
newtype CreateArrRel b = CreateArrRel { unCreateArrRel :: WithTable b (ArrRelDef b) }
deriving newtype (Eq, ToJSON, FromJSON)
type ObjRelUsing b = RelUsing b (ObjRelUsingChoice b)
type ObjRelDef b = RelDef (ObjRelUsing b)
newtype CreateObjRel b = CreateObjRel { unCreateObjRel :: WithTable b (ObjRelDef b) }
deriving newtype (Eq, ToJSON, FromJSON)
data DropRel b
= DropRel
{ drSource :: !SourceName
, drTable :: !(TableName b)
, drRelationship :: !RelName
, drCascade :: !Bool
} deriving (Generic)
deriving instance (Backend b) => Show (DropRel b)
deriving instance (Backend b) => Eq (DropRel b)
instance (Backend b) => ToJSON (DropRel b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields = True}
instance (Backend b) => FromJSON (DropRel b) where
parseJSON = withObject "Object" $ \o ->
DropRel
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "relationship"
<*> o .:? "cascade" .!= False
data SetRelComment b
= SetRelComment
{ arSource :: !SourceName
, arTable :: !(TableName b)
, arRelationship :: !RelName
, arComment :: !(Maybe T.Text)
} deriving (Generic)
deriving instance (Backend b) => Show (SetRelComment b)
deriving instance (Backend b) => Eq (SetRelComment b)
instance (Backend b) => ToJSON (SetRelComment b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields = True}
instance (Backend b) => FromJSON (SetRelComment b) where
parseJSON = withObject "Object" $ \o ->
SetRelComment
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "relationship"
<*> o .:? "comment"
data RenameRel b
= RenameRel
{ rrSource :: !SourceName
, rrTable :: !(TableName b)
, rrName :: !RelName
, rrNewName :: !RelName
} deriving (Generic)
deriving instance (Backend b) => Show (RenameRel b)
deriving instance (Backend b) => Eq (RenameRel b)
instance (Backend b) => ToJSON (RenameRel b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (RenameRel b) where
parseJSON = withObject "Object" $ \o ->
RenameRel
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
<*> o .: "new_name"
-- should this be parameterized by both the source and the destination backend?
data RelInfo (b :: BackendType)

View File

@ -29,7 +29,6 @@ module Hasura.RQL.Types.RemoteRelationship
, _RemoteSourceRelDef
, FieldCall(..)
, RemoteArguments(..)
, DeleteRemoteRelationship(..)
, graphQLValueToJSON
) where
@ -402,21 +401,16 @@ instance ToJSON RemoteRelationshipDef where
object [ "remote_schema" .= toJSON schema ]
-- | Metadata type for remote relationship
data RemoteRelationship b =
RemoteRelationship
{ _rtrName :: !RemoteRelationshipName
-- ^ Field name to which we'll map the remote in hasura; this becomes part
-- of the hasura schema.
, _rtrSource :: !SourceName
, _rtrTable :: !(TableName b)
-- ^ (SourceName, QualifiedTable) determines the table on which the relationship
-- is defined
, _rtrDefinition :: !RemoteRelationshipDef
} deriving (Generic)
deriving instance (Backend b) => Show (RemoteRelationship b)
deriving instance (Backend b) => Eq (RemoteRelationship b)
instance (Backend b) => NFData (RemoteRelationship b)
instance (Backend b) => Cacheable (RemoteRelationship b)
data RemoteRelationship b = RemoteRelationship
{ _rtrName :: !RemoteRelationshipName
-- ^ Field name to which we'll map the remote in hasura; this becomes part
-- of the hasura schema.
, _rtrSource :: !SourceName
, _rtrTable :: !(TableName b)
-- ^ (SourceName, QualifiedTable) determines the table on which the relationship
-- is defined
, _rtrDefinition :: !RemoteRelationshipDef
} deriving (Generic)
instance (Backend b) => ToJSON (RemoteRelationship b) where
toJSON = genericToJSON hasuraJSON
@ -432,21 +426,3 @@ instance (Backend b) => FromJSON (RemoteRelationship b) where
<*> o .: "table"
<*> pure (RemoteSchemaRelDef RFRemoteSchemaOnly $ RemoteSchemaRelationshipDef name hasuraFields remoteField)
$(makeLenses ''RemoteRelationship)
data DeleteRemoteRelationship (b :: BackendType) = DeleteRemoteRelationship
{ drrSource :: !SourceName
, drrTable :: !(TableName b)
, drrName :: !RemoteRelationshipName
} deriving stock (Generic)
deriving instance (Backend b) => Show (DeleteRemoteRelationship b)
deriving instance (Backend b) => Eq (DeleteRemoteRelationship b)
instance Backend b => FromJSON (DeleteRemoteRelationship b) where
parseJSON = withObject "Object" $ \o ->
DeleteRemoteRelationship
<$> o .:? "source" .!= defaultSource
<*> o .: "table"
<*> o .: "name"
instance Backend b => ToJSON (DeleteRemoteRelationship b) where
toJSON = genericToJSON hasuraJSON{omitNothingFields=True}

View File

@ -8,7 +8,6 @@ import qualified Data.HashMap.Strict as M
import Control.Lens
import Data.Aeson.Extended
import Data.Aeson.TH
import qualified Hasura.SQL.AnyBackend as AB
import qualified Hasura.Tracing as Tracing
@ -79,7 +78,7 @@ data ResolvedSource b
, _rsTables :: !(DBTablesMetadata b)
, _rsFunctions :: !(DBFunctionsMetadata b)
, _rsPgScalars :: !(HashSet (ScalarType b))
} deriving (Eq)
}
type SourceTables b = HashMap SourceName (TableCache b)
@ -100,52 +99,3 @@ instance (MonadResolveSource m) => MonadResolveSource (Tracing.TraceT m) where
instance (MonadResolveSource m) => MonadResolveSource (LazyTxT QErr m) where
getSourceResolver = lift getSourceResolver
-- Metadata API related types
data AddSource b
= AddSource
{ _asName :: !SourceName
, _asConfiguration :: !(SourceConnConfiguration b)
, _asReplaceConfiguration :: !Bool
} deriving (Generic)
deriving instance (Backend b) => Show (AddSource b)
deriving instance (Backend b) => Eq (AddSource b)
instance (Backend b) => ToJSON (AddSource b) where
toJSON = genericToJSON hasuraJSON
instance (Backend b) => FromJSON (AddSource b) where
parseJSON = withObject "Object" $ \o ->
AddSource
<$> o .: "name"
<*> o .: "configuration"
<*> o .:? "replace_configuration" .!= False
data RenameSource
= RenameSource
{ _rmName :: !SourceName
, _rmNewName :: !SourceName
} deriving stock (Generic, Show, Eq)
instance ToJSON RenameSource where
toJSON = genericToJSON hasuraJSON
instance FromJSON RenameSource where
parseJSON = withObject "Object" $ \o ->
RenameSource <$> o .: "name" <*> o .: "new_name"
data DropSource
= DropSource
{ _dsName :: !SourceName
, _dsCascade :: !Bool
} deriving (Show, Eq)
$(deriveToJSON hasuraJSON ''DropSource)
instance FromJSON DropSource where
parseJSON = withObject "Object" $ \o ->
DropSource <$> o .: "name" <*> o .:? "cascade" .!= False
newtype PostgresSourceName =
PostgresSourceName {_psnName :: SourceName}
deriving (Show, Eq)
$(deriveJSON hasuraJSON ''PostgresSourceName)

View File

@ -94,8 +94,8 @@ data RQLMetadataV1
| RMUntrackFunction !(AnyBackend UnTrackFunction)
-- Functions permissions
| RMCreateFunctionPermission !(AnyBackend CreateFunctionPermission)
| RMDropFunctionPermission !(AnyBackend DropFunctionPermission)
| RMCreateFunctionPermission !(AnyBackend FunctionPermissionArgument)
| RMDropFunctionPermission !(AnyBackend FunctionPermissionArgument)
-- Computed fields (PG-specific)
| RMAddComputedField !(AddComputedField ('Postgres 'Vanilla))
@ -178,7 +178,6 @@ data RQLMetadataV1
-- Bulk metadata queries
| RMBulk [RQLMetadataRequest]
deriving (Eq)
instance FromJSON RQLMetadataV1 where
parseJSON = withObject "RQLMetadataV1" \o -> do
@ -265,7 +264,7 @@ instance FromJSON RQLMetadataV1 where
data RQLMetadataV2
= RMV2ReplaceMetadata !ReplaceMetadataV2
| RMV2ExportMetadata !ExportMetadata
deriving (Eq, Generic)
deriving (Generic)
instance FromJSON RQLMetadataV2 where
parseJSON = genericParseJSON $
@ -277,7 +276,6 @@ instance FromJSON RQLMetadataV2 where
data RQLMetadataRequest
= RMV1 !RQLMetadataV1
| RMV2 !RQLMetadataV2
deriving (Eq)
instance FromJSON RQLMetadataRequest where
parseJSON = withObject "RQLMetadataRequest" $ \o -> do
@ -292,7 +290,7 @@ data RQLMetadata
= RQLMetadata
{ _rqlMetadataResourceVersion :: !(Maybe MetadataResourceVersion)
, _rqlMetadata :: !RQLMetadataRequest
} deriving (Eq)
}
instance FromJSON RQLMetadata where
parseJSON = withObject "RQLMetadata" $ \o -> do

View File

@ -6,7 +6,11 @@ import Hasura.RQL.DDL.EventTrigger
import Hasura.RQL.DDL.Metadata
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.QueryCollection
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.Relationship.Rename
import Hasura.RQL.DDL.RemoteRelationship
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.Types
import Hasura.SQL.AnyBackend
@ -53,8 +57,8 @@ data RQLMetadataV1
| RMUntrackFunction !(AnyBackend UnTrackFunction)
-- Functions permissions
| RMCreateFunctionPermission !(AnyBackend CreateFunctionPermission)
| RMDropFunctionPermission !(AnyBackend DropFunctionPermission)
| RMCreateFunctionPermission !(AnyBackend FunctionPermissionArgument)
| RMDropFunctionPermission !(AnyBackend FunctionPermissionArgument)
-- Computed fields (PG-specific)
| RMAddComputedField !(AddComputedField ('Postgres 'Vanilla))

View File

@ -139,19 +139,16 @@ data RQLQueryV1
| RQDumpInternalState !DumpInternalState
| RQSetCustomTypes !CustomTypes
deriving (Eq)
data RQLQueryV2
= RQV2TrackTable !(TrackTableV2 ('Postgres 'Vanilla))
| RQV2SetTableCustomFields !SetTableCustomFields -- deprecated
| RQV2TrackFunction !(TrackFunctionV2 ('Postgres 'Vanilla))
| RQV2ReplaceMetadata !ReplaceMetadataV2
deriving (Eq)
data RQLQuery
= RQV1 !RQLQueryV1
| RQV2 !RQLQueryV2
deriving (Eq)
instance FromJSON RQLQuery where
parseJSON = withObject "Object" $ \o -> do

View File

@ -48,7 +48,6 @@ data RQLQuery
| RQBigqueryRunSql !BigQuery.BigQueryRunSQL
| RQBigqueryDatabaseInspection !BigQuery.BigQueryRunSQL
| RQBulk ![RQLQuery]
deriving (Show)
$(deriveFromJSON
defaultOptions { constructorTagModifier = snakeCase . drop 2
@ -138,4 +137,4 @@ runQueryM env = \case
RQCitusRunSql q -> Postgres.runRunSQL @'Citus q
RQBigqueryRunSql q -> BigQuery.runSQL q
RQBigqueryDatabaseInspection q -> BigQuery.runDatabaseInspection q
RQBulk l -> encJFromList <$> indexedMapM (runQueryM env) l
RQBulk l -> encJFromList <$> indexedMapM (runQueryM env) l

View File

@ -36,11 +36,11 @@ import qualified Hasura.Server.AuthSpec as AuthSpec
import qualified Hasura.Server.MigrateSpec as MigrateSpec
import qualified Hasura.Server.TelemetrySpec as TelemetrySpec
import Hasura.App (PGMetadataStorageAppT (..))
import Hasura.App (PGMetadataStorageAppT (..),
mkPgSourceResolver)
import Hasura.Metadata.Class
import Hasura.RQL.DDL.Schema.Cache
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.Types
import Hasura.Server.Init
import Hasura.Server.Migrate