diff --git a/server/lib/pg-client-hs/src/Database/PG/Query/Class.hs b/server/lib/pg-client-hs/src/Database/PG/Query/Class.hs index 800e931d7ac..3d3f93c1cf3 100644 --- a/server/lib/pg-client-hs/src/Database/PG/Query/Class.hs +++ b/server/lib/pg-client-hs/src/Database/PG/Query/Class.hs @@ -18,7 +18,7 @@ module Database.PG.Query.Class ToPrepArgs (..), SingleRow (..), Discard (..), - AltJ (..), + ViaJSON (..), JSON (..), JSONB (..), ) @@ -78,15 +78,16 @@ newtype SingleRow a = SingleRow } deriving stock (Eq, Show) -type AltJ :: Type -> Type -newtype AltJ a = AltJ {getAltJ :: a} +-- | Helper newtype to allow parsing JSON directly into a chosen type +type ViaJSON :: Type -> Type +newtype ViaJSON a = ViaJSON {getViaJSON :: a} -instance (FromJSON a) => FromCol (AltJ a) where +instance (FromJSON a) => FromCol (ViaJSON a) where fromCol = decodeJson >=> parse where - parse :: Value -> Either Text (AltJ a) - parse = fmap AltJ . first fromString . parseEither parseJSON + parse :: Value -> Either Text (ViaJSON a) + parse = fmap ViaJSON . first fromString . parseEither parseJSON decodeJson :: Maybe ByteString -> Either Text Value decodeJson = fromColHelper PD.json_ast . fmap dropFirst @@ -478,8 +479,8 @@ instance ToPrepArg PrepArg where toPrepValHelper :: PQ.Oid -> (a -> PE.Encoding) -> a -> PrepArg toPrepValHelper o e a = (o, Just (PE.encodingBytes $ e a, PQ.Binary)) -instance (ToJSON a) => ToPrepArg (AltJ a) where - toPrepVal (AltJ a) = toPrepValHelper PTI.json PE.bytea_lazy $ encode a +instance (ToJSON a) => ToPrepArg (ViaJSON a) where + toPrepVal (ViaJSON a) = toPrepValHelper PTI.json PE.bytea_lazy $ encode a instance ToPrepArg Word64 where toPrepVal = toPrepValHelper PTI.int8 PE.int8_word64 diff --git a/server/lib/pg-client-hs/test/Jsonb.hs b/server/lib/pg-client-hs/test/Jsonb.hs index 8ee05232cf5..2c93560eb3a 100644 --- a/server/lib/pg-client-hs/test/Jsonb.hs +++ b/server/lib/pg-client-hs/test/Jsonb.hs @@ -29,8 +29,8 @@ newtype TestValue = TestValue {hey :: Int} instance J.FromJSON TestValue -instance Show (AltJ TestValue) where - show (AltJ tv) = show tv +instance Show (ViaJSON TestValue) where + show (ViaJSON tv) = show tv getPgUri :: (MonadIO m) => m BS.ByteString getPgUri = liftIO $ fromString <$> Env.getEnv "DATABASE_URL" @@ -68,7 +68,7 @@ specJsonb = do Right (SingleRow (Identity (_ :: BS.ByteString))) -> True Left e -> error e - it "Querying 'json' from PostgreSQL into AltJ type succeeds" $ do + it "Querying 'json' from PostgreSQL into ViaJSON type succeeds" $ do pg <- getPostgresConnect result <- runTxT @@ -76,10 +76,10 @@ specJsonb = do (rawQE show "select '{\"hey\":42}'::json" [] False) result `shouldSatisfy` \case - Right (SingleRow (Identity (AltJ (_ :: TestValue)))) -> True + Right (SingleRow (Identity (ViaJSON (_ :: TestValue)))) -> True Left e -> error e - it "Querying 'jsonb' from PostgreSQL into AltJ type succeeds" $ do + it "Querying 'jsonb' from PostgreSQL into ViaJSON type succeeds" $ do pg <- getPostgresConnect result <- runTxT @@ -87,7 +87,7 @@ specJsonb = do (rawQE show "select '{\"hey\":42}'::jsonb" [] False) result `shouldSatisfy` \case - Right (SingleRow (Identity (AltJ (_ :: TestValue)))) -> True + Right (SingleRow (Identity (ViaJSON (_ :: TestValue)))) -> True Left e -> error e instance FromPGConnErr String where diff --git a/server/src-lib/Hasura/App.hs b/server/src-lib/Hasura/App.hs index c23a6c3fb33..df39e95d1ce 100644 --- a/server/src-lib/Hasura/App.hs +++ b/server/src-lib/Hasura/App.hs @@ -1116,7 +1116,7 @@ notifySchemaCacheSyncTx (MetadataResourceVersion resourceVersion) instanceId inv resource_version = $2, instance_id = $3::uuid |] - (PG.AltJ invalidations, resourceVersion, instanceId) + (PG.ViaJSON invalidations, resourceVersion, instanceId) True pure () @@ -1132,7 +1132,7 @@ getCatalogStateTx = () False where - mkCatalogState (dbId, PG.AltJ cliState, PG.AltJ consoleState) = + mkCatalogState (dbId, PG.ViaJSON cliState, PG.ViaJSON consoleState) = CatalogState dbId cliState consoleState setCatalogStateTx :: CatalogStateType -> A.Value -> PG.TxE QErr () @@ -1145,7 +1145,7 @@ setCatalogStateTx stateTy stateValue = UPDATE hdb_catalog.hdb_version SET cli_state = $1 |] - (Identity $ PG.AltJ stateValue) + (Identity $ PG.ViaJSON stateValue) False CSTConsole -> PG.unitQE @@ -1154,7 +1154,7 @@ setCatalogStateTx stateTy stateValue = UPDATE hdb_catalog.hdb_version SET console_state = $1 |] - (Identity $ PG.AltJ stateValue) + (Identity $ PG.ViaJSON stateValue) False -- | Each of the function in the type class is executed in a totally separate transaction. diff --git a/server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs b/server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs index c2713aa98c1..c86dba3b77e 100644 --- a/server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs +++ b/server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs @@ -350,8 +350,8 @@ insertInvocation tName invo = do ( iEventId invo, (triggerNameToTxt tName), fromIntegral <$> iStatus invo :: Maybe Int64, - PG.AltJ $ toJSON $ iRequest invo, - PG.AltJ $ toJSON $ iResponse invo + PG.ViaJSON $ toJSON $ iRequest invo, + PG.ViaJSON $ toJSON $ iResponse invo ) True PG.unitQE @@ -377,7 +377,7 @@ insertPGManualEvent (QualifiedObject schemaName tableName) triggerName rowData = [PG.sql| SELECT hdb_catalog.insert_event_log($1, $2, $3, $4, $5) |] - (schemaName, tableName, triggerName, (tshow MANUAL), PG.AltJ rowData) + (schemaName, tableName, triggerName, (tshow MANUAL), PG.ViaJSON rowData) False archiveEvents :: TriggerName -> PG.TxE QErr () @@ -437,7 +437,7 @@ fetchEvents source triggerNames (FetchBatchSize fetchBatchSize) = (limit, triggerNamesTxt) True where - uncurryEvent (id', sourceName, tableName, triggerName, PG.AltJ payload, tries, created) = + uncurryEvent (id', sourceName, tableName, triggerName, PG.ViaJSON payload, tries, created) = Event { eId = id', eSource = source, @@ -473,7 +473,7 @@ fetchEventsMaintenanceMode sourceName triggerNames fetchBatchSize = \case (Identity limit) True where - uncurryEvent (id', sn, tn, trn, PG.AltJ payload, tries, created) = + uncurryEvent (id', sn, tn, trn, PG.ViaJSON payload, tries, created) = Event { eId = id', eSource = SNDefault, -- in v1, there'll only be the default source diff --git a/server/src-lib/Hasura/Backends/Postgres/DDL/RunSQL.hs b/server/src-lib/Hasura/Backends/Postgres/DDL/RunSQL.hs index d684f49513a..06bb26d379d 100644 --- a/server/src-lib/Hasura/Backends/Postgres/DDL/RunSQL.hs +++ b/server/src-lib/Hasura/Backends/Postgres/DDL/RunSQL.hs @@ -402,7 +402,7 @@ fetchTablesFunctionsFromOids :: [OID] -> PG.TxET QErr m ([TableName ('Postgres pgKind)], [FunctionName ('Postgres pgKind)]) fetchTablesFunctionsFromOids tableOids functionOids = - ((PG.getAltJ *** PG.getAltJ) . PG.getRow) + ((PG.getViaJSON *** PG.getViaJSON) . PG.getRow) <$> PG.withQE defaultTxErrorHandler [PG.sql| @@ -445,7 +445,7 @@ fetchTablesFunctionsFromOids tableOids functionOids = '[]' ) AS "functions" |] - (PG.AltJ $ map mkOidObject tableOids, PG.AltJ $ map mkOidObject functionOids) + (PG.ViaJSON $ map mkOidObject tableOids, PG.ViaJSON $ map mkOidObject functionOids) True where mkOidObject oid = object ["oid" .= oid] diff --git a/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs b/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs index f3a5771bbdf..c33582d3aee 100644 --- a/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs +++ b/server/src-lib/Hasura/Backends/Postgres/DDL/Source.hs @@ -135,7 +135,7 @@ logPGSourceCatalogMigrationLockedQueries logger sourceConfig = forever $ do -- The blocking query in the below transaction is truncated to the first 20 characters because it may contain -- sensitive info. fetchLockedQueriesTx = - (PG.getAltJ . runIdentity . PG.getRow) + (PG.getViaJSON . runIdentity . PG.getRow) <$> PG.withQE defaultTxErrorHandler [PG.sql| @@ -365,12 +365,12 @@ pgFetchTableMetadata tables = do PG.withQE defaultTxErrorHandler (tableMetadata @pgKind) - [PG.AltJ $ LE.uniques tables] + [PG.ViaJSON $ LE.uniques tables] True pure $ Map.fromList $ flip map results $ - \(schema, table, PG.AltJ info) -> (QualifiedObject schema table, info) + \(schema, table, PG.ViaJSON info) -> (QualifiedObject schema table, info) -- | Fetch Cockroach metadata of all user tables cockroachFetchTableMetadata :: @@ -389,7 +389,7 @@ cockroachFetchTableMetadata _tables = do pure $ Map.fromList $ flip map results $ - \(schema, table, PG.AltJ info) -> (QualifiedObject schema table, info) + \(schema, table, PG.ViaJSON info) -> (QualifiedObject schema table, info) class FetchFunctionMetadata (pgKind :: PostgresKind) where fetchFunctionMetadata :: @@ -414,18 +414,18 @@ pgFetchFunctionMetadata functions = do PG.withQE defaultTxErrorHandler $(makeRelativeToProject "src-rsr/pg_function_metadata.sql" >>= PG.sqlFromFile) - [PG.AltJ $ LE.uniques functions] + [PG.ViaJSON $ LE.uniques functions] True pure $ Map.fromList $ flip map results $ - \(schema, table, PG.AltJ infos) -> (QualifiedObject schema table, infos) + \(schema, table, PG.ViaJSON infos) -> (QualifiedObject schema table, infos) -- | Fetch all scalar types from Postgres fetchPgScalars :: MonadTx m => m (HashSet PGScalarType) fetchPgScalars = liftTx $ - PG.getAltJ . runIdentity . PG.getRow + PG.getViaJSON . runIdentity . PG.getRow <$> PG.withQE defaultTxErrorHandler [PG.sql| diff --git a/server/src-lib/Hasura/Backends/Postgres/Execute/Mutation.hs b/server/src-lib/Hasura/Backends/Postgres/Execute/Mutation.hs index 3eae76c9a41..ba620453713 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Execute/Mutation.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Execute/Mutation.hs @@ -261,8 +261,8 @@ mutateAndFetchCols qt cols (cte, p) strfyNum tCase = do PG.rawQE dmlTxErrorHandler sqlText (toList p) False if checkPermissionRequired cte - then withCheckPermission $ (first PG.getAltJ . PG.getRow) <$> mutationTx - else (PG.getAltJ . runIdentity . PG.getRow) <$> mutationTx + then withCheckPermission $ (first PG.getViaJSON . PG.getRow) <$> mutationTx + else (PG.getViaJSON . runIdentity . PG.getRow) <$> mutationTx where rawAliasIdentifier = "mutres__" <> qualifiedObjectToText qt aliasIdentifier = Identifier rawAliasIdentifier diff --git a/server/src-lib/Hasura/Backends/Postgres/Execute/Prepare.hs b/server/src-lib/Hasura/Backends/Postgres/Execute/Prepare.hs index c02efd6dd07..4bf5f919a02 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Execute/Prepare.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Execute/Prepare.hs @@ -127,7 +127,7 @@ prepareWithoutPlan userInfo = \case withUserVars :: SessionVariables -> PrepArgMap -> PrepArgMap withUserVars usrVars list = let usrVarsAsPgScalar = PGValJSON $ PG.JSON $ J.toJSON usrVars - prepArg = PG.toPrepVal (PG.AltJ usrVars) + prepArg = PG.toPrepVal (PG.ViaJSON usrVars) in IntMap.insert 1 (prepArg, usrVarsAsPgScalar) list -- | In prepared statements, we refer to variables by a number, not their name. diff --git a/server/src-lib/Hasura/Backends/Postgres/Execute/Subscription.hs b/server/src-lib/Hasura/Backends/Postgres/Execute/Subscription.hs index fdcecc7770c..e35fd8a067c 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Execute/Subscription.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Execute/Subscription.hs @@ -285,7 +285,7 @@ executeStreamingMultiplexedQuery :: (MonadTx m) => MultiplexedQuery -> [(CohortId, CohortVariables)] -> - m [(CohortId, B.ByteString, PG.AltJ CursorVariableValues)] + m [(CohortId, B.ByteString, PG.ViaJSON CursorVariableValues)] executeStreamingMultiplexedQuery (MultiplexedQuery query) cohorts = do executeQuery query cohorts diff --git a/server/src-lib/Hasura/Backends/Postgres/Instances/Transport.hs b/server/src-lib/Hasura/Backends/Postgres/Instances/Transport.hs index 77e597144b6..44383188a54 100644 --- a/server/src-lib/Hasura/Backends/Postgres/Instances/Transport.hs +++ b/server/src-lib/Hasura/Backends/Postgres/Instances/Transport.hs @@ -127,7 +127,7 @@ runPGStreamingSubscription sourceConfig query variables = withElapsedTime $ runExceptT $ do res <- runQueryTx (_pscExecCtx sourceConfig) $ PGL.executeStreamingMultiplexedQuery query variables - pure $ res <&> (\(cohortId, cohortRes, cursorVariableVals) -> (cohortId, cohortRes, PG.getAltJ cursorVariableVals)) + pure $ res <&> (\(cohortId, cohortRes, cursorVariableVals) -> (cohortId, cohortRes, PG.getViaJSON cursorVariableVals)) runPGQueryExplain :: forall pgKind m. diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs index da6211cee65..d3a3a9ca8e9 100644 --- a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs +++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs @@ -560,7 +560,7 @@ getScheduledEventsForDeliveryTx = where getCronEventsForDelivery :: PG.TxE QErr [CronEvent] getCronEventsForDelivery = - map (PG.getAltJ . runIdentity) + map (PG.getViaJSON . runIdentity) <$> PG.listQE defaultTxErrorHandler [PG.sql| @@ -586,7 +586,7 @@ getScheduledEventsForDeliveryTx = getOneOffEventsForDelivery :: PG.TxE QErr [OneOffScheduledEvent] getOneOffEventsForDelivery = do - map (PG.getAltJ . runIdentity) + map (PG.getViaJSON . runIdentity) <$> PG.listQE defaultTxErrorHandler [PG.sql| @@ -623,8 +623,8 @@ insertInvocationTx invo type' = do |] ( iEventId invo, fromIntegral <$> iStatus invo :: Maybe Int64, - PG.AltJ $ J.toJSON $ iRequest invo, - PG.AltJ $ J.toJSON $ iResponse invo + PG.ViaJSON $ J.toJSON $ iRequest invo, + PG.ViaJSON $ J.toJSON $ iResponse invo ) True PG.unitQE @@ -646,8 +646,8 @@ insertInvocationTx invo type' = do |] ( iEventId invo, fromIntegral <$> iStatus invo :: Maybe Int64, - PG.AltJ $ J.toJSON $ iRequest invo, - PG.AltJ $ J.toJSON $ iResponse invo + PG.ViaJSON $ J.toJSON $ iRequest invo, + PG.ViaJSON $ J.toJSON $ iResponse invo ) True PG.unitQE @@ -795,11 +795,11 @@ insertOneOffScheduledEventTx CreateScheduledEvent {..} = VALUES ($1, $2, $3, $4, $5, $6) RETURNING id |] - ( PG.AltJ cseWebhook, + ( PG.ViaJSON cseWebhook, cseScheduleAt, - PG.AltJ csePayload, - PG.AltJ cseRetryConf, - PG.AltJ cseHeaders, + PG.ViaJSON csePayload, + PG.ViaJSON cseRetryConf, + PG.ViaJSON cseHeaders, cseComment ) False @@ -890,11 +890,11 @@ mkPaginationSelectExp allRowsSelect ScheduledEventPagination {..} shouldIncludeR } in S.Extractor (S.handleIfNull (S.SELit "[]") (S.SESelect selectExp)) Nothing -withCount :: (Int, PG.AltJ a) -> WithOptionalTotalCount a -withCount (count, PG.AltJ a) = WithOptionalTotalCount (Just count) a +withCount :: (Int, PG.ViaJSON a) -> WithOptionalTotalCount a +withCount (count, PG.ViaJSON a) = WithOptionalTotalCount (Just count) a -withoutCount :: PG.AltJ a -> WithOptionalTotalCount a -withoutCount (PG.AltJ a) = WithOptionalTotalCount Nothing a +withoutCount :: PG.ViaJSON a -> WithOptionalTotalCount a +withoutCount (PG.ViaJSON a) = WithOptionalTotalCount Nothing a executeWithOptionalTotalCount :: J.FromJSON a => PG.Query -> RowsCountOption -> PG.TxE QErr (WithOptionalTotalCount a) executeWithOptionalTotalCount sql getRowsCount = diff --git a/server/src-lib/Hasura/GraphQL/Execute/Action.hs b/server/src-lib/Hasura/GraphQL/Execute/Action.hs index 2e3ad67b89d..d81a853ccf0 100644 --- a/server/src-lib/Hasura/GraphQL/Execute/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Execute/Action.hs @@ -694,9 +694,9 @@ insertActionTx actionName sessionVariables httpHeaders inputArgsPayload = RETURNING "id" |] ( actionName, - PG.AltJ sessionVariables, - PG.AltJ $ toHeadersMap httpHeaders, - PG.AltJ inputArgsPayload, + PG.ViaJSON sessionVariables, + PG.ViaJSON $ toHeadersMap httpHeaders, + PG.ViaJSON inputArgsPayload, "created" :: Text ) False @@ -725,9 +725,9 @@ fetchUndeliveredActionEventsTx = mapEvent ( actionId, actionName, - PG.AltJ headersMap, - PG.AltJ sessionVariables, - PG.AltJ inputPayload + PG.ViaJSON headersMap, + PG.ViaJSON sessionVariables, + PG.ViaJSON inputPayload ) = ActionLogItem actionId actionName (fromHeadersMap headersMap) sessionVariables inputPayload @@ -743,7 +743,7 @@ setActionStatusTx actionId = \case set response_payload = $1, status = 'completed' where id = $2 |] - (PG.AltJ responsePayload, actionId) + (PG.ViaJSON responsePayload, actionId) False AASError qerr -> PG.unitQE @@ -753,12 +753,12 @@ setActionStatusTx actionId = \case set errors = $1, status = 'error' where id = $2 |] - (PG.AltJ qerr, actionId) + (PG.ViaJSON qerr, actionId) False fetchActionResponseTx :: ActionId -> PG.TxE QErr ActionLogResponse fetchActionResponseTx actionId = do - (ca, rp, errs, PG.AltJ sessVars) <- + (ca, rp, errs, PG.ViaJSON sessVars) <- PG.getRow <$> PG.withQE defaultTxErrorHandler @@ -769,7 +769,7 @@ fetchActionResponseTx actionId = do |] (Identity actionId) True - pure $ ActionLogResponse actionId ca (PG.getAltJ <$> rp) (PG.getAltJ <$> errs) sessVars + pure $ ActionLogResponse actionId ca (PG.getViaJSON <$> rp) (PG.getViaJSON <$> errs) sessVars clearActionDataTx :: ActionName -> PG.TxE QErr () clearActionDataTx actionName = diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs index e0ec3f2a291..05953a57ed9 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs @@ -37,7 +37,7 @@ fetchMetadataFromCatalog = do True case rows of [] -> pure emptyMetadata - [Identity (PG.AltJ metadata)] -> pure metadata + [Identity (PG.ViaJSON metadata)] -> pure metadata _ -> throw500 "multiple rows in hdb_metadata table" fetchMetadataAndResourceVersionFromCatalog :: PG.TxE QErr (Metadata, MetadataResourceVersion) @@ -52,7 +52,7 @@ fetchMetadataAndResourceVersionFromCatalog = do True case rows of [] -> pure (emptyMetadata, initialResourceVersion) - [(PG.AltJ metadata, resourceVersion)] -> pure (metadata, MetadataResourceVersion resourceVersion) + [(PG.ViaJSON metadata, resourceVersion)] -> pure (metadata, MetadataResourceVersion resourceVersion) _ -> throw500 "multiple rows in hdb_metadata table" fetchMetadataResourceVersionFromCatalog :: PG.TxE QErr MetadataResourceVersion @@ -72,7 +72,7 @@ fetchMetadataResourceVersionFromCatalog = do fetchMetadataNotificationsFromCatalog :: MetadataResourceVersion -> InstanceId -> PG.TxE QErr [(MetadataResourceVersion, CacheInvalidations)] fetchMetadataNotificationsFromCatalog (MetadataResourceVersion resourceVersion) instanceId = do - fmap (bimap MetadataResourceVersion PG.getAltJ) + fmap (bimap MetadataResourceVersion PG.getViaJSON) <$> PG.withQE defaultTxErrorHandler [PG.sql| @@ -103,7 +103,7 @@ insertMetadataInCatalog metadata = INSERT INTO hdb_catalog.hdb_metadata(id, metadata) VALUES (1, $1::json) |] - (Identity $ PG.AltJ metadata) + (Identity $ PG.ViaJSON metadata) True -- | Check that the specified resource version matches the currently stored one, and... @@ -124,7 +124,7 @@ setMetadataInCatalog resourceVersion metadata = do WHERE hdb_catalog.hdb_metadata.resource_version = $2 RETURNING resource_version |] - (PG.AltJ metadata, getMetadataResourceVersion resourceVersion) + (PG.ViaJSON metadata, getMetadataResourceVersion resourceVersion) True case rows of [] -> throw409 $ "metadata resource version referenced (" <> tshow (getMetadataResourceVersion resourceVersion) <> ") did not match current version" diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs b/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs index 0555b35f25e..984cb6fe0a7 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/LegacyCatalog.hs @@ -164,7 +164,7 @@ saveTableToCatalog (QualifiedObject sn tn) isEnum config = do (sn, tn, systemDefined, isEnum, configVal) False where - configVal = PG.AltJ $ toJSON config + configVal = PG.ViaJSON $ toJSON config insertRelationshipToCatalog :: (MonadTx m, MonadReader SystemDefined m, ToJSON a) => @@ -174,7 +174,7 @@ insertRelationshipToCatalog :: m () insertRelationshipToCatalog (QualifiedObject schema table) relType (RelDef name using comment) = do systemDefined <- ask - let args = (schema, table, name, relTypeToTxt relType, PG.AltJ using, comment, systemDefined) + let args = (schema, table, name, relTypeToTxt relType, PG.ViaJSON using, comment, systemDefined) liftTx $ PG.unitQE defaultTxErrorHandler query args True where query = @@ -197,7 +197,7 @@ addEventTriggerToCatalog qt etc = liftTx do (name, type, schema_name, table_name, configuration) VALUES ($1, 'table', $2, $3, $4) |] - (name, sn, tn, PG.AltJ $ toJSON etc) + (name, sn, tn, PG.ViaJSON $ toJSON etc) False where QualifiedObject sn tn = qt @@ -216,7 +216,7 @@ addComputedFieldToCatalog q = (table_schema, table_name, computed_field_name, definition, commentText) VALUES ($1, $2, $3, $4, $5) |] - (schemaName, tableName, computedField, PG.AltJ definition, commentText) + (schemaName, tableName, computedField, PG.ViaJSON definition, commentText) True where commentText = commentToMaybeText comment @@ -233,7 +233,7 @@ addRemoteRelationshipToCatalog CreateFromSourceRelationship {..} = (remote_relationship_name, table_schema, table_name, definition) VALUES ($1, $2, $3, $4::jsonb) |] - (_crrName, schemaName, tableName, PG.AltJ _crrDefinition) + (_crrName, schemaName, tableName, PG.ViaJSON _crrDefinition) True where QualifiedObject schemaName tableName = _crrTable @@ -253,7 +253,7 @@ addFunctionToCatalog (QualifiedObject sn fn) config = do (function_schema, function_name, configuration, is_system_defined) VALUES ($1, $2, $3, $4) |] - (sn, fn, PG.AltJ config, systemDefined) + (sn, fn, PG.ViaJSON config, systemDefined) False addRemoteSchemaToCatalog :: @@ -267,7 +267,7 @@ addRemoteSchemaToCatalog (RemoteSchemaMetadata name def comment _ _) = (name, definition, comment) VALUES ($1, $2, $3) |] - (name, PG.AltJ $ toJSON def, comment) + (name, PG.ViaJSON $ toJSON def, comment) True addCollectionToCatalog :: @@ -281,7 +281,7 @@ addCollectionToCatalog (CreateCollection name defn mComment) systemDefined = (collection_name, collection_defn, comment, is_system_defined) VALUES ($1, $2, $3, $4) |] - (name, PG.AltJ defn, mComment, systemDefined) + (name, PG.ViaJSON defn, mComment, systemDefined) True addCollectionToAllowlistCatalog :: MonadTx m => CollectionName -> m () @@ -307,7 +307,7 @@ setCustomTypesInCatalog customTypes = liftTx do (custom_types) VALUES ($1) |] - (Identity $ PG.AltJ customTypes) + (Identity $ PG.ViaJSON customTypes) False where clearCustomTypes = do @@ -329,7 +329,7 @@ addActionToCatalog (CreateAction actionName actionDefinition comment) = do (action_name, action_defn, comment) VALUES ($1, $2, $3) |] - (actionName, PG.AltJ actionDefinition, comment) + (actionName, PG.ViaJSON actionDefinition, comment) True addActionPermissionToCatalog :: (MonadTx m) => CreateActionPermission -> m () @@ -361,7 +361,7 @@ addPermissionToCatalog (QualifiedObject sn tn) (PermDef rn qdef mComment) system (table_schema, table_name, role_name, perm_type, perm_def, comment, is_system_defined) VALUES ($1, $2, $3, $4, $5 :: jsonb, $6, $7) |] - (sn, tn, rn, permTypeToCode (reflectPermDefPermission qdef), PG.AltJ qdef, mComment, systemDefined) + (sn, tn, rn, permTypeToCode (reflectPermDefPermission qdef), PG.ViaJSON qdef, mComment, systemDefined) True addCronTriggerToCatalog :: (MonadTx m) => CronTriggerMetadata -> m () @@ -374,11 +374,11 @@ addCronTriggerToCatalog CronTriggerMetadata {..} = liftTx $ do VALUES ($1, $2, $3, $4, $5, $6, $7, $8) |] ( ctName, - PG.AltJ ctWebhook, + PG.ViaJSON ctWebhook, ctSchedule, - PG.AltJ <$> ctPayload, - PG.AltJ ctRetryConf, - PG.AltJ ctHeaders, + PG.ViaJSON <$> ctPayload, + PG.ViaJSON ctRetryConf, + PG.ViaJSON ctHeaders, ctIncludeInMetadata, ctComment ) @@ -400,7 +400,7 @@ fetchMetadataFromHdbTables = liftTx do let tableMetaMap = OMap.fromList . flip map tables $ \(schema, name, isEnum, maybeConfig) -> let qualifiedName = QualifiedObject schema name - configuration = maybe emptyTableConfig PG.getAltJ maybeConfig + configuration = maybe emptyTableConfig PG.getViaJSON maybeConfig in (qualifiedName, mkTableMeta qualifiedName isEnum configuration) -- Fetch all the relationships @@ -467,19 +467,19 @@ fetchMetadataFromHdbTables = liftTx do mkPermDefs pt = mapM permRowToDef . filter (\pr -> pr ^. _4 == pt) - permRowToDef (sn, tn, rn, _, PG.AltJ pDef, mComment) = do + permRowToDef (sn, tn, rn, _, PG.ViaJSON pDef, mComment) = do perm <- decodeValue pDef return (QualifiedObject sn tn, PermDef rn perm mComment) mkRelDefs rt = mapM relRowToDef . filter (\rr -> rr ^. _4 == rt) - relRowToDef (sn, tn, rn, _, PG.AltJ rDef, mComment) = do + relRowToDef (sn, tn, rn, _, PG.ViaJSON rDef, mComment) = do using <- decodeValue rDef return (QualifiedObject sn tn, RelDef rn using mComment) mkTriggerMetaDefs = mapM trigRowToDef - trigRowToDef (sn, tn, PG.AltJ configuration) = do + trigRowToDef (sn, tn, PG.ViaJSON configuration) = do conf :: EventTriggerConf ('Postgres pgKind) <- decodeValue configuration return (QualifiedObject sn tn, conf) @@ -539,7 +539,7 @@ fetchMetadataFromHdbTables = liftTx do False pure $ oMapFromL _fmFunction $ - flip map l $ \(sn, fn, PG.AltJ config) -> + flip map l $ \(sn, fn, PG.ViaJSON config) -> -- function permissions were only introduced post 43rd -- migration, so it's impossible we get any permissions -- here @@ -557,7 +557,7 @@ fetchMetadataFromHdbTables = liftTx do () True where - fromRow (name, PG.AltJ def, comment) = + fromRow (name, PG.ViaJSON def, comment) = RemoteSchemaMetadata name def comment mempty mempty fetchCollections = @@ -573,7 +573,7 @@ fetchMetadataFromHdbTables = liftTx do () False where - fromRow (name, PG.AltJ defn, mComment) = + fromRow (name, PG.ViaJSON defn, mComment) = CreateCollection name defn mComment fetchAllowlist = @@ -602,7 +602,7 @@ fetchMetadataFromHdbTables = liftTx do () False pure $ - flip map r $ \(schema, table, name, PG.AltJ definition, comment) -> + flip map r $ \(schema, table, name, PG.ViaJSON definition, comment) -> ( QualifiedObject schema table, ComputedFieldMetadata name definition (commentFromMaybeText comment) ) @@ -624,11 +624,11 @@ fetchMetadataFromHdbTables = liftTx do (name, webhook, schedule, payload, retryConfig, headerConfig, includeMetadata, comment) = CronTriggerMetadata { ctName = name, - ctWebhook = PG.getAltJ webhook, + ctWebhook = PG.getViaJSON webhook, ctSchedule = schedule, - ctPayload = PG.getAltJ <$> payload, - ctRetryConf = PG.getAltJ retryConfig, - ctHeaders = PG.getAltJ headerConfig, + ctPayload = PG.getViaJSON <$> payload, + ctRetryConf = PG.getViaJSON retryConfig, + ctHeaders = PG.getViaJSON headerConfig, ctIncludeInMetadata = includeMetadata, ctComment = comment, ctRequestTransform = Nothing, @@ -637,7 +637,7 @@ fetchMetadataFromHdbTables = liftTx do fetchCustomTypes :: PG.TxE QErr CustomTypes fetchCustomTypes = - PG.getAltJ . runIdentity . PG.getRow + PG.getViaJSON . runIdentity . PG.getRow <$> PG.rawQE defaultTxErrorHandler [PG.sql| @@ -647,7 +647,7 @@ fetchMetadataFromHdbTables = liftTx do False fetchActions = - PG.getAltJ . runIdentity . PG.getRow + PG.getViaJSON . runIdentity . PG.getRow <$> PG.rawQE defaultTxErrorHandler [PG.sql| @@ -696,7 +696,7 @@ fetchMetadataFromHdbTables = liftTx do () False pure $ - flip map r $ \(schema, table, name, PG.AltJ definition) -> + flip map r $ \(schema, table, name, PG.ViaJSON definition) -> ( QualifiedObject schema table, name, definition diff --git a/server/src-lib/Hasura/Server/Migrate/Internal.hs b/server/src-lib/Hasura/Server/Migrate/Internal.hs index 63cb2cb8bee..03f65175775 100644 --- a/server/src-lib/Hasura/Server/Migrate/Internal.hs +++ b/server/src-lib/Hasura/Server/Migrate/Internal.hs @@ -67,14 +67,14 @@ from3To4 = liftTx $ where uncurryEventTrigger :: ( TriggerName, - PG.AltJ (TriggerOpsDef ('Postgres 'Vanilla)), + PG.ViaJSON (TriggerOpsDef ('Postgres 'Vanilla)), InputWebhook, Int, Int, - PG.AltJ (Maybe [HeaderConf]) + PG.ViaJSON (Maybe [HeaderConf]) ) -> EventTriggerConf ('Postgres 'Vanilla) - uncurryEventTrigger (trn, PG.AltJ tDef, w, nr, rint, PG.AltJ headers) = + uncurryEventTrigger (trn, PG.ViaJSON tDef, w, nr, rint, PG.ViaJSON headers) = EventTriggerConf trn tDef (Just w) Nothing (RetryConf nr rint Nothing) headers Nothing Nothing Nothing updateEventTrigger3To4 etc@(EventTriggerConf name _ _ _ _ _ _ _ _) = PG.unitQ @@ -84,7 +84,7 @@ from3To4 = liftTx $ configuration = $1 WHERE name = $2 |] - (PG.AltJ $ A.toJSON etc, name) + (PG.ViaJSON $ A.toJSON etc, name) True setCatalogVersion :: MonadTx m => Text -> UTCTime -> m ()