server: codecs for object & array relationships, and computed fields

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5923
GitOrigin-RevId: e0c7584539998f5af16795f023640aa5c659b783

cabal.project.freeze

@@ -147,6 +147,7 @@ constraints: any.Cabal ==3.6.3.0,
              any.hspec-core ==2.10.0,
              any.hspec-discover ==2.10.0,
              any.hspec-expectations ==0.8.2,
+             any.hspec-expectations-json ==1.0.0.7,
              any.hspec-expectations-lifted ==0.10.0,
              any.hspec-hedgehog ==0.0.1.2,
              any.http-api-data ==0.4.3,

server/graphql-engine.cabal

@@ -1003,6 +1003,7 @@ test-suite graphql-engine-tests
     , hspec >=2.8.3 && <3
     , hspec-core >=2.8.3 && <3
     , hspec-expectations
+    , hspec-expectations-json
     , hspec-expectations-lifted
     , hspec-hedgehog
     , http-client

server/src-lib/Hasura/Backends/BigQuery/Types.hs

@@ -69,6 +69,7 @@ module Hasura.Backends.BigQuery.Types
   )
 where
 
+import Autodocodec (HasCodec (codec), dimapCodec, object, requiredField', (.=))
 import Data.Aeson (FromJSON, FromJSONKey, ToJSON, ToJSONKey)
 import Data.Aeson qualified as J
 import Data.Aeson.Casing qualified as J
@@ -570,6 +571,13 @@ data TableName = TableName
   }
   deriving (Eq, Show, Generic, Data, Lift, Ord)
 
+instance HasCodec TableName where
+  codec =
+    object "BigQueryTableName" $
+      TableName
+        <$> requiredField' "name" .= tableName
+        <*> requiredField' "dataset" .= tableNameSchema
+
 instance FromJSON TableName where
   parseJSON =
     J.withObject
@@ -614,6 +622,9 @@ newtype ColumnName = ColumnName
   }
   deriving (Eq, Ord, Show, Generic, Data, Lift, FromJSON, ToJSON, ToJSONKey, FromJSONKey, Hashable, Cacheable, NFData, ToTxt)
 
+instance HasCodec ColumnName where
+  codec = dimapCodec ColumnName columnName codec
+
 instance ToErrorValue ColumnName where
   toErrorValue = ErrorValue.squote . columnName
 

server/src-lib/Hasura/Backends/DataConnector/Adapter/Types.hs

@@ -200,6 +200,9 @@ newtype TableName = TableName {unTableName :: NonEmpty Text}
   deriving stock (Data, Eq, Generic, Ord, Show)
   deriving newtype (Cacheable, Hashable, NFData, ToJSON)
 
+instance HasCodec TableName where
+  codec = dimapCodec TableName unTableName codec
+
 instance FromJSON TableName where
   parseJSON value =
     TableName <$> J.parseJSON value
@@ -245,6 +248,9 @@ newtype ColumnName = ColumnName {unColumnName :: Text}
   deriving stock (Eq, Ord, Show, Generic, Data)
   deriving newtype (NFData, Hashable, Cacheable, FromJSON, ToJSON, ToJSONKey, FromJSONKey)
 
+instance HasCodec ColumnName where
+  codec = dimapCodec ColumnName unColumnName codec
+
 instance Witch.From API.ColumnName ColumnName where
   from (API.ColumnName n) = ColumnName n
 

server/src-lib/Hasura/Backends/MSSQL/Types/Instances.hs

@@ -11,6 +11,8 @@
 -- Instances for types from "Hasura.Backends.MSSQL.Types.Internal" that're slow to compile.
 module Hasura.Backends.MSSQL.Types.Instances () where
 
+import Autodocodec (HasCodec (codec), dimapCodec, optionalFieldWithDefault', parseAlternative, requiredField')
+import qualified Autodocodec as AC
 import Data.Aeson.Extended
 import Data.Aeson.Types
 import Data.Text.Extended (ToTxt (..))
@@ -176,6 +178,9 @@ INSTANCE_CLUMP_3(NullsOrder)
 INSTANCE_CLUMP_3(ScalarType)
 INSTANCE_CLUMP_3(FieldName)
 
+instance HasCodec ColumnName where
+  codec = dimapCodec ColumnName columnNameText codec
+
 deriving instance FromJSON ColumnName
 
 deriving instance ToJSON ColumnName
@@ -184,6 +189,19 @@ deriving instance ToJSON ConstraintName
 
 deriving instance ToJSON FunctionName
 
