server: codecs for postgres connection configuration types

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5722
GitOrigin-RevId: 85de9a550229d3ac3304ec46fed81e97f2a150f6

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

@@ -29,7 +29,8 @@ module Hasura.Backends.Postgres.Connection.Settings
   )
 where
 
-import Autodocodec (HasCodec (codec), named)
+import Autodocodec hiding (object, (.=))
+import Autodocodec qualified as AC
 import Control.Lens (makeLenses)
 import Data.Aeson
 import Data.Aeson.Casing (aesonDrop)
@@ -38,6 +39,7 @@ import Data.Bifoldable
 import Data.Bifunctor
 import Data.Bitraversable
 import Data.Char (toLower)
+import Data.List.NonEmpty qualified as NonEmpty
 import Data.Semigroup (Max (..))
 import Data.Text (unpack)
 import Data.Text qualified as T
@@ -69,6 +71,30 @@ instance Hashable PostgresPoolSettings
 
 instance NFData PostgresPoolSettings
 
+instance HasCodec PostgresPoolSettings where
+  codec =
+    CommentCodec "https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgpoolsettings" $
+      AC.object "PostgresPoolSettings" $
+        PostgresPoolSettings
+          <$> optionalFieldOrNull "max_connections" maxConnectionsDoc .== _ppsMaxConnections
+          <*> optionalFieldOrNull "idle_timeout" idleTimeoutDoc .== _ppsIdleTimeout
+          <*> optionalFieldOrNull "retries" retriesDoc .== _ppsRetries
+          <*> optionalFieldOrNull "pool_timeout" poolTimeoutDoc .== _ppsPoolTimeout
+          <*> parseConnLifeTime `rmapCodec` optionalFieldOrNull "connection_lifetime" connectionLifetimeDoc .== _ppsConnectionLifetime
+    where
+      maxConnectionsDoc = "Maximum number of connections to be kept in the pool (default: 50)"
+      idleTimeoutDoc = "The idle timeout (in seconds) per connection (default: 180)"
+      retriesDoc = "Number of retries to perform (default: 1)"
+      poolTimeoutDoc = "Maximum time to wait while acquiring a Postgres connection from the pool, in seconds (default: forever)"
+      connectionLifetimeDoc =
+        T.unwords
+          [ "Time from connection creation after which the connection should be",
+            "destroyed and a new one created. A value of 0 indicates we should",
+            "never destroy an active connection. If 0 is passed, memory from large",
+            "query results may not be reclaimed. (default: 600 sec)"
+          ]
+      (.==) = (AC..=)
+
 $(deriveToJSON hasuraJSON {omitNothingFields = True} ''PostgresPoolSettings)
 
 instance FromJSON PostgresPoolSettings where
@@ -147,6 +173,13 @@ instance Show SSLMode where
 
 deriving via (Max SSLMode) instance Semigroup SSLMode
 
+instance HasCodec SSLMode where
+  codec =
+    named "SSLMode" $
+      stringConstCodec $
+        NonEmpty.fromList $
+          (\m -> (m, tshow m)) <$> [minBound ..]
+
 instance FromJSON SSLMode where
   parseJSON = withText "SSLMode" $ \case
     "disable" -> pure Disable
@@ -167,6 +200,13 @@ instance Hashable CertVar
 
 instance NFData CertVar
 
+instance HasCodec CertVar where
+  codec =
+    AC.object "CertVar" $ CertVar <$> requiredField' "from_env" .== unCertVar
+    where
+      unCertVar (CertVar t) = t
+      (.==) = (AC..=)
+
 instance ToJSON CertVar where
   toJSON (CertVar var) = (object ["from_env" .= var])
 
@@ -176,6 +216,9 @@ instance FromJSON CertVar where
 newtype CertData = CertData {unCert :: Text}
   deriving (Show, Eq, Generic)
 
+instance HasCodec CertData where
+  codec = dimapCodec CertData unCert textCodec
+
 instance ToJSON CertData where
   toJSON = String . unCert
 
@@ -188,6 +231,24 @@ data PGClientCerts p a = PGClientCerts
   }
   deriving (Show, Eq, Generic, Functor, Foldable, Traversable)
 
+instance (HasCodec p, HasCodec a) => HasCodec (PGClientCerts p a) where
+  codec =
+    CommentCodec "https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgcertsettings" $
+      AC.object "PGClientCerts" $
+        PGClientCerts
+          <$> optionalFieldOrNull "sslcert" sslcertDoc .== pgcSslCert
+          <*> optionalFieldOrNull "sslkey" sslkeyDoc .== pgcSslKey
+          <*> optionalFieldOrNull "sslrootcert" sslrootcertDoc .== pgcSslRootCert
+          <*> requiredField "sslmode" sslmodeDoc .== pgcSslMode
+          <*> optionalFieldOrNull "sslpassword" sslpasswordDoc .== pgcSslPassword
+    where
+      sslcertDoc = "Environment variable which stores the client certificate."
+      sslkeyDoc = "Environment variable which stores the client private key."
+      sslrootcertDoc = "Environment variable which stores trusted certificate authorities."
+      sslmodeDoc = "The SSL connection mode. See the libpq ssl support docs <https://www.postgresql.org/docs/9.1/libpq-ssl.html> for more details."
+      sslpasswordDoc = "Password in the case where the sslkey is encrypted."
+      (.==) = (AC..=)
+
 $(deriveFromJSON (aesonDrop 3 (fmap toLower)) ''PGClientCerts)
 $(deriveToJSON (aesonDrop 3 (fmap toLower)) {omitNothingFields = True} ''PGClientCerts)
 
