server: Avoid partial fields wherever possible.

This turns on the `partial-fields` warning, which yells at you if you try and create fields on sum types that end up being partial functions. These are dangerous; we had a bug because we introduced a new case to a data type, making the field accessors partial, and leading to a crash in certain cases.

This means that we have introduced a few wrappers in various places where the field names are useful, but we want to avoid partial matches.

Unfortunately this can be turned off by prefixing the field name with an underscore. Ideally we would try and avoid exporting any field names with underscores, but lenses make this hard. I have removed some underscores for the areas in which we've seen this break in the past.

We will have to be vigilant.

[NDAT-794]: https://hasurahq.atlassian.net/browse/NDAT-794?atlOrigin=eyJpIjoiNWRkNTljNzYxNjVmNDY3MDlhMDU5Y2ZhYzA5YTRkZjUiLCJwIjoiZ2l0aHViLWNvbS1KU1cifQ

PR-URL: hasura/graphql-engine-mono#9991
GitOrigin-RevId: fd69b1ef999682969f3507f0e97513f983da4da6

server/graphql-engine.cabal

@@ -179,7 +179,6 @@ common common-all
     -Wno-implicit-lift
     -Wno-identities
     -Wno-operator-whitespace
-    -Wno-partial-fields
     -Wno-redundant-bang-patterns
     -Wno-unused-type-patterns
 

server/src-exec/Main.hs

@@ -68,12 +68,12 @@ runApp env (HGEOptions rci metadataDbUrl hgeCmd) = do
     HCServe serveOptions@ServeOptions {..} -> do
       let poolSettings =
             PostgresPoolSettings
-              { _ppsMaxConnections = Just $ PG.cpConns soConnParams,
-                _ppsTotalMaxConnections = Nothing,
-                _ppsIdleTimeout = Just $ PG.cpIdleTime soConnParams,
-                _ppsRetries = _pciRetries rci <|> Just 1,
-                _ppsPoolTimeout = PG.cpTimeout soConnParams,
-                _ppsConnectionLifetime = PG.cpMbLifetime soConnParams
+              { ppsMaxConnections = Just $ PG.cpConns soConnParams,
+                ppsTotalMaxConnections = Nothing,
+                ppsIdleTimeout = Just $ PG.cpIdleTime soConnParams,
+                ppsRetries = _pciRetries rci <|> Just 1,
+                ppsPoolTimeout = PG.cpTimeout soConnParams,
+                ppsConnectionLifetime = PG.cpMbLifetime soConnParams
               }
       basicConnectionInfo <-
         initBasicConnectionInfo
@@ -130,7 +130,7 @@ runApp env (HGEOptions rci metadataDbUrl hgeCmd) = do
       let cleanSuccessMsg = "successfully cleaned graphql-engine related data"
       either (throwErrJExit MetadataCleanError) (const $ liftIO $ putStrLn cleanSuccessMsg) res
     HCDowngrade opts -> do
-      let poolSettings = setPostgresPoolSettings {_ppsRetries = _pciRetries rci <|> Just 1}
+      let poolSettings = setPostgresPoolSettings {ppsRetries = _pciRetries rci <|> Just 1}
       BasicConnectionInfo {..} <- initBasicConnectionInfo env metadataDbUrl rci (Just poolSettings) False PG.ReadCommitted
       res <- runTxWithMinimalPool bciMetadataConnInfo $ downgradeCatalog bciDefaultPostgres opts initTime
       either (throwErrJExit DowngradeProcessError) (liftIO . print) res

server/src-lib/Database/MSSQL/Pool.hs

@@ -4,6 +4,7 @@ module Database.MSSQL.Pool
     ConnectionString (..),
     ConnectionOptions (..),
     MSSQLPool (..),
+    PoolOptions (..),
 
     -- * Functions
     initMSSQLPool,
@@ -31,14 +32,17 @@ instance HasCodec ConnectionString where
   codec = dimapCodec ConnectionString unConnectionString codec
 
 data ConnectionOptions
-  = ConnectionOptions
-      { _coConnections :: Int,
-        _coStripes :: Int,
-        _coIdleTime :: Int
-      }
+  = ConnectionOptionsPool PoolOptions
   | ConnectionOptionsNoPool
   deriving (Show, Eq)
 
+data PoolOptions = PoolOptions
+  { poConnections :: Int,
+    poStripes :: Int,
+    poIdleTime :: Int
+  }
+  deriving (Show, Eq)
+
 -- | ODBC connection pool
 data MSSQLPool
   = MSSQLPool (Pool.Pool ODBC.Connection)
@@ -51,14 +55,14 @@ initMSSQLPool ::
   IO MSSQLPool
 initMSSQLPool (ConnectionString connString) ConnectionOptionsNoPool = do
   return $ MSSQLNoPool (ODBC.connect connString)
-initMSSQLPool (ConnectionString connString) ConnectionOptions {..} = do
+initMSSQLPool (ConnectionString connString) (ConnectionOptionsPool PoolOptions {..}) = do
   MSSQLPool
     <$> Pool.createPool
       (ODBC.connect connString)
       ODBC.close
-      _coStripes
-      (fromIntegral _coIdleTime)
-      _coConnections
+      poStripes
+      (fromIntegral poIdleTime)
+      poConnections
 
 -- | Destroy all pool resources
 drainMSSQLPool :: MSSQLPool -> IO ()

server/src-lib/Hasura/App.hs

@@ -321,18 +321,18 @@ initBasicConnectionInfo
           }
       mkSourceConfig srcURL =
         PostgresConnConfiguration
