packages feed

consumers 2.1.2.0 → 2.2.0.0

raw patch · 5 files changed

+53/−38 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Database.PostgreSQL.Consumers.Utils: instance GHC.Exception.Exception Database.PostgreSQL.Consumers.Utils.StopExecution
- Database.PostgreSQL.Consumers.Utils: instance GHC.Exception.Exception Database.PostgreSQL.Consumers.Utils.ThrownFrom
+ Database.PostgreSQL.Consumers.Utils: instance GHC.Exception.Type.Exception Database.PostgreSQL.Consumers.Utils.StopExecution
+ Database.PostgreSQL.Consumers.Utils: instance GHC.Exception.Type.Exception Database.PostgreSQL.Consumers.Utils.ThrownFrom
- Database.PostgreSQL.Consumers: runConsumer :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> m (m ())
+ Database.PostgreSQL.Consumers: runConsumer :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, FromSQL idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> m (m ())
- Database.PostgreSQL.Consumers: runConsumerWithIdleSignal :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> TMVar Bool -> m (m ())
+ Database.PostgreSQL.Consumers: runConsumerWithIdleSignal :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, FromSQL idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> TMVar Bool -> m (m ())
- Database.PostgreSQL.Consumers.Components: runConsumer :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> m (m ())
+ Database.PostgreSQL.Consumers.Components: runConsumer :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, FromSQL idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> m (m ())
- Database.PostgreSQL.Consumers.Components: runConsumerWithIdleSignal :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> TMVar Bool -> m (m ())
+ Database.PostgreSQL.Consumers.Components: runConsumerWithIdleSignal :: (MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx, FromSQL idx, ToSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> TMVar Bool -> m (m ())
- Database.PostgreSQL.Consumers.Components: spawnMonitor :: (MonadBaseControl IO m, MonadLog m, MonadMask m) => ConsumerConfig m idx job -> ConnectionSourceM m -> ConsumerID -> m ThreadId
+ Database.PostgreSQL.Consumers.Components: spawnMonitor :: forall m idx job. (MonadBaseControl IO m, MonadLog m, MonadMask m, Show idx, FromSQL idx) => ConsumerConfig m idx job -> ConnectionSourceM m -> ConsumerID -> m ThreadId
- Database.PostgreSQL.Consumers.Config: ConsumerConfig :: !(RawSQL ()) -> !(RawSQL ()) -> ![SQL] -> !(row -> job) -> !(job -> idx) -> !(Maybe Channel) -> !Int -> !Int -> !(job -> m Result) -> !(SomeException -> job -> m Action) -> ConsumerConfig m idx job
+ Database.PostgreSQL.Consumers.Config: ConsumerConfig :: !RawSQL () -> !RawSQL () -> ![SQL] -> !row -> job -> !job -> idx -> !Maybe Channel -> !Int -> !Int -> !job -> m Result -> !SomeException -> job -> m Action -> ConsumerConfig m idx job
- Database.PostgreSQL.Consumers.Config: [ccConsumersTable] :: ConsumerConfig m idx job -> !(RawSQL ())
+ Database.PostgreSQL.Consumers.Config: [ccConsumersTable] :: ConsumerConfig m idx job -> !RawSQL ()
- Database.PostgreSQL.Consumers.Config: [ccJobFetcher] :: ConsumerConfig m idx job -> !(row -> job)
+ Database.PostgreSQL.Consumers.Config: [ccJobFetcher] :: ConsumerConfig m idx job -> !row -> job
- Database.PostgreSQL.Consumers.Config: [ccJobIndex] :: ConsumerConfig m idx job -> !(job -> idx)
+ Database.PostgreSQL.Consumers.Config: [ccJobIndex] :: ConsumerConfig m idx job -> !job -> idx
- Database.PostgreSQL.Consumers.Config: [ccJobsTable] :: ConsumerConfig m idx job -> !(RawSQL ())
+ Database.PostgreSQL.Consumers.Config: [ccJobsTable] :: ConsumerConfig m idx job -> !RawSQL ()
- Database.PostgreSQL.Consumers.Config: [ccNotificationChannel] :: ConsumerConfig m idx job -> !(Maybe Channel)
+ Database.PostgreSQL.Consumers.Config: [ccNotificationChannel] :: ConsumerConfig m idx job -> !Maybe Channel
- Database.PostgreSQL.Consumers.Config: [ccOnException] :: ConsumerConfig m idx job -> !(SomeException -> job -> m Action)
+ Database.PostgreSQL.Consumers.Config: [ccOnException] :: ConsumerConfig m idx job -> !SomeException -> job -> m Action
- Database.PostgreSQL.Consumers.Config: [ccProcessJob] :: ConsumerConfig m idx job -> !(job -> m Result)
+ Database.PostgreSQL.Consumers.Config: [ccProcessJob] :: ConsumerConfig m idx job -> !job -> m Result

Files

CHANGELOG.md view
@@ -1,3 +1,7 @@+# consumers-2.2.0.0 (2019-02-19)+* When jobs are relased from a dead consumer, reset their finished_at column+* Start the consumer only when ccMaxRunningJobs >= 1+ # consumers-2.1.2.0 (2018-07-11)  * Support hpqtypes-1.6.0.0.
consumers.cabal view
@@ -1,5 +1,5 @@ name:               consumers-version:            2.1.2.0+version:            2.2.0.0 synopsis:           Concurrent PostgreSQL data consumers  description:        Library for setting up concurrent consumers of data@@ -18,7 +18,7 @@ category:           Concurrency, Database build-type:         Simple cabal-version:      >=1.10-tested-with:        GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+tested-with:        GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.2  Source-repository head   Type:             git
example/Example.hs view
@@ -19,6 +19,7 @@ import Data.Monoid import Log import Log.Backend.StandardOutput+import Prelude import System.Environment import TextShow 
src/Database/PostgreSQL/Consumers/Components.hs view
@@ -39,7 +39,7 @@ -- seamlessly handle the finalization. runConsumer   :: ( MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx-     , ToSQL idx )+     , FromSQL idx, ToSQL idx )   => ConsumerConfig m idx job   -> ConnectionSourceM m   -> m (m ())@@ -47,7 +47,7 @@  runConsumerWithIdleSignal   :: ( MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx-     , ToSQL idx )+     , FromSQL idx, ToSQL idx )   => ConsumerConfig m idx job   -> ConnectionSourceM m   -> TMVar Bool@@ -56,35 +56,38 @@  -- | Run the consumer and also signal whenever the consumer is waiting for -- getNotification or threadDelay.- runConsumerWithMaybeIdleSignal   :: ( MonadBaseControl IO m, MonadLog m, MonadMask m, Eq idx, Show idx-     , ToSQL idx )+     , FromSQL idx, ToSQL idx )   => ConsumerConfig m idx job   -> ConnectionSourceM m   -> Maybe (TMVar Bool)   -> m (m ())-runConsumerWithMaybeIdleSignal cc cs mIdleSignal = do-  semaphore <- newMVar ()-  runningJobsInfo <- liftBase $ newTVarIO M.empty-  runningJobs <- liftBase $ newTVarIO 0+runConsumerWithMaybeIdleSignal cc cs mIdleSignal+  | ccMaxRunningJobs cc < 1 = do+      logInfo_ "ccMaxRunningJobs < 1, not starting the consumer"+      return $ return ()+  | otherwise = do+      semaphore <- newMVar ()+      runningJobsInfo <- liftBase $ newTVarIO M.empty+      runningJobs <- liftBase $ newTVarIO 0 -  skipLockedTest :: Either DBException () <- try . runDBT cs def $-    runSQL_ "SELECT TRUE FOR UPDATE SKIP LOCKED"-  let useSkipLocked = either (const False) (const True) skipLockedTest+      skipLockedTest :: Either DBException () <- try . runDBT cs def $+        runSQL_ "SELECT TRUE FOR UPDATE SKIP LOCKED"+      let useSkipLocked = either (const False) (const True) skipLockedTest -  cid <- registerConsumer cc cs-  localData ["consumer_id" .= show cid] $ do-    listener <- spawnListener cc cs semaphore-    monitor <- localDomain "monitor" $ spawnMonitor cc cs cid-    dispatcher <- localDomain "dispatcher" $ spawnDispatcher cc useSkipLocked-      cs cid semaphore runningJobsInfo runningJobs mIdleSignal-    return . localDomain "finalizer" $ do-      stopExecution listener-      stopExecution dispatcher-      waitForRunningJobs runningJobsInfo runningJobs-      stopExecution monitor-      unregisterConsumer cc cs cid+      cid <- registerConsumer cc cs+      localData ["consumer_id" .= show cid] $ do+        listener <- spawnListener cc cs semaphore+        monitor <- localDomain "monitor" $ spawnMonitor cc cs cid+        dispatcher <- localDomain "dispatcher" $ spawnDispatcher cc useSkipLocked+          cs cid semaphore runningJobsInfo runningJobs mIdleSignal+        return . localDomain "finalizer" $ do+          stopExecution listener+          stopExecution dispatcher+          waitForRunningJobs runningJobsInfo runningJobs+          stopExecution monitor+          unregisterConsumer cc cs cid   where     waitForRunningJobs runningJobsInfo runningJobs = do       initialJobs <- liftBase $ readTVarIO runningJobsInfo@@ -143,7 +146,8 @@ -- | Spawn a thread that monitors working consumers -- for activity and periodically updates its own. spawnMonitor-  :: (MonadBaseControl IO m, MonadLog m, MonadMask m)+  :: forall m idx job. (MonadBaseControl IO m, MonadLog m, MonadMask m,+                        Show idx, FromSQL idx)   => ConsumerConfig m idx job   -> ConnectionSourceM m   -> ConsumerID@@ -177,23 +181,28 @@       , "  RETURNING id::bigint"       ]     inactive :: [Int64] <- fetchMany runIdentity-    -- Reset reserved jobs manually, do not rely-    -- on the foreign key constraint to do its job.-    freed <- if null inactive-      then return 0-      else runSQL $ smconcat [-        "UPDATE" <+> raw ccJobsTable-      , "SET reserved_by = NULL"-      , "WHERE reserved_by = ANY(" <?> Array1 inactive <+> ")"-      ]-    return (length inactive, freed)+    -- Reset reserved jobs manually, do not rely on the foreign key constraint+    -- to do its job. We also reset finished_at to correctly bump number of+    -- attempts on the next try.+    freedJobs :: [idx] <- if null inactive+      then return []+      else do+        runSQL_ $ smconcat+          [ "UPDATE" <+> raw ccJobsTable+          , "SET reserved_by = NULL"+          , "  , finished_at = NULL"+          , "WHERE reserved_by = ANY(" <?> Array1 inactive <+> ")"+          , "RETURNING id"+          ]+        fetchMany runIdentity+    return (length inactive, freedJobs)   when (inactiveConsumers > 0) $ do     logInfo "Unregistered inactive consumers" $ object [         "inactive_consumers" .= inactiveConsumers       ]-  when (freedJobs > 0) $ do+  unless (null freedJobs) $ do     logInfo "Freed locked jobs" $ object [-        "freed_jobs" .= freedJobs+        "freed_jobs" .= map show freedJobs       ]   liftBase . threadDelay $ 30 * 1000000 -- wait 30 seconds   where
test/Test.hs view
@@ -30,6 +30,7 @@ import Data.Time import Log import Log.Backend.StandardOutput+import Prelude import System.Environment import TextShow