Implement registry version check script

nix/overlay.nix

@@ -62,6 +62,10 @@ let
       module = "Registry.Scripts.PackageTransferrer";
       description = "Check for moved packages and submit transfer jobs";
     };
+    version-check = {
+      module = "Registry.Scripts.VersionCheck";
+      description = "Report registry versions pending a package set update";
+    };
     verify-integrity = {
       module = "Registry.Scripts.VerifyIntegrity";
       description = "Verify registry and registry-index consistency";

scripts/spago.yaml

@@ -25,3 +25,9 @@ package:
     - registry-lib
     - run
     - strings
+  test:
+    main: Test.Registry.Scripts.Main
+    dependencies:
+      - registry-test-utils
+      - spec
+      - spec-node

scripts/src/PackageSetUpdater.purs

@@ -48,6 +48,13 @@ data Mode = DryRun | Submit
 
 derive instance Eq Mode
 
+-- | Which registry releases should be considered for a package set update.
+-- | `AllPending` only reports upgrades to packages already in the set; adding
+-- | packages that have never appeared in a package set is a separate concern.
+data CandidateSelection
+  = RecentUploads DateTime.DateTime Hours
+  | AllPending
+
 parser :: ArgParser Mode
 parser = Arg.choose "command"
   [ Arg.flag [ "dry-run" ]
@@ -111,16 +118,9 @@ runPackageSetUpdater mode registryApiUrl = do
     Just set -> pure (Just set)
 
   for_ latestPackageSet \packageSet -> do
-    let currentPackages = (un PackageSet packageSet).packages
-
     -- Find packages uploaded in the last 24 hours
-    recentUploads <- findRecentUploads (Hours 24.0)
-    let
-      -- Filter out packages already in the set at the same or newer version
-      newOrUpdated = recentUploads # Map.filterWithKey \name version ->
-        case Map.lookup name currentPackages of
-          Nothing -> true -- new package
-          Just currentVersion -> version > currentVersion -- upgrade
+    now <- nowUTC
+    newOrUpdated <- findPackageSetCandidates (RecentUploads now (Hours 24.0)) packageSet
 
     if Map.isEmpty newOrUpdated then
       Log.info "No new packages for package set update."
@@ -175,23 +175,39 @@ runPackageSetUpdater mode registryApiUrl = do
               Right { jobId } -> do
                 Log.info $ "Submitted package set job " <> unwrap jobId
 
--- | Find the latest version of each package uploaded within the time limit
-findRecentUploads :: Hours -> Run PackageSetUpdaterEffects (Map PackageName Version)
-findRecentUploads limit = do
+-- | Find the latest eligible registry version for each package relative to the
+-- | current package set.
+findPackageSetCandidates
+  :: forall r
+   . CandidateSelection
+  -> PackageSet
+  -> Run (REGISTRY_READ + EXCEPT String + r) (Map PackageName Version)
+findPackageSetCandidates selection packageSet = do
   allMetadata <- Registry.readAllMetadata
-  now <- nowUTC
-
+  pure $ selectPackageSetCandidates selection packageSet allMetadata
+
+-- | Select package set candidates in one traversal of registry metadata.
+selectPackageSetCandidates
+  :: CandidateSelection
+  -> PackageSet
+  -> Map PackageName Metadata
+  -> Map PackageName Version
+selectPackageSetCandidates selection (PackageSet packageSet) = Map.mapMaybeWithKey \name (Metadata metadata) -> do
   let
-    getLatestRecentVersion :: Metadata -> Maybe Version
-    getLatestRecentVersion (Metadata metadata) = do
-      let
-        recentVersions = Array.catMaybes $ flip map (Map.toUnfoldable metadata.published)
-          \(Tuple version { publishedTime }) ->
-            if (DateTime.diff now publishedTime) <= limit then Just version else Nothing
-      Array.last $ Array.sort recentVersions
-
-  pure $ Map.fromFoldable $ Array.catMaybes $ flip map (Map.toUnfoldable allMetadata) \(Tuple name metadata) ->
-    map (Tuple name) $ getLatestRecentVersion metadata
+    eligibleVersions = Array.mapMaybe
+      ( \(Tuple version { publishedTime }) -> case selection of
+          RecentUploads now limit
+            | DateTime.diff now publishedTime <= limit -> Just version
+          RecentUploads _ _ -> Nothing
+          AllPending -> Just version
+      )
+      (Map.toUnfoldable metadata.published)
+  latestVersion <- Array.last $ Array.sort eligibleVersions
+  case Map.lookup name packageSet.packages of
+    Just currentVersion
+      | latestVersion > currentVersion -> Just latestVersion
+    Nothing | RecentUploads _ _ <- selection -> Just latestVersion
+    _ -> Nothing
 
 -- | Submit a package set job to the registry API
 submitPackageSetJob :: String -> Operation.PackageSetUpdateRequest -> Aff (Either String V1.JobCreatedResponse)

scripts/src/VersionCheck.purs

@@ -0,0 +1,75 @@
+-- | Report the latest registry versions that are newer than their versions in
+-- | the latest package set.
+-- |
+-- | Packages that have never appeared in a package set are intentionally not
+-- | included; discovering those packages is tracked as separate follow-up work.
+-- |
+-- | Run via Nix:
+-- |   nix run .#version-check
+module Registry.Scripts.VersionCheck where
+
+import Registry.App.Prelude
+
+import Data.Map as Map
+import Effect.Class.Console as Console
+import Node.Process as Process
+import Registry.App.CLI.Git as Git
+import Registry.App.Effect.Cache as Cache
+import Registry.App.Effect.Log (LOG)
+import Registry.App.Effect.Log as Log
+import Registry.App.Effect.Registry (REGISTRY_READ)
+import Registry.App.Effect.Registry as Registry
+import Registry.PackageName as PackageName
+import Registry.Scripts.PackageSetUpdater as PackageSetUpdater
+import Registry.Version as Version
+import Run (AFF, EFFECT, Run)
+import Run as Run
+import Run.Except (EXCEPT)
+import Run.Except as Except
+
+main :: Effect Unit
+main = launchAff_ do
+  registryCacheRef <- Cache.newCacheRef
+  debouncer <- Registry.newDebouncer
+
+  let
+    registryEnv :: Registry.RegistryEnv
+    registryEnv =
+      { jobId: Nothing
+      , pull: Git.Autostash
+      , write: Registry.ReadOnly
+      , repos: Registry.defaultRepos
+      , workdir: scratchDir
+      , debouncer
+      , cacheRef: registryCacheRef
+      }
+
+  runVersionCheck
+    # Except.runExcept
+    # Registry.interpretRead (Registry.handleRead registryEnv)
+    # Log.interpret (Log.handleTerminal Normal)
+    # Run.runBaseAff'
+    >>= case _ of
+      Left err -> do
+        Console.error $ "Error: " <> err
+        liftEffect $ Process.exit' 1
+      Right _ -> pure unit
+
+type VersionCheckEffects = (REGISTRY_READ + LOG + EXCEPT String + AFF + EFFECT + ())
+
+runVersionCheck :: Run VersionCheckEffects (Map PackageName Version)
+runVersionCheck = do
+  Log.info "Registry Version Check: checking for pending package set updates..."
+  Registry.readLatestPackageSet >>= case _ of
+    Nothing -> do
+      Log.warn "No package set found, skipping version check."
+      pure Map.empty
+    Just packageSet -> do
+      pending <- PackageSetUpdater.findPackageSetCandidates PackageSetUpdater.AllPending packageSet
+      if Map.isEmpty pending then
+        Log.info "No package versions are pending a package set update."
+      else do
+        Log.info $ "Found " <> show (Map.size pending) <> " package versions pending a package set update:"
+        for_ (Map.toUnfoldable pending :: Array _) \(Tuple name version) ->
+          Log.info $ "  - " <> PackageName.print name <> "@" <> Version.print version
+      pure pending

scripts/test/Main.purs

@@ -0,0 +1,75 @@
+module Test.Registry.Scripts.Main (main) where
+
+import Registry.App.Prelude
+
+import Data.DateTime (DateTime)
+import Data.Map as Map
+import Data.Time.Duration (Hours(..))
+import Registry.Metadata (Metadata)
+import Registry.Metadata as Metadata
+import Registry.PackageName (PackageName)
+import Registry.PackageSet (PackageSet)
+import Registry.PackageSet as PackageSet
+import Registry.Scripts.PackageSetUpdater as PackageSetUpdater
+import Registry.Test.Assert as Assert
+import Registry.Test.Utils as Utils
+import Registry.Version (Version)
+import Test.Spec as Spec
+import Test.Spec.Reporter.Console (consoleReporter)
+import Test.Spec.Runner.Node (runSpecAndExitProcess)
+
+main :: Effect Unit
+main = runSpecAndExitProcess [ consoleReporter ] do
+  Spec.describe "PackageSetUpdater candidate selection" do
+    Spec.it "finds all newer versions of packages already in the package set" do
+      let
+        metadata = Map.fromFoldable
+          [ Utils.unsafeMetadata "prelude" [ Tuple "1.0.0" [ "0.15.10" ], Tuple "2.0.0" [ "0.15.10" ] ]
+          , Utils.unsafeMetadata "effect" [ Tuple "2.0.0" [ "0.15.10" ] ]
+          , Utils.unsafeMetadata "older" [ Tuple "1.0.0" [ "0.15.10" ] ]
+          , Utils.unsafeMetadata "never-in-set" [ Tuple "1.0.0" [ "0.15.10" ] ]
+          ]
+        packageSet = mkPackageSet $ Map.fromFoldable
+          [ Tuple (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "1.0.0")
+          , Tuple (Utils.unsafePackageName "effect") (Utils.unsafeVersion "2.0.0")
+          , Tuple (Utils.unsafePackageName "older") (Utils.unsafeVersion "2.0.0")
+          ]
+        expected = Map.singleton (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "2.0.0")
+
+      PackageSetUpdater.selectPackageSetCandidates PackageSetUpdater.AllPending packageSet metadata
+        `Assert.shouldEqual` expected
+
+    Spec.it "preserves recent candidate selection for new packages and upgrades" do
+      let
+        oldTime = Utils.unsafeDateTime "2023-12-30T00:00:00.000Z"
+        now = Utils.unsafeDateTime "2024-01-02T00:00:00.000Z"
+        metadata = Map.fromFoldable
+          [ Utils.unsafeMetadata "prelude" [ Tuple "1.0.0" [ "0.15.10" ], Tuple "2.0.0" [ "0.15.10" ] ]
+          , Utils.unsafeMetadata "effect" [ Tuple "1.0.0" [ "0.15.10" ] ]
+          , withPublishedTime oldTime $ Utils.unsafeMetadata "old-upload" [ Tuple "1.0.0" [ "0.15.10" ] ]
+          , Utils.unsafeMetadata "new-package" [ Tuple "1.0.0" [ "0.15.10" ] ]
+          ]
+        packageSet = mkPackageSet $ Map.fromFoldable
+          [ Tuple (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "1.0.0")
+          , Tuple (Utils.unsafePackageName "effect") (Utils.unsafeVersion "1.0.0")
+          ]
+        expected = Map.fromFoldable
+          [ Tuple (Utils.unsafePackageName "prelude") (Utils.unsafeVersion "2.0.0")
+          , Tuple (Utils.unsafePackageName "new-package") (Utils.unsafeVersion "1.0.0")
+          ]
+
+      PackageSetUpdater.selectPackageSetCandidates (PackageSetUpdater.RecentUploads now (Hours 24.0)) packageSet metadata
+        `Assert.shouldEqual` expected
+
+mkPackageSet :: Map PackageName Version -> PackageSet
+mkPackageSet packages = PackageSet.PackageSet
+  { version: Utils.unsafeVersion "1.0.0"
+  , compiler: Utils.unsafeVersion "0.15.10"
+  , published: Utils.unsafeDate "2024-01-01"
+  , packages
+  }
+
+withPublishedTime :: forall a. DateTime -> Tuple a Metadata -> Tuple a Metadata
+withPublishedTime publishedTime (Tuple name (Metadata.Metadata metadata)) =
+  Tuple name $ Metadata.Metadata $ metadata
+    { published = map (_ { publishedTime = publishedTime }) metadata.published }

spago.lock

@@ -291,7 +291,11 @@
           ]
         },
         "test": {
-          "dependencies": []
+          "dependencies": [
+            "registry-test-utils",
+            "spec",
+            "spec-node"
+          ]
         }
       },
       "registry-test-utils": {