faktory 1.1.2.3 → 1.1.2.4

raw patch · 7 files changed

+102/−62 lines, 7 filesdep ~aesondep ~aeson-casingdep ~aeson-qqPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: aeson, aeson-casing, aeson-qq, async, bytestring, connection, cryptonite, errors, hspec, markdown-unlit, megaparsec, memory, mtl, network, random, safe-exceptions, scanner, text, time, unix, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−1
• faktory.cabal +39/−39
• library/Faktory/Ent/Batch.hs +1/−0
• library/Faktory/Ent/Batch/Status.hs +9/−2
• tests/Faktory/Ent/BatchSpec.hs +29/−7
• tests/Faktory/Test.hs +11/−6
• tests/FaktorySpec.hs +7/−7

@@ -1,4 +1,9 @@-## [*Unreleased*](https://github.com/frontrowed/faktory_worker_haskell/compare/v1.1.2.3...main)+## [_Unreleased_](https://github.com/frontrowed/faktory_worker_haskell/compare/v1.1.2.4...main)++## [v1.1.2.4](https://github.com/frontrowed/faktory_worker_haskell/compare/v1.1.2.3...v1.1.2.4)++- Fix `jobBatchId` to work for all job types. Faktory seems to use both `bid` and `_bid`+  in a jobs custom object when enqueing jobs. This allows the parser to use both  ## [v1.1.2.3](https://github.com/frontrowed/faktory_worker_haskell/compare/v1.1.2.2...v1.1.2.3) 

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            faktory-version:         1.1.2.3+version:         1.1.2.4 license:         MIT license-file:    LICENSE copyright:       2018 Freckle Education@@ -88,25 +88,25 @@         -Wno-monomorphism-restriction -Wno-missing-import-lists      build-depends:-        aeson >=1.4.6.0,-        aeson-casing >=0.2.0.0,-        base ==4.*,-        bytestring >=0.10.8.2,-        connection >=0.3.1,-        cryptonite >=0.25,-        errors >=2.3.0,-        megaparsec >=7.0.5,-        memory >=0.14.18,-        mtl >=2.2.2,-        network >=2.8.0.1,-        random >=1.1,-        safe-exceptions >=0.1.7.0,-        scanner >=0.3.1,+        aeson,+        aeson-casing,+        base >=4 && <5,+        bytestring,+        connection,+        cryptonite,+        errors,+        megaparsec,+        memory,+        mtl,+        network,+        random,+        safe-exceptions,+        scanner,         semigroups >=0.19.1,-        text >=1.2.3.1,-        time >=1.8.0.2,-        unix >=2.7.2.2,-        unordered-containers >=0.2.10.0+        text,+        time,+        unix,+        unordered-containers      if impl(ghc >=8.10)         ghc-options:@@ -136,10 +136,10 @@         -Wno-monomorphism-restriction -Wno-missing-import-lists      build-depends:-        aeson >=1.4.6.0,-        base ==4.*,-        faktory -any,-        safe-exceptions >=0.1.7.0+        aeson,+        base >=4 && <5,+        faktory,+        safe-exceptions      if impl(ghc >=8.10)         ghc-options:@@ -169,10 +169,10 @@         -Wno-monomorphism-restriction -Wno-missing-import-lists      build-depends:-        aeson >=1.4.6.0,-        base ==4.*,-        faktory -any,-        safe-exceptions >=0.1.7.0+        aeson,+        base >=4 && <5,+        faktory,+        safe-exceptions      if impl(ghc >=8.10)         ghc-options:@@ -212,14 +212,14 @@         -Wno-monomorphism-restriction -Wno-missing-import-lists -rtsopts      build-depends:-        aeson >=1.4.6.0,-        aeson-qq >=0.8.3,-        async >=2.2.2,-        base ==4.*,-        faktory -any,-        hspec >=2.7.1,-        mtl >=2.2.2,-        time >=1.8.0.2+        aeson,+        aeson-qq,+        async,+        base >=4 && <5,+        faktory,+        hspec,+        mtl,+        time      if impl(ghc >=8.10)         ghc-options:@@ -251,10 +251,10 @@         markdown-unlit      build-depends:-        aeson >=1.4.6.0,-        base ==4.*,-        faktory -any,-        markdown-unlit >=0.5.0+        aeson,+        base >=4 && <5,+        faktory,+        markdown-unlit      if impl(ghc >=8.10)         ghc-options:

