server: refactor MaintenanceMode datatype

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/4298
GitOrigin-RevId: 0b88d040bd4b24c61c4ae91e18dc6edf67b3672e

server/src-lib/Hasura/Backends/MSSQL/DDL/EventTrigger.hs

@@ -56,7 +56,7 @@ fetchUndeliveredEvents ::
   MSSQLSourceConfig ->
   SourceName ->
   [TriggerName] ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   FetchBatchSize ->
   m [Event 'MSSQL]
 fetchUndeliveredEvents sourceConfig sourceName triggerNames _ fetchBatchSize = do
@@ -70,7 +70,7 @@ setRetry ::
   MSSQLSourceConfig ->
   Event 'MSSQL ->
   UTCTime ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m ()
 setRetry sourceConfig event retryTime maintenanceModeVersion = do
   liftEitherM $
@@ -110,7 +110,7 @@ recordSuccess ::
   MSSQLSourceConfig ->
   Event 'MSSQL ->
   Invocation 'EventType ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordSuccess sourceConfig event invocation maintenanceModeVersion =
   liftIO $
@@ -124,7 +124,7 @@ recordError ::
   Event 'MSSQL ->
   Invocation 'EventType ->
   ProcessEventError ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordError sourceConfig event invocation processEventError maintenanceModeVersion =
   recordError' sourceConfig event (Just invocation) processEventError maintenanceModeVersion
@@ -135,12 +135,12 @@ recordError' ::
   Event 'MSSQL ->
   Maybe (Invocation 'EventType) ->
   ProcessEventError ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordError' sourceConfig event invocation processEventError maintenanceModeVersion =
   liftIO $
     runMSSQLSourceWriteTx sourceConfig $ do
-      onJust invocation (\inv -> insertInvocation inv)
+      onJust invocation insertInvocation
       case processEventError of
         PESetRetry retryTime -> do
           setRetryTx event retryTime maintenanceModeVersion
@@ -258,11 +258,11 @@ insertMSSQLManualEventTx (TableName tableName (SchemaName schemaName)) triggerNa
     triggerNameTxt = triggerNameToTxt triggerName
     payload = J.encode rowData
 
-setSuccessTx :: Event 'MSSQL -> Maybe MaintenanceModeVersion -> TxE QErr ()
+setSuccessTx :: Event 'MSSQL -> MaintenanceMode MaintenanceModeVersion -> TxE QErr ()
 setSuccessTx event = \case
-  Just PreviousMMVersion -> throw500 "unexpected: no previous maintenance mode version found for MSSQL source"
-  Just CurrentMMVersion -> latestVersionSetSuccess
-  Nothing -> latestVersionSetSuccess
+  (MaintenanceModeEnabled PreviousMMVersion) -> throw500 "unexpected: no previous maintenance mode version found for MSSQL source"
+  (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetSuccess
+  MaintenanceModeDisabled -> latestVersionSetSuccess
   where
     eventId = unEventId $ eId event
 
@@ -275,11 +275,11 @@ setSuccessTx event = \case
           WHERE id = $eventId
         |]
 
-setErrorTx :: Event 'MSSQL -> Maybe MaintenanceModeVersion -> TxE QErr ()
+setErrorTx :: Event 'MSSQL -> MaintenanceMode MaintenanceModeVersion -> TxE QErr ()
 setErrorTx event = \case
-  Just PreviousMMVersion -> throw500 "unexpected: there is no previous maintenance mode version supported for MSSQL event triggers"
-  Just CurrentMMVersion -> latestVersionSetSuccess
-  Nothing -> latestVersionSetSuccess
+  (MaintenanceModeEnabled PreviousMMVersion) -> throw500 "unexpected: there is no previous maintenance mode version supported for MSSQL event triggers"
+  (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetSuccess
+  MaintenanceModeDisabled -> latestVersionSetSuccess
   where
     eventId = unEventId $ eId event
 
@@ -293,13 +293,13 @@ setErrorTx event = \case
         |]
 
 -- See Note [UTCTIME not supported in SQL Server]
-setRetryTx :: Event 'MSSQL -> UTCTime -> Maybe MaintenanceModeVersion -> TxE QErr ()
+setRetryTx :: Event 'MSSQL -> UTCTime -> MaintenanceMode MaintenanceModeVersion -> TxE QErr ()
 setRetryTx event utcTime maintenanceMode = do
   time <- convertUTCToDatetime2 utcTime
   case maintenanceMode of
-    Just PreviousMMVersion -> throw500 "unexpected: there is no previous maintenance mode version supported for MSSQL event triggers"
-    Just CurrentMMVersion -> latestVersionSetRetry time
-    Nothing -> latestVersionSetRetry time
+    (MaintenanceModeEnabled PreviousMMVersion) -> throw500 "unexpected: there is no previous maintenance mode version supported for MSSQL event triggers"
+    (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetRetry time
+    MaintenanceModeDisabled -> latestVersionSetRetry time
   where
     eventId = unEventId $ eId event
     -- NOTE: Naveen: The following method to convert from Datetime to Datetimeoffset  was

server/src-lib/Hasura/Backends/Postgres/DDL/EventTrigger.hs

@@ -60,13 +60,13 @@ fetchUndeliveredEvents ::
   SourceConfig ('Postgres pgKind) ->
   SourceName ->
   [TriggerName] ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   FetchBatchSize ->
   m [Event ('Postgres pgKind)]
 fetchUndeliveredEvents sourceConfig sourceName triggerNames maintenanceMode fetchBatchSize = do
   fetchEventsTxE <-
     case maintenanceMode of
-      MaintenanceModeEnabled -> do
+      MaintenanceModeEnabled () -> do
         maintenanceModeVersion <- liftIO $ runPgSourceReadTx sourceConfig getMaintenanceModeVersionTx
         pure $ fmap (fetchEventsMaintenanceMode sourceName triggerNames fetchBatchSize) maintenanceModeVersion
       MaintenanceModeDisabled -> pure $ Right $ fetchEvents sourceName triggerNames fetchBatchSize
@@ -84,7 +84,7 @@ setRetry ::
   SourceConfig ('Postgres pgKind) ->
   Event ('Postgres pgKind) ->
   Time.UTCTime ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m ()
 setRetry sourceConfig event retryTime maintenanceModeVersion =
   liftEitherM $ liftIO $ runPgSourceWriteTx sourceConfig (setRetryTx event retryTime maintenanceModeVersion)
@@ -125,7 +125,7 @@ recordSuccess ::
   SourceConfig ('Postgres pgKind) ->
   Event ('Postgres pgKind) ->
   Invocation 'EventType ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordSuccess sourceConfig event invocation maintenanceModeVersion =
   liftIO $
@@ -139,7 +139,7 @@ recordError ::
   Event ('Postgres pgKind) ->
   Invocation 'EventType ->
   ProcessEventError ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordError sourceConfig event invocation processEventError maintenanceModeVersion =
   recordError' sourceConfig event (Just invocation) processEventError maintenanceModeVersion
@@ -150,7 +150,7 @@ recordError' ::
   Event ('Postgres pgKind) ->
   Maybe (Invocation 'EventType) ->
   ProcessEventError ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   m (Either QErr ())
 recordError' sourceConfig event invocation processEventError maintenanceModeVersion =
   liftIO $
@@ -402,9 +402,9 @@ fetchEventsMaintenanceMode sourceName triggerNames fetchBatchSize = \case
       limit = fromIntegral (_unFetchBatchSize fetchBatchSize) :: Word64
   CurrentMMVersion -> fetchEvents sourceName triggerNames fetchBatchSize
 
-setSuccessTx :: Event ('Postgres pgKind) -> Maybe MaintenanceModeVersion -> Q.TxE QErr ()
+setSuccessTx :: Event ('Postgres pgKind) -> MaintenanceMode MaintenanceModeVersion -> Q.TxE QErr ()
 setSuccessTx e = \case
-  Just PreviousMMVersion ->
+  (MaintenanceModeEnabled PreviousMMVersion) ->
     Q.unitQE
       defaultTxErrorHandler
       [Q.sql|
@@ -414,8 +414,8 @@ setSuccessTx e = \case
     |]
       (Identity $ eId e)
       True
-  Just CurrentMMVersion -> latestVersionSetSuccess
-  Nothing -> latestVersionSetSuccess
+  (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetSuccess
+  MaintenanceModeDisabled -> latestVersionSetSuccess
   where
     latestVersionSetSuccess =
       Q.unitQE
@@ -428,9 +428,9 @@ setSuccessTx e = \case
         (Identity $ eId e)
         True
 
-setErrorTx :: Event ('Postgres pgKind) -> Maybe MaintenanceModeVersion -> Q.TxE QErr ()
+setErrorTx :: Event ('Postgres pgKind) -> MaintenanceMode MaintenanceModeVersion -> Q.TxE QErr ()
 setErrorTx e = \case
-  Just PreviousMMVersion ->
+  (MaintenanceModeEnabled PreviousMMVersion) ->
     Q.unitQE
       defaultTxErrorHandler
       [Q.sql|
@@ -440,8 +440,8 @@ setErrorTx e = \case
     |]
       (Identity $ eId e)
       True
-  Just CurrentMMVersion -> latestVersionSetError
-  Nothing -> latestVersionSetError
+  (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetError
+  MaintenanceModeDisabled -> latestVersionSetError
   where
     latestVersionSetError =
       Q.unitQE
@@ -454,9 +454,9 @@ setErrorTx e = \case
         (Identity $ eId e)
         True
 
-setRetryTx :: Event ('Postgres pgKind) -> Time.UTCTime -> Maybe MaintenanceModeVersion -> Q.TxE QErr ()
+setRetryTx :: Event ('Postgres pgKind) -> Time.UTCTime -> MaintenanceMode MaintenanceModeVersion -> Q.TxE QErr ()
 setRetryTx e time = \case
-  Just PreviousMMVersion ->
+  (MaintenanceModeEnabled PreviousMMVersion) ->
     Q.unitQE
       defaultTxErrorHandler
       [Q.sql|
@@ -466,8 +466,8 @@ setRetryTx e time = \case
     |]
       (time, eId e)
       True
-  Just CurrentMMVersion -> latestVersionSetRetry
-  Nothing -> latestVersionSetRetry
+  (MaintenanceModeEnabled CurrentMMVersion) -> latestVersionSetRetry
+  MaintenanceModeDisabled -> latestVersionSetRetry
   where
     latestVersionSetRetry =
       Q.unitQE

server/src-lib/Hasura/Eventing/EventTrigger.hs

@@ -225,7 +225,7 @@ processEventQueue ::
   EventEngineCtx ->
   LockedEventsCtx ->
   ServerMetrics ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   m (Forever m)
 processEventQueue logger logBehavior httpMgr getSchemaCache EventEngineCtx {..} LockedEventsCtx {leEvents} serverMetrics maintenanceMode = do
   events0 <- popEventsBatch
@@ -369,13 +369,13 @@ processEventQueue logger logBehavior httpMgr getSchemaCache EventEngineCtx {..}
               Tracing.runTraceTInContext
               tracingCtx
 
-      maintenanceModeVersionEither :: Either QErr (Maybe MaintenanceModeVersion) <-
+      maintenanceModeVersionEither :: Either QErr (MaintenanceMode MaintenanceModeVersion) <-
         case maintenanceMode of
-          MaintenanceModeEnabled -> do
+          MaintenanceModeEnabled () -> do
             runExceptT (getMaintenanceModeVersion @b sourceConfig) <&> \case
               Left err -> Left err
-              Right maintenanceModeVersion -> Right $ Just maintenanceModeVersion
-          MaintenanceModeDisabled -> return $ Right Nothing
+              Right maintenanceModeVersion -> Right $ (MaintenanceModeEnabled maintenanceModeVersion)
+          MaintenanceModeDisabled -> return $ Right MaintenanceModeDisabled
 
       case maintenanceModeVersionEither of
         Left maintenanceModeVersionErr -> logQErr maintenanceModeVersionErr
@@ -454,7 +454,7 @@ processSuccess ::
   Event b ->
   [HeaderConf] ->
   J.Value ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   HTTPResp a ->
   m (Either QErr ())
 processSuccess sourceConfig e reqHeaders ep maintenanceModeVersion resp = do
@@ -475,7 +475,7 @@ processError ::
   RetryConf ->
   [HeaderConf] ->
   J.Value ->
-  Maybe MaintenanceModeVersion ->
+  MaintenanceMode MaintenanceModeVersion ->
   HTTPErr a ->
   m (Either QErr ())
 processError sourceConfig e retryConf reqHeaders ep maintenanceModeVersion err = do

server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs

@@ -452,7 +452,7 @@ buildSchemaCacheRule logger env = proc (metadata, invalidationKeys) -> do
                   -- when eventing mode is disabled, don't perform any migrations
                   | eventingMode == EventingDisabled -> pure RETDoNothing
                   -- when maintenance mode is enabled, don't perform any migrations
-                  | maintenanceMode == MaintenanceModeEnabled -> pure RETDoNothing
+                  | maintenanceMode == (MaintenanceModeEnabled ()) -> pure RETDoNothing
                   | otherwise -> do
                     let initCatalogAction =
                           case backendTag @b of

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

@@ -77,7 +77,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     SourceName ->
     -- | List of trigger names which exist in the metadata
     [TriggerName] ->
-    MaintenanceMode ->
+    MaintenanceMode () ->
     FetchBatchSize ->
     m [Event b]
 
@@ -89,7 +89,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     SourceConfig b ->
     Event b ->
     Time.UTCTime ->
-    Maybe MaintenanceModeVersion ->
+    MaintenanceMode MaintenanceModeVersion ->
     m ()
 
   -- | @getMaintenanceModeVersion@ gets the source catalog version from the
@@ -111,7 +111,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     SourceConfig b ->
     Event b ->
     Invocation 'EventType ->
-    Maybe MaintenanceModeVersion ->
+    MaintenanceMode MaintenanceModeVersion ->
     m (Either QErr ())
 
   -- | @recordError@ records an erronous event invocation, it does a couple of
@@ -127,7 +127,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     Event b ->
     Invocation 'EventType ->
     ProcessEventError ->
-    Maybe MaintenanceModeVersion ->
+    MaintenanceMode MaintenanceModeVersion ->
     m (Either QErr ())
 
   -- | @recordError'@ records an erronous event invocation, it does a couple of
@@ -143,7 +143,7 @@ class Backend b => BackendEventTrigger (b :: BackendType) where
     Event b ->
     Maybe (Invocation 'EventType) ->
     ProcessEventError ->
-    Maybe MaintenanceModeVersion ->
+    MaintenanceMode MaintenanceModeVersion ->
     m (Either QErr ())
 
   -- | @dropTriggerAndArchiveEvents@ drops the database trigger and

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -352,11 +352,11 @@ runMetadataQuery env logger instanceId userInfo httpManager serverConfigCtx sche
             & liftEitherM
 
         pure (r, modSchemaCache')
-      (MaintenanceModeEnabled, ReadOnlyModeDisabled) ->
+      (MaintenanceModeEnabled (), ReadOnlyModeDisabled) ->
         throw500 "metadata cannot be modified in maintenance mode"
       (MaintenanceModeDisabled, ReadOnlyModeEnabled) ->
         throw400 NotSupported "metadata cannot be modified in read-only mode"
-      (MaintenanceModeEnabled, ReadOnlyModeEnabled) ->
+      (MaintenanceModeEnabled (), ReadOnlyModeEnabled) ->
         throw500 "metadata cannot be modified in maintenance mode"
     else pure (r, modSchemaCache)
 

server/src-lib/Hasura/Server/API/Query.hs

@@ -213,7 +213,7 @@ runQuery env logger instanceId userInfo sc hMgr serverConfigCtx query = do
             newResourceVersion <- setMetadata currentResourceVersion updatedMetadata
             -- notify schema cache sync
             notifySchemaCacheSync newResourceVersion instanceId invalidations
-          MaintenanceModeEnabled ->
+          MaintenanceModeEnabled () ->
             throw500 "metadata cannot be modified in maintenance mode"
       pure (result, updatedCache)
 

server/src-lib/Hasura/Server/API/V2Query.hs

@@ -103,7 +103,7 @@ runQuery env instanceId userInfo schemaCache httpManager serverConfigCtx rqlQuer
             newResourceVersion <- setMetadata currentResourceVersion updatedMetadata
             -- notify schema cache sync
             notifySchemaCacheSync newResourceVersion instanceId invalidations
-          MaintenanceModeEnabled ->
+          MaintenanceModeEnabled () ->
             throw500 "metadata cannot be modified in maintenance mode"
       pure (result, updatedCache)
 

server/src-lib/Hasura/Server/App.hs

@@ -122,7 +122,7 @@ data ServerCtx = ServerCtx
     scEnvironment :: !Env.Environment,
     scRemoteSchemaPermsCtx :: !RemoteSchemaPermsCtx,
     scFunctionPermsCtx :: !FunctionPermissionsCtx,
-    scEnableMaintenanceMode :: !MaintenanceMode,
+    scEnableMaintenanceMode :: !(MaintenanceMode ()),
     scExperimentalFeatures :: !(S.HashSet ExperimentalFeature),
     scLoggingSettings :: !LoggingSettings,
     scEventingMode :: !EventingMode,
@@ -768,7 +768,7 @@ mkWaiApp ::
   FunctionPermissionsCtx ->
   WS.ConnectionOptions ->
   KeepAliveDelay ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   EventingMode ->
   ReadOnlyMode ->
   -- | Set of the enabled experimental features

server/src-lib/Hasura/Server/Init.hs

@@ -259,7 +259,7 @@ mkServeOptions rso = do
       <$> withEnv (rsoInferFunctionPermissions rso) (fst inferFunctionPermsEnv)
 
   maintenanceMode <-
-    bool MaintenanceModeDisabled MaintenanceModeEnabled
+    bool MaintenanceModeDisabled (MaintenanceModeEnabled ())
       <$> withEnvBool (rsoEnableMaintenanceMode rso) (fst maintenanceModeEnv)
 
   eventsFetchBatchSize <-

server/src-lib/Hasura/Server/Init/Config.hs

@@ -253,7 +253,7 @@ data ServeOptions impl = ServeOptions
     soConnectionOptions :: WS.ConnectionOptions,
     soWebsocketKeepAlive :: KeepAliveDelay,
     soInferFunctionPermissions :: FunctionPermissionsCtx,
-    soEnableMaintenanceMode :: MaintenanceMode,
+    soEnableMaintenanceMode :: MaintenanceMode (),
     soSchemaPollInterval :: OptionalInterval,
     soExperimentalFeatures :: Set.HashSet ExperimentalFeature,
     soEventsFetchBatchSize :: NonNegativeInt,

server/src-lib/Hasura/Server/Migrate.hs

@@ -107,7 +107,7 @@ migrateCatalog ::
     MonadBaseControl IO m
   ) =>
   Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   UTCTime ->
   m (MigrationResult, Metadata)
 migrateCatalog maybeDefaultSourceConfig maintenanceMode migrationTime = do
@@ -116,7 +116,7 @@ migrateCatalog maybeDefaultSourceConfig maintenanceMode migrationTime = do
   metadataTableExists <- doesTableExist (SchemaName "hdb_catalog") (TableName "hdb_metadata")
   migrationResult <-
     if
-        | maintenanceMode == MaintenanceModeEnabled -> do
+        | maintenanceMode == (MaintenanceModeEnabled ()) -> do
           if
               | not catalogSchemaExists ->
                 throw500 "unexpected: hdb_catalog schema not found in maintenance mode"
@@ -259,7 +259,7 @@ migrations ::
   (MonadIO m, MonadTx m) =>
   Maybe (SourceConnConfiguration ('Postgres 'Vanilla)) ->
   Bool ->
-  MaintenanceMode ->
+  MaintenanceMode () ->
   [(Float, MigrationPair m)]
 migrations maybeDefaultSourceConfig dryRun maintenanceMode =
   -- We need to build the list of migrations at compile-time so that we can compile the SQL
@@ -309,7 +309,7 @@ migrations maybeDefaultSourceConfig dryRun maintenanceMode =
       | otherwise = multiQ
 
     from42To43 = do
-      when (maintenanceMode == MaintenanceModeEnabled) $
+      when (maintenanceMode == MaintenanceModeEnabled ()) $
         throw500 "cannot migrate to catalog version 43 in maintenance mode"
       let query = $(makeRelativeToProject "src-rsr/migrations/42_to_43.sql" >>= Q.sqlFromFile)
       if dryRun

server/src-lib/Hasura/Server/Types.hs

@@ -67,16 +67,16 @@ instance ToJSON ExperimentalFeature where
     EFOptimizePermissionFilters -> "optimize_permission_filters"
     EFStreamingSubscriptions -> "streaming_subscriptions"
 
-data MaintenanceMode = MaintenanceModeEnabled | MaintenanceModeDisabled
+data MaintenanceMode a = MaintenanceModeEnabled a | MaintenanceModeDisabled
   deriving (Show, Eq)
 
-instance FromJSON MaintenanceMode where
+instance FromJSON (MaintenanceMode ()) where
   parseJSON =
     withBool "MaintenanceMode" $
-      pure . bool MaintenanceModeDisabled MaintenanceModeEnabled
+      pure . bool MaintenanceModeDisabled (MaintenanceModeEnabled ())
 
-instance ToJSON MaintenanceMode where
-  toJSON = Bool . (== MaintenanceModeEnabled)
+instance ToJSON (MaintenanceMode ()) where
+  toJSON = Bool . (== MaintenanceModeEnabled ())
 
 data StreamingSubscriptionsCtx = StreamingSubscriptionsEnabled | StreamingSubscriptionsDisabled
   deriving (Show, Eq)
@@ -95,7 +95,7 @@ data ServerConfigCtx = ServerConfigCtx
   { _sccFunctionPermsCtx :: FunctionPermissionsCtx,
     _sccRemoteSchemaPermsCtx :: RemoteSchemaPermsCtx,
     _sccSQLGenCtx :: SQLGenCtx,
-    _sccMaintenanceMode :: MaintenanceMode,
+    _sccMaintenanceMode :: MaintenanceMode (),
     _sccExperimentalFeatures :: Set.HashSet ExperimentalFeature,
     _sccEventingMode :: EventingMode,
     _sccReadOnlyMode :: ReadOnlyMode