From b65d2c4abdf6506c0080271bfc0965a976a6997c Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sat, 7 Feb 2026 13:44:41 +0200 Subject: [PATCH 1/2] Add 'until' to API routes that list things --- app-e2e/src/Test/E2E/Support/Client.purs | 6 +-- app/src/App/Effect/Db.purs | 10 ++--- app/src/App/SQLite.js | 55 ++++++++++++++++-------- app/src/App/SQLite.purs | 54 +++++++++++++---------- app/src/App/Server/Router.purs | 54 +++++++++++++++-------- lib/src/API/V1.purs | 6 ++- 6 files changed, 116 insertions(+), 69 deletions(-) diff --git a/app-e2e/src/Test/E2E/Support/Client.purs b/app-e2e/src/Test/E2E/Support/Client.purs index 3c1c02e62..e6f556705 100644 --- a/app-e2e/src/Test/E2E/Support/Client.purs +++ b/app-e2e/src/Test/E2E/Support/Client.purs @@ -122,7 +122,7 @@ getJobsWith filter = do includeCompleted = case filter of ActiveOnly -> Just false IncludeCompleted -> Just true - route = Jobs { since: Nothing, include_completed: includeCompleted } + route = Jobs { since: Nothing, until: Nothing, include_completed: includeCompleted } liftAff $ get (CJ.array V1.jobCodec) clientConfig.baseUrl (printRoute route) -- | Get the list of jobs (includes completed jobs) @@ -133,7 +133,7 @@ getJobs = getJobsWith IncludeCompleted getJob :: JobId -> Maybe LogLevel -> Maybe DateTime -> E2E Job getJob jobId level since = do { clientConfig } <- ask - let route = Job jobId { level, since } + let route = Job jobId { level, since, until: Nothing } liftAff $ get V1.jobCodec clientConfig.baseUrl (printRoute route) -- | Try to get a specific job by ID, returning Left on HTTP/parse errors. @@ -141,7 +141,7 @@ getJob jobId level since = do tryGetJob :: JobId -> Maybe LogLevel -> Maybe DateTime -> E2E (Either ClientError Job) tryGetJob jobId level since = do { clientConfig } <- ask - let route = Job jobId { level, since } + let route = Job jobId { level, since, until: Nothing } liftAff $ tryGet V1.jobCodec clientConfig.baseUrl (printRoute route) -- | Check if the server is healthy diff --git a/app/src/App/Effect/Db.purs b/app/src/App/Effect/Db.purs index edad2a9c1..52e60352d 100644 --- a/app/src/App/Effect/Db.purs +++ b/app/src/App/Effect/Db.purs @@ -45,7 +45,7 @@ data Db a | SelectTransferJob PackageName (Either String (Maybe TransferJobDetails) -> a) | SelectPackageSetJobByPayload PackageSetOperation (Either String (Maybe PackageSetJobDetails) -> a) | InsertLogLine LogLine a - | SelectLogsByJob JobId LogLevel DateTime (Array LogLine -> a) + | SelectLogsByJob JobId LogLevel (Maybe DateTime) (Maybe DateTime) (Array LogLine -> a) | ResetIncompleteJobs (Array JobId -> a) derive instance Functor Db @@ -61,8 +61,8 @@ insertLog :: forall r. LogLine -> Run (DB + r) Unit insertLog log = Run.lift _db (InsertLogLine log unit) -- | Select all logs for a given job, filtered by loglevel. -selectLogsByJob :: forall r. JobId -> LogLevel -> DateTime -> Run (DB + r) (Array LogLine) -selectLogsByJob jobId logLevel since = Run.lift _db (SelectLogsByJob jobId logLevel since identity) +selectLogsByJob :: forall r. JobId -> LogLevel -> Maybe DateTime -> Maybe DateTime -> Run (DB + r) (Array LogLine) +selectLogsByJob jobId logLevel since until = Run.lift _db (SelectLogsByJob jobId logLevel since until identity) -- | Set a job in the database to the 'finished' state. finishJob :: forall r. FinishJob -> Run (DB + r) Unit @@ -228,8 +228,8 @@ handleSQLite env = case _ of Run.liftEffect $ SQLite.insertLogLine env.db log pure next - SelectLogsByJob jobId logLevel since reply -> do - { fail, success } <- Run.liftEffect $ SQLite.selectLogsByJob env.db jobId logLevel since + SelectLogsByJob jobId logLevel since until reply -> do + { fail, success } <- Run.liftEffect $ SQLite.selectLogsByJob env.db jobId logLevel since until unless (Array.null fail) do Log.warn $ "Some logs are not readable: " <> String.joinWith "\n" fail pure $ reply success diff --git a/app/src/App/SQLite.js b/app/src/App/SQLite.js index 397557f44..8296a8242 100644 --- a/app/src/App/SQLite.js +++ b/app/src/App/SQLite.js @@ -168,14 +168,24 @@ export const selectPackageSetJobByPayloadImpl = (db, payload) => { return stmt.get(payload); }; -const _selectJobs = (db, { table, since, includeCompleted }) => { +const _selectJobs = (db, { table, since, until, includeCompleted }) => { let query = ` SELECT job.*, info.* FROM ${table} job JOIN ${JOB_INFO_TABLE} info ON job.jobId = info.jobId - WHERE info.createdAt >= ? + WHERE 1=1 `; - let params = [since]; + let params = []; + + if (since != null) { + query += ` AND info.createdAt >= ?`; + params.push(since); + } + + if (until != null) { + query += ` AND info.createdAt <= ?`; + params.push(until); + } if (includeCompleted === false) { query += ` AND info.finishedAt IS NULL`; @@ -187,24 +197,24 @@ const _selectJobs = (db, { table, since, includeCompleted }) => { return stmt.all(...params); } -export const selectPublishJobsImpl = (db, since, includeCompleted) => { - return _selectJobs(db, { table: PUBLISH_JOBS_TABLE, since, includeCompleted }); +export const selectPublishJobsImpl = (db, since, until, includeCompleted) => { + return _selectJobs(db, { table: PUBLISH_JOBS_TABLE, since, until, includeCompleted }); }; -export const selectUnpublishJobsImpl = (db, since, includeCompleted) => { - return _selectJobs(db, { table: UNPUBLISH_JOBS_TABLE, since, includeCompleted }); +export const selectUnpublishJobsImpl = (db, since, until, includeCompleted) => { + return _selectJobs(db, { table: UNPUBLISH_JOBS_TABLE, since, until, includeCompleted }); }; -export const selectTransferJobsImpl = (db, since, includeCompleted) => { - return _selectJobs(db, { table: TRANSFER_JOBS_TABLE, since, includeCompleted }); +export const selectTransferJobsImpl = (db, since, until, includeCompleted) => { + return _selectJobs(db, { table: TRANSFER_JOBS_TABLE, since, until, includeCompleted }); }; -export const selectMatrixJobsImpl = (db, since, includeCompleted) => { - return _selectJobs(db, { table: MATRIX_JOBS_TABLE, since, includeCompleted }); +export const selectMatrixJobsImpl = (db, since, until, includeCompleted) => { + return _selectJobs(db, { table: MATRIX_JOBS_TABLE, since, until, includeCompleted }); }; -export const selectPackageSetJobsImpl = (db, since, includeCompleted) => { - return _selectJobs(db, { table: PACKAGE_SET_JOBS_TABLE, since, includeCompleted }); +export const selectPackageSetJobsImpl = (db, since, until, includeCompleted) => { + return _selectJobs(db, { table: PACKAGE_SET_JOBS_TABLE, since, until, includeCompleted }); }; export const startJobImpl = (db, args) => { @@ -258,13 +268,24 @@ export const insertLogLineImpl = (db, logLine) => { return stmt.run(logLine); }; -export const selectLogsByJobImpl = (db, jobId, logLevel, since) => { +export const selectLogsByJobImpl = (db, jobId, logLevel, since, until) => { let query = ` SELECT * FROM ${LOGS_TABLE} - WHERE jobId = ? AND level >= ? AND timestamp >= ? - ORDER BY timestamp ASC LIMIT 100 + WHERE jobId = ? AND level >= ? `; + let params = [jobId, logLevel]; + if (since != null) { + query += ` AND timestamp >= ?`; + params.push(since); + } + + if (until != null) { + query += ` AND timestamp <= ?`; + params.push(until); + } + + query += ` ORDER BY timestamp ASC LIMIT 100`; const stmt = db.prepare(query); - return stmt.all(jobId, logLevel, since); + return stmt.all(...params); }; diff --git a/app/src/App/SQLite.purs b/app/src/App/SQLite.purs index a2fa53cc5..ecb83f9b6 100644 --- a/app/src/App/SQLite.purs +++ b/app/src/App/SQLite.purs @@ -57,7 +57,7 @@ import Data.Function (on) import Data.Nullable (notNull, null) import Data.Nullable as Nullable import Data.UUID.Random as UUID -import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, EffectFn4) +import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn4, EffectFn5) import Effect.Uncurried as Uncurried import Record as Record import Registry.API.V1 (Job(..), JobId(..), LogLevel(..), LogLine) @@ -192,14 +192,15 @@ toSuccess success = case success of type SelectJobRequest = { level :: Maybe LogLevel - , since :: DateTime + , since :: Maybe DateTime + , until :: Maybe DateTime , jobId :: JobId } selectJob :: SQLite -> SelectJobRequest -> Effect { unreadableLogs :: Array String, job :: Either String (Maybe Job) } -selectJob db { level: maybeLogLevel, since, jobId: JobId jobId } = do +selectJob db { level: maybeLogLevel, since, until, jobId: JobId jobId } = do let logLevel = fromMaybe Info maybeLogLevel - { fail: unreadableLogs, success: logs } <- selectLogsByJob db (JobId jobId) logLevel since + { fail: unreadableLogs, success: logs } <- selectLogsByJob db (JobId jobId) logLevel since until -- Failing to decode a log should not prevent us from returning a job, so we pass -- failures through to be handled by application code job <- runExceptT $ firstJust @@ -262,12 +263,13 @@ selectJob db { level: maybeLogLevel, since, jobId: JobId jobId } = do maybeJobDetails type SelectJobsRequest = - { since :: DateTime + { since :: Maybe DateTime + , until :: Maybe DateTime , includeCompleted :: Boolean } selectJobs :: SQLite -> SelectJobsRequest -> Effect { failed :: Array String, jobs :: Array Job } -selectJobs db { since, includeCompleted } = do +selectJobs db { since, until, includeCompleted } = do publishJobs <- selectPublishJobs unpublishJobs <- selectUnpublishJobs transferJobs <- selectTransferJobs @@ -279,24 +281,27 @@ selectJobs db { since, includeCompleted } = do pure { failed: failedJobs, jobs: take 100 $ sortBy (compare `on` (V1.jobInfo >>> _.createdAt)) allJobs } where + sinceStr = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) since + untilStr = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) until + selectPublishJobs = do - jobs <- Uncurried.runEffectFn3 selectPublishJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted + jobs <- Uncurried.runEffectFn4 selectPublishJobsImpl db sinceStr untilStr includeCompleted pure $ map (map (PublishJob <<< Record.merge { logs: [], jobType: Proxy :: _ "publish" }) <<< publishJobDetailsFromJSRep) jobs selectUnpublishJobs = do - jobs <- Uncurried.runEffectFn3 selectUnpublishJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted + jobs <- Uncurried.runEffectFn4 selectUnpublishJobsImpl db sinceStr untilStr includeCompleted pure $ map (map (UnpublishJob <<< Record.merge { logs: [], jobType: Proxy :: _ "unpublish" }) <<< unpublishJobDetailsFromJSRep) jobs selectTransferJobs = do - jobs <- Uncurried.runEffectFn3 selectTransferJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted + jobs <- Uncurried.runEffectFn4 selectTransferJobsImpl db sinceStr untilStr includeCompleted pure $ map (map (TransferJob <<< Record.merge { logs: [], jobType: Proxy :: _ "transfer" }) <<< transferJobDetailsFromJSRep) jobs selectMatrixJobs = do - jobs <- Uncurried.runEffectFn3 selectMatrixJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted + jobs <- Uncurried.runEffectFn4 selectMatrixJobsImpl db sinceStr untilStr includeCompleted pure $ map (map (MatrixJob <<< Record.merge { logs: [], jobType: Proxy :: _ "matrix" }) <<< matrixJobDetailsFromJSRep) jobs selectPackageSetJobs = do - jobs <- Uncurried.runEffectFn3 selectPackageSetJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted + jobs <- Uncurried.runEffectFn4 selectPackageSetJobsImpl db sinceStr untilStr includeCompleted pure $ map (map (PackageSetJob <<< Record.merge { logs: [], jobType: Proxy :: _ "packageset" }) <<< packageSetJobDetailsFromJSRep) jobs -------------------------------------------------------------------------------- @@ -352,7 +357,7 @@ type SelectPublishParams = foreign import selectPublishJobImpl :: EffectFn2 SQLite SelectPublishParams (Nullable JSPublishJobDetails) -foreign import selectPublishJobsImpl :: EffectFn3 SQLite String Boolean (Array JSPublishJobDetails) +foreign import selectPublishJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSPublishJobDetails) selectNextPublishJob :: SQLite -> Effect (Either String (Maybe PublishJobDetails)) selectNextPublishJob db = do @@ -452,7 +457,7 @@ type SelectUnpublishParams = foreign import selectUnpublishJobImpl :: EffectFn2 SQLite SelectUnpublishParams (Nullable JSUnpublishJobDetails) -foreign import selectUnpublishJobsImpl :: EffectFn3 SQLite String Boolean (Array JSUnpublishJobDetails) +foreign import selectUnpublishJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSUnpublishJobDetails) selectNextUnpublishJob :: SQLite -> Effect (Either String (Maybe UnpublishJobDetails)) selectNextUnpublishJob db = do @@ -550,7 +555,7 @@ type SelectTransferParams = { jobId :: Nullable String, packageName :: Nullable foreign import selectTransferJobImpl :: EffectFn2 SQLite SelectTransferParams (Nullable JSTransferJobDetails) -foreign import selectTransferJobsImpl :: EffectFn3 SQLite String Boolean (Array JSTransferJobDetails) +foreign import selectTransferJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSTransferJobDetails) selectNextTransferJob :: SQLite -> Effect (Either String (Maybe TransferJobDetails)) selectNextTransferJob db = do @@ -686,7 +691,7 @@ matrixJobDetailsFromJSRep { jobId, packageName, packageVersion, compilerVersion, foreign import selectMatrixJobImpl :: EffectFn2 SQLite (Nullable String) (Nullable JSMatrixJobDetails) -foreign import selectMatrixJobsImpl :: EffectFn3 SQLite String Boolean (Array JSMatrixJobDetails) +foreign import selectMatrixJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSMatrixJobDetails) selectNextMatrixJob :: SQLite -> Effect (Either String (Maybe MatrixJobDetails)) selectNextMatrixJob db = do @@ -734,7 +739,7 @@ foreign import selectPackageSetJobImpl :: EffectFn2 SQLite (Nullable String) (Nu foreign import selectPackageSetJobByPayloadImpl :: EffectFn2 SQLite String (Nullable JSPackageSetJobDetails) -foreign import selectPackageSetJobsImpl :: EffectFn3 SQLite String Boolean (Array JSPackageSetJobDetails) +foreign import selectPackageSetJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSPackageSetJobDetails) selectNextPackageSetJob :: SQLite -> Effect (Either String (Maybe PackageSetJobDetails)) selectNextPackageSetJob db = do @@ -814,18 +819,21 @@ foreign import insertLogLineImpl :: EffectFn2 SQLite JSLogLine Unit insertLogLine :: SQLite -> LogLine -> Effect Unit insertLogLine db = Uncurried.runEffectFn2 insertLogLineImpl db <<< logLineToJSRep -foreign import selectLogsByJobImpl :: EffectFn4 SQLite String Int String (Array JSLogLine) +foreign import selectLogsByJobImpl :: EffectFn5 SQLite String Int (Nullable String) (Nullable String) (Array JSLogLine) -- | Select all logs for a given job at or above the indicated log level. To get all --- | logs, pass the DEBUG log level. -selectLogsByJob :: SQLite -> JobId -> LogLevel -> DateTime -> Effect { fail :: Array String, success :: Array LogLine } -selectLogsByJob db jobId level since = do - let timestamp = DateTime.format Internal.Format.iso8601DateTime since +-- | logs, pass the DEBUG log level. Both since and until are optional; when provided +-- | they create a half-open [since, until) time window. +selectLogsByJob :: SQLite -> JobId -> LogLevel -> Maybe DateTime -> Maybe DateTime -> Effect { fail :: Array String, success :: Array LogLine } +selectLogsByJob db jobId level since until = do + let sinceTimestamp = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) since + let untilTimestamp = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) until jsLogLines <- - Uncurried.runEffectFn4 + Uncurried.runEffectFn5 selectLogsByJobImpl db (un JobId jobId) (API.V1.logLevelToPriority level) - timestamp + sinceTimestamp + untilTimestamp pure $ partitionEithers $ map logLineFromJSRep jsLogLines diff --git a/app/src/App/Server/Router.purs b/app/src/App/Server/Router.purs index be38b284d..dcf906564 100644 --- a/app/src/App/Server/Router.purs +++ b/app/src/App/Server/Router.purs @@ -3,17 +3,11 @@ module Registry.App.Server.Router where import Registry.App.Prelude hiding ((/)) import Data.Codec.JSON as CJ -import Data.Date as Date -import Data.DateTime (DateTime(..)) -import Data.DateTime as DateTime -import Data.Enum as Enum -import Data.Time.Duration (Hours(..), negateDuration) import Effect.Aff as Aff import Effect.Class.Console as Console import HTTPurple (Method(..), Request, Response) import HTTPurple as HTTPurple import HTTPurple.Status as Status -import Partial.Unsafe (unsafePartial) import Registry.API.V1 (Route(..)) import Registry.API.V1 as V1 import Registry.App.API as API @@ -28,12 +22,6 @@ import Run (Run) import Run as Run import Run.Except as Run.Except --- | The earliest date for which we have job logs (registry server launch date) -registryLaunch :: DateTime -registryLaunch = DateTime date bottom - where - date = Date.canonicalDate (unsafePartial fromJust $ Enum.toEnum 2026) Date.January (unsafePartial fromJust $ Enum.toEnum 31) - runRouter :: ServerEnv -> Effect Unit runRouter env = do -- Read port from SERVER_PORT env var (optional, HTTPurple defaults to 8080) @@ -43,7 +31,7 @@ runRouter env = do , port } { route: V1.routes - , router: runServer + , router: corsMiddleware runServer } where runServer :: Request Route -> Aff Response @@ -55,6 +43,27 @@ runRouter env = do HTTPurple.badRequest (Aff.message error) Right response -> pure response +-- | CORS middleware that wraps the router. +-- | - OPTIONS requests return a 204 preflight response +-- | - All other responses have CORS headers appended +corsMiddleware :: (Request Route -> Aff Response) -> Request Route -> Aff Response +corsMiddleware next request = case request.method of + Options -> + HTTPurple.emptyResponse' Status.noContent preflightHeaders + _ -> do + response <- next request + pure $ response { headers = response.headers <> corsHeaders } + where + corsHeaders = + HTTPurple.header "Access-Control-Allow-Origin" "*" + <> HTTPurple.header "Access-Control-Allow-Methods" "GET, HEAD, POST, OPTIONS" + <> HTTPurple.header "Vary" "Origin" + + preflightHeaders = + corsHeaders + <> HTTPurple.header "Access-Control-Allow-Headers" "Content-Type" + <> HTTPurple.header "Access-Control-Max-Age" "86400" + router :: Request Route -> Run ServerEffects Response router { route, method, body } = HTTPurple.usingCont case route, method of Publish, Post -> do @@ -112,13 +121,16 @@ router { route, method, body } = HTTPurple.usingCont case route, method of _ -> HTTPurple.badRequest "Expected transfer operation." - Jobs { since, include_completed }, Get -> do - now <- liftEffect nowUTC - let oneHourAgo = fromMaybe now $ DateTime.adjust (negateDuration (Hours 1.0)) now + Jobs { since, until: until', include_completed }, Get -> do + -- If neither since nor until is provided, default until to now + until <- case since, until' of + Nothing, Nothing -> Just <$> liftEffect nowUTC + _, _ -> pure until' lift ( Run.Except.runExcept $ Db.selectJobs { includeCompleted: fromMaybe false include_completed - , since: fromMaybe oneHourAgo since + , since + , until } ) >>= case _ of Left err -> do @@ -126,8 +138,12 @@ router { route, method, body } = HTTPurple.usingCont case route, method of HTTPurple.internalServerError $ "Error while fetching jobs: " <> err Right jobs -> jsonOk (CJ.array V1.jobCodec) jobs - Job jobId { level: maybeLogLevel, since }, Get -> do - lift (Run.Except.runExcept $ Db.selectJob { jobId, level: maybeLogLevel, since: fromMaybe registryLaunch since }) >>= case _ of + Job jobId { level: maybeLogLevel, since, until: until' }, Get -> do + -- If neither since nor until is provided, default until to now + until <- case since, until' of + Nothing, Nothing -> Just <$> liftEffect nowUTC + _, _ -> pure until' + lift (Run.Except.runExcept $ Db.selectJob { jobId, level: maybeLogLevel, since, until }) >>= case _ of Left err -> do lift $ Log.error $ "Error while fetching job: " <> err HTTPurple.internalServerError $ "Error while fetching job: " <> err diff --git a/lib/src/API/V1.purs b/lib/src/API/V1.purs index 5dd128fda..1e7bae689 100644 --- a/lib/src/API/V1.purs +++ b/lib/src/API/V1.purs @@ -62,8 +62,8 @@ data Route | Unpublish | Transfer | PackageSets - | Jobs { since :: Maybe DateTime, include_completed :: Maybe Boolean } - | Job JobId { level :: Maybe LogLevel, since :: Maybe DateTime } + | Jobs { since :: Maybe DateTime, until :: Maybe DateTime, include_completed :: Maybe Boolean } + | Job JobId { level :: Maybe LogLevel, since :: Maybe DateTime, until :: Maybe DateTime } | Status derive instance Generic Route _ @@ -76,12 +76,14 @@ routes = Routing.root $ Routing.prefix "api" $ Routing.prefix "v1" $ RoutingG.su , "PackageSets": "package-sets" / RoutingG.noArgs , "Jobs": "jobs" ? { since: Routing.optional <<< timestampP <<< Routing.string + , until: Routing.optional <<< timestampP <<< Routing.string , include_completed: Routing.optional <<< Routing.boolean } , "Job": "jobs" / ( jobIdS ? { level: Routing.optional <<< logLevelP <<< Routing.string , since: Routing.optional <<< timestampP <<< Routing.string + , until: Routing.optional <<< timestampP <<< Routing.string } ) , "Status": "status" / RoutingG.noArgs From 333b74cf7296dcf0806e3339012b1721ca6307e1 Mon Sep 17 00:00:00 2001 From: Fabrizio Ferrai Date: Sun, 8 Feb 2026 01:55:46 +0200 Subject: [PATCH 2/2] Review feedback --- app-e2e/src/Test/E2E/Support/Client.purs | 6 +-- app/src/App/Effect/Db.purs | 12 ++--- app/src/App/SQLite.js | 65 ++++++++--------------- app/src/App/SQLite.purs | 67 +++++++++++++----------- app/src/App/Server/Router.purs | 35 ++++++++----- lib/src/API/V1.purs | 27 +++++++++- 6 files changed, 116 insertions(+), 96 deletions(-) diff --git a/app-e2e/src/Test/E2E/Support/Client.purs b/app-e2e/src/Test/E2E/Support/Client.purs index e6f556705..4ec1b1cda 100644 --- a/app-e2e/src/Test/E2E/Support/Client.purs +++ b/app-e2e/src/Test/E2E/Support/Client.purs @@ -122,7 +122,7 @@ getJobsWith filter = do includeCompleted = case filter of ActiveOnly -> Just false IncludeCompleted -> Just true - route = Jobs { since: Nothing, until: Nothing, include_completed: includeCompleted } + route = Jobs { since: Nothing, until: Nothing, order: Nothing, include_completed: includeCompleted } liftAff $ get (CJ.array V1.jobCodec) clientConfig.baseUrl (printRoute route) -- | Get the list of jobs (includes completed jobs) @@ -133,7 +133,7 @@ getJobs = getJobsWith IncludeCompleted getJob :: JobId -> Maybe LogLevel -> Maybe DateTime -> E2E Job getJob jobId level since = do { clientConfig } <- ask - let route = Job jobId { level, since, until: Nothing } + let route = Job jobId { level, since, until: Nothing, order: Nothing } liftAff $ get V1.jobCodec clientConfig.baseUrl (printRoute route) -- | Try to get a specific job by ID, returning Left on HTTP/parse errors. @@ -141,7 +141,7 @@ getJob jobId level since = do tryGetJob :: JobId -> Maybe LogLevel -> Maybe DateTime -> E2E (Either ClientError Job) tryGetJob jobId level since = do { clientConfig } <- ask - let route = Job jobId { level, since, until: Nothing } + let route = Job jobId { level, since, until: Nothing, order: Nothing } liftAff $ tryGet V1.jobCodec clientConfig.baseUrl (printRoute route) -- | Check if the server is healthy diff --git a/app/src/App/Effect/Db.purs b/app/src/App/Effect/Db.purs index 52e60352d..6416a70e5 100644 --- a/app/src/App/Effect/Db.purs +++ b/app/src/App/Effect/Db.purs @@ -5,7 +5,7 @@ import Registry.App.Prelude import Data.Array as Array import Data.DateTime (DateTime) import Data.String as String -import Registry.API.V1 (Job, JobId, LogLevel, LogLine) +import Registry.API.V1 (Job, JobId, LogLevel, LogLine, SortOrder) import Registry.App.Effect.Log (LOG) import Registry.App.Effect.Log as Log import Registry.App.SQLite (FinishJob, InsertMatrixJob, InsertPackageSetJob, InsertPublishJob, InsertTransferJob, InsertUnpublishJob, MatrixJobDetails, PackageSetJobDetails, PublishJobDetails, SQLite, SelectJobRequest, SelectJobsRequest, StartJob, TransferJobDetails, UnpublishJobDetails) @@ -45,7 +45,7 @@ data Db a | SelectTransferJob PackageName (Either String (Maybe TransferJobDetails) -> a) | SelectPackageSetJobByPayload PackageSetOperation (Either String (Maybe PackageSetJobDetails) -> a) | InsertLogLine LogLine a - | SelectLogsByJob JobId LogLevel (Maybe DateTime) (Maybe DateTime) (Array LogLine -> a) + | SelectLogsByJob JobId LogLevel DateTime DateTime SortOrder (Array LogLine -> a) | ResetIncompleteJobs (Array JobId -> a) derive instance Functor Db @@ -61,8 +61,8 @@ insertLog :: forall r. LogLine -> Run (DB + r) Unit insertLog log = Run.lift _db (InsertLogLine log unit) -- | Select all logs for a given job, filtered by loglevel. -selectLogsByJob :: forall r. JobId -> LogLevel -> Maybe DateTime -> Maybe DateTime -> Run (DB + r) (Array LogLine) -selectLogsByJob jobId logLevel since until = Run.lift _db (SelectLogsByJob jobId logLevel since until identity) +selectLogsByJob :: forall r. JobId -> LogLevel -> DateTime -> DateTime -> SortOrder -> Run (DB + r) (Array LogLine) +selectLogsByJob jobId logLevel since until order = Run.lift _db (SelectLogsByJob jobId logLevel since until order identity) -- | Set a job in the database to the 'finished' state. finishJob :: forall r. FinishJob -> Run (DB + r) Unit @@ -228,8 +228,8 @@ handleSQLite env = case _ of Run.liftEffect $ SQLite.insertLogLine env.db log pure next - SelectLogsByJob jobId logLevel since until reply -> do - { fail, success } <- Run.liftEffect $ SQLite.selectLogsByJob env.db jobId logLevel since until + SelectLogsByJob jobId logLevel since until order reply -> do + { fail, success } <- Run.liftEffect $ SQLite.selectLogsByJob env.db jobId logLevel since until order unless (Array.null fail) do Log.warn $ "Some logs are not readable: " <> String.joinWith "\n" fail pure $ reply success diff --git a/app/src/App/SQLite.js b/app/src/App/SQLite.js index 8296a8242..cd0648762 100644 --- a/app/src/App/SQLite.js +++ b/app/src/App/SQLite.js @@ -168,53 +168,44 @@ export const selectPackageSetJobByPayloadImpl = (db, payload) => { return stmt.get(payload); }; -const _selectJobs = (db, { table, since, until, includeCompleted }) => { +const _selectJobs = (db, { table, since, until, includeCompleted, order }) => { let query = ` SELECT job.*, info.* FROM ${table} job JOIN ${JOB_INFO_TABLE} info ON job.jobId = info.jobId - WHERE 1=1 + WHERE info.createdAt >= ? AND info.createdAt < ? `; - let params = []; - - if (since != null) { - query += ` AND info.createdAt >= ?`; - params.push(since); - } - - if (until != null) { - query += ` AND info.createdAt <= ?`; - params.push(until); - } + const params = [since, until]; if (includeCompleted === false) { query += ` AND info.finishedAt IS NULL`; } - query += ` ORDER BY info.createdAt ASC LIMIT 100`; + const dir = order === 'DESC' ? 'DESC' : 'ASC'; + query += ` ORDER BY info.createdAt ${dir} LIMIT 100`; const stmt = db.prepare(query); return stmt.all(...params); } -export const selectPublishJobsImpl = (db, since, until, includeCompleted) => { - return _selectJobs(db, { table: PUBLISH_JOBS_TABLE, since, until, includeCompleted }); +export const selectPublishJobsImpl = (db, since, until, includeCompleted, order) => { + return _selectJobs(db, { table: PUBLISH_JOBS_TABLE, since, until, includeCompleted, order }); }; -export const selectUnpublishJobsImpl = (db, since, until, includeCompleted) => { - return _selectJobs(db, { table: UNPUBLISH_JOBS_TABLE, since, until, includeCompleted }); +export const selectUnpublishJobsImpl = (db, since, until, includeCompleted, order) => { + return _selectJobs(db, { table: UNPUBLISH_JOBS_TABLE, since, until, includeCompleted, order }); }; -export const selectTransferJobsImpl = (db, since, until, includeCompleted) => { - return _selectJobs(db, { table: TRANSFER_JOBS_TABLE, since, until, includeCompleted }); +export const selectTransferJobsImpl = (db, since, until, includeCompleted, order) => { + return _selectJobs(db, { table: TRANSFER_JOBS_TABLE, since, until, includeCompleted, order }); }; -export const selectMatrixJobsImpl = (db, since, until, includeCompleted) => { - return _selectJobs(db, { table: MATRIX_JOBS_TABLE, since, until, includeCompleted }); +export const selectMatrixJobsImpl = (db, since, until, includeCompleted, order) => { + return _selectJobs(db, { table: MATRIX_JOBS_TABLE, since, until, includeCompleted, order }); }; -export const selectPackageSetJobsImpl = (db, since, until, includeCompleted) => { - return _selectJobs(db, { table: PACKAGE_SET_JOBS_TABLE, since, until, includeCompleted }); +export const selectPackageSetJobsImpl = (db, since, until, includeCompleted, order) => { + return _selectJobs(db, { table: PACKAGE_SET_JOBS_TABLE, since, until, includeCompleted, order }); }; export const startJobImpl = (db, args) => { @@ -268,24 +259,12 @@ export const insertLogLineImpl = (db, logLine) => { return stmt.run(logLine); }; -export const selectLogsByJobImpl = (db, jobId, logLevel, since, until) => { - let query = ` +export const selectLogsByJobImpl = (db, jobId, logLevel, since, until, order) => { + const dir = order === 'DESC' ? 'DESC' : 'ASC'; + const stmt = db.prepare(` SELECT * FROM ${LOGS_TABLE} - WHERE jobId = ? AND level >= ? - `; - let params = [jobId, logLevel]; - - if (since != null) { - query += ` AND timestamp >= ?`; - params.push(since); - } - - if (until != null) { - query += ` AND timestamp <= ?`; - params.push(until); - } - - query += ` ORDER BY timestamp ASC LIMIT 100`; - const stmt = db.prepare(query); - return stmt.all(...params); + WHERE jobId = ? AND level >= ? AND timestamp >= ? AND timestamp < ? + ORDER BY timestamp ${dir} LIMIT 100 + `); + return stmt.all(jobId, logLevel, since, until); }; diff --git a/app/src/App/SQLite.purs b/app/src/App/SQLite.purs index ecb83f9b6..decb85b0f 100644 --- a/app/src/App/SQLite.purs +++ b/app/src/App/SQLite.purs @@ -57,10 +57,10 @@ import Data.Function (on) import Data.Nullable (notNull, null) import Data.Nullable as Nullable import Data.UUID.Random as UUID -import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn4, EffectFn5) +import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn5, EffectFn6) import Effect.Uncurried as Uncurried import Record as Record -import Registry.API.V1 (Job(..), JobId(..), LogLevel(..), LogLine) +import Registry.API.V1 (Job(..), JobId(..), LogLevel(..), LogLine, SortOrder(..)) import Registry.API.V1 as API.V1 import Registry.API.V1 as V1 import Registry.Internal.Codec as Internal.Codec @@ -192,15 +192,16 @@ toSuccess success = case success of type SelectJobRequest = { level :: Maybe LogLevel - , since :: Maybe DateTime - , until :: Maybe DateTime + , since :: DateTime + , until :: DateTime + , order :: SortOrder , jobId :: JobId } selectJob :: SQLite -> SelectJobRequest -> Effect { unreadableLogs :: Array String, job :: Either String (Maybe Job) } -selectJob db { level: maybeLogLevel, since, until, jobId: JobId jobId } = do +selectJob db { level: maybeLogLevel, since, until, order, jobId: JobId jobId } = do let logLevel = fromMaybe Info maybeLogLevel - { fail: unreadableLogs, success: logs } <- selectLogsByJob db (JobId jobId) logLevel since until + { fail: unreadableLogs, success: logs } <- selectLogsByJob db (JobId jobId) logLevel since until order -- Failing to decode a log should not prevent us from returning a job, so we pass -- failures through to be handled by application code job <- runExceptT $ firstJust @@ -263,13 +264,14 @@ selectJob db { level: maybeLogLevel, since, until, jobId: JobId jobId } = do maybeJobDetails type SelectJobsRequest = - { since :: Maybe DateTime - , until :: Maybe DateTime + { since :: DateTime + , until :: DateTime + , order :: SortOrder , includeCompleted :: Boolean } selectJobs :: SQLite -> SelectJobsRequest -> Effect { failed :: Array String, jobs :: Array Job } -selectJobs db { since, until, includeCompleted } = do +selectJobs db { since, until, order, includeCompleted } = do publishJobs <- selectPublishJobs unpublishJobs <- selectUnpublishJobs transferJobs <- selectTransferJobs @@ -278,30 +280,34 @@ selectJobs db { since, until, includeCompleted } = do let { fail: failedJobs, success: allJobs } = partitionEithers (publishJobs <> unpublishJobs <> transferJobs <> matrixJobs <> packageSetJobs) - pure { failed: failedJobs, jobs: take 100 $ sortBy (compare `on` (V1.jobInfo >>> _.createdAt)) allJobs } + cmp = case order of + ASC -> compare `on` (V1.jobInfo >>> _.createdAt) + DESC -> flip compare `on` (V1.jobInfo >>> _.createdAt) + pure { failed: failedJobs, jobs: take 100 $ sortBy cmp allJobs } where - sinceStr = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) since - untilStr = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) until + sinceStr = DateTime.format Internal.Format.iso8601DateTime since + untilStr = DateTime.format Internal.Format.iso8601DateTime until + orderStr = V1.printSortOrder order selectPublishJobs = do - jobs <- Uncurried.runEffectFn4 selectPublishJobsImpl db sinceStr untilStr includeCompleted + jobs <- Uncurried.runEffectFn5 selectPublishJobsImpl db sinceStr untilStr includeCompleted orderStr pure $ map (map (PublishJob <<< Record.merge { logs: [], jobType: Proxy :: _ "publish" }) <<< publishJobDetailsFromJSRep) jobs selectUnpublishJobs = do - jobs <- Uncurried.runEffectFn4 selectUnpublishJobsImpl db sinceStr untilStr includeCompleted + jobs <- Uncurried.runEffectFn5 selectUnpublishJobsImpl db sinceStr untilStr includeCompleted orderStr pure $ map (map (UnpublishJob <<< Record.merge { logs: [], jobType: Proxy :: _ "unpublish" }) <<< unpublishJobDetailsFromJSRep) jobs selectTransferJobs = do - jobs <- Uncurried.runEffectFn4 selectTransferJobsImpl db sinceStr untilStr includeCompleted + jobs <- Uncurried.runEffectFn5 selectTransferJobsImpl db sinceStr untilStr includeCompleted orderStr pure $ map (map (TransferJob <<< Record.merge { logs: [], jobType: Proxy :: _ "transfer" }) <<< transferJobDetailsFromJSRep) jobs selectMatrixJobs = do - jobs <- Uncurried.runEffectFn4 selectMatrixJobsImpl db sinceStr untilStr includeCompleted + jobs <- Uncurried.runEffectFn5 selectMatrixJobsImpl db sinceStr untilStr includeCompleted orderStr pure $ map (map (MatrixJob <<< Record.merge { logs: [], jobType: Proxy :: _ "matrix" }) <<< matrixJobDetailsFromJSRep) jobs selectPackageSetJobs = do - jobs <- Uncurried.runEffectFn4 selectPackageSetJobsImpl db sinceStr untilStr includeCompleted + jobs <- Uncurried.runEffectFn5 selectPackageSetJobsImpl db sinceStr untilStr includeCompleted orderStr pure $ map (map (PackageSetJob <<< Record.merge { logs: [], jobType: Proxy :: _ "packageset" }) <<< packageSetJobDetailsFromJSRep) jobs -------------------------------------------------------------------------------- @@ -357,7 +363,7 @@ type SelectPublishParams = foreign import selectPublishJobImpl :: EffectFn2 SQLite SelectPublishParams (Nullable JSPublishJobDetails) -foreign import selectPublishJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSPublishJobDetails) +foreign import selectPublishJobsImpl :: EffectFn5 SQLite String String Boolean String (Array JSPublishJobDetails) selectNextPublishJob :: SQLite -> Effect (Either String (Maybe PublishJobDetails)) selectNextPublishJob db = do @@ -457,7 +463,7 @@ type SelectUnpublishParams = foreign import selectUnpublishJobImpl :: EffectFn2 SQLite SelectUnpublishParams (Nullable JSUnpublishJobDetails) -foreign import selectUnpublishJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSUnpublishJobDetails) +foreign import selectUnpublishJobsImpl :: EffectFn5 SQLite String String Boolean String (Array JSUnpublishJobDetails) selectNextUnpublishJob :: SQLite -> Effect (Either String (Maybe UnpublishJobDetails)) selectNextUnpublishJob db = do @@ -555,7 +561,7 @@ type SelectTransferParams = { jobId :: Nullable String, packageName :: Nullable foreign import selectTransferJobImpl :: EffectFn2 SQLite SelectTransferParams (Nullable JSTransferJobDetails) -foreign import selectTransferJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSTransferJobDetails) +foreign import selectTransferJobsImpl :: EffectFn5 SQLite String String Boolean String (Array JSTransferJobDetails) selectNextTransferJob :: SQLite -> Effect (Either String (Maybe TransferJobDetails)) selectNextTransferJob db = do @@ -691,7 +697,7 @@ matrixJobDetailsFromJSRep { jobId, packageName, packageVersion, compilerVersion, foreign import selectMatrixJobImpl :: EffectFn2 SQLite (Nullable String) (Nullable JSMatrixJobDetails) -foreign import selectMatrixJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSMatrixJobDetails) +foreign import selectMatrixJobsImpl :: EffectFn5 SQLite String String Boolean String (Array JSMatrixJobDetails) selectNextMatrixJob :: SQLite -> Effect (Either String (Maybe MatrixJobDetails)) selectNextMatrixJob db = do @@ -739,7 +745,7 @@ foreign import selectPackageSetJobImpl :: EffectFn2 SQLite (Nullable String) (Nu foreign import selectPackageSetJobByPayloadImpl :: EffectFn2 SQLite String (Nullable JSPackageSetJobDetails) -foreign import selectPackageSetJobsImpl :: EffectFn4 SQLite (Nullable String) (Nullable String) Boolean (Array JSPackageSetJobDetails) +foreign import selectPackageSetJobsImpl :: EffectFn5 SQLite String String Boolean String (Array JSPackageSetJobDetails) selectNextPackageSetJob :: SQLite -> Effect (Either String (Maybe PackageSetJobDetails)) selectNextPackageSetJob db = do @@ -819,21 +825,22 @@ foreign import insertLogLineImpl :: EffectFn2 SQLite JSLogLine Unit insertLogLine :: SQLite -> LogLine -> Effect Unit insertLogLine db = Uncurried.runEffectFn2 insertLogLineImpl db <<< logLineToJSRep -foreign import selectLogsByJobImpl :: EffectFn5 SQLite String Int (Nullable String) (Nullable String) (Array JSLogLine) +foreign import selectLogsByJobImpl :: EffectFn6 SQLite String Int String String String (Array JSLogLine) -- | Select all logs for a given job at or above the indicated log level. To get all --- | logs, pass the DEBUG log level. Both since and until are optional; when provided --- | they create a half-open [since, until) time window. -selectLogsByJob :: SQLite -> JobId -> LogLevel -> Maybe DateTime -> Maybe DateTime -> Effect { fail :: Array String, success :: Array LogLine } -selectLogsByJob db jobId level since until = do - let sinceTimestamp = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) since - let untilTimestamp = Nullable.toNullable $ map (DateTime.format Internal.Format.iso8601DateTime) until +-- | logs, pass the DEBUG log level. The since and until parameters define a +-- | half-open [since, until) time window. +selectLogsByJob :: SQLite -> JobId -> LogLevel -> DateTime -> DateTime -> SortOrder -> Effect { fail :: Array String, success :: Array LogLine } +selectLogsByJob db jobId level since until order = do + let sinceTimestamp = DateTime.format Internal.Format.iso8601DateTime since + let untilTimestamp = DateTime.format Internal.Format.iso8601DateTime until jsLogLines <- - Uncurried.runEffectFn5 + Uncurried.runEffectFn6 selectLogsByJobImpl db (un JobId jobId) (API.V1.logLevelToPriority level) sinceTimestamp untilTimestamp + (V1.printSortOrder order) pure $ partitionEithers $ map logLineFromJSRep jsLogLines diff --git a/app/src/App/Server/Router.purs b/app/src/App/Server/Router.purs index dcf906564..9fc60bf89 100644 --- a/app/src/App/Server/Router.purs +++ b/app/src/App/Server/Router.purs @@ -3,12 +3,16 @@ module Registry.App.Server.Router where import Registry.App.Prelude hiding ((/)) import Data.Codec.JSON as CJ +import Data.Date as Date +import Data.DateTime (DateTime(..)) +import Data.Enum as Enum import Effect.Aff as Aff import Effect.Class.Console as Console import HTTPurple (Method(..), Request, Response) import HTTPurple as HTTPurple import HTTPurple.Status as Status -import Registry.API.V1 (Route(..)) +import Partial.Unsafe (unsafePartial) +import Registry.API.V1 (Route(..), SortOrder(..)) import Registry.API.V1 as V1 import Registry.App.API as API import Registry.App.Auth as Auth @@ -22,6 +26,12 @@ import Run (Run) import Run as Run import Run.Except as Run.Except +-- | The earliest date for which we have job logs (registry server launch date) +registryLaunch :: DateTime +registryLaunch = DateTime date bottom + where + date = Date.canonicalDate (unsafePartial fromJust $ Enum.toEnum 2026) Date.January (unsafePartial fromJust $ Enum.toEnum 31) + runRouter :: ServerEnv -> Effect Unit runRouter env = do -- Read port from SERVER_PORT env var (optional, HTTPurple defaults to 8080) @@ -121,16 +131,17 @@ router { route, method, body } = HTTPurple.usingCont case route, method of _ -> HTTPurple.badRequest "Expected transfer operation." - Jobs { since, until: until', include_completed }, Get -> do - -- If neither since nor until is provided, default until to now - until <- case since, until' of - Nothing, Nothing -> Just <$> liftEffect nowUTC - _, _ -> pure until' + Jobs { since: since', until: until', order: order', include_completed }, Get -> do + now <- liftEffect nowUTC + let since = fromMaybe registryLaunch since' + let until = fromMaybe now until' + let order = fromMaybe ASC order' lift ( Run.Except.runExcept $ Db.selectJobs { includeCompleted: fromMaybe false include_completed , since , until + , order } ) >>= case _ of Left err -> do @@ -138,12 +149,12 @@ router { route, method, body } = HTTPurple.usingCont case route, method of HTTPurple.internalServerError $ "Error while fetching jobs: " <> err Right jobs -> jsonOk (CJ.array V1.jobCodec) jobs - Job jobId { level: maybeLogLevel, since, until: until' }, Get -> do - -- If neither since nor until is provided, default until to now - until <- case since, until' of - Nothing, Nothing -> Just <$> liftEffect nowUTC - _, _ -> pure until' - lift (Run.Except.runExcept $ Db.selectJob { jobId, level: maybeLogLevel, since, until }) >>= case _ of + Job jobId { level: maybeLogLevel, since: since', until: until', order: order' }, Get -> do + now <- liftEffect nowUTC + let since = fromMaybe registryLaunch since' + let until = fromMaybe now until' + let order = fromMaybe ASC order' + lift (Run.Except.runExcept $ Db.selectJob { jobId, level: maybeLogLevel, since, until, order }) >>= case _ of Left err -> do lift $ Log.error $ "Error while fetching job: " <> err HTTPurple.internalServerError $ "Error while fetching job: " <> err diff --git a/lib/src/API/V1.purs b/lib/src/API/V1.purs index 1e7bae689..df39d6c9b 100644 --- a/lib/src/API/V1.purs +++ b/lib/src/API/V1.purs @@ -1,3 +1,4 @@ +-- | Types, codecs, and routes for the Registry HTTP API (v1). module Registry.API.V1 ( JobCreatedResponse , JobId(..) @@ -10,6 +11,7 @@ module Registry.API.V1 , PackageSetJobData , PublishJobData , Route(..) + , SortOrder(..) , TransferJobData , UnpublishJobData , jobInfo @@ -19,6 +21,7 @@ module Registry.API.V1 , logLevelToPriority , printJobType , printLogLevel + , printSortOrder , routes ) where @@ -62,8 +65,8 @@ data Route | Unpublish | Transfer | PackageSets - | Jobs { since :: Maybe DateTime, until :: Maybe DateTime, include_completed :: Maybe Boolean } - | Job JobId { level :: Maybe LogLevel, since :: Maybe DateTime, until :: Maybe DateTime } + | Jobs { since :: Maybe DateTime, until :: Maybe DateTime, order :: Maybe SortOrder, include_completed :: Maybe Boolean } + | Job JobId { level :: Maybe LogLevel, since :: Maybe DateTime, until :: Maybe DateTime, order :: Maybe SortOrder } | Status derive instance Generic Route _ @@ -77,6 +80,7 @@ routes = Routing.root $ Routing.prefix "api" $ Routing.prefix "v1" $ RoutingG.su , "Jobs": "jobs" ? { since: Routing.optional <<< timestampP <<< Routing.string , until: Routing.optional <<< timestampP <<< Routing.string + , order: Routing.optional <<< sortOrderP <<< Routing.string , include_completed: Routing.optional <<< Routing.boolean } , "Job": "jobs" / @@ -84,6 +88,7 @@ routes = Routing.root $ Routing.prefix "api" $ Routing.prefix "v1" $ RoutingG.su { level: Routing.optional <<< logLevelP <<< Routing.string , since: Routing.optional <<< timestampP <<< Routing.string , until: Routing.optional <<< timestampP <<< Routing.string + , order: Routing.optional <<< sortOrderP <<< Routing.string } ) , "Status": "status" / RoutingG.noArgs @@ -101,6 +106,24 @@ timestampP = Routing.as printTimestamp parseTimestamp printTimestamp t = DateTime.format Internal.Format.iso8601DateTime t parseTimestamp s = DateTime.unformat Internal.Format.iso8601DateTime s +data SortOrder = ASC | DESC + +derive instance Eq SortOrder + +printSortOrder :: SortOrder -> String +printSortOrder = case _ of + ASC -> "ASC" + DESC -> "DESC" + +parseSortOrder :: String -> Either String SortOrder +parseSortOrder = case _ of + "ASC" -> Right ASC + "DESC" -> Right DESC + other -> Left $ "Invalid sort order: " <> other + +sortOrderP :: RouteDuplex' String -> RouteDuplex' SortOrder +sortOrderP = Routing.as printSortOrder parseSortOrder + type JobCreatedResponse = { jobId :: JobId } jobCreatedResponseCodec :: CJ.Codec JobCreatedResponse