Change monad stack architecture of MonadMetadataStorage

server/src-lib/Hasura/App.hs

@@ -307,7 +307,7 @@ runHGEServer
      , MonadExecuteQuery m
      , Tracing.HasReporter m
      , MonadQueryInstrumentation m
-     , MonadMetadataStorage m
+     , MonadMetadataStorage (MetadataStorageT m)
      )
   => Env.Environment
   -> ServeOptions impl
@@ -685,7 +685,7 @@ runTxInMetadataStorage tx = do
   liftEitherM $ liftIO $ runExceptT $
     Q.runTx pool (Q.RepeatableRead, Just Q.ReadWrite) tx
 
-instance MonadMetadataStorage ServerAppM where
+instance MonadMetadataStorage (MetadataStorageT ServerAppM) where
 
   getDeprivedCronTriggerStats        = runTxInMetadataStorage getDeprivedCronTriggerStatsTx
   getScheduledEventsForDelivery      = runTxInMetadataStorage getScheduledEventsForDeliveryTx

server/src-lib/Hasura/Class.hs

@@ -10,7 +10,7 @@ import           Hasura.Eventing.ScheduledTrigger.Types
 import           Hasura.Prelude
 import           Hasura.RQL.Types
 
-import           Control.Monad.Morph                    (MFunctor, hoist)
+import           Control.Monad.Morph                    (MFunctor)
 
 import qualified Hasura.Tracing                         as Tracing
 
@@ -21,6 +21,7 @@ newtype MetadataStorageT m a
            , MFunctor
            , MonadTrans
            , MonadIO
+           , Tracing.HasReporter
            )
 
 runMetadataStorageT
@@ -29,56 +30,56 @@ runMetadataStorageT =
   runExceptT . unMetadataStorageT
 
 
-class (Monad m) => MonadMetadataStorage m where
+class (MonadError QErr m) => MonadMetadataStorage m where
 
   -- Scheduled triggers
-  getDeprivedCronTriggerStats :: MetadataStorageT m [CronTriggerStats]
-  getScheduledEventsForDelivery :: MetadataStorageT m ([CronEvent], [OneOffScheduledEvent])
-  insertScheduledEvent :: ScheduledEventSeed -> MetadataStorageT m ()
+  getDeprivedCronTriggerStats :: m [CronTriggerStats]
+  getScheduledEventsForDelivery :: m ([CronEvent], [OneOffScheduledEvent])
+  insertScheduledEvent :: ScheduledEventSeed -> m ()
   insertScheduledEventInvocation
-    :: Invocation 'ScheduledType -> ScheduledEventType -> MetadataStorageT m ()
+    :: Invocation 'ScheduledType -> ScheduledEventType -> m ()
   setScheduledEventOp
-    :: ScheduledEventId -> ScheduledEventOp -> ScheduledEventType -> MetadataStorageT m ()
+    :: ScheduledEventId -> ScheduledEventOp -> ScheduledEventType -> m ()
   unlockScheduledEvents
-    :: ScheduledEventType -> [ScheduledEventId] -> MetadataStorageT m Int
-  unlockAllLockedScheduledEvents :: MetadataStorageT m ()
+    :: ScheduledEventType -> [ScheduledEventId] -> m Int
+  unlockAllLockedScheduledEvents :: m ()
 
 instance (MonadMetadataStorage m) => MonadMetadataStorage (ReaderT r m) where
 
-  getDeprivedCronTriggerStats        = (hoist lift) getDeprivedCronTriggerStats
-  getScheduledEventsForDelivery      = (hoist lift) getScheduledEventsForDelivery
-  insertScheduledEvent               = (hoist lift) . insertScheduledEvent
-  insertScheduledEventInvocation a b = (hoist lift) $ insertScheduledEventInvocation a b
-  setScheduledEventOp a b c          = (hoist lift) $ setScheduledEventOp a b c
-  unlockScheduledEvents a b          = (hoist lift) $ unlockScheduledEvents a b
-  unlockAllLockedScheduledEvents     = (hoist lift) unlockAllLockedScheduledEvents
+  getDeprivedCronTriggerStats        = lift getDeprivedCronTriggerStats
+  getScheduledEventsForDelivery      = lift getScheduledEventsForDelivery
+  insertScheduledEvent               = lift . insertScheduledEvent
+  insertScheduledEventInvocation a b = lift $ insertScheduledEventInvocation a b
+  setScheduledEventOp a b c          = lift $ setScheduledEventOp a b c
+  unlockScheduledEvents a b          = lift $ unlockScheduledEvents a b
+  unlockAllLockedScheduledEvents     = lift unlockAllLockedScheduledEvents
 
-instance (MonadMetadataStorage m) => MonadMetadataStorage (ExceptT e m) where
+-- instance (MonadMetadataStorage m) => MonadMetadataStorage (ExceptT e m) where
 