+instance HasCodec TableName where
+  codec = parseAlternative objCodec strCodec
+    where
+      objCodec =
+        AC.object "MSSQLTableName" $
+          TableName
+            <$> requiredField' "name" AC..= tableName
+            <*> optionalFieldWithDefault' "schema" "dbo" AC..= tableSchema
+      strCodec = flip TableName "dbo" <$> codec
+
+instance HasCodec SchemaName where
+  codec = dimapCodec SchemaName _unSchemaName codec
+
 instance FromJSON TableName where
   parseJSON v@(String _) =
     TableName <$> parseJSON v <*> pure "dbo"

server/src-lib/Hasura/Backends/MySQL/Types/Instances.hs

@@ -5,8 +5,16 @@
 -- | Instances that're slow to compile.
 module Hasura.Backends.MySQL.Types.Instances () where
 
-import Autodocodec (HasCodec (codec), optionalFieldWithDefault', requiredField, requiredField')
+import Autodocodec
+  ( HasCodec (codec),
+    dimapCodec,
+    optionalFieldWithDefault',
+    parseAlternative,
+    requiredField,
+    requiredField',
+  )
 import Autodocodec qualified as AC
+import Autodocodec.Extended (optionalFieldOrIncludedNull')
 import Control.DeepSeq
 import Data.Aeson qualified as J
 import Data.Aeson.Casing qualified as J
@@ -157,13 +165,27 @@ $( concat <$> for
 instance ToTxt TableName where
   toTxt TableName {..} = name
 
+instance HasCodec TableName where
+  codec = parseAlternative objCodec strCodec
+    where
+      objCodec =
+        AC.object "MySQLTableName" $
+          TableName
+            <$> requiredField' "name"
+            AC..= name
+            <*> optionalFieldOrIncludedNull' "schema"
+            AC..= schema
+      strCodec = flip TableName Nothing <$> codec
+
 instance FromJSON TableName where
   parseJSON v@(String _) =
     TableName <$> parseJSON v <*> pure Nothing
   parseJSON (Object o) =
     TableName
-      <$> o .: "name"
-      <*> o .:? "schema"
+      <$> o
+      .: "name"
+      <*> o
+      .:? "schema"
   parseJSON _ =
     fail "expecting a string/object for TableName"
 
@@ -175,6 +197,9 @@ instance ToJSONKey TableName where
     toJSONKeyText $ \(TableName {schema, name}) ->
       maybe "" (<> ".") schema <> name
 
+instance HasCodec Column where
+  codec = dimapCodec Column unColumn codec
+
 instance ToJSONKey ScalarType
 
 instance ToTxt ScalarType where
@@ -200,8 +225,10 @@ instance HasCodec ConnPoolSettings where
   codec =
     AC.object "MySQLConnPoolSettings" $
       ConnPoolSettings
-        <$> optionalFieldWithDefault' "idle_timeout" (_cscIdleTimeout defaultConnPoolSettings) AC..= _cscIdleTimeout
-        <*> optionalFieldWithDefault' "max_connections" (_cscMaxConnections defaultConnPoolSettings) AC..= _cscMaxConnections
+        <$> optionalFieldWithDefault' "idle_timeout" (_cscIdleTimeout defaultConnPoolSettings)
+        AC..= _cscIdleTimeout
+        <*> optionalFieldWithDefault' "max_connections" (_cscMaxConnections defaultConnPoolSettings)
+        AC..= _cscMaxConnections
 
 instance J.FromJSON ConnPoolSettings where
   parseJSON = J.withObject "MySQL pool settings" $ \o ->
@@ -222,12 +249,18 @@ instance HasCodec ConnSourceConfig where
   codec =
     AC.object "MySQLConnSourceConfig" $
       ConnSourceConfig
-        <$> requiredField "host" hostDoc AC..= _cscHost
-        <*> requiredField' "port" AC..= _cscPort
-        <*> requiredField' "user" AC..= _cscUser
-        <*> requiredField' "password" AC..= _cscPassword
-        <*> requiredField' "database" AC..= _cscDatabase
-        <*> requiredField' "pool_settings" AC..= _cscPoolSettings
+        <$> requiredField "host" hostDoc
+        AC..= _cscHost
+        <*> requiredField' "port"
+        AC..= _cscPort
+        <*> requiredField' "user"
+        AC..= _cscUser
+        <*> requiredField' "password"
+        AC..= _cscPassword
+        <*> requiredField' "database"
+        AC..= _cscDatabase
+        <*> requiredField' "pool_settings"
+        AC..= _cscPoolSettings
     where
       hostDoc = "Works with `127.0.0.1` but not with `localhost`: https://mariadb.com/kb/en/troubleshooting-connection-issues/#localhost-and"
 

server/src-lib/Hasura/Backends/Postgres/Connection/Settings.hs

@@ -329,8 +329,8 @@ instance HasCodec PostgresSourceConnInfo where
         PostgresSourceConnInfo
           <$> requiredField "database_url" databaseUrlDoc .== _psciDatabaseUrl
           <*> optionalFieldOrNull "pool_settings" poolSettingsDoc .== _psciPoolSettings
-          <*> optionalFieldWithOmittedDefault "use_prepared_statements" False usePreparedStatementsDoc .== _psciUsePreparedStatements
-          <*> optionalFieldWithOmittedDefault "isolation_level" PG.ReadCommitted isolationLevelDoc .== _psciIsolationLevel
+          <*> optionalFieldWithDefault "use_prepared_statements" False usePreparedStatementsDoc .== _psciUsePreparedStatements
+          <*> optionalFieldWithDefault "isolation_level" PG.ReadCommitted isolationLevelDoc .== _psciIsolationLevel
           <*> optionalFieldOrNull "ssl_configuration" sslConfigurationDoc .== _psciSslConfiguration
     where
       databaseUrlDoc = "The database connection URL as a string, as an environment variable, or as connection parameters."

server/src-lib/Hasura/Backends/Postgres/SQL/Types.hs

@@ -56,6 +56,8 @@ module Hasura.Backends.Postgres.SQL.Types
   )
 where
 
+import Autodocodec (HasCodec (codec), dimapCodec, optionalFieldWithDefault', parseAlternative, requiredField')
+import Autodocodec qualified as AC
 import Data.Aeson
 import Data.Aeson.Encoding (text)
 import Data.Aeson.Key qualified as K
@@ -67,6 +69,7 @@ import Data.String
 import Data.Text qualified as T
 import Data.Text.Casing qualified as C
 import Data.Text.Extended
+import Data.Typeable (Typeable)
 import Database.PG.Query qualified as PG
 import Database.PG.Query.PTI qualified as PTI
 import Database.PostgreSQL.LibPQ qualified as PQ
@@ -75,6 +78,7 @@ import Hasura.Base.ErrorValue qualified as ErrorValue
 import Hasura.Base.ToErrorValue
 import Hasura.GraphQL.Parser.Name qualified as GName
 import Hasura.Incremental (Cacheable)
+import Hasura.Metadata.DTO.Utils (typeableName)
 import Hasura.Name qualified as Name
 import Hasura.Prelude
 import Hasura.RQL.Types.Backend (SupportedNamingCase (..))
@@ -179,6 +183,9 @@ newtype TableName = TableName {getTableTxt :: Text}
       IsString
     )
 
