diff --git a/nix/overlay.nix b/nix/overlay.nix index 54fa965e..c344a578 100644 --- a/nix/overlay.nix +++ b/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"; diff --git a/scripts/spago.yaml b/scripts/spago.yaml index a3bdb19f..76d33506 100644 --- a/scripts/spago.yaml +++ b/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 diff --git a/scripts/src/PackageSetUpdater.purs b/scripts/src/PackageSetUpdater.purs index d1f83370..ab9571c7 100644 --- a/scripts/src/PackageSetUpdater.purs +++ b/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) diff --git a/scripts/src/VersionCheck.purs b/scripts/src/VersionCheck.purs new file mode 100644 index 00000000..a89ccbfc --- /dev/null +++ b/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 diff --git a/scripts/test/Main.purs b/scripts/test/Main.purs new file mode 100644 index 00000000..9bacfbcb --- /dev/null +++ b/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 } diff --git a/spago.lock b/spago.lock index d3b93a36..98749509 100644 --- a/spago.lock +++ b/spago.lock @@ -291,7 +291,11 @@ ] }, "test": { - "dependencies": [] + "dependencies": [ + "registry-test-utils", + "spec", + "spec-node" + ] } }, "registry-test-utils": {