-  getDeprivedCronTriggerStats        = (hoist lift) getDeprivedCronTriggerStats
-  getScheduledEventsForDelivery      = (hoist lift) getScheduledEventsForDelivery
-  insertScheduledEvent               = (hoist lift) . insertScheduledEvent
-  insertScheduledEventInvocation a b = (hoist lift) $ insertScheduledEventInvocation a b
-  setScheduledEventOp a b c          = (hoist lift) $ setScheduledEventOp a b c
-  unlockScheduledEvents a b          = (hoist lift) $ unlockScheduledEvents a b
-  unlockAllLockedScheduledEvents     = (hoist lift) unlockAllLockedScheduledEvents
+--   getDeprivedCronTriggerStats        = lift getDeprivedCronTriggerStats
+--   getScheduledEventsForDelivery      = lift getScheduledEventsForDelivery
+--   insertScheduledEvent               = lift . insertScheduledEvent
+--   insertScheduledEventInvocation a b = lift $ insertScheduledEventInvocation a b
+--   setScheduledEventOp a b c          = lift $ setScheduledEventOp a b c
+--   unlockScheduledEvents a b          = lift $ unlockScheduledEvents a b
+--   unlockAllLockedScheduledEvents     = lift unlockAllLockedScheduledEvents
 
 instance (MonadMetadataStorage m) => MonadMetadataStorage (Tracing.TraceT m) where
 
-  getDeprivedCronTriggerStats        = (hoist lift) getDeprivedCronTriggerStats
-  getScheduledEventsForDelivery      = (hoist lift) getScheduledEventsForDelivery
-  insertScheduledEvent               = (hoist lift) . insertScheduledEvent
-  insertScheduledEventInvocation a b = (hoist lift) $ insertScheduledEventInvocation a b
-  setScheduledEventOp a b c          = (hoist lift) $ setScheduledEventOp a b c
-  unlockScheduledEvents a b          = (hoist lift) $ unlockScheduledEvents a b
-  unlockAllLockedScheduledEvents     = (hoist lift) unlockAllLockedScheduledEvents
-
-instance (MonadMetadataStorage m) => MonadMetadataStorage (LazyTxT e m) where
-
-  getDeprivedCronTriggerStats        = (hoist lift) getDeprivedCronTriggerStats
-  getScheduledEventsForDelivery      = (hoist lift) getScheduledEventsForDelivery
-  insertScheduledEvent               = (hoist lift) . insertScheduledEvent
-  insertScheduledEventInvocation a b = (hoist lift) $ insertScheduledEventInvocation a b
-  setScheduledEventOp a b c          = (hoist lift) $ setScheduledEventOp a b c
-  unlockScheduledEvents a b          = (hoist lift) $ unlockScheduledEvents a b
-  unlockAllLockedScheduledEvents     = (hoist lift) unlockAllLockedScheduledEvents
+  getDeprivedCronTriggerStats        = lift getDeprivedCronTriggerStats
+  getScheduledEventsForDelivery      = lift getScheduledEventsForDelivery
+  insertScheduledEvent               = lift . insertScheduledEvent
+  insertScheduledEventInvocation a b = lift $ insertScheduledEventInvocation a b
+  setScheduledEventOp a b c          = lift $ setScheduledEventOp a b c
+  unlockScheduledEvents a b          = lift $ unlockScheduledEvents a b
+  unlockAllLockedScheduledEvents     = lift unlockAllLockedScheduledEvents
+
+-- instance (MonadMetadataStorage m) => MonadMetadataStorage (LazyTxT e m) where
+
+--   getDeprivedCronTriggerStats        = lift getDeprivedCronTriggerStats
+--   getScheduledEventsForDelivery      = lift getScheduledEventsForDelivery
+--   insertScheduledEvent               = lift . insertScheduledEvent
+--   insertScheduledEventInvocation a b = lift $ insertScheduledEventInvocation a b
+--   setScheduledEventOp a b c          = lift $ setScheduledEventOp a b c
+--   unlockScheduledEvents a b          = lift $ unlockScheduledEvents a b
+--   unlockAllLockedScheduledEvents     = lift unlockAllLockedScheduledEvents

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

@@ -120,7 +120,7 @@ import           Hasura.SQL.Types
 --   have an adequate buffer of cron events.
 runCronEventsGenerator
   :: ( MonadIO m
-     , MonadMetadataStorage m
+     , MonadMetadataStorage (MetadataStorageT m)
      )
   => L.Logger L.Hasura
   -> IO SchemaCache
@@ -160,7 +160,7 @@ runCronEventsGenerator logger getSC = do
 insertCronEventsFor
   :: (MonadMetadataStorage m)
   => [(CronTriggerInfo, CronTriggerStats)]
-  -> MetadataStorageT m ()
+  -> m ()
 insertCronEventsFor cronTriggersWithStats = do
   let scheduledEvents = flip concatMap cronTriggersWithStats $ \(cti, stats) ->
         generateCronEventsFrom (ctsMaxScheduledTime stats) cti
@@ -183,7 +183,7 @@ processCronEvents
   :: ( HasVersion
      , MonadIO m
      , Tracing.HasReporter m
-     , MonadMetadataStorage m
+     , MonadMetadataStorage (MetadataStorageT m)
      )
   => L.Logger L.Hasura
   -> LogEnvHeaders