+instance HasCodec TableName where
+  codec = dimapCodec TableName getTableTxt codec
+
 instance IsIdentifier TableName where
   toIdentifier (TableName t) = Identifier t
 
@@ -223,6 +230,9 @@ instance ToErrorValue ConstraintName where
 newtype FunctionName = FunctionName {getFunctionTxt :: Text}
   deriving (Show, Eq, Ord, FromJSON, ToJSON, PG.ToPrepArg, PG.FromCol, Hashable, Data, Generic, NFData, Cacheable)
 
+instance HasCodec FunctionName where
+  codec = dimapCodec FunctionName getFunctionTxt codec
+
 instance IsIdentifier FunctionName where
   toIdentifier (FunctionName t) = Identifier t
 
@@ -252,6 +262,9 @@ newtype SchemaName = SchemaName {getSchemaTxt :: Text}
       IsString
     )
 
+instance HasCodec SchemaName where
+  codec = dimapCodec SchemaName getSchemaTxt codec
+
 publicSchema :: SchemaName
 publicSchema = SchemaName "public"
 
@@ -274,6 +287,16 @@ instance (NFData a) => NFData (QualifiedObject a)
 
 instance (Cacheable a) => Cacheable (QualifiedObject a)
 
+instance (HasCodec a, Typeable a) => HasCodec (QualifiedObject a) where
+  codec = parseAlternative objCodec strCodec
+    where
+      objCodec =
+        AC.object ("PostgresQualified_" <> typeableName @a) $
+          QualifiedObject
+            <$> optionalFieldWithDefault' "schema" publicSchema AC..= qSchema
+            <*> requiredField' "name" AC..= qName
+      strCodec = QualifiedObject publicSchema <$> codec @a
+
 instance (FromJSON a) => FromJSON (QualifiedObject a) where
   parseJSON v@(String _) =
     QualifiedObject publicSchema <$> parseJSON v
@@ -372,6 +395,9 @@ newtype PGCol = PGCol {getPGColTxt :: Text}
       IsString
     )
 
