Job queue, matrix builder, concurrency control

.env.example

@@ -1,38 +1,44 @@
-# =====
-# Dev Configuration
-# The devShell reads this file to set defaults, so changing values here
-# affects local development.
-# =====
+# -----------------------------------------------------------------------------
+# Server Configuration (dev defaults, required in all environments)
+# -----------------------------------------------------------------------------
 
-# Server port - used by both the server and E2E tests
+# Port the registry server listens on
+# - Dev/Test: 9000 (from this file)
+# - Prod: Set in deployment config
 SERVER_PORT=9000
 
 # SQLite database path (relative to working directory)
+# - Dev: Uses local ./db directory
+# - Test: Overridden to use temp state directory
+# - Prod: Set to production database path
 DATABASE_URL="sqlite:db/registry.sqlite3"
 
-# =====
-# Dev Secrets
-# these must be set in .env when running scripts like legacy-importer
-# =====
+# -----------------------------------------------------------------------------
+# Secrets (required for production, use dummy values for local dev)
+# -----------------------------------------------------------------------------
+# IMPORTANT: Never commit real secrets. The values below are dummies for testing.
 
-# GitHub personal access token for API requests when running scripts
-GITHUB_TOKEN="ghp_your_personal_access_token"
-
-# =====
-# Prod Secrets
-# these must be set in .env to run the production server and some scripts
-# =====
-
-# DigitalOcean Spaces credentials for S3-compatible storage
-SPACES_KEY="digitalocean_spaces_key"
-SPACES_SECRET="digitalocean_spaces_secret"
-
-# Pacchettibotti bot account credentials
-# Used for automated registry operations (commits, releases, etc.)
+# GitHub personal access token for pacchettibotti bot
+# Used for: commits to registry repos, issue management
 PACCHETTIBOTTI_TOKEN="ghp_pacchettibotti_token"
 
 # Pacchettibotti SSH keys (base64-encoded)
+# Used for: signing authenticated operations (unpublish, transfer)
 # Generate with: ssh-keygen -t ed25519 -C "pacchettibotti@purescript.org"
 # Encode with: cat key | base64 | tr -d '\n'
 PACCHETTIBOTTI_ED25519_PUB="c3NoLWVkMjU1MTkgYWJjeHl6IHBhY2NoZXR0aWJvdHRpQHB1cmVzY3JpcHQub3Jn"
 PACCHETTIBOTTI_ED25519="YWJjeHl6"
+
+# DigitalOcean Spaces credentials for S3-compatible storage
+# Used for: uploading/downloading package tarballs
+SPACES_KEY="digitalocean_spaces_key"
+SPACES_SECRET="digitalocean_spaces_secret"
+
+
+# -----------------------------------------------------------------------------
+# Script-only Secrets (not used by server, used by scripts like legacy-importer)
+# -----------------------------------------------------------------------------
+
+# Personal GitHub token for API requests when running scripts
+# This is YOUR token, not pacchettibotti's
+GITHUB_TOKEN="ghp_your_personal_access_token"

app-e2e/spago.yaml

@@ -5,12 +5,20 @@ package:
   dependencies:
     - aff
     - arrays
+    - codec-json
     - console
     - datetime
     - effect
     - either
+    - foldable-traversable
+    - json
     - maybe
+    - node-fs
+    - node-path
+    - node-process
     - prelude
+    - registry-app
+    - registry-foreign
     - registry-lib
     - registry-test-utils
     - spec

app-e2e/src/Test/E2E/GitHubIssue.purs