@@ -209,7 +209,7 @@ processCronEvents logger logEnv httpMgr cronEvents getSC lockedCronEvents = do
                       (fromMaybe J.Null ctiPayload) ctiComment
                       Nothing
             retryCtx = RetryContext tries ctiRetryConf
-        finally <- runExceptT $ flip runReaderT (logger, httpMgr) $
+        finally <- runMetadataStorageT $ flip runReaderT (logger, httpMgr) $
                    processScheduledEvent logEnv id' ctiHeaders retryCtx
                                          payload webhookUrl Cron
         removeEventFromLockedEvents id' lockedCronEvents
@@ -221,7 +221,7 @@ processOneOffScheduledEvents
   :: ( HasVersion
      , MonadIO m
      , Tracing.HasReporter m
-     , MonadMetadataStorage m
+     , MonadMetadataStorage (MetadataStorageT m)
      )
   => Env.Environment
   -> L.Logger L.Hasura
@@ -236,7 +236,7 @@ processOneOffScheduledEvents env logger logEnv httpMgr oneOffEvents lockedOneOff
   -- graceful shutdown is initiated in midst of processing these events
   saveLockedEvents (map _ooseId oneOffEvents) lockedOneOffScheduledEvents
   for_ oneOffEvents $ \OneOffScheduledEvent{..} -> do
-    (either logInternalError pure) =<< runExceptT do
+    (either logInternalError pure) =<< runMetadataStorageT do
       webhookInfo <- resolveWebhook env _ooseWebhookConf
       headerInfo <- getHeaderInfosFromConf env _ooseHeaderConf
       let webhookUrl = unResolvedWebhook webhookInfo
@@ -255,7 +255,7 @@ processScheduledTriggers
   :: ( HasVersion
      , MonadIO m
      , Tracing.HasReporter m
-     , MonadMetadataStorage m
+     , MonadMetadataStorage (MetadataStorageT m)
      )
   => Env.Environment
   -> L.Logger L.Hasura
@@ -282,7 +282,6 @@ processScheduledEvent
      , Has (L.Logger L.Hasura) r
      , HasVersion
      , MonadIO m
-     , MonadError QErr m
      , Tracing.HasReporter m
      , MonadMetadataStorage m
      )
@@ -322,7 +321,6 @@ processScheduledEvent logEnv eventId eventHeaders retryCtx payload webhookUrl ty
 
 processError
   :: ( MonadIO m
-     , MonadError QErr m
      , MonadMetadataStorage m
      )
   => ScheduledEventId
@@ -348,17 +346,16 @@ processError eventId retryCtx decodedHeaders type' reqJson err = do
         HOther detail -> do
           let errMsg = (TBS.fromLBS $ J.encode detail)
           mkInvocation eventId 500 decodedHeaders errMsg [] reqJson
-  liftEitherM $ runMetadataStorageT $ do
-    insertScheduledEventInvocation invocation type'
-    retryOrMarkError eventId retryCtx err type'
+  insertScheduledEventInvocation invocation type'
+  retryOrMarkError eventId retryCtx err type'
 
 retryOrMarkError
   :: (MonadIO m, MonadMetadataStorage m)
   => ScheduledEventId
   -> RetryContext
   -> HTTPErr a
   -> ScheduledEventType
-  -> MetadataStorageT m ()
+  -> m ()
 retryOrMarkError eventId retryCtx err type' = do
   let RetryContext tries retryConf = retryCtx
       mRetryHeader = getRetryAfterHeaderFromHTTPErr err
@@ -409,7 +406,7 @@ and it can transition to other states in the following ways:
 -}
 
 processSuccess
-  :: (MonadIO m, MonadError QErr m, MonadMetadataStorage m)
+  :: (MonadMetadataStorage m)
   => ScheduledEventId
   -> [HeaderConf]
   -> ScheduledEventType
@@ -421,16 +418,14 @@ processSuccess eventId decodedHeaders type' reqBodyJson resp = do
       respHeaders = hrsHeaders resp
       respStatus = hrsStatus resp
       invocation = mkInvocation eventId respStatus decodedHeaders respBody respHeaders reqBodyJson
-  liftEitherM $ runMetadataStorageT $ do
-    insertScheduledEventInvocation invocation type'
-    setScheduledEventOp eventId (SEOpStatus SESDelivered) type'
+  insertScheduledEventInvocation invocation type'
+  setScheduledEventOp eventId (SEOpStatus SESDelivered) type'
 
 processDead
-  :: (MonadError QErr m, MonadMetadataStorage m)
+  :: (MonadMetadataStorage m)
   => ScheduledEventId -> ScheduledEventType -> m ()
 processDead eventId type' =
-  liftEitherM $ runMetadataStorageT $
-    setScheduledEventOp eventId (SEOpStatus SESDead) type'
+  setScheduledEventOp eventId (SEOpStatus SESDead) type'
 
 mkInvocation
   :: ScheduledEventId