+instance HasCodec PGCol where
+  codec = dimapCodec PGCol getPGColTxt codec
+
 instance IsIdentifier PGCol where
   toIdentifier (PGCol t) = Identifier t
 

server/src-lib/Hasura/Metadata/DTO/Utils.hs

@@ -4,6 +4,7 @@ module Hasura.Metadata.DTO.Utils
     fromEnvCodec,
     versionField,
     optionalVersionField,
+    typeableName,
   )
 where
 
@@ -18,9 +19,11 @@ import Autodocodec
     scientificCodec,
     (.=),
   )
+import Data.Char (isAlphaNum)
 import Data.Scientific (Scientific)
 import Data.Text qualified as T
 import Data.Text.Extended qualified as T
+import Data.Typeable (Proxy (Proxy), Typeable, typeRep)
 import Hasura.Prelude
 import Hasura.SQL.Tag (HasTag (backendTag), reify)
 
@@ -48,6 +51,13 @@ optionalVersionField v =
 codecNamePrefix :: forall b. (HasTag b) => Text
 codecNamePrefix = T.toTitle $ T.toTxt $ reify $ backendTag @b
 
+-- | Provides a string based on the given type to use to uniquely name
+-- instantiations of polymorphic codecs.
+typeableName :: forall a. (Typeable a) => Text
+typeableName = T.map toValidChar $ tshow $ typeRep (Proxy @a)
+  where
+    toValidChar c = if isAlphaNum c then c else '_'
+
 -- | Represents a text field wrapped in an object with a single property
 -- named @from_env@.
 --

server/src-lib/Hasura/RQL/Types/Backend.hs

@@ -103,7 +103,9 @@ class
     FromJSON (HealthCheckTest b),
     FromJSONKey (Column b),
     HasCodec (BackendSourceKind b),
+    HasCodec (Column b),
     HasCodec (SourceConnConfiguration b),
+    HasCodec (TableName b),
     ToJSON (BackendConfig b),
     ToJSON (BackendInfo b),
     ToJSON (Column b),

server/src-lib/Hasura/RQL/Types/Common.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TemplateHaskell #-}
 
 module Hasura.RQL.Types.Common
@@ -43,7 +44,15 @@ module Hasura.RQL.Types.Common
   )
 where
 
-import Autodocodec (HasCodec (codec), bimapCodec, dimapCodec, disjointEitherCodec, optionalFieldOrNull', requiredField')
+import Autodocodec
+  ( HasCodec (codec),
+    bimapCodec,
+    dimapCodec,
+    disjointEitherCodec,
+    optionalFieldOrNull',
+    requiredField',
+    stringConstCodec,
+  )
 import Autodocodec qualified as AC
 import Data.Aeson
 import Data.Aeson qualified as J
@@ -92,6 +101,9 @@ newtype RelName = RelName {getRelTxt :: NonEmptyText}
 instance ToTxt RelName where
   toTxt = relNameToTxt
 
+instance HasCodec RelName where
+  codec = dimapCodec RelName getRelTxt codec
+
 relNameToTxt :: RelName -> Text
 relNameToTxt = unNonEmptyText . getRelTxt
 
@@ -149,6 +161,13 @@ instance Hashable InsertOrder
 
 instance Cacheable InsertOrder
 
+instance HasCodec InsertOrder where
+  codec =
+    stringConstCodec
+      [ (BeforeParent, "before_parent"),
+        (AfterParent, "after_parent")
+      ]
+
 instance FromJSON InsertOrder where
   parseJSON (String t)
     | t == "before_parent" = pure BeforeParent
@@ -351,22 +370,32 @@ instance HasCodec PGConnectionParams where
   codec =
     AC.object "PGConnectionParams" $
       PGConnectionParams
-        <$> requiredField' "host" AC..= _pgcpHost
-        <*> requiredField' "username" AC..= _pgcpUsername
-        <*> optionalFieldOrNull' "password" AC..= _pgcpPassword
-        <*> requiredField' "port" AC..= _pgcpPort
-        <*> requiredField' "database" AC..= _pgcpDatabase
+        <$> requiredField' "host"
+        AC..= _pgcpHost
+        <*> requiredField' "username"
+        AC..= _pgcpUsername
+        <*> optionalFieldOrNull' "password"
+        AC..= _pgcpPassword
+        <*> requiredField' "port"
+        AC..= _pgcpPort
+        <*> requiredField' "database"
+        AC..= _pgcpDatabase
 
 $(deriveToJSON hasuraJSON {omitNothingFields = True} ''PGConnectionParams)
 
 instance FromJSON PGConnectionParams where
   parseJSON = withObject "PGConnectionParams" $ \o ->
     PGConnectionParams