@@ -228,6 +289,16 @@ instance NFData Q.TxIsolation
 
 instance Hashable Q.TxIsolation
 
+instance HasCodec Q.TxIsolation where
+  codec =
+    named "TxIsolation" $
+      stringConstCodec $
+        NonEmpty.fromList $
+          [ (Q.ReadCommitted, "read-committed"),
+            (Q.RepeatableRead, "repeatable-read"),
+            (Q.Serializable, "serializable")
+          ]
+
 instance FromJSON Q.TxIsolation where
   parseJSON = withText "Q.TxIsolation" $ \t ->
     onLeft (readIsoLevel $ T.unpack t) fail
@@ -252,6 +323,33 @@ instance Hashable PostgresSourceConnInfo
 
 instance NFData PostgresSourceConnInfo
 
+instance HasCodec PostgresSourceConnInfo where
+  codec =
+    CommentCodec "https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgsourceconnectioninfo" $
+      AC.object "PostgresSourceConnInfo" $
+        PostgresSourceConnInfo
+          <$> requiredFieldWith "database_url" placeholderCodecViaJSON databaseUrlDoc .== _psciDatabaseUrl
+          <*> optionalFieldOrNull "pool_settings" poolSettingsDoc .== _psciPoolSettings
+          <*> optionalFieldWithOmittedDefault "use_prepared_statements" False usePreparedStatementsDoc .== _psciUsePreparedStatements
+          <*> optionalFieldWithOmittedDefault "isolation_level" Q.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."
+      poolSettingsDoc = "Connection pool settings"
+      usePreparedStatementsDoc =
+        T.unwords
+          [ "If set to true the server prepares statement before executing on the",
+            "source database (default: false). For more details, refer to the",
+            "Postgres docs"
+          ]
+      isolationLevelDoc =
+        T.unwords
+          [ "The transaction isolation level in which the queries made to the",
+            "source will be run with (default: read-committed)."
+          ]
+      sslConfigurationDoc = "The client SSL certificate settings for the database (Only available in Cloud)."
+      (.==) = (AC..=)
+
 $(deriveToJSON hasuraJSON {omitNothingFields = True} ''PostgresSourceConnInfo)
 $(makeLenses ''PostgresSourceConnInfo)
 
@@ -295,6 +393,17 @@ instance ToJSON PostgresConnConfiguration where
         <> bool mempty (["extensions_schema" .= _pccExtensionsSchema]) (_pccExtensionsSchema /= defaultPostgresExtensionsSchema)
 
 instance HasCodec PostgresConnConfiguration where
-  codec = named "PostgresConnConfiguration" $ placeholderCodecViaJSON
+  codec =
+    CommentCodec "https://hasura.io/docs/latest/graphql/core/api-reference/syntax-defs.html#pgconfiguration" $
+      AC.object "PostgresConnConfiguration" $
+        PostgresConnConfiguration
+          <$> requiredField "connection_info" connectionInfoDoc .== _pccConnectionInfo
+          <*> optionalFieldOrNull "read_replicas" readReplicasDoc .== _pccReadReplicas
+          <*> optionalFieldWithOmittedDefault "extensions_schema" defaultPostgresExtensionsSchema extensionsSchemaDoc .== _pccExtensionsSchema
+    where
+      connectionInfoDoc = "Connection parameters for the source"
+      readReplicasDoc = "Optional list of read replica configuration (supported only in cloud/enterprise versions)"
+      extensionsSchemaDoc = "Name of the schema where the graphql-engine will install database extensions (default: public)"
+      (.==) = (AC..=)
 
 $(makeLenses ''PostgresConnConfiguration)

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

@@ -7,9 +7,12 @@ module Hasura.RQL.Types.QueryTags
   )
 where
 
+import Autodocodec (HasCodec (codec), named, optionalFieldWithDefault', stringConstCodec)
+import Autodocodec qualified as AC
 import Data.Aeson
 import Data.Aeson.Casing qualified as J
 import Data.Aeson.TH qualified as J
+import Data.List.NonEmpty qualified as NonEmpty
 import Data.Text qualified as T
 import Hasura.Incremental (Cacheable (..))
 import Hasura.Prelude
@@ -39,6 +42,18 @@ instance FromJSON QueryTagsFormat where
     where
       errMsg = "Not a valid query tags format value. Use either standard or sqlcommenter"
 
+-- TODO: Replace JSON instances with versions derived from this codec. We'll
+-- need to support case-insenitivity on input to make that change without
+-- affecting the API.
+instance HasCodec QueryTagsFormat where
+  codec =
+    named "QueryTagsFormat" $
+      stringConstCodec $
+        NonEmpty.fromList $
+          [ (Standard, "standard"),
+            (SQLCommenter, "sqlcommenter")
+          ]
+
 -- | QueryTagsConfig is the configuration created by the users to control query tags
 --
 -- This config let's hasura know about the followingL
@@ -82,5 +97,14 @@ instance FromJSON QueryTagsConfig where
       <$> o .:? "disabled" .!= False
       <*> o .:? "format" .!= Standard
 
+instance HasCodec QueryTagsConfig where
+  codec =
+    AC.object "QueryTagsConfig" $
+      QueryTagsConfig
+        <$> optionalFieldWithDefault' "disabled" False .== _qtcDisabled
+        <*> optionalFieldWithDefault' "format" Standard .== _qtcFormat
+    where
+      (.==) = (AC..=)
+
 defaultQueryTagsConfig :: QueryTagsConfig
 defaultQueryTagsConfig = QueryTagsConfig False Standard