mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
24592a516b
* Pass environment variables around as a data structure, via @sordina * Resolving build error * Adding Environment passing note to changelog * Removing references to ILTPollerLog as this seems to have been reintroduced from a bad merge * removing commented-out imports * Language pragmas already set by project * Linking async thread * Apply suggestions from code review Use `runQueryTx` instead of `runLazyTx` for queries. * remove the non-user facing entry in the changelog Co-authored-by: Phil Freeman <paf31@cantab.net> Co-authored-by: Phil Freeman <phil@hasura.io> Co-authored-by: Vamshi Surabhi <0x777@users.noreply.github.com>
41 lines
1.5 KiB
Haskell
41 lines
1.5 KiB
Haskell
module Hasura.Eventing.Common where
|
|
|
|
import Control.Concurrent.STM.TVar
|
|
import Control.Monad.STM
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types.EventTrigger (EventId)
|
|
import Hasura.RQL.Types.ScheduledTrigger (CronEventId, StandAloneScheduledEventId)
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
data LockedEventsCtx
|
|
= LockedEventsCtx
|
|
{ leCronEvents :: TVar (Set.Set CronEventId)
|
|
, leStandAloneEvents :: TVar (Set.Set StandAloneScheduledEventId)
|
|
, leEvents :: TVar (Set.Set EventId)
|
|
}
|
|
|
|
initLockedEventsCtx :: STM LockedEventsCtx
|
|
initLockedEventsCtx = do
|
|
leCronEvents <- newTVar Set.empty
|
|
leStandAloneEvents <- newTVar Set.empty
|
|
leEvents <- newTVar Set.empty
|
|
return $ LockedEventsCtx{..}
|
|
|
|
-- | After the events are fetched from the DB, we store the locked events
|
|
-- in a hash set(order doesn't matter and look ups are faster) in the
|
|
-- event engine context
|
|
saveLockedEvents :: (MonadIO m) => [Text] -> TVar (Set.Set Text) -> m ()
|
|
saveLockedEvents eventIds lockedEvents =
|
|
liftIO $ atomically $ do
|
|
lockedEventsVals <- readTVar lockedEvents
|
|
writeTVar lockedEvents $!
|
|
Set.union lockedEventsVals $ Set.fromList eventIds
|
|
|
|
-- | Remove an event from the 'LockedEventsCtx' after it has been processed
|
|
removeEventFromLockedEvents :: MonadIO m => Text -> TVar (Set.Set Text) -> m ()
|
|
removeEventFromLockedEvents eventId lockedEvents =
|
|
liftIO $ atomically $ do
|
|
lockedEventsVals <- readTVar lockedEvents
|
|
writeTVar lockedEvents $! Set.delete eventId lockedEventsVals
|