@@ -63,6 +63,7 @@   deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader BatchId)  newtype BatchId = BatchId Text+  deriving stock (Show, Eq)   deriving newtype (FromJSON, ToJSON)  data BatchOptions arg = BatchOptions

@@ -6,6 +6,7 @@  import Faktory.Prelude +import Control.Applicative ((<|>)) import Control.Error.Util (hush) import Data.Aeson import Data.ByteString.Lazy as BSL@@ -33,8 +34,14 @@ newtype ReadCustomBatchId = ReadCustomBatchId   { _bid :: BatchId   }-  deriving stock Generic-  deriving anyclass FromJSON+  deriving stock (Show,Eq,Generic)++instance FromJSON ReadCustomBatchId where+  -- Faktory seems to use the key '_bid' when enqueuing callback jobs and 'bid' for normal jobs...+  parseJSON v = withParser "_bid" v <|> withParser "bid" v+   where+    withParser s =+      withObject "ReadCustomBatchId" $ \o -> ReadCustomBatchId <$> o .: s  jobBatchId :: Job arg -> Maybe BatchId jobBatchId job = do

@@ -4,13 +4,35 @@  import Faktory.Test +import Control.Arrow ((&&&)) import Control.Concurrent (threadDelay) import Control.Monad.Reader import Faktory.Ent.Batch+import Faktory.Ent.Batch.Status (jobBatchId) import qualified Faktory.Ent.Batch.Status as BatchStatus  spec :: Spec spec = do+  describe "jobBatchId" $ do+    it "parses the batchId out of batch jobs" $ do+      (jobs, batchId) <- withWorker id $ withProducer $ \producer -> do+        c <- buildJob @Text mempty producer "c"+        d <- buildJob @Text mempty producer "d"+        let options = description "foo" <> complete c <> success d+        batchId <- runBatch options producer $ do+          void $ batchPerform @Text mempty producer "a"+          void $ batchPerform @Text mempty producer "b"+          ask+        batchId <$ liftIO (threadDelay 500000)++      fmap (jobArg &&& jobBatchId) jobs+        `shouldMatchList` [ ("HALT", Nothing)+                          , ("a", Just batchId)+                          , ("b", Just batchId)+                          , ("c", Just batchId)+                          , ("d", Just batchId)+                          ]+   describe "runBatch" $ do     it "runs a success job if all in-batch jobs succeed" $ do       jobs <- workerTestCase $ \producer -> do@@ -21,7 +43,7 @@         -- Give a little time for Faktory to fire the callback         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["a", "b", "c", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["a", "b", "c", "HALT"]      it "does not run a success job if all jobs don't succeed" $ do       jobs <- workerTestCase $ \producer -> do@@ -31,7 +53,7 @@           void $ batchPerform @Text mempty producer "b"         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["BOOM", "b", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["BOOM", "b", "HALT"]      it "runs a job on complete" $ do       jobs <- workerTestCase $ \producer -> do@@ -41,7 +63,7 @@           void $ batchPerform @Text mempty producer "b"         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["a", "b", "c", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["a", "b", "c", "HALT"]      it "runs a job on complete, even if in-batch jobs fail" $ do       jobs <- workerTestCase $ \producer -> do@@ -51,7 +73,7 @@           void $ batchPerform @Text mempty producer "b"         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["BOOM", "b", "c", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["BOOM", "b", "c", "HALT"]      it "combines duplicate options in last-wins fashion" $ do       jobs <- workerTestCase $ \producer -> do@@ -63,7 +85,7 @@           void $ batchPerform @Text mempty producer "b"         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["a", "b", "d", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["a", "b", "d", "HALT"]      it "runs success and complete if all Jobs were successful" $ do       jobs <- workerTestCase $ \producer -> do@@ -75,10 +97,10 @@           void $ batchPerform @Text mempty producer "b"         liftIO $ threadDelay 500000 -      jobs `shouldMatchList` ["a", "b", "c", "d", "HALT"]+      fmap jobArg jobs `shouldMatchList` ["a", "b", "c", "d", "HALT"]      it "supports BATCH STATUS" $ do-      batchId <- withWorker id $ withProducer $ \producer -> do+      (_, batchId) <- withWorker id $ withProducer $ \producer -> do         c <- buildJob @Text mempty producer "c"         d <- buildJob @Text mempty producer "d"         let options = description "foo" <> complete c <> success d

@@ -1,3 +1,5 @@+{-# LANGUAGE TupleSections #-}+ module Faktory.Test   ( module X   , workerTestCase@@ -24,14 +26,14 @@ import Faktory.Settings import Faktory.Worker -workerTestCase :: HasCallStack => (Producer -> IO ()) -> IO [Text]+workerTestCase :: HasCallStack => (Producer -> IO ()) -> IO [Job Text] workerTestCase = workerTestCaseWith id  workerTestCaseWith   :: HasCallStack   => (WorkerSettings -> WorkerSettings)   -> (Producer -> IO ())-  -> IO [Text]+  -> IO [Job Text] workerTestCaseWith editSettings run = do   a <- startWorker editSettings   withProducer run@@ -41,14 +43,17 @@ withProducer f = bracket newProducerEnv closeProducer f  withWorker-  :: HasCallStack => (WorkerSettings -> WorkerSettings) -> IO a -> IO a+  :: HasCallStack+  => (WorkerSettings -> WorkerSettings)+  -> IO a+  -> IO ([Job Text], a) withWorker editSettings f = do   a <- startWorker editSettings   result <- f-  result <$ haltWorker a+  (, result) <$> haltWorker a  startWorker-  :: HasCallStack => (WorkerSettings -> WorkerSettings) -> IO (Async [Text])+  :: HasCallStack => (WorkerSettings -> WorkerSettings) -> IO (Async [Job Text]) startWorker editSettings = do   withProducer $ void . flush   settings <- envSettings@@ -59,7 +64,7 @@     runWorker settings workerSettings $ \faktoryJob -> do       let job = jobArg faktoryJob       when (job == "WAIT") $ threadDelay 3000000-      modifyMVar_ processedJobs $ pure . (job :)+      modifyMVar_ processedJobs $ pure . (faktoryJob :)       when (job == "BOOM") $ throw $ userError "BOOM"       when (job == "HALT") $ throw WorkerHalt 

@@ -15,27 +15,27 @@       void $ perform @Text mempty producer "a"       void $ perform @Text mempty producer "b" -    jobs `shouldMatchList` ["a", "b", "HALT"]+    fmap jobArg jobs `shouldMatchList` ["a", "b", "HALT"]    it "can push jobs with optional attributes" $ do     jobs <- workerTestCase $ \producer -> do       void $ perform @Text once producer "a"       void $ perform @Text (retry 0) producer "b" -    jobs `shouldMatchList` ["a", "b", "HALT"]+    fmap jobArg jobs `shouldMatchList` ["a", "b", "HALT"]    it "can push Jobs to run at a given time" $ do     now <- getCurrentTime     jobs <- workerTestCase $ \producer -> do       void $ perform @Text (at now) producer "a" -    jobs `shouldMatchList` ["a", "HALT"]+    fmap jobArg jobs `shouldMatchList` ["a", "HALT"]    it "can push Jobs to run in a given amount of seconds" $ do     jobs <- workerTestCase $ \producer -> do       void $ perform @Text (in_ 0) producer "a" -    jobs `shouldMatchList` ["a", "HALT"]+    fmap jobArg jobs `shouldMatchList` ["a", "HALT"]    it "correctly handles fetch timeouts" $ do     -- Pause longer than the fetch timeout@@ -50,16 +50,16 @@     jobs <- workerTestCaseWith editSettings $ \_ -> do       threadDelay $ 2 * 1000000 + 250000 -    jobs `shouldMatchList` ["HALT"]+    fmap jobArg jobs `shouldMatchList` ["HALT"]    it "does not process jobs when reserve_for timeout expires" $ do     jobs <- workerTestCase $ \producer -> do       void $ perform @Text (reserveFor 1) producer "WAIT" -    jobs `shouldMatchList` ["HALT"]+    fmap jobArg jobs `shouldMatchList` ["HALT"]    it "processes jobs within reserve_for window" $ do     jobs <- workerTestCase $ \producer -> do       void $ perform @Text (reserveFor 4) producer "WAIT" -    jobs `shouldMatchList` ["WAIT", "HALT"]+    fmap jobArg jobs `shouldMatchList` ["WAIT", "HALT"]