Add 'until' to API routes that list things (#752)

f-f · web-flow · commit a0a7a51948ff · 2026-02-08T10:37:04.000+02:00
diff --git 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, order: Nothing, include_completed: includeCompleted }
   liftAff $ get (CJ.array V1.jobCodec) clientConfig.baseUrl (printRoute route)
 
 -- | Get the list of jobs (includes completed jobs)
@@ -133,15 +133,15 @@ 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, order: Nothing }
   liftAff $ get V1.jobCodec clientConfig.baseUrl (printRoute route)
 
 -- | Try to get a specific job by ID, returning Left on HTTP/parse errors.
 -- | Use this when testing error responses (e.g., expecting 404).
 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, 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
@@ -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 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 -> DateTime -> Run (DB + r) (Array LogLine)
-selectLogsByJob jobId logLevel since = Run.lift _db (SelectLogsByJob jobId logLevel since 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 reply -> do
-    { fail, success } <- Run.liftEffect $ SQLite.selectLogsByJob env.db jobId logLevel since
+  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
@@ -168,43 +168,44 @@ export const selectPackageSetJobByPayloadImpl = (db, payload) => {
   return stmt.get(payload);
 };
 
-const _selectJobs = (db, { table, since, 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 info.createdAt >= ?
+    WHERE info.createdAt >= ? AND info.createdAt < ?
   `;
-  let params = [since];
+  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, includeCompleted) => {
-  return _selectJobs(db, { table: PUBLISH_JOBS_TABLE, since, 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, includeCompleted) => {
-  return _selectJobs(db, { table: UNPUBLISH_JOBS_TABLE, since, 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, includeCompleted) => {
-  return _selectJobs(db, { table: TRANSFER_JOBS_TABLE, since, 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, includeCompleted) => {
-  return _selectJobs(db, { table: MATRIX_JOBS_TABLE, since, 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, includeCompleted) => {
-  return _selectJobs(db, { table: PACKAGE_SET_JOBS_TABLE, since, 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) => {
@@ -258,13 +259,12 @@ export const insertLogLineImpl = (db, logLine) => {
   return stmt.run(logLine);
 };
 
-export const selectLogsByJobImpl = (db, jobId, logLevel, since) => {
-  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 >= ? AND timestamp >= ?
-    ORDER BY timestamp ASC LIMIT 100
-  `;
-
-  const stmt = db.prepare(query);
-  return stmt.all(jobId, logLevel, since);
+    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
@@ -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, EffectFn3, EffectFn4)
+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
@@ -193,13 +193,15 @@ toSuccess success = case success of
 type SelectJobRequest =
   { level :: Maybe LogLevel
   , 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, 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
+  { 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,11 +265,13 @@ selectJob db { level: maybeLogLevel, since, jobId: JobId jobId } = do
 
 type SelectJobsRequest =
   { since :: DateTime
+  , until :: DateTime
+  , order :: SortOrder
   , includeCompleted :: Boolean
   }
 
 selectJobs :: SQLite -> SelectJobsRequest -> Effect { failed :: Array String, jobs :: Array Job }
-selectJobs db { since, includeCompleted } = do
+selectJobs db { since, until, order, includeCompleted } = do
   publishJobs <- selectPublishJobs
   unpublishJobs <- selectUnpublishJobs
   transferJobs <- selectTransferJobs
@@ -276,27 +280,34 @@ selectJobs db { since, 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 = DateTime.format Internal.Format.iso8601DateTime since
+  untilStr = DateTime.format Internal.Format.iso8601DateTime until
+  orderStr = V1.printSortOrder order
+
   selectPublishJobs = do
-    jobs <- Uncurried.runEffectFn3 selectPublishJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) 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.runEffectFn3 selectUnpublishJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) 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.runEffectFn3 selectTransferJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) 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.runEffectFn3 selectMatrixJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) 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.runEffectFn3 selectPackageSetJobsImpl db (DateTime.format Internal.Format.iso8601DateTime since) includeCompleted
+    jobs <- Uncurried.runEffectFn5 selectPackageSetJobsImpl db sinceStr untilStr includeCompleted orderStr
     pure $ map (map (PackageSetJob <<< Record.merge { logs: [], jobType: Proxy :: _ "packageset" }) <<< packageSetJobDetailsFromJSRep) jobs
 
 --------------------------------------------------------------------------------
@@ -352,7 +363,7 @@ type SelectPublishParams =
 
 foreign import selectPublishJobImpl :: EffectFn2 SQLite SelectPublishParams (Nullable JSPublishJobDetails)
 
-foreign import selectPublishJobsImpl :: EffectFn3 SQLite 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
@@ -452,7 +463,7 @@ type SelectUnpublishParams =
 
 foreign import selectUnpublishJobImpl :: EffectFn2 SQLite SelectUnpublishParams (Nullable JSUnpublishJobDetails)
 
-foreign import selectUnpublishJobsImpl :: EffectFn3 SQLite 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
@@ -550,7 +561,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 :: EffectFn5 SQLite String String Boolean String (Array JSTransferJobDetails)
 
 selectNextTransferJob :: SQLite -> Effect (Either String (Maybe TransferJobDetails))
 selectNextTransferJob db = do
@@ -686,7 +697,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 :: EffectFn5 SQLite String String Boolean String (Array JSMatrixJobDetails)
 
 selectNextMatrixJob :: SQLite -> Effect (Either String (Maybe MatrixJobDetails))
 selectNextMatrixJob db = do
@@ -734,7 +745,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 :: EffectFn5 SQLite String String Boolean String (Array JSPackageSetJobDetails)
 
 selectNextPackageSetJob :: SQLite -> Effect (Either String (Maybe PackageSetJobDetails))
 selectNextPackageSetJob db = do
@@ -814,18 +825,22 @@ 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 :: 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.
-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. 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.runEffectFn4
+    Uncurried.runEffectFn6
       selectLogsByJobImpl
       db
       (un JobId jobId)
       (API.V1.logLevelToPriority level)
-      timestamp
+      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
@@ -5,16 +5,14 @@ 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 (Route(..), SortOrder(..))
 import Registry.API.V1 as V1
 import Registry.App.API as API
 import Registry.App.Auth as Auth
@@ -43,7 +41,7 @@ runRouter env = do
     , port
     }
     { route: V1.routes
-    , router: runServer
+    , router: corsMiddleware runServer
     }
   where
   runServer :: Request Route -> Aff Response
@@ -55,6 +53,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,22 +131,30 @@ router { route, method, body } = HTTPurple.usingCont case route, method of
       _ ->
         HTTPurple.badRequest "Expected transfer operation."
 
-  Jobs { since, include_completed }, Get -> do
+  Jobs { since: since', until: until', order: order', include_completed }, Get -> do
     now <- liftEffect nowUTC
-    let oneHourAgo = fromMaybe now $ DateTime.adjust (negateDuration (Hours 1.0)) now
+    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: fromMaybe oneHourAgo since
+          , since
+          , until
+          , order
           }
       ) >>= case _ of
       Left err -> do
         lift $ Log.error $ "Error while fetching jobs: " <> err
         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: 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
