Integrate registry cron scripts into the job queue

app-e2e/src/Test/E2E/Endpoint/PackageSets.purs

@@ -16,6 +16,10 @@ spec :: E2ESpec
 spec = do
   Spec.describe "Package Sets endpoint" do
     Spec.it "accepts unauthenticated add/upgrade requests" do
+      -- First publish unsafe-coerce to create the tarball in storage
+      { jobId: publishJobId } <- Client.publish Fixtures.unsafeCoercePublishData
+      _ <- Env.pollJobOrFail publishJobId
+      -- Now add it to the package set
       { jobId } <- Client.packageSets Fixtures.packageSetAddRequest
       job <- Env.pollJobOrFail jobId
       Assert.shouldSatisfy (V1.jobInfo job).finishedAt isJust
@@ -47,6 +51,10 @@ spec = do
           Assert.shouldSatisfy (V1.jobInfo job).finishedAt isJust
 
     Spec.it "returns existing job for duplicate requests" do
+      -- First publish unsafe-coerce so the package set request is valid
+      { jobId: publishJobId } <- Client.publish Fixtures.unsafeCoercePublishData
+      _ <- Env.pollJobOrFail publishJobId
+      -- Now test that duplicate requests return the same job ID
       { jobId: firstJobId } <- Client.packageSets Fixtures.packageSetAddRequest
       { jobId: secondJobId } <- Client.packageSets Fixtures.packageSetAddRequest
       Assert.shouldEqual firstJobId secondJobId

app-e2e/src/Test/E2E/Endpoint/Startup.purs