-      <$> o .: "host"
-      <*> o .: "username"
-      <*> o .:? "password"
-      <*> o .: "port"
-      <*> o .: "database"
+      <$> o
+      .: "host"
+      <*> o
+      .: "username"
+      <*> o
+      .:? "password"
+      <*> o
+      .: "port"
+      <*> o
+      .: "database"
 
 data UrlConf
   = -- | the database connection string
@@ -386,7 +415,8 @@ instance Hashable UrlConf
 instance HasCodec UrlConf where
   codec =
     dimapCodec dec enc $
-      disjointEitherCodec valCodec $ disjointEitherCodec fromEnvCodec fromParamsCodec
+      disjointEitherCodec valCodec $
+        disjointEitherCodec fromEnvCodec fromParamsCodec
     where
       valCodec = codec
       fromParamsCodec = AC.object "UrlConfFromParams" $ requiredField' "connection_parameters"
@@ -422,7 +452,9 @@ instance FromJSON UrlConf where
       -- helper for formatting error messages within this instance
       commonJSONParseErrorMessage :: String -> String
       commonJSONParseErrorMessage strToBePrepended =
-        strToBePrepended <> dquoteStr "from_env" <> " or "
+        strToBePrepended
+          <> dquoteStr "from_env"
+          <> " or "
           <> dquoteStr "connection_parameters"
           <> " should be provided"
   parseJSON t@(String _) =
@@ -520,6 +552,16 @@ instance Cacheable Comment
 
 instance Hashable Comment
 
+instance HasCodec Comment where
+  codec = dimapCodec dec enc (codec @(Maybe Text))
+    where
+      dec Nothing = Automatic
+      dec (Just text) = Explicit $ mkNonEmptyText text
+
+      enc Automatic = Nothing
+      enc (Explicit (Just text)) = Just (toTxt text)
+      enc (Explicit Nothing) = Just ""
+
 instance FromJSON Comment where
   parseJSON = \case
     Null -> pure Automatic

server/src-lib/Hasura/RQL/Types/ComputedField.hs

@@ -19,6 +19,7 @@ module Hasura.RQL.Types.ComputedField
   )
 where
 
+import Autodocodec (HasCodec (codec), dimapCodec)
 import Control.Lens hiding ((.=))
 import Data.Aeson
 import Data.Sequence qualified as Seq
@@ -36,6 +37,9 @@ import Language.GraphQL.Draft.Syntax (Name)
 newtype ComputedFieldName = ComputedFieldName {unComputedFieldName :: NonEmptyText}
   deriving (Show, Eq, Ord, NFData, FromJSON, ToJSON, ToJSONKey, PG.ToPrepArg, ToTxt, Hashable, PG.FromCol, Generic, Cacheable)
 
+instance HasCodec ComputedFieldName where
+  codec = dimapCodec ComputedFieldName unComputedFieldName codec
+
 computedFieldNameToText :: ComputedFieldName -> Text
 computedFieldNameToText = unNonEmptyText . unComputedFieldName
 

server/src-lib/Hasura/RQL/Types/HealthCheck.hs

@@ -14,13 +14,11 @@ import Autodocodec hiding (object, (.=))
 import Autodocodec qualified as AC
 import Data.Aeson.Extended
 import Data.Aeson.Types (parseFail)
-import Data.Text qualified as T
-import Data.Text.Extended qualified as T
 import Hasura.Incremental (Cacheable)
+import Hasura.Metadata.DTO.Utils (codecNamePrefix)
 import Hasura.Prelude
 import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.HealthCheckImplementation (HealthCheckImplementation (HealthCheckImplementation, _hciDefaultTest, _hciTestCodec))
