From b91c1e1eb7372931f9e0ef34731cfee5d39c8339 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Sun, 1 Oct 2023 18:04:24 +0200 Subject: [PATCH 1/9] Support aeson-2.2 --- src/OddJobs/Job.hs | 4 ++-- stack.yaml | 16 +++++++++++++++- 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index b887ac3..7bcc517 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -125,11 +125,11 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import System.FilePath (FilePath) import qualified System.Directory as Dir -import Data.Aeson.Internal (iparse, IResult(..), formatError) import Prelude hiding (log) import GHC.Exts (toList) import Database.PostgreSQL.Simple.Types as PGS (Identifier(..)) import Database.PostgreSQL.Simple.ToField as PGS (toField) +import Data.Aeson.Types -- | The documentation of odd-jobs currently promotes 'startJobRunner', which -- expects a fairly detailed 'Config' record, as a top-level function for @@ -427,7 +427,7 @@ runJob jid = do runJobWithTimeout lockTimeout job endTime <- liftIO getCurrentTime shouldDeleteJob <- deleteSuccessfulJobs - let newJob = job{jobStatus=Success, jobLockedBy=Nothing, jobLockedAt=Nothing, jobUpdatedAt = endTime} + let newJob = job{jobStatus=OddJobs.Types.Success, jobLockedBy=Nothing, jobLockedAt=Nothing, jobUpdatedAt = endTime} if shouldDeleteJob then deleteJob jid else void $ saveJob newJob diff --git a/stack.yaml b/stack.yaml index 0e1c474..4bf5d37 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,6 +1,20 @@ -resolver: lts-20.26 +resolver: lts-21.2 + packages: - . extra-deps: + - aeson-2.2.0.0 - timing-convenience-0.1@sha256:7ff807a9a9e5596f2b18d45c5a01aefb91d4a98f6a1008d183b5c550f68f7cb7,2092 - resource-pool-0.4.0.0@sha256:9c1e448a159875e21a7e68697feee2b61a4e584720974fa465a2fa1bc0776c73,1342 + - integer-conversion-0.1@sha256:9f77cc7711d3100a4483f2dd1a22f4be5b59d235a556d910d0e6c5e90a967551,2208 + - text-iso8601-0.1@sha256:fc10d8de72fc094d0d299644f17421b9430d1c1092a1355c7f0c02d8b6edf6a7,2371 + - th-abstraction-0.5.0.0@sha256:4351cadf6bf0ca80c90225bae0b12f4cfdd550f30c333b050186af5a8bc19457,2236 + - git: https://github.com/haskell-servant/servant.git + commit: c194e5ccefb49c92b0be1bf9248d647aba1b5d95 + subdir: servant + - git: https://github.com/haskell-servant/servant.git + commit: c194e5ccefb49c92b0be1bf9248d647aba1b5d95 + subdir: servant-server + - postgresql-simple-0.6.5.1 + +allow-newer: true From f8f92afc940445e2456e6f69fc11b8dc390e0bf1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Sun, 1 Oct 2023 18:05:54 +0200 Subject: [PATCH 2/9] fixup! Support aeson-2.2 --- stack.yaml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/stack.yaml b/stack.yaml index 4bf5d37..7cf8b7d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-21.2 +resolver: lts-21.13 packages: - . @@ -10,10 +10,10 @@ extra-deps: - text-iso8601-0.1@sha256:fc10d8de72fc094d0d299644f17421b9430d1c1092a1355c7f0c02d8b6edf6a7,2371 - th-abstraction-0.5.0.0@sha256:4351cadf6bf0ca80c90225bae0b12f4cfdd550f30c333b050186af5a8bc19457,2236 - git: https://github.com/haskell-servant/servant.git - commit: c194e5ccefb49c92b0be1bf9248d647aba1b5d95 + commit: a14cd7e520816c38c267efcef43e3c10d66d0186 subdir: servant - git: https://github.com/haskell-servant/servant.git - commit: c194e5ccefb49c92b0be1bf9248d647aba1b5d95 + commit: a14cd7e520816c38c267efcef43e3c10d66d0186 subdir: servant-server - postgresql-simple-0.6.5.1 From ee75a7a9f9b75ddff6640edee6e46ba6a8cf09c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Mon, 2 Oct 2023 17:44:19 +0200 Subject: [PATCH 3/9] Update src/OddJobs/Job.hs Co-authored-by: Jappie Klooster --- src/OddJobs/Job.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index 7bcc517..3cd5f2c 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -129,7 +129,11 @@ import Prelude hiding (log) import GHC.Exts (toList) import Database.PostgreSQL.Simple.Types as PGS (Identifier(..)) import Database.PostgreSQL.Simple.ToField as PGS (toField) +#if MIN_VERSION_aeson(2,2,0) import Data.Aeson.Types +#else +import Data.Aeson.Internal (iparse, IResult(..), formatError) +#endif -- | The documentation of odd-jobs currently promotes 'startJobRunner', which -- expects a fairly detailed 'Config' record, as a top-level function for From 77e74ecdf5353fed5b27f300d9bc95f62c444473 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Th=C3=A9ophile=20Choutri?= Date: Mon, 2 Oct 2023 18:15:08 +0200 Subject: [PATCH 4/9] fixup! Update src/OddJobs/Job.hs --- src/OddJobs/Job.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index 3cd5f2c..4fc15cd 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -1,5 +1,5 @@ {-# LANGUAGE RankNTypes, FlexibleInstances, FlexibleContexts, PartialTypeSignatures, UndecidableInstances #-} -{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables #-} +{-# LANGUAGE ExistentialQuantification, RecordWildCards, ScopedTypeVariables, CPP #-} module OddJobs.Job ( @@ -527,7 +527,7 @@ jobMonitor = do -- | Ref: 'jobPoller' jobPollingSql :: Query jobPollingSql = - "update ? set status = ?, locked_at = ?, locked_by = ?, attempts=attempts+1\ + "update ? set status = ?, locked_at = ?, locked_by = ?, attempts=attempts+1 \ \ WHERE id in (select id from ? where (run_at<=? AND ((status in ?) OR (status = ? and locked_at Date: Sat, 7 Oct 2023 20:14:07 +0200 Subject: [PATCH 5/9] Split out multi line strings in seperate module --- odd-jobs.cabal | 1 + src/OddJobs/Job.hs | 72 +------------------------------- src/OddJobs/Job/Query.hs | 89 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 92 insertions(+), 70 deletions(-) create mode 100644 src/OddJobs/Job/Query.hs diff --git a/odd-jobs.cabal b/odd-jobs.cabal index 8104388..f680a97 100644 --- a/odd-jobs.cabal +++ b/odd-jobs.cabal @@ -58,6 +58,7 @@ library OddJobs.ConfigBuilder other-modules: UI + OddJobs.Job.Query Paths_odd_jobs hs-source-dirs: src diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index 4fc15cd..171571e 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -82,6 +82,7 @@ module OddJobs.Job ) where +import OddJobs.Job.Query import OddJobs.Types import qualified Data.Pool as Pool import Data.Pool(Pool) @@ -129,6 +130,7 @@ import Prelude hiding (log) import GHC.Exts (toList) import Database.PostgreSQL.Simple.Types as PGS (Identifier(..)) import Database.PostgreSQL.Simple.ToField as PGS (toField) +import OddJobs.Job.Query #if MIN_VERSION_aeson(2,2,0) import Data.Aeson.Types #else @@ -239,39 +241,6 @@ jobWorkerName = do hname <- getHostName pure $ hname ++ ":" ++ show pid --- | If you are writing SQL queries where you want to return ALL columns from --- the jobs table it is __recommended__ that you do not issue a @SELECT *@ or --- @RETURNIG *@. List out specific DB columns using 'jobDbColumns' and --- 'concatJobDbColumns' instead. This will insulate you from runtime errors --- caused by addition of new columns to 'cfgTableName' in future versions of --- OddJobs. -jobDbColumns :: (IsString s, Semigroup s) => [s] -jobDbColumns = - [ "id" - , "created_at" - , "updated_at" - , "run_at" - , "status" - , "payload" - , "last_error" - , "attempts" - , "locked_at" - , "locked_by" - ] - --- | All 'jobDbColumns' joined together with commas. Useful for constructing SQL --- queries, eg: --- --- @'query_' conn $ "SELECT " <> concatJobDbColumns <> "FROM jobs"@ - -concatJobDbColumns :: (IsString s, Semigroup s) => s -concatJobDbColumns = concatJobDbColumns_ jobDbColumns "" - where - concatJobDbColumns_ [] x = x - concatJobDbColumns_ [col] x = x <> col - concatJobDbColumns_ (col:cols) x = concatJobDbColumns_ cols (x <> col <> ", ") - - findJobByIdQuery :: PGS.Query findJobByIdQuery = "SELECT " <> concatJobDbColumns <> " FROM ? WHERE id = ?" @@ -524,29 +493,6 @@ jobMonitor = do log LevelInfo (LogText "Waiting for jobs to complete.") waitForJobs --- | Ref: 'jobPoller' -jobPollingSql :: Query -jobPollingSql = - "update ? set status = ?, locked_at = ?, locked_by = ?, attempts=attempts+1 \ - \ WHERE id in (select id from ? where (run_at<=? AND ((status in ?) OR (status = ? and locked_at m () waitForJobs = do @@ -724,9 +670,6 @@ jobEventListener = do let tryLockingJob jid mResCfg = withDbConnection $ \conn -> do let q = "UPDATE ? SET status=?, locked_at=now(), locked_by=?, attempts=attempts+1 WHERE id=? AND status in ? RETURNING id" - qWithResources = - "UPDATE ? SET status=?, locked_at=now(), locked_by=?, attempts=attempts+1 \ - \ WHERE id=? AND status in ? AND ?(id) RETURNING id" result <- case mResCfg of Nothing -> liftIO $ PGS.query conn q (tname, Locked, jwName, jid, In [Queued, Retry]) Just ResourceCfg{..} -> liftIO $ PGS.query conn qWithResources @@ -780,17 +723,6 @@ jobEventListener = do jid <- o .: "id" pure (jid, runAt_, mLockedAt_) - - -createJobQuery :: PGS.Query -createJobQuery = "INSERT INTO ? (run_at, status, payload, last_error, attempts, locked_at, locked_by) VALUES (?, ?, ?, ?, ?, ?, ?) RETURNING " <> concatJobDbColumns - -ensureResource :: PGS.Query -ensureResource = "INSERT INTO ? (id, usage_limit) VALUES (?, ?) ON CONFLICT DO NOTHING" - -registerResourceUsage :: PGS.Query -registerResourceUsage = "INSERT INTO ? (job_id, resource_id, usage) VALUES (?, ?, ?)" - -- $createJobs -- -- Ideally you'd want to create wrappers for 'createJob' and 'scheduleJob' in diff --git a/src/OddJobs/Job/Query.hs b/src/OddJobs/Job/Query.hs new file mode 100644 index 0000000..8c3d94e --- /dev/null +++ b/src/OddJobs/Job/Query.hs @@ -0,0 +1,89 @@ + +-- | Split out the queries because the multiline strings conflict +-- with CPP. +-- see https://gitlab.haskell.org/ghc/ghc/-/issues/16520 +module OddJobs.Job.Query + ( jobPollingSql + , jobPollingWithResourceSql + , killJobPollingSql + , qWithResources + , createJobQuery + , ensureResource + , registerResourceUsage + , concatJobDbColumns + , jobDbColumns + ) +where + +import Database.PostgreSQL.Simple(Query) +import Data.String + +-- | Ref: 'jobPoller' +jobPollingSql :: Query +jobPollingSql = + "update ? set status = ?, locked_at = ?, locked_by = ?, attempts=attempts+1 \ + \ WHERE id in (select id from ? where (run_at<=? AND ((status in ?) OR (status = ? and locked_at concatJobDbColumns + +ensureResource :: Query +ensureResource = "INSERT INTO ? (id, usage_limit) VALUES (?, ?) ON CONFLICT DO NOTHING" + +registerResourceUsage :: Query +registerResourceUsage = "INSERT INTO ? (job_id, resource_id, usage) VALUES (?, ?, ?)" + +-- | All 'jobDbColumns' joined together with commas. Useful for constructing SQL +-- queries, eg: +-- +-- @'query_' conn $ "SELECT " <> concatJobDbColumns <> "FROM jobs"@ + +concatJobDbColumns :: (IsString s, Semigroup s) => s +concatJobDbColumns = concatJobDbColumns_ jobDbColumns "" + where + concatJobDbColumns_ [] x = x + concatJobDbColumns_ [col] x = x <> col + concatJobDbColumns_ (col:cols) x = concatJobDbColumns_ cols (x <> col <> ", ") + +-- | If you are writing SQL queries where you want to return ALL columns from +-- the jobs table it is __recommended__ that you do not issue a @SELECT *@ or +-- @RETURNIG *@. List out specific DB columns using 'jobDbColumns' and +-- 'concatJobDbColumns' instead. This will insulate you from runtime errors +-- caused by addition of new columns to 'cfgTableName' in future versions of +-- OddJobs. +jobDbColumns :: (IsString s, Semigroup s) => [s] +jobDbColumns = + [ "id" + , "created_at" + , "updated_at" + , "run_at" + , "status" + , "payload" + , "last_error" + , "attempts" + , "locked_at" + , "locked_by" + ] From b8aced00b47f633ed7aa8af34d47285be5da1461 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 7 Oct 2023 20:17:13 +0200 Subject: [PATCH 6/9] use fewer imports hint --- odd-jobs.cabal | 1 + src/OddJobs/Job.hs | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/odd-jobs.cabal b/odd-jobs.cabal index f680a97..ebaf1a0 100644 --- a/odd-jobs.cabal +++ b/odd-jobs.cabal @@ -118,6 +118,7 @@ executable devel OddJobs.Endpoints OddJobs.Job OddJobs.Migrations + OddJobs.Job.Query OddJobs.Types OddJobs.Web UI diff --git a/src/OddJobs/Job.hs b/src/OddJobs/Job.hs index 171571e..f7b5cf8 100644 --- a/src/OddJobs/Job.hs +++ b/src/OddJobs/Job.hs @@ -82,7 +82,6 @@ module OddJobs.Job ) where -import OddJobs.Job.Query import OddJobs.Types import qualified Data.Pool as Pool import Data.Pool(Pool) From bdf36341dc2955b2e8e4ee713e5ffadda70b03c8 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 7 Oct 2023 20:42:12 +0200 Subject: [PATCH 7/9] don't upgrade servant --- stack.yaml | 6 ------ 1 file changed, 6 deletions(-) diff --git a/stack.yaml b/stack.yaml index 7cf8b7d..4f00344 100644 --- a/stack.yaml +++ b/stack.yaml @@ -9,12 +9,6 @@ extra-deps: - integer-conversion-0.1@sha256:9f77cc7711d3100a4483f2dd1a22f4be5b59d235a556d910d0e6c5e90a967551,2208 - text-iso8601-0.1@sha256:fc10d8de72fc094d0d299644f17421b9430d1c1092a1355c7f0c02d8b6edf6a7,2371 - th-abstraction-0.5.0.0@sha256:4351cadf6bf0ca80c90225bae0b12f4cfdd550f30c333b050186af5a8bc19457,2236 - - git: https://github.com/haskell-servant/servant.git - commit: a14cd7e520816c38c267efcef43e3c10d66d0186 - subdir: servant - - git: https://github.com/haskell-servant/servant.git - commit: a14cd7e520816c38c267efcef43e3c10d66d0186 - subdir: servant-server - postgresql-simple-0.6.5.1 allow-newer: true From e76f7981992301f19bbda156a9c0182b11da88c8 Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 7 Oct 2023 21:07:39 +0200 Subject: [PATCH 8/9] use newer hackage --- stack.yaml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index 4f00344..e430639 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-21.13 +resolver: lts-21.14 packages: - . @@ -9,6 +9,8 @@ extra-deps: - integer-conversion-0.1@sha256:9f77cc7711d3100a4483f2dd1a22f4be5b59d235a556d910d0e6c5e90a967551,2208 - text-iso8601-0.1@sha256:fc10d8de72fc094d0d299644f17421b9430d1c1092a1355c7f0c02d8b6edf6a7,2371 - th-abstraction-0.5.0.0@sha256:4351cadf6bf0ca80c90225bae0b12f4cfdd550f30c333b050186af5a8bc19457,2236 + - servant-0.20.1 + - servant-0.20 - postgresql-simple-0.6.5.1 allow-newer: true From 6f59871ab55812a5ae4e3c9355f411b5625cd6bb Mon Sep 17 00:00:00 2001 From: Jappie Klooster Date: Sat, 7 Oct 2023 21:20:57 +0200 Subject: [PATCH 9/9] server --- stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/stack.yaml b/stack.yaml index e430639..9d0eefc 100644 --- a/stack.yaml +++ b/stack.yaml @@ -10,7 +10,7 @@ extra-deps: - text-iso8601-0.1@sha256:fc10d8de72fc094d0d299644f17421b9430d1c1092a1355c7f0c02d8b6edf6a7,2371 - th-abstraction-0.5.0.0@sha256:4351cadf6bf0ca80c90225bae0b12f4cfdd550f30c333b050186af5a8bc19457,2236 - servant-0.20.1 - - servant-0.20 + - servant-server-0.20 - postgresql-simple-0.6.5.1 allow-newer: true