From fa5f82d18b7205f5113eba961f9b9588e5b90aa9 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Sat, 31 Jan 2026 15:07:57 -0500 Subject: [PATCH 1/2] only pick up daily jobs in last 24hrs --- app/src/App/Effect/GitHub.purs | 11 +++++ app/test/Test/Assert/Run.purs | 3 ++ foreign/src/Foreign/Octokit.purs | 15 ++++++ lib/src/Internal/Codec.purs | 9 +++- scripts/src/DailyImporter.purs | 81 ++++++++++++++++++++------------ scripts/src/VerifyIntegrity.purs | 2 +- 6 files changed, 89 insertions(+), 32 deletions(-) diff --git a/app/src/App/Effect/GitHub.purs b/app/src/App/Effect/GitHub.purs index 914a3aa92..0caa8cc40 100644 --- a/app/src/App/Effect/GitHub.purs +++ b/app/src/App/Effect/GitHub.purs @@ -12,6 +12,7 @@ module Registry.App.Effect.GitHub , getRefCommit , handle , interpret + , listCommitsSince , listTags , listTeamMembers ) where @@ -73,6 +74,7 @@ instance FsEncodable GitHubCache where data GitHub a = ListTags Address (Either GitHubError (Array Tag) -> a) + | ListCommitsSince Address DateTime (Either GitHubError (Array String) -> a) | ListTeamMembers Team (Either GitHubError (Array String) -> a) | GetContent Address String FilePath (Either GitHubError String -> a) | GetRefCommit Address String (Either GitHubError String -> a) @@ -90,6 +92,10 @@ _github = Proxy listTags :: forall r. Address -> Run (GITHUB + r) (Either GitHubError (Array Tag)) listTags address = Run.lift _github (ListTags address identity) +-- | List commits since a given date. Returns an array of commit SHAs. +listCommitsSince :: forall r. Address -> DateTime -> Run (GITHUB + r) (Either GitHubError (Array String)) +listCommitsSince address since = Run.lift _github (ListCommitsSince address since identity) + -- | List the members of the provided team. Requires that the authorization on -- | the request has read rights for the given organization and team. listTeamMembers :: forall r. Team -> Run (GITHUB + r) (Either GitHubError (Array String)) @@ -139,6 +145,11 @@ handle env = Cache.interpret _githubCache (Cache.handleMemoryFs { cache: env.cac result <- request env.octokit (Octokit.listTagsRequest address) pure $ reply result + ListCommitsSince address since reply -> do + Log.debug $ "Listing commits since " <> Internal.Codec.formatIso8601 since <> " for " <> address.owner <> "/" <> address.repo + result <- request env.octokit (Octokit.listCommitsSinceRequest { address, since }) + pure $ reply $ map (map _.sha) result + ListTeamMembers team reply -> do Log.debug $ "Listing members of team " <> team.org <> "/" <> team.team result <- request env.octokit (Octokit.listTeamMembersRequest team) diff --git a/app/test/Test/Assert/Run.purs b/app/test/Test/Assert/Run.purs index 4c841c09c..e6bd0bdda 100644 --- a/app/test/Test/Assert/Run.purs +++ b/app/test/Test/Assert/Run.purs @@ -403,6 +403,9 @@ handleGitHubMock env = case _ of pure $ reply $ Right tags + ListCommitsSince _address _since reply -> + pure $ reply $ Left $ UnexpectedError "Unimplemented" + ListTeamMembers team reply -> pure $ reply $ case team of { org: "purescript", team: "packaging" } -> Right [ "pacchettibotti", "f-f", "thomashoneyman" ] _ -> Left $ APIError { statusCode: 404, message: "No fixture provided for team " <> team.org <> "/" <> team.team } diff --git a/foreign/src/Foreign/Octokit.purs b/foreign/src/Foreign/Octokit.purs index fdc95e0d5..92637620b 100644 --- a/foreign/src/Foreign/Octokit.purs +++ b/foreign/src/Foreign/Octokit.purs @@ -29,8 +29,10 @@ module Registry.Foreign.Octokit , githubApiErrorCodec , githubErrorCodec , isPermanentGitHubError + , listCommitsSinceRequest , listTagsRequest , listTeamMembersRequest + , CommitSha , newOctokit , noArgs , printGitHubError @@ -158,6 +160,19 @@ listTagsRequest address = toJsonRep { name, sha, url } = { name, commit: { sha, url } } fromJsonRep { name, commit } = { name, sha: commit.sha, url: commit.url } +type CommitSha = { sha :: String } + +-- | List repository commits since a given date +-- | https://docs.github.com/en/rest/commits/commits#list-commits +listCommitsSinceRequest :: { address :: Address, since :: DateTime } -> Request (Array CommitSha) +listCommitsSinceRequest { address, since } = + { route: GitHubRoute GET [ "repos", address.owner, address.repo, "commits" ] (Map.singleton "since" (Internal.Codec.formatIso8601 since)) + , headers: Object.empty + , args: noArgs + , paginate: true + , codec: CJ.array $ CJ.named "CommitSha" $ CJ.Record.object { sha: CJ.string } + } + -- | Fetch a specific file from the provided repository at the given ref and -- | filepath. Filepaths should lead to a single file from the root of the repo. -- | https://github.com/octokit/plugin-rest-endpoint-methods.js/blob/v5.16.0/docs/repos/getContent.md diff --git a/lib/src/Internal/Codec.purs b/lib/src/Internal/Codec.purs index e062a4414..8ce88ec6b 100644 --- a/lib/src/Internal/Codec.purs +++ b/lib/src/Internal/Codec.purs @@ -1,5 +1,6 @@ module Registry.Internal.Codec - ( iso8601Date + ( formatIso8601 + , iso8601Date , iso8601DateTime , limitedString , packageMap @@ -40,6 +41,12 @@ import Registry.PackageName as PackageName import Registry.Version (Version) import Registry.Version as Version +-- | INTERNAL +-- | +-- | Format a DateTime as an ISO8601 string. +formatIso8601 :: DateTime -> String +formatIso8601 = Formatter.DateTime.format Internal.Format.iso8601DateTime + -- | INTERNAL -- | -- | A codec for date times that encode as JSON strings in the ISO8601 date-time diff --git a/scripts/src/DailyImporter.purs b/scripts/src/DailyImporter.purs index 1cc194582..9b8af6cdd 100644 --- a/scripts/src/DailyImporter.purs +++ b/scripts/src/DailyImporter.purs @@ -1,13 +1,14 @@ --- | This script checks for new package versions by fetching GitHub tags for all --- | packages in the registry. When a new version is discovered (a tag that hasn't --- | been published or unpublished), it submits a publish job to the registry API. +-- | This script checks for new package versions by fetching commits from the last +-- | 24 hours for all packages in the registry. When a recent commit is found that +-- | corresponds to an unpublished version tag, it submits a publish job to the +-- | registry API. -- | -- | Run via Nix: -- | nix run .#daily-importer -- --dry-run # Log what would be submitted -- | nix run .#daily-importer -- --submit # Actually submit to the API -- | -- | Required environment variables: --- | GITHUB_TOKEN - GitHub API token for fetching tags +-- | GITHUB_TOKEN - GitHub API token for fetching commits and tags -- | REGISTRY_API_URL - Registry API URL (default: https://registry.purescript.org) module Registry.Scripts.DailyImporter where @@ -18,10 +19,13 @@ import ArgParse.Basic as Arg import Codec.JSON.DecodeError as CJ.DecodeError import Data.Array as Array import Data.Codec.JSON as CJ +import Data.DateTime as DateTime import Data.Map as Map import Data.Set as Set +import Data.Time.Duration (Hours(..)) import Effect.Aff as Aff import Effect.Class.Console as Console +import Effect.Now as Now import Fetch (Method(..)) import Fetch as Fetch import JSON as JSON @@ -112,46 +116,63 @@ runDailyImport :: Mode -> URL -> Run DailyImportEffects Unit runDailyImport mode registryApiUrl = do Log.info "Daily Importer: checking for new package versions..." + now <- Run.liftEffect Now.nowDateTime + let since = fromMaybe now $ DateTime.adjust (Hours (-24.0)) now + allMetadata <- Registry.readAllMetadata let packages = Map.toUnfoldable allMetadata :: Array (Tuple PackageName Metadata) - Log.info $ "Checking " <> show (Array.length packages) <> " packages for new versions..." + Log.info $ "Checking " <> show (Array.length packages) <> " packages for commits in the last 24 hours..." submitted <- for packages \(Tuple name (Metadata metadata)) -> do case metadata.location of Git _ -> pure 0 -- Skip non-GitHub packages for now GitHub { owner, repo } -> do - GitHub.listTags { owner, repo } >>= case _ of + let address = { owner, repo } + -- First, check if there are any recent commits + GitHub.listCommitsSince address since >>= case _ of Left err -> do - Log.debug $ "Failed to fetch tags for " <> PackageName.print name <> ": " <> Octokit.printGitHubError err + Log.debug $ "Failed to fetch commits for " <> PackageName.print name <> ": " <> Octokit.printGitHubError err + pure 0 + Right [] -> do + -- No recent commits, skip fetching tags pure 0 - Right tags -> do - let - -- Combine published and unpublished versions into a set - publishedVersions = Set.fromFoldable - $ Map.keys metadata.published - <> Map.keys metadata.unpublished - - -- Parse tags as versions and filter out already published ones - newVersions = Array.catMaybes $ tags <#> \tag -> - case LenientVersion.parse tag.name of - Left _ -> Nothing -- Not a valid version tag - Right result -> - let - version = LenientVersion.version result - in - if Set.member version publishedVersions then Nothing - else Just { version, ref: tag.name } - - -- Submit publish jobs for new versions - count <- for newVersions \{ version, ref } -> do - submitPublishJob mode registryApiUrl name version ref - - pure $ Array.length $ Array.filter identity count + Right recentCommitShas -> do + let recentShas = Set.fromFoldable recentCommitShas + -- There are recent commits, now fetch tags to see if any point to them + GitHub.listTags address >>= case _ of + Left err -> do + Log.debug $ "Failed to fetch tags for " <> PackageName.print name <> ": " <> Octokit.printGitHubError err + pure 0 + Right tags -> do + let + publishedVersions = combinedPublishedVersions { published: metadata.published, unpublished: metadata.unpublished } + newVersions = findNewVersions tags recentShas publishedVersions + + -- Submit publish jobs for new versions + count <- for newVersions \{ version, ref } -> do + submitPublishJob mode registryApiUrl name version ref + + pure $ Array.length $ Array.filter identity count let totalSubmitted = Array.foldl (+) 0 submitted Log.info $ "Daily Importer complete. Submitted " <> show totalSubmitted <> " publish jobs." +-- | Combine published and unpublished versions into a set +combinedPublishedVersions :: forall a b. { published :: Map Version a, unpublished :: Map Version b } -> Set Version +combinedPublishedVersions metadata = Set.fromFoldable $ Map.keys metadata.published <> Map.keys metadata.unpublished + +-- | Find new version tags that point to recent commits and haven't been published +findNewVersions :: Array Octokit.Tag -> Set String -> Set Version -> Array { version :: Version, ref :: String } +findNewVersions tags recentShas publishedVersions = Array.catMaybes $ tags <#> \tag -> + case LenientVersion.parse tag.name of + Left _ -> Nothing -- Not a valid version tag + Right result -> do + let version = LenientVersion.version result + if not (Set.member tag.sha recentShas) then Nothing -- Tag doesn't point to a recent commit + else if Set.member version publishedVersions then Nothing -- Already published + else Just { version, ref: tag.name } + -- | Submit a publish job for a new package version. The compiler is not specified; the registry -- | API will discover the latest compatible compiler based on the package's dependencies. submitPublishJob :: Mode -> URL -> PackageName -> Version -> String -> Run DailyImportEffects Boolean diff --git a/scripts/src/VerifyIntegrity.purs b/scripts/src/VerifyIntegrity.purs index 061435b61..226abe3d0 100644 --- a/scripts/src/VerifyIntegrity.purs +++ b/scripts/src/VerifyIntegrity.purs @@ -12,9 +12,9 @@ import Data.Either (isLeft) import Data.Foldable (class Foldable, foldM, intercalate) import Data.Formatter.DateTime as Formatter.DateTime import Data.Map as Map -import Effect.Aff as Aff import Data.Set as Set import Data.String as String +import Effect.Aff as Aff import Effect.Class.Console (log) import Effect.Class.Console as Console import Node.FS.Aff as FS.Aff From 0259d0d67e5fd28dcde22720ac8a261e073e4a94 Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Sat, 31 Jan 2026 15:23:51 -0500 Subject: [PATCH 2/2] add wiremock configs Amp-Thread-ID: https://ampcode.com/threads/T-019c15b2-32b8-74e4-8420-34239500a7a7 Co-authored-by: Amp --- nix/test/config.nix | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/nix/test/config.nix b/nix/test/config.nix index e7975a407..f3f73336b 100644 --- a/nix/test/config.nix +++ b/nix/test/config.nix @@ -309,6 +309,33 @@ let ]; }; } + # Commits endpoint for prelude - return empty (no recent commits) + { + request = { + method = "GET"; + urlPattern = "/repos/purescript/purescript-prelude/commits\\?since=.*"; + }; + response = { + status = 200; + headers."Content-Type" = "application/json"; + jsonBody = [ ]; + }; + } + # Commits endpoint for type-equality - return the v4.0.2 commit sha + # This makes the DailyImporter detect that v4.0.2 is a recent commit + { + request = { + method = "GET"; + urlPattern = "/repos/purescript/purescript-type-equality/commits\\?since=.*"; + }; + response = { + status = 200; + headers."Content-Type" = "application/json"; + jsonBody = [ + { sha = "type-eq-sha-402"; } + ]; + }; + } # Tags for type-equality package (used by two scheduler tests): # 1. Transfer detection: metadata says purescript, commit URLs point to new-owner # 2. Legacy imports: v4.0.2 is a new version not yet published