-import Hasura.SQL.Tag (HasTag (backendTag), reify)
 
 newtype HealthCheckTestSql = HealthCheckTestSql
   { _hctSql :: Text
@@ -124,6 +122,3 @@ defaultRetryInterval = HealthCheckRetryInterval 10
 
 defaultTimeout :: HealthCheckTimeout
 defaultTimeout = HealthCheckTimeout 10
-
-codecNamePrefix :: forall b. (HasTag b) => Text
-codecNamePrefix = T.toTitle $ T.toTxt $ reify $ backendTag @b

server/src-lib/Hasura/RQL/Types/Metadata/Common.hs

@@ -156,9 +156,17 @@ deriving instance (Backend b) => Eq (ComputedFieldMetadata b)
 
 instance (Backend b) => Cacheable (ComputedFieldMetadata b)
 
+instance Backend b => HasCodec (ComputedFieldMetadata b) where
+  codec =
+    AC.object (codecNamePrefix @b <> "ComputedFieldMetadata") $
+      ComputedFieldMetadata
+        <$> requiredField' "name" AC..= _cfmName
+        <*> requiredFieldWith' "definition" placeholderCodecViaJSON AC..= _cfmDefinition
+        <*> optionalFieldWithOmittedDefault' "comment" Automatic AC..= _cfmComment
+
 instance (Backend b) => ToJSON (ComputedFieldMetadata b) where
   toJSON ComputedFieldMetadata {..} =
-    object
+    object $
       [ "name" .= _cfmName,
         "definition" .= _cfmDefinition,
         "comment" .= _cfmComment
@@ -284,9 +292,9 @@ instance (Backend b) => HasCodec (TableMetadata b) where
           <$> requiredFieldWith' "table" placeholderCodecViaJSON .== _tmTable
           <*> optionalFieldWithOmittedDefault' "is_enum" False .== _tmIsEnum
           <*> optionalFieldWithOmittedDefaultWith "configuration" placeholderCodecViaJSON emptyTableConfig configDoc .== _tmConfiguration
-          <*> optSortedListViaJSON "object_relationships" _rdName .== _tmObjectRelationships
-          <*> optSortedListViaJSON "array_relationships" _rdName .== _tmArrayRelationships
-          <*> optSortedListViaJSON "computed_fields" _cfmName .== _tmComputedFields
+          <*> optSortedList "object_relationships" _rdName .== _tmObjectRelationships
+          <*> optSortedList "array_relationships" _rdName .== _tmArrayRelationships
+          <*> optSortedList "computed_fields" _cfmName .== _tmComputedFields
           <*> optSortedListViaJSON "remote_relationships" _rrName .== _tmRemoteRelationships
           <*> optSortedList "insert_permissions" _pdRole .== _tmInsertPermissions
           <*> optSortedList "select_permissions" _pdRole .== _tmSelectPermissions
@@ -436,9 +444,9 @@ instance (Backend b) => HasCodec (FunctionMetadata b) where
       $ AC.object (codecNamePrefix @b <> "FunctionMetadata") $
         FunctionMetadata
           <$> requiredFieldWith "function" placeholderCodecViaJSON nameDoc .== _fmFunction
-          <*> optionalFieldOrNullWithOmittedDefaultWith "configuration" placeholderCodecViaJSON emptyFunctionConfig configDoc .== _fmConfiguration
-          <*> optionalFieldOrNullWithOmittedDefaultWith' "permissions" (listCodec placeholderCodecViaJSON) [] .== _fmPermissions
-          <*> optionalFieldOrNull' "comment" .== _fmComment
+          <*> optionalFieldWithOmittedDefaultWith "configuration" placeholderCodecViaJSON emptyFunctionConfig configDoc .== _fmConfiguration
+          <*> optionalFieldWithOmittedDefaultWith' "permissions" (listCodec placeholderCodecViaJSON) [] .== _fmPermissions
+          <*> optionalField' "comment" .== _fmComment
     where
       nameDoc = "Name of the SQL function"
       configDoc = "Configuration for the SQL function"
@@ -540,8 +548,8 @@ instance Backend b => HasCodec (SourceMetadata b) where
         <*> requiredFieldWith' "tables" (sortedElemsCodec _tmTable) .== _smTables
         <*> optionalFieldOrNullWithOmittedDefaultWith' "functions" (sortedElemsCodec _fmFunction) mempty .== _smFunctions
         <*> requiredField' "configuration" .== _smConfiguration
-        <*> optionalFieldOrNullWith' "query_tags" placeholderCodecViaJSON .== _smQueryTags -- TODO: replace placeholder
-        <*> optionalFieldOrNullWithOmittedDefault' "customization" emptySourceCustomization .== _smCustomization
+        <*> optionalFieldOrNull' "query_tags" .== _smQueryTags
+        <*> optionalFieldWithOmittedDefault' "customization" emptySourceCustomization .== _smCustomization
         <*> healthCheckField
     where
       healthCheckField = case healthCheckImplementation @b of

server/src-lib/Hasura/RQL/Types/Relationships/Local.hs

@@ -21,12 +21,17 @@ module Hasura.RQL.Types.Relationships.Local
   )
 where
 
+import Autodocodec (HasCodec (codec), dimapCodec, disjointEitherCodec, optionalField', requiredField')
+import Autodocodec qualified as AC
+import Autodocodec.Extended (optionalFieldOrIncludedNull')
 import Control.Lens (makeLenses)
 import Data.Aeson.KeyMap qualified as KM
 import Data.Aeson.TH
 import Data.Aeson.Types
 import Data.Text qualified as T
+import Data.Typeable (Typeable)
 import Hasura.Incremental (Cacheable)
+import Hasura.Metadata.DTO.Utils (codecNamePrefix, typeableName)
 import Hasura.Prelude
 import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.Common
@@ -41,6 +46,14 @@ data RelDef a = RelDef
 
 instance (Cacheable a) => Cacheable (RelDef a)
 
+instance (HasCodec a, Typeable a) => HasCodec (RelDef a) where
+  codec =
+    AC.object ("RelDef_" <> typeableName @a) $
+      RelDef
+        <$> requiredField' "name" AC..= _rdName
+        <*> requiredField' "using" AC..= _rdUsing
+        <*> optionalField' "comment" AC..= _rdComment
+
 $(deriveFromJSON hasuraJSON {omitNothingFields = True} ''RelDef)
 $(makeLenses ''RelDef)
 
@@ -67,6 +80,14 @@ deriving instance Backend b => Show (RelManualConfig b)
 
 instance (Backend b) => Cacheable (RelManualConfig b)
 
+instance (Backend b) => HasCodec (RelManualConfig b) where
+  codec =
+    AC.object (codecNamePrefix @b <> "RelManualConfig") $
+      RelManualConfig
+        <$> requiredField' "remote_table" AC..= rmTable
+        <*> requiredField' "column_mapping" AC..= rmColumns
+        <*> optionalFieldOrIncludedNull' "insertion_order" AC..= rmInsertOrder
+
 instance (Backend b) => FromJSON (RelManualConfig b) where
   parseJSON (Object v) =
     RelManualConfig
@@ -91,6 +112,21 @@ data RelUsing (b :: BackendType) a
 
 instance (Backend b, Cacheable a) => Cacheable (RelUsing b a)
 
+instance (Backend b, HasCodec a, Typeable a) => HasCodec (RelUsing b a) where
+  codec = dimapCodec dec enc $ disjointEitherCodec fkCodec manualCodec
+    where
+      fkCodec =
+        AC.object ("RUFKeyOn_" <> typeableName @a) $
+          requiredField' "foreign_key_constraint_on"
+
+      manualCodec =
+        AC.object (codecNamePrefix @b <> "RUManual") $
+          requiredField' "manual_configuration"
+
+      dec = either RUFKeyOn RUManual
+      enc (RUFKeyOn fkey) = Left fkey
+      enc (RUManual manual) = Right manual
+
 instance (Backend b, ToJSON a) => ToJSON (RelUsing b a) where
   toJSON (RUFKeyOn fkey) =
     object ["foreign_key_constraint_on" .= fkey]
@@ -157,6 +193,51 @@ deriving instance Backend b => Show (ObjRelUsingChoice b)
 
 instance (Backend b) => Cacheable (ObjRelUsingChoice b)
 
+instance (Backend b) => HasCodec (ObjRelUsingChoice b) where
+  codec = dimapCodec dec enc $ disjointEitherCodec sameTableCodec remoteTableCodec
+    where
+      sameTableCodec :: AC.JSONCodec (Either (Column b) (NonEmpty (Column b)))
+      sameTableCodec = disjointEitherCodec codec codec
+
+      remoteTableCodec :: AC.JSONCodec (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
+      remoteTableCodec =
+        singleOrMultipleRelColumnsCodec @b $
+          codecNamePrefix @b <> "ObjRelRemoteTable"
+
+      dec = \case
+        Left (Left col) -> SameTable $ pure col
+        Left (Right cols) -> SameTable $ cols
+        Right (Left (qt, col)) -> RemoteTable qt $ pure col
+        Right (Right (qt, cols)) -> RemoteTable qt $ cols
+
+      enc = \case
+        SameTable (col :| []) -> Left $ Left col
+        SameTable cols -> Left $ Right cols
+        RemoteTable qt (col :| []) -> Right $ Left (qt, col)
+        RemoteTable qt cols -> Right $ Right (qt, cols)
+
+singleOrMultipleRelColumnsCodec ::
+  forall b.
+  Backend b =>
+  Text ->
+  AC.JSONCodec
+    ( Either
+        (TableName b, Column b)
+        (TableName b, NonEmpty (Column b))
+    )
+singleOrMultipleRelColumnsCodec codecName =
+  disjointEitherCodec
+    ( AC.object (codecName <> "SingleColumn") $
+        (,)
+          <$> requiredField' "table" AC..= fst
+          <*> requiredField' "column" AC..= snd
+    )
+    ( AC.object (codecName <> "MultipleColumns") $
+        (,)
+          <$> requiredField' "table" AC..= fst
+          <*> requiredField' "columns" AC..= snd
+    )
+
 instance (Backend b) => ToJSON (ObjRelUsingChoice b) where
   toJSON = \case
     SameTable (col :| []) -> toJSON col
@@ -191,6 +272,21 @@ instance (Backend b) => FromJSON (ObjRelUsingChoice b) where
         v@(Array _) -> parseJSON v
         _ -> fail "Expected string or array"
 
+instance Backend b => HasCodec (ArrRelUsingFKeyOn b) where
+  codec =
+    dimapCodec dec enc $
+      singleOrMultipleRelColumnsCodec @b (codecNamePrefix @b <> "ArrRelUsingFKeyOn")
+    where
+      dec :: (Either (TableName b, Column b) (TableName b, NonEmpty (Column b))) -> ArrRelUsingFKeyOn b
+      dec = \case
+        Left (qt, col) -> ArrRelUsingFKeyOn qt (pure col)
+        Right (qt, cols) -> ArrRelUsingFKeyOn qt cols
+
+      enc :: ArrRelUsingFKeyOn b -> (Either (TableName b, Column b) (TableName b, NonEmpty (Column b)))
+      enc = \case
+        ArrRelUsingFKeyOn qt (col :| []) -> Left (qt, col)
+        ArrRelUsingFKeyOn qt cols -> Right (qt, cols)
+
 instance (Backend b) => ToJSON (ArrRelUsingFKeyOn b) where
   toJSON ArrRelUsingFKeyOn {arufTable = _arufTable, arufColumns = _arufColumns} =
     object $

server/src-test/Hasura/Metadata/DTO/MetadataDTOSpec.hs

@@ -12,7 +12,7 @@ import Data.Aeson
   )
 import Data.Aeson.QQ.Simple (aesonQQ)
 import Data.Aeson.Types (parseEither)
-import Data.Either (isLeft)
+import Data.Either (isLeft, isRight)
 import Data.Either.Combinators (fromRight')
 import Data.FileEmbed (makeRelativeToProject, strToExp)
 import Hasura.Metadata.DTO.Metadata (MetadataDTO (..))
@@ -23,6 +23,7 @@ import Hasura.Metadata.DTO.Placeholder (PlaceholderArray (PlaceholderArray))
 import Hasura.Prelude
 import Hasura.RQL.Types.Metadata (Metadata, metadataToDTO)
 import Test.Hspec
+import Test.Hspec.Expectations.Json (shouldBeJson)
 
 spec :: Spec
 spec = describe "MetadataDTO" $ do
@@ -70,22 +71,19 @@ spec = describe "MetadataDTO" $ do
       let actual = eitherDecode input :: Either String MetadataDTO
       actual `shouldSatisfy` isLeft
 
-  beforeAll getMetadataFixture $ do
-    describe "v3" $ do
-      -- TODO: There are some cases where DTO serialization emits @null@ where
-      -- Metadata serialization omits the field instead. So this test doesn't
-      -- quite pass yet. This is expected to be re-enabled in an upcoming PR.
-      -- it "deserializes and re-serializes equivalently to Metadata" $ \(MetadataFixture {..}) -> do
-      --   let dto = parseEither (parseJSON @MetadataDTO) _mfJSON
-      --   let fromDto = toJSON <$> dto
-      --   fromDto `shouldSatisfy` isRight
-      --   (fromRight' fromDto) `shouldBeJson` _mfJSON
+    beforeAll getMetadataFixture $ do
+      describe "v3" $ do
+        it "deserializes and re-serializes equivalently to Metadata" $ \(MetadataFixture {..}) -> do
+          let dto = parseEither (parseJSON @MetadataDTO) _mfJSON
+          let fromDto = toJSON <$> dto
+          fromDto `shouldSatisfy` isRight
+          (fromRight' fromDto) `shouldBeJson` _mfJSON
 
-      it "converts metadata to DTO to JSON to metadata" $ \(MetadataFixture {..}) -> do
-        let dto = metadataToDTO $ _mfMetadata
-        let json = toJSON dto
-        let metadata = parseEither (parseJSON @Metadata) json
-        metadata `shouldBe` (Right _mfMetadata)
+        it "converts metadata to DTO to JSON to metadata" $ \(MetadataFixture {..}) -> do
+          let dto = metadataToDTO $ _mfMetadata
+          let json = toJSON dto
+          let metadata = parseEither (parseJSON @Metadata) json
+          metadata `shouldBe` (Right _mfMetadata)
 
 emptyMetadataV3 :: MetadataV3
 emptyMetadataV3 =