-          { _pccConnectionInfo =
+          { pccConnectionInfo =
               PostgresSourceConnInfo
-                { _psciDatabaseUrl = srcURL,
-                  _psciPoolSettings = poolSettings,
-                  _psciUsePreparedStatements = usePreparedStatements,
-                  _psciIsolationLevel = isolationLevel,
-                  _psciSslConfiguration = Nothing
+                { psciDatabaseUrl = srcURL,
+                  psciPoolSettings = poolSettings,
+                  psciUsePreparedStatements = usePreparedStatements,
+                  psciIsolationLevel = isolationLevel,
+                  psciSslConfiguration = Nothing
                 },
-            _pccReadReplicas = Nothing,
-            _pccExtensionsSchema = defaultPostgresExtensionsSchema,
-            _pccConnectionTemplate = Nothing,
-            _pccConnectionSet = mempty
+            pccReadReplicas = Nothing,
+            pccExtensionsSchema = defaultPostgresExtensionsSchema,
+            pccConnectionTemplate = Nothing,
+            pccConnectionSet = mempty
           }
 
 -- | Creates a 'PG.ConnInfo' from a 'UrlConf' parameter.
@@ -1449,7 +1449,7 @@ telemetryNotice =
 
 mkPgSourceResolver :: PG.PGLogger -> SourceResolver ('Postgres 'Vanilla)
 mkPgSourceResolver pgLogger env sourceName config = runExceptT do
-  let PostgresSourceConnInfo urlConf poolSettings allowPrepare isoLevel _ = _pccConnectionInfo config
+  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
@@ -1459,24 +1459,25 @@ mkPgSourceResolver pgLogger env sourceName config = runExceptT do
           { PG.cpIdleTime = idleTimeout,
             PG.cpConns = maxConns,
             PG.cpAllowPrepare = allowPrepare,
-            PG.cpMbLifetime = _ppsConnectionLifetime =<< poolSettings,
-            PG.cpTimeout = _ppsPoolTimeout =<< poolSettings
+            PG.cpMbLifetime = ppsConnectionLifetime =<< poolSettings,
+            PG.cpTimeout = ppsPoolTimeout =<< poolSettings
           }
   let context = J.object [("source" J..= sourceName)]
   pgPool <- liftIO $ Q.initPGPool connInfo context connParams pgLogger
   let pgExecCtx = mkPGExecCtx isoLevel pgPool NeverResizePool
-  pure $ PGSourceConfig pgExecCtx connInfo Nothing mempty (_pccExtensionsSchema config) mempty ConnTemplate_NotApplicable
+  pure $ PGSourceConfig pgExecCtx connInfo Nothing mempty (pccExtensionsSchema config) mempty ConnTemplate_NotApplicable
 
-mkMSSQLSourceResolver :: SourceResolver ('MSSQL)
+mkMSSQLSourceResolver :: SourceResolver 'MSSQL
 mkMSSQLSourceResolver env _name (MSSQLConnConfiguration connInfo _) = runExceptT do
   let MSSQLConnectionInfo iConnString poolSettings isolationLevel = connInfo
       connOptions = case poolSettings of
-        MSSQLPoolSettings {..} ->
-          MSPool.ConnectionOptions
-            { _coConnections = fromMaybe defaultMSSQLMaxConnections _mpsMaxConnections,
-              _coStripes = 1,
-              _coIdleTime = _mpsIdleTimeout
-            }
+        MSSQLPoolSettingsPool (MSSQLPoolConnectionSettings {..}) ->
+          MSPool.ConnectionOptionsPool
+            $ MSPool.PoolOptions
+              { poConnections = fromMaybe defaultMSSQLMaxConnections mpsMaxConnections,
+                poStripes = 1,
+                poIdleTime = mpsIdleTimeout
+              }
         MSSQLPoolSettingsNoPool -> MSPool.ConnectionOptionsNoPool
   (connString, mssqlPool) <- createMSSQLPool iConnString connOptions env
   let mssqlExecCtx = mkMSSQLExecCtx isolationLevel mssqlPool NeverResizePool

server/src-lib/Hasura/Backends/MSSQL/Connection.hs

@@ -10,6 +10,7 @@ module Hasura.Backends.MSSQL.Connection
     MSSQLSourceConfig (MSSQLSourceConfig, _mscExecCtx, _mscReadReplicas),
     MSSQLConnectionInfo (..),
     MSSQLPoolSettings (..),
+    MSSQLPoolConnectionSettings (..),
     MSSQLExecCtx (..),
     MonadMSSQLTx (..),
     defaultMSSQLMaxConnections,
@@ -99,12 +100,19 @@ instance FromJSON InputConnectionString where
       s@(String _) -> RawString <$> parseJSON s
       _ -> fail "one of string or object must be provided"
 
+data MSSQLPoolConnectionSettings = MSSQLPoolConnectionSettings
+  { mpsMaxConnections :: Maybe Int,
+    mpsTotalMaxConnections :: Maybe Int,
+    mpsIdleTimeout :: Int
+  }
+  deriving (Show, Eq, Generic)
+
+instance Hashable MSSQLPoolConnectionSettings
+
+instance NFData MSSQLPoolConnectionSettings
+
 data MSSQLPoolSettings
-  = MSSQLPoolSettings
-      { _mpsMaxConnections :: Maybe Int,
-        _mpsTotalMaxConnections :: Maybe Int,
-        _mpsIdleTimeout :: Int
-      }
+  = MSSQLPoolSettingsPool MSSQLPoolConnectionSettings
   | MSSQLPoolSettingsNoPool
   deriving (Show, Eq, Generic)
 
@@ -123,7 +131,7 @@ instance HasCodec MSSQLPoolSettings where
       toInput :: MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
       toInput = \case
         p@MSSQLPoolSettingsNoPool {} -> Left p
-        p@MSSQLPoolSettings {} -> Right p
+        p@MSSQLPoolSettingsPool {} -> Right p
 
       codecNoPool :: AC.JSONCodec MSSQLPoolSettings
       codecNoPool =
@@ -142,30 +150,37 @@ instance HasCodec MSSQLPoolSettings where
 
       codecWithPool :: AC.JSONCodec MSSQLPoolSettings
       codecWithPool =
-        AC.object "MSSQLPoolSettings"
-          $ MSSQLPoolSettings
-          <$> optionalFieldWithDefault' "max_connections" (Just defaultMSSQLMaxConnections)
-          AC..= _mpsMaxConnections
-            <*> optionalFieldOrNull' "total_max_connections"
-          AC..= _mpsTotalMaxConnections
-            <*> optionalFieldWithDefault' "idle_timeout" (_mpsIdleTimeout defaultMSSQLPoolSettings)
-          AC..= _mpsIdleTimeout
+        AC.dimapCodec MSSQLPoolSettingsPool (\case MSSQLPoolSettingsPool p -> p; MSSQLPoolSettingsNoPool -> error "unexpected MSSQLPoolSettingsNoPool")
+          $ AC.object
+            "MSSQLPoolSettings"
+            ( MSSQLPoolConnectionSettings
+                <$> optionalFieldWithDefault' "max_connections" (Just defaultMSSQLMaxConnections)
+                AC..= mpsMaxConnections
+                  <*> optionalFieldOrNull' "total_max_connections"
+                AC..= mpsTotalMaxConnections
+                  <*> optionalFieldWithDefault' "idle_timeout" defaultMSSQLIdleTimeout
+                AC..= mpsIdleTimeout
+            )
 
 defaultMSSQLMaxConnections :: Int
 defaultMSSQLMaxConnections = 50
 
+defaultMSSQLIdleTimeout :: Int
+defaultMSSQLIdleTimeout = 5
+
 defaultMSSQLPoolSettings :: MSSQLPoolSettings
 defaultMSSQLPoolSettings =
-  MSSQLPoolSettings
-    { _mpsMaxConnections = Nothing,
-      _mpsTotalMaxConnections = Nothing,
-      _mpsIdleTimeout = 5
-    }
+  MSSQLPoolSettingsPool
+    $ MSSQLPoolConnectionSettings
+      { mpsMaxConnections = Nothing,
+        mpsTotalMaxConnections = Nothing,
+        mpsIdleTimeout = defaultMSSQLIdleTimeout
+      }
 
 data MSSQLConnectionInfo = MSSQLConnectionInfo
-  { _mciConnectionString :: InputConnectionString,
-    _mciPoolSettings :: MSSQLPoolSettings,
-    _mciIsolationLevel :: MSTx.TxIsolation
+  { mciConnectionString :: InputConnectionString,
+    mciPoolSettings :: MSSQLPoolSettings,
+    mciIsolationLevel :: MSTx.TxIsolation
   }
   deriving (Show, Eq, Generic)
 
@@ -178,11 +193,11 @@ instance HasCodec MSSQLConnectionInfo where
     AC.object "MSSQLConnectionInfo"
       $ MSSQLConnectionInfo
       <$> requiredField' "connection_string"
-      AC..= _mciConnectionString
+      AC..= mciConnectionString
         <*> requiredField' "pool_settings"
-      AC..= _mciPoolSettings
+      AC..= mciPoolSettings
         <*> AC.optionalFieldWithDefault "isolation_level" MSTx.ReadCommitted isolationLevelDoc
-      AC..= _mciIsolationLevel
+      AC..= mciIsolationLevel
     where
       isolationLevelDoc =
         T.unwords
@@ -206,8 +221,8 @@ instance FromJSON MSSQLConnectionInfo where
       .!= MSTx.ReadCommitted
 
 data MSSQLConnConfiguration = MSSQLConnConfiguration
-  { _mccConnectionInfo :: MSSQLConnectionInfo,
-    _mccReadReplicas :: Maybe (NonEmpty MSSQLConnectionInfo)
+  { mccConnectionInfo :: MSSQLConnectionInfo,
+    mccReadReplicas :: Maybe (NonEmpty MSSQLConnectionInfo)
   }
   deriving (Show, Eq, Generic)
 
@@ -220,9 +235,9 @@ instance HasCodec MSSQLConnConfiguration where
     AC.object "MSSQLConnConfiguration"
       $ MSSQLConnConfiguration
       <$> requiredField' "connection_info"
-      AC..= _mccConnectionInfo
+      AC..= mccConnectionInfo
         <*> optionalFieldOrNull' "read_replicas"
-      AC..= _mccReadReplicas
+      AC..= mccReadReplicas
 
 instance FromJSON MSSQLConnConfiguration where
   parseJSON = genericParseJSON hasuraJSON {omitNothingFields = True}

server/src-lib/Hasura/Backends/MSSQL/FromIr/Query.hs

@@ -382,13 +382,13 @@ fromStoredProcedure storedProcedure = do
           <$> InsOrdHashMap.toList (columnsFromFields $ lmFields storedProcedureReturnType)
 
   -- \| add create temp table to "the environment"
-  tellBefore (CreateTemp (TempTableName rawTempTableName) columns)
+  tellBefore (TempTableCreate (TempTableName rawTempTableName) columns)
 
   -- \| add insert into temp table
-  tellBefore (InsertTemp declares (TempTableName rawTempTableName) sql)
+  tellBefore (TempTableInsert (TempTableName rawTempTableName) declares sql)
 
   -- \| when we're done, drop the temp table
-  tellAfter (DropTemp (TempTableName rawTempTableName))
+  tellAfter (TempTableDrop (TempTableName rawTempTableName))
 
   pure $ TSQL.FromTempTable aliasedTempTableName
 

server/src-lib/Hasura/Backends/MSSQL/ToQuery.hs

@@ -440,7 +440,7 @@ fromUpdateSet setColumns =
 
 fromTempTableDDL :: TempTableDDL -> Printer
 fromTempTableDDL = \case
-  CreateTemp tempTableName tempColumns ->
+  TempTableCreate tempTableName tempColumns ->
     "CREATE TABLE "
       <+> fromTempTableName tempTableName
       <+> " ( "
@@ -456,7 +456,7 @@ fromTempTableDDL = \case
           <+> " "
           <+> fromString (T.unpack (scalarTypeDBName DataLengthMax ty))
           <+> " null"
-  InsertTemp declares tempTableName interpolatedQuery ->
+  TempTableInsert tempTableName declares interpolatedQuery ->
     SepByPrinter
       NewlinePrinter
       ( map fromDeclare declares
@@ -466,7 +466,7 @@ fromTempTableDDL = \case
                  <+> renderInterpolatedQuery interpolatedQuery
              ]
       )
-  DropTemp tempTableName ->
+  TempTableDrop tempTableName ->
     "DROP TABLE "
       <+> fromTempTableName tempTableName
 

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

@@ -397,19 +397,11 @@ data CTEBody
 -- query to do things like setup temp tables
 data TempTableDDL
   = -- | create a temp table
-    CreateTemp
-      { stcTempTableName :: TempTableName,
-        stcColumns :: [UnifiedColumn]
-      }
+    TempTableCreate TempTableName [UnifiedColumn]
   | -- | insert output of a statement into a temp table
-    InsertTemp
-      { stiDeclares :: [Declare],
-        stiTempTableName :: TempTableName,
-        stiExpression :: InterpolatedQuery Expression
-      }
+    TempTableInsert TempTableName [Declare] (InterpolatedQuery Expression)
   | -- | Drop a temp table
-    DropTemp
-      {stdTempTableName :: TempTableName}
+    TempTableDrop TempTableName
 
 data Declare = Declare
   { dName :: Text,

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

@@ -18,7 +18,7 @@ import Hasura.RQL.Types.Common (SourceName, resolveUrlConf)
 -- | Connect to a postgres database and run a transaction.
 withPostgresDB :: Env.Environment -> SourceName -> PG.PostgresConnConfiguration -> PG.TxET QErr IO a -> IO (Either QErr a)
 withPostgresDB env sourceName PG.PostgresConnConfiguration {..} tx = do
-  generateMinimalPool _pccConnectionInfo >>= \case
+  generateMinimalPool pccConnectionInfo >>= \case
     Left err ->
       -- Cannot able to intialise a pool due to a bad connection config.
       pure $ Left err
@@ -29,7 +29,7 @@ withPostgresDB env sourceName PG.PostgresConnConfiguration {..} tx = do
 
     generateMinimalPool :: PG.PostgresSourceConnInfo -> IO (Either QErr PG.PGPool)
     generateMinimalPool PG.PostgresSourceConnInfo {..} = runExceptT do
-      urlText <- resolveUrlConf env _psciDatabaseUrl
+      urlText <- resolveUrlConf env psciDatabaseUrl
       let connInfo = PG.ConnInfo 0 $ PG.CDDatabaseURI $ txtToBs urlText
           -- Create pool with only one connection
           connParams = PG.defaultConnParams {PG.cpConns = 1}