@@ -0,0 +1,218 @@
+-- | End-to-end tests for the GitHubIssue workflow.
+-- | These tests exercise the full flow: parsing a GitHub event, submitting to
+-- | the registry API, polling for completion, and posting comments.
+module Test.E2E.GitHubIssue (spec) where
+
+import Registry.App.Prelude
+
+import Data.Array as Array
+import Data.Codec.JSON as CJ
+import Data.Codec.JSON.Record as CJ.Record
+import Data.String as String
+import Effect.Aff (Milliseconds(..))
+import Effect.Aff as Aff
+import JSON as JSON
+import Node.FS.Aff as FS.Aff
+import Node.Path as Path
+import Node.Process as Process
+import Registry.App.GitHubIssue as GitHubIssue
+import Registry.Foreign.Tmp as Tmp
+import Registry.Operation (AuthenticatedData)
+import Registry.Operation as Operation
+import Registry.Test.E2E.Client as Client
+import Registry.Test.E2E.Fixtures as Fixtures
+import Registry.Test.E2E.WireMock (WireMockRequest)
+import Registry.Test.E2E.WireMock as WireMock
+import Test.Spec (Spec)
+import Test.Spec as Spec
+
+spec :: Spec Unit
+spec = do
+  Spec.describe "GitHubIssue end-to-end" do
+    Spec.before clearWireMockJournal do
+
+      Spec.it "handles a publish via GitHub issue, posts comments, and closes issue on success" \_ -> do
+        result <- runWorkflowWithEvent $ mkGitHubPublishEvent Fixtures.effectPublishData
+
+        assertJobSucceeded result
+        assertHasComment jobStartedText result
+        assertHasComment jobCompletedText result
+        assertIssueClosed result
+
+      Spec.it "posts failure comment and leaves issue open when job fails" \_ -> do
+        result <- runWorkflowWithEvent $ mkGitHubAuthenticatedEventFrom "random-user" Fixtures.failingTransferData
+
+        assertJobFailed result
+        assertHasComment jobStartedText result
+        assertHasComment jobFailedText result
+        assertNoComment jobCompletedText result
+        assertIssueOpen result
+
+      Spec.it "re-signs authenticated operation for trustee (job fails due to unpublish time limit)" \_ -> do
+        result <- runWorkflowWithEvent $ mkGitHubAuthenticatedEvent Fixtures.trusteeAuthenticatedData
+
+        assertHasComment jobStartedText result
+        assertTeamsApiCalled result
+
+  where
+  clearWireMockJournal :: Aff Unit
+  clearWireMockJournal = do
+    wmConfig <- liftEffect WireMock.configFromEnv
+    WireMock.clearRequestsOrFail wmConfig
+
+testIssueNumber :: Int
+testIssueNumber = 101
+
+-- | Username configured as a packaging team member in test WireMock fixtures.
+-- | See nix/test/config.nix for the GitHub Teams API stub.
+packagingTeamUsername :: String
+packagingTeamUsername = "packaging-team-user"
+
+jobStartedText :: String
+jobStartedText = "Job started"
+
+jobCompletedText :: String
+jobCompletedText = "Job completed successfully"
+
+jobFailedText :: String
+jobFailedText = "Job failed"
+
+packagingTeamMembersPath :: String
+packagingTeamMembersPath = "/orgs/purescript/teams/packaging/members"
+
+testPollConfig :: GitHubIssue.PollConfig
+testPollConfig =
+  { maxAttempts: 60
+  , interval: Milliseconds 500.0
+  }
+
+githubEventCodec :: CJ.Codec { sender :: { login :: String }, issue :: { number :: Int, body :: String } }
+githubEventCodec = CJ.named "GitHubEvent" $ CJ.Record.object
+  { sender: CJ.Record.object { login: CJ.string }
+  , issue: CJ.Record.object { number: CJ.int, body: CJ.string }
+  }
+
+mkGitHubPublishEvent :: Operation.PublishData -> String
+mkGitHubPublishEvent publishData =
+  let
+    publishJson = JSON.print $ CJ.encode Operation.publishCodec publishData
+    body = "```json\n" <> publishJson <> "\n```"
+    event = { sender: { login: packagingTeamUsername }, issue: { number: testIssueNumber, body } }
+  in
+    JSON.print $ CJ.encode githubEventCodec event
+
+mkGitHubAuthenticatedEvent :: AuthenticatedData -> String
+mkGitHubAuthenticatedEvent = mkGitHubAuthenticatedEventFrom packagingTeamUsername
+
+mkGitHubAuthenticatedEventFrom :: String -> AuthenticatedData -> String
+mkGitHubAuthenticatedEventFrom username authData =
+  let
+    authJson = JSON.print $ CJ.encode Operation.authenticatedCodec authData
+    body = "```json\n" <> authJson <> "\n```"
+    event = { sender: { login: username }, issue: { number: testIssueNumber, body } }
+  in
+    JSON.print $ CJ.encode githubEventCodec event
+
+issuePath :: Int -> String
+issuePath n = "/issues/" <> show n
+
+issueCommentsPath :: Int -> String
+issueCommentsPath n = issuePath n <> "/comments"
+
+commentRequests :: Array WireMockRequest -> Array WireMockRequest
+commentRequests =
+  WireMock.filterByMethod "POST"
+    >>> WireMock.filterByUrlContaining (issueCommentsPath testIssueNumber)
+
+closeRequests :: Array WireMockRequest -> Array WireMockRequest
+closeRequests =
+  WireMock.filterByMethod "PATCH"
+    >>> WireMock.filterByUrlContaining (issuePath testIssueNumber)
+
+teamsRequests :: Array WireMockRequest -> Array WireMockRequest
+teamsRequests =
+  WireMock.filterByMethod "GET"
+    >>> WireMock.filterByUrlContaining packagingTeamMembersPath
+
+bodyContains :: String -> WireMockRequest -> Boolean
+bodyContains text r = fromMaybe false (String.contains (String.Pattern text) <$> r.body)
+
+hasComment :: String -> Array WireMockRequest -> Boolean
+hasComment text = Array.any (bodyContains text)
+
+-- | Result of running the GitHubIssue workflow.
+type RunResult =
+  { success :: Boolean
+  , requests :: Array WireMockRequest
+  }
+
+-- | Run the GitHub issue workflow with a given event JSON.
+-- | Handles server check, temp file creation, env setup, and request capture.
+runWorkflowWithEvent :: String -> Aff RunResult
+runWorkflowWithEvent eventJson = do
+  -- Verify server is reachable
+  config <- liftEffect Client.configFromEnv
+  statusResult <- Client.getStatus config
+  case statusResult of
+    Left err -> Aff.throwError $ Aff.error $ "Server not reachable: " <> Client.printClientError err
+    Right _ -> pure unit
+
+  -- Write event to temp file
+  tmpDir <- Tmp.mkTmpDir
+  let eventPath = Path.concat [ tmpDir, "github-event.json" ]
+  FS.Aff.writeTextFile UTF8 eventPath eventJson
+  liftEffect $ Process.setEnv "GITHUB_EVENT_PATH" eventPath
+
+  -- Initialize and run workflow
+  envResult <- GitHubIssue.initializeGitHub
+  case envResult of
+    Nothing ->
+      Aff.throwError $ Aff.error "initializeGitHub returned Nothing"
+    Just env -> do
+      let testEnv = env { pollConfig = testPollConfig, logVerbosity = Quiet }
+      result <- GitHubIssue.runGitHubIssue testEnv
+
+      -- Capture WireMock requests
+      wmConfig <- liftEffect WireMock.configFromEnv
+      requests <- WireMock.getRequestsOrFail wmConfig
+
+      case result of
+        Left err ->
+          WireMock.failWithRequests ("runGitHubIssue failed: " <> err) requests
+        Right success ->
+          pure { success, requests }
+
+assertJobSucceeded :: RunResult -> Aff Unit
+assertJobSucceeded { success, requests } =
+  unless success do
+    WireMock.failWithRequests "Job did not succeed" requests
+
+assertJobFailed :: RunResult -> Aff Unit
+assertJobFailed { success, requests } =
+  when success do
+    WireMock.failWithRequests "Expected job to fail but it succeeded" requests
+
+assertHasComment :: String -> RunResult -> Aff Unit
+assertHasComment text { requests } =
+  unless (hasComment text (commentRequests requests)) do
+    WireMock.failWithRequests ("Expected '" <> text <> "' comment but not found") requests
+
+assertNoComment :: String -> RunResult -> Aff Unit
+assertNoComment text { requests } =
+  when (hasComment text (commentRequests requests)) do
+    WireMock.failWithRequests ("Did not expect '" <> text <> "' comment") requests
+
+assertIssueClosed :: RunResult -> Aff Unit
+assertIssueClosed { requests } =
+  when (Array.null (closeRequests requests)) do
+    WireMock.failWithRequests "Expected issue to be closed, but no close request was made" requests
+
+assertIssueOpen :: RunResult -> Aff Unit
+assertIssueOpen { requests } =
+  unless (Array.null (closeRequests requests)) do
+    WireMock.failWithRequests "Expected issue to remain open, but a close request was made" requests
+
+assertTeamsApiCalled :: RunResult -> Aff Unit
+assertTeamsApiCalled { requests } =
+  when (Array.null (teamsRequests requests)) do
+    WireMock.failWithRequests "Expected GitHub Teams API to be called, but no such request was seen" requests

app-e2e/src/Test/E2E/Main.purs

@@ -5,6 +5,7 @@ import Prelude
 import Data.Maybe (Maybe(..))
 import Data.Time.Duration (Milliseconds(..))
 import Effect (Effect)
+import Test.E2E.GitHubIssue as Test.E2E.GitHubIssue
 import Test.E2E.Publish as Test.E2E.Publish
 import Test.Spec as Spec
 import Test.Spec.Reporter.Console (consoleReporter)
@@ -15,6 +16,7 @@ main :: Effect Unit
 main = runSpecAndExitProcess' config [ consoleReporter ] do
   Spec.describe "E2E Tests" do
     Spec.describe "Publish" Test.E2E.Publish.spec
+    Spec.describe "GitHubIssue" Test.E2E.GitHubIssue.spec
   where
   config =
     { defaultConfig: Cfg.defaultConfig { timeout = Just $ Milliseconds 120_000.0 }