@@ -0,0 +1,185 @@
+-- | E2E tests for the Scheduler and JobExecutor startup, covering:
+-- | - scheduleDailyPublish: Detects new package versions via GitHub tags
+-- | - scheduleTransfers: Detects packages that moved to new GitHub locations
+-- | - schedulePackageSetUpdates: Detects recent uploads for package set inclusion
+-- | - checkIfNewCompiler: Detects new compiler and enqueues matrix jobs
+-- |
+-- | IMPORTANT: These tests must run BEFORE resetTestState is called, since
+-- | the scheduler runs at server startup and creates jobs that would be cleared.
+module Test.E2E.Endpoint.Startup (spec) where
+
+import Registry.App.Prelude
+
+import Data.Array as Array
+import Data.Map as Map
+import Registry.API.V1 (Job(..))
+import Registry.Location (Location(..))
+import Registry.Operation (AuthenticatedPackageOperation(..))
+import Registry.Operation as Operation
+import Registry.PackageName as PackageName
+import Registry.Test.Assert as Assert
+import Registry.Version as Version
+import Test.E2E.Support.Client as Client
+import Test.E2E.Support.Env (E2ESpec)
+import Test.Spec as Spec
+
+spec :: E2ESpec
+spec = do
+  Spec.describe "scheduleDailyPublish" do
+    Spec.it "enqueues publish jobs for new package versions discovered via GitHub tags" do
+      -- The scheduler runs at server startup and should have already
+      -- fetched tags for packages in the registry metadata.
+      -- type-equality has v4.0.1 published but v4.0.2 in tags (per wiremock config)
+      jobs <- Client.getJobs
+
+      -- Find publish jobs for type-equality
+      let
+        isTypeEqualityPublishJob :: Job -> Boolean
+        isTypeEqualityPublishJob = case _ of
+          PublishJob { packageName, packageVersion } ->
+            packageName == unsafeFromRight (PackageName.parse "type-equality")
+              && packageVersion
+              == unsafeFromRight (Version.parse "4.0.2")
+          _ -> false
+
+        typeEqualityJob = Array.find isTypeEqualityPublishJob jobs
+
+      case typeEqualityJob of
+        Just (PublishJob { payload }) -> do
+          -- The scheduler determines a compatible compiler by looking at the previous
+          -- version's dependencies and finding the intersection of their supported compilers.
+          -- type-equality@4.0.1 has no dependencies, so the scheduler falls back to the
+          -- lowest compiler from the previous version (0.15.10).
+          let expectedCompiler = unsafeFromRight (Version.parse "0.15.10")
+          when (payload.compiler /= expectedCompiler) do
+            Assert.fail $ "Expected compiler 0.15.10 but got " <> Version.print payload.compiler
+        Just _ -> Assert.fail "Expected PublishJob but got different job type"
+        Nothing -> do
+          -- Log what jobs we did find for debugging
+          let publishJobs = Array.filter isPublishJob jobs
+          Assert.fail $ "Expected to find a publish job for type-equality@4.0.2 but found "
+            <> show (Array.length publishJobs)
+            <> " publish jobs: "
+            <> show (map formatPublishJob publishJobs)
+
+    Spec.it "does not enqueue jobs for already-published versions" do
+      jobs <- Client.getJobs
+
+      -- type-equality v4.0.1 is already published, should NOT have a new job
+      let
+        isDuplicateJob :: Job -> Boolean
+        isDuplicateJob = case _ of
+          PublishJob { packageName, packageVersion } ->
+            packageName == unsafeFromRight (PackageName.parse "type-equality")
+              && packageVersion
+              == unsafeFromRight (Version.parse "4.0.1")
+          _ -> false
+
+        duplicateJob = Array.find isDuplicateJob jobs
+
+      case duplicateJob of
+        Nothing -> pure unit -- Good, no duplicate job
+        Just _ -> Assert.fail "Found unexpected publish job for already-published type-equality@4.0.1"
+
+  Spec.describe "scheduleTransfers" do
+    Spec.it "enqueues transfer jobs when package location changes" do
+      -- type-equality metadata says old-owner, but tags point to purescript
+      jobs <- Client.getJobs
+      let
+        isTypeEqualityTransferJob :: Job -> Boolean
+        isTypeEqualityTransferJob = case _ of
+          TransferJob { packageName } ->
+            packageName == unsafeFromRight (PackageName.parse "type-equality")
+          _ -> false
+      case Array.find isTypeEqualityTransferJob jobs of
+        Just (TransferJob { packageName, payload }) -> do
+          -- Verify packageName
+          when (packageName /= unsafeFromRight (PackageName.parse "type-equality")) do
+            Assert.fail $ "Wrong package name: " <> PackageName.print packageName
+          -- Verify newLocation in payload
+          case payload.payload of
+            Transfer { newLocation } ->
+              case newLocation of
+                GitHub { owner } ->
+                  when (owner /= "purescript") do
+                    Assert.fail $ "Expected owner 'purescript' but got '" <> owner <> "'"
+                _ -> Assert.fail "Expected GitHub location"
+            _ -> Assert.fail "Expected Transfer payload"
+        Just _ -> Assert.fail "Expected TransferJob but got different job type"
+        Nothing -> do
+          let transferJobs = Array.filter isTransferJob jobs
+          Assert.fail $ "Expected to find a transfer job for 'type-equality' but found "
+            <> show (Array.length transferJobs)
+            <> " transfer jobs"
+
+  Spec.describe "schedulePackageSetUpdates" do
+    Spec.it "enqueues package set update for recent uploads not in set" do
+      jobs <- Client.getJobs
+      let packageSetJobs = Array.filter isPackageSetJob jobs
+      case Array.head packageSetJobs of
+        Just (PackageSetJob { payload }) ->
+          case payload of
+            Operation.PackageSetUpdate { packages } ->
+              case Map.lookup (unsafeFromRight $ PackageName.parse "type-equality") packages of
+                Just (Just _) -> pure unit
+                _ -> Assert.fail "Expected type-equality in package set update"
+        Just _ -> Assert.fail "Expected PackageSetJob but got different job type"
+        Nothing -> Assert.fail "Expected package set job to be enqueued"
+
+  Spec.describe "checkIfNewCompiler" do
+    Spec.it "enqueues matrix jobs for packages with no dependencies when new compiler detected" do
+      -- The test env has compilers 0.15.10 and 0.15.11 available.
+      -- prelude@6.0.1 fixture only has compiler 0.15.10 in metadata.
+      -- So 0.15.11 should be detected as "new" at startup, triggering
+      -- matrix jobs for packages with no dependencies.
+      jobs <- Client.getJobs
+      let
+        isNewCompilerMatrixJob :: Job -> Boolean
+        isNewCompilerMatrixJob = case _ of
+          MatrixJob { compilerVersion } ->
+            compilerVersion == unsafeFromRight (Version.parse "0.15.11")
+          _ -> false
+
+        matrixJobs = Array.filter isNewCompilerMatrixJob jobs
+
+        -- Get package names from matrix jobs
+        matrixPackages = Array.mapMaybe
+          ( \j -> case j of
+              MatrixJob { packageName } -> Just packageName
+              _ -> Nothing
+          )
+          matrixJobs
+
+      -- Should have matrix jobs for packages with no dependencies
+      -- prelude has no dependencies, so it should get a matrix job
+      let preludeName = unsafeFromRight (PackageName.parse "prelude")
+      unless (Array.elem preludeName matrixPackages) do
+        Assert.fail $ "Expected matrix job for prelude with compiler 0.15.11, found: "
+          <> show (Array.length matrixJobs)
+          <> " matrix jobs for packages: "
+          <> show (map PackageName.print matrixPackages)
+
+-- | Check if a job is a PublishJob
+isPublishJob :: Job -> Boolean
+isPublishJob = case _ of
+  PublishJob _ -> true
+  _ -> false
+
+-- | Format a PublishJob for debugging output
+formatPublishJob :: Job -> String
+formatPublishJob = case _ of
+  PublishJob { packageName, packageVersion } ->
+    PackageName.print packageName <> "@" <> Version.print packageVersion
+  _ -> "<not a publish job>"
+
+-- | Check if a job is a TransferJob
+isTransferJob :: Job -> Boolean
+isTransferJob = case _ of
+  TransferJob _ -> true
+  _ -> false
+
+-- | Check if a job is a PackageSetJob
+isPackageSetJob :: Job -> Boolean
+isPackageSetJob = case _ of
+  PackageSetJob _ -> true
+  _ -> false

app-e2e/src/Test/E2E/Support/Env.purs

@@ -16,6 +16,7 @@ module Test.E2E.Support.Env
   , resetTestState
   , resetDatabase
   , resetGitFixtures
+  , stashGitFixtures
   , resetLogs
   , resetGitHubRequestCache
   , pollJobOrFail
@@ -25,6 +26,7 @@ module Test.E2E.Support.Env
   , gitStatus
   , isCleanGitStatus
   , waitForAllMatrixJobs
+  , waitForAllPendingJobs
   , isMatrixJobFor
   , readMetadata
   , readManifestIndexEntry
@@ -99,6 +101,10 @@ runE2E env = flip runReaderT env
 -- | Resets: database, git fixtures, storage mock, and logs.
 resetTestState :: E2E Unit
 resetTestState = do
+  -- Wait for any pending jobs to complete before clearing state.
+  -- This is important because startup jobs (like matrix jobs from new compiler
+  -- detection) may still be running when this is called.
+  waitForAllPendingJobs
   resetDatabase
   resetGitFixtures
   WireMock.clearStorageRequests
@@ -124,9 +130,10 @@ resetDatabase = do
 -- | Reset the git fixtures to restore original state.
 -- | This restores metadata files modified by unpublish/transfer operations.
 -- |
--- | Strategy: Reset the origin repos to their initial-fixture tag (created during
--- | setup), then delete the server's scratch git clones. The server will
--- | re-clone fresh copies on the next operation, ensuring a clean cache state.
+-- | Strategy: Reset the origin repos to the `post-startup` tag if it exists (created
+-- | by stashGitFixtures after startup jobs complete), otherwise fall back to the
+-- | `initial-fixture` tag. Then delete the server's scratch git clones so the
+-- | server will re-clone fresh copies on the next operation.
 resetGitFixtures :: E2E Unit
 resetGitFixtures = do
   { stateDir } <- ask
@@ -140,13 +147,41 @@ resetGitFixtures = do
   deleteGitClones scratchDir
   where
   resetOrigin dir = do
-    void $ gitOrFail [ "reset", "--hard", "initial-fixture" ] dir
+    -- Try to reset to post-startup tag first, fall back to initial-fixture
+    tag <- hasTag "post-startup" dir
+    let targetTag = if tag then "post-startup" else "initial-fixture"
+    void $ gitOrFail [ "reset", "--hard", targetTag ] dir
     void $ gitOrFail [ "clean", "-fd" ] dir
 
+  hasTag tagName dir = do
+    result <- liftAff $ Git.gitCLI [ "tag", "-l", tagName ] (Just dir)
+    pure $ case result of
+      Right output -> String.contains (String.Pattern tagName) output
+      Left _ -> false
+
   deleteGitClones scratchDir = do
     liftAff $ FS.Extra.remove $ Path.concat [ scratchDir, "registry" ]
     liftAff $ FS.Extra.remove $ Path.concat [ scratchDir, "registry-index" ]
 
+-- | Stash the current git fixtures state by creating a `post-startup` tag.
+-- | This should be called after startup jobs (like matrix jobs from new compiler
+-- | detection) have completed, so that resetGitFixtures can restore to this
+-- | state instead of the initial fixtures.
+stashGitFixtures :: E2E Unit
+stashGitFixtures = do
+  fixturesDir <- liftEffect $ Env.lookupRequired Env.repoFixturesDir
+  let
+    registryOrigin = Path.concat [ fixturesDir, "purescript", "registry" ]
+    registryIndexOrigin = Path.concat [ fixturesDir, "purescript", "registry-index" ]
+  createStashTag registryOrigin
+  createStashTag registryIndexOrigin
+  Console.log "Stashed git fixtures at post-startup tag"
+  where
+  createStashTag dir = do
+    -- Delete existing tag if present, then create new one at HEAD
+    void $ liftAff $ Git.gitCLI [ "tag", "-d", "post-startup" ] (Just dir)
+    void $ gitOrFail [ "tag", "post-startup" ] dir
+
 -- | Clear server log files for test isolation.
 -- | Deletes *.log files from the scratch/logs directory but preserves the directory itself.
 resetLogs :: E2E Unit
@@ -246,6 +281,26 @@ waitForAllMatrixJobs pkg = go 120 0
       liftAff $ Aff.delay (Milliseconds 1000.0)
       go (attempts - 1) totalCount
 
+-- | Wait for all pending jobs (of any type) to complete.
+-- | Useful for ensuring startup jobs finish before running tests that clear the DB.
+waitForAllPendingJobs :: E2E Unit
+waitForAllPendingJobs = go 300 -- 5 minutes max
+  where
+  go :: Int -> E2E Unit
+  go 0 = liftAff $ Aff.throwError $ Aff.error "Timed out waiting for all jobs to complete"
+  go attempts = do
+    jobs <- Client.getJobs
+    let
+      pendingJobs = Array.filter (\j -> isNothing (V1.jobInfo j).finishedAt) jobs
+      pendingCount = Array.length pendingJobs
+    if pendingCount == 0 then
+      pure unit
+    else do
+      when (attempts `mod` 30 == 0) do
+        Console.log $ "Waiting for " <> show pendingCount <> " pending jobs to complete..."
+      liftAff $ Aff.delay (Milliseconds 1000.0)
+      go (attempts - 1)
+
 -- | Check if a job is a matrix job for the given package.
 isMatrixJobFor :: PackageFixture -> Job -> Boolean
 isMatrixJobFor pkg = case _ of

app-e2e/src/Test/E2E/Support/Fixtures.purs

@@ -5,9 +5,11 @@ module Test.E2E.Support.Fixtures
   , effect
   , console
   , prelude
+  , unsafeCoerce
   , effectPublishData
   , effectPublishDataDifferentLocation
   , consolePublishData
+  , unsafeCoercePublishData
   , failingTransferData
   , nonexistentTransferData
   , trusteeAuthenticatedData
@@ -99,6 +101,22 @@ consolePublishData =
   , version: console.version
   }
 
+-- | Publish data for unsafe-coerce@6.0.0, used by package set tests.
+-- | Has no dependencies. Published first to create the tarball before adding to package set.
+unsafeCoercePublishData :: Operation.PublishData
+unsafeCoercePublishData =
+  { name: unsafeCoerce.name
+  , location: Just $ GitHub
+      { owner: "purescript"
+      , repo: "purescript-unsafe-coerce"
+      , subdir: Nothing
+      }
+  , ref: "v6.0.0"
+  , compiler: Utils.unsafeVersion "0.15.10"
+  , resolutions: Nothing
+  , version: unsafeCoerce.version
+  }
+
 -- | Unpublish data for effect@4.0.0, used for publish-then-unpublish tests.
 effectUnpublishData :: UnpublishData
 effectUnpublishData =
@@ -222,19 +240,19 @@ signTransfer privateKey transferData = do
     , signature
     }
 
--- | type-equality@4.0.1 fixture package (exists in registry-index but not in initial package set)
-typeEquality :: PackageFixture
-typeEquality = { name: Utils.unsafePackageName "type-equality", version: Utils.unsafeVersion "4.0.1" }
+-- | unsafe-coerce@6.0.0 fixture package (exists in registry-index but not in package set)
+unsafeCoerce :: PackageFixture
+unsafeCoerce = { name: Utils.unsafePackageName "unsafe-coerce", version: Utils.unsafeVersion "6.0.0" }
 
--- | Package set request to add type-equality@4.0.1.
+-- | Package set request to add unsafe-coerce@6.0.0.
 -- | This is an unauthenticated request (no signature) since adding packages
 -- | doesn't require trustee authentication.
 packageSetAddRequest :: PackageSetUpdateRequest
 packageSetAddRequest =
   let
     payload = PackageSetUpdate
       { compiler: Nothing
-      , packages: Map.singleton typeEquality.name (Just typeEquality.version)
+      , packages: Map.singleton unsafeCoerce.name (Just unsafeCoerce.version)
       }
     rawPayload = JSON.print $ CJ.encode Operation.packageSetOperationCodec payload
   in