keiro 0.11.0.0 → 0.12.0.0

raw patch · 64 files changed

+47157/−13774 lines, 64 filesdep ~aesondep ~keikidep ~keiro-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, keiki, keiro-core, kiroku-store, shibuya-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +450/−0
• LICENSE +28/−0
• bench/Main.hs +767/−15
• bench/ReadModelBench.hs +1442/−0
• keiro.cabal +83/−37
• src/Keiro.hs +13/−7
• src/Keiro/Command.hs +448/−76
• src/Keiro/Command/Domain.hs +29/−0
• src/Keiro/DeterministicId.hs +69/−0
• src/Keiro/Inbox.hs +1/−0
• src/Keiro/Inbox/Schema.hs +19/−0
• src/Keiro/Outbox.hs +2/−0
• src/Keiro/Outbox/Schema.hs +38/−0
• src/Keiro/ProcessManager.hs +509/−36
• src/Keiro/Projection.hs +415/−45
• src/Keiro/Projection/Catalog.hs +3742/−0
• src/Keiro/Projection/Catalog/Operations.hs +1455/−0
• src/Keiro/Projection/Catalog/Preimage.hs +65/−0
• src/Keiro/Projection/Types.hs +39/−0
• src/Keiro/ReadModel.hs +338/−67
• src/Keiro/ReadModel/External.hs +1104/−0
• src/Keiro/ReadModel/Rebuild.hs +134/−44
• src/Keiro/ReadModel/Rebuild/Group.hs +1703/−0
• src/Keiro/ReadModel/Rebuild/Runner.hs +1614/−0
• src/Keiro/ReadModel/Rebuild/Status.hs +168/−0
• src/Keiro/ReadModel/Rebuild/Stream.hs +431/−0
• src/Keiro/ReadModel/Rebuild/Versioned.hs +3756/−0
• src/Keiro/ReadModel/Schema.hs +92/−17
• src/Keiro/Router.hs +502/−85
• src/Keiro/Router/Selection.hs +184/−0
• src/Keiro/Snapshot/Schema.hs +48/−0
• src/Keiro/Subscription/Shard.hs +17/−0
• src/Keiro/Telemetry.hs +136/−2
• src/Keiro/Timer.hs +81/−5
• src/Keiro/Timer/Schema.hs +22/−0
• src/Keiro/Workflow.hs +334/−322
• src/Keiro/Workflow/Awakeable.hs +71/−27
• src/Keiro/Workflow/Awakeable/Compatibility.hs +30/−0
• src/Keiro/Workflow/Awakeable/Internal/Identity.hs +44/−0
• src/Keiro/Workflow/Awakeable/Schema.hs +20/−5
• src/Keiro/Workflow/Child.hs +9/−49
• src/Keiro/Workflow/Child/Cancel.hs +95/−0
• src/Keiro/Workflow/Child/Schema.hs +15/−7
• src/Keiro/Workflow/Gc.hs +119/−10
• src/Keiro/Workflow/Instance.hs +377/−76
• src/Keiro/Workflow/Instance/Schema.hs +79/−0
• src/Keiro/Workflow/Journal.hs +207/−0
• src/Keiro/Workflow/Resume.hs +283/−80
• src/Keiro/Workflow/Schema.hs +141/−16
• src/Keiro/Workflow/Sleep.hs +71/−11
• src/Keiro/Workflow/Types.hs +13/−0
• test/CatalogEvolutionSpec.hs +442/−0
• test/CatalogOperationsSpec.hs +306/−0
• test/CatalogSpec.hs +1375/−0
• test/Compatibility/ReadModel011.hs +83/−0
• test/ExternalReadSpec.hs +790/−0
• test/GroupRebuildSpec.hs +595/−0
• test/Main.hs +16068/−12735
• test/PreCanonicalRecoverySpec.hs +303/−0
• test/PreimageSpec.hs +149/−0
• test/ProjectionReplaySpec.hs +1478/−0
• test/ReadModelSpec.hs +83/−0
• test/VersionedRebuildSpec.hs +3066/−0
• test/VersionedTargetPostgresSpec.hs +567/−0

@@ -4,6 +4,456 @@ [Keep a Changelog](https://keepachangelog.com/), and the project aims to follow the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## Unreleased++## 0.12.0.0 — 2026-08-14++### Breaking Changes++- `Keiro.Workflow.Awakeable` no longer exports+  `deterministicAwakeableId` or `legacyDeterministicAwakeableId`. Compatibility+  tooling that must inspect generation-0 rows should import+  `generation0AwakeableId` or `preUtf8Generation0AwakeableId` from+  `Keiro.Workflow.Awakeable.Compatibility`; ordinary workflow code must retain and+  pass the `AwakeableId` returned by allocation.+- The schema-versioned rebuild resume contract advances to+  `versioned-contract-v3` and its persisted runner to+  `keiro/versioned-rebuild/v3`. The contract adds run-scoped dedup staging and a+  persisted promotion admission limit. Complete active v2 versioned runs with the old+  runtime or abandon them before upgrading; they cannot resume under v3.+- `adoptCatalogGroups` now returns `CatalogAdoptionResult`, including adopted group+  metadata, per-registration update/insert outcomes, and removed old-name rows.+  `CatalogAdoptionPlan` likewise adds planned registration actions and orphan rows; code+  constructing or exhaustively matching either result must handle the registry-complete+  contract.+- `Keiro.Workflow.Instance.claimInstance` now returns `ClaimOutcome` instead of+  `Bool`, distinguishing an acquired lease from a live foreign lease, crash+  pacing, and an instance that became unavailable. `ResumeSummary` adds+  `advanced`, `paced`, `sleepDue`, and `unregisteredNames`; `advanced` counts+  only a fresh journal append by the re-invocation, a terminal failure recorded+  at the crash ceiling, or an external wake observed mid-pass. Replay-only+  re-suspensions and terminal short-circuit races report no advance, so bounded+  drains terminate on every reachable pool. `WorkflowRunOptions` adds+  `onJournalAppend`; direct record constructions must initialize it, while+  `defaultWorkflowRunOptions` users are unaffected.++- The catalog rebuild resume contract advances to `contract-v4:` and the persisted runner+  format to `keiro/projection-replay/v4`. The contract now pins replay-adapter application+  order. `CatalogRebuildError` gains `CatalogRebuildSliceMismatch`, and+  `abandonCatalogRebuild` compares group slices rather than resume contracts.++- Canonical identity advances to `catalog-v3:`, `slice-v2:`, `contract-v3:`, and+  `keiro/projection-replay/v3`; catalog inventory and rebuild preview JSON advance to v2.+  Stored `slice-v1:` groups require preview and explicit live-group adoption. An active v2+  replay cannot resume under the v3 runner: complete it with the old runtime or abandon it+  before upgrading and adopting metadata.+- Catalog fingerprints, group metadata, rebuild contracts, and grouped errors+  use the new canonical slice identity. `GroupRebuildMetadata.catalogFingerprint`+  is now `sliceFingerprint`; fingerprint-drift errors are slice-specific; and+  `RebuildRunReport` adds `groupSliceFingerprint`. Persisted replay format is+  `keiro/projection-replay/v3`. Complete or abandon active catalog rebuilds before+  migration `0024` or the v3 runner cutover, then explicitly adopt stale group rows.++- Requires `kiroku-store >=0.7 && <0.8`. Direct constructors of+  `SubscriptionDeclaration` and exhaustive matches on grouped+  `RebuildStartError` must adopt the explicit checkpoint lifecycle surface.+  `KeiroMetrics` gains the+  `projectionGlobalPositionDistance` gauge field; code constructing that record+  directly must initialize it. Exhaustive custom Kiroku interpreters must also+  implement the 0.5 checkpoint lifecycle, 0.6 visible-head effect surface, and+  0.7 renewable history-retention lease surface.+- Requires `keiro-core ^>=0.12.0.0` and `shibuya-core ^>=0.9.0.0`, replacing+  the 0.11 package-family and Shibuya 0.8 bounds.+- `Keiro.Workflow.JournalAppendOutcome` gains a `JournalRefusedTerminal !Text`+  constructor. The journal-append transaction now declines an ordinary+  `StepRecorded` append into a workflow generation that already carries a+  `__workflow_cancelled__` or `__workflow_failed__` marker, and reports which+  marker refused it. A refusal is not an error: the wake source should settle+  its own durable row and deliver nothing. `appendJournalEntry` /+  `appendJournalEntryReturningId` absorb it and return normally, so only code+  that pattern-matches on `JournalAppendOutcome` needs to change.++- A workflow that is terminally *failed* now stops at the next step boundary,+  as a cancelled one already did. Previously the failure marker was checked only+  at run entry, so a direct `runWorkflow` call that overlapped the resume+  worker's `WorkflowFailed` marker kept executing fresh side effects. Runs that+  relied on that behaviour will now return `Failed` at the boundary.++- `Keiro.Workflow.Instance.markInstanceSuspended` is replaced by+  `markInstanceSuspendedAwaiting :: WorkflowName -> WorkflowId -> Int -> Text ->+  Eff es ()`, which takes the run's generation and the awaited step name and+  arbitrates the suspended-status write against a concurrent wake delivery.++- `Keiro.Workflow.Instance.recordCrashTx` returns `Maybe Int32` instead of+  `Int32`. `Nothing` means the workflow reached a terminal status between+  crashing and having that crash recorded, so no attempt was counted — an+  ordinary race, not an error.++- `Keiro.Workflow.Gc.gcWorkflowsOnce` and `runWorkflowGcWorker` gain an+  `Error StoreError :> es` constraint, which they need to isolate a failing+  deletion. Callers running them under `runStoreIO` are unaffected.++- `Keiro.Workflow.Resume.ResumeLogEvent` gains a `ResumeCrashRecordSkipped+  !Text !Text` constructor (workflow name, workflow id). Only code that+  pattern-matches exhaustively on `ResumeLogEvent` needs to change.++- `Keiro.Workflow.Resume.WorkflowResumeOptions` gains a+  `maxConcurrentAdvances :: !Int` field. Only code that builds the record+  without `defaultWorkflowResumeOptions` needs to change; the default is 1,+  which is the behaviour every previous release had.++### New Features++- Projection revisions now bind every live closure to its exact inline owner or+  subscription/dedup delivery capability. Catalog validation requires one handler per+  declared capability and restricts it to the supplying projection's targets; command+  and subscription paths dispatch only their matching closure. The canonical identity+  advances to `catalog-v7:` and `slice-v6:`.+- Projection revisions may declare explicit `StreamScopedReplay` policies. The targeted+  runner repairs one complete retained stream against the persisted serving revision in+  one group-fenced transaction, verifies exact target evidence, backfills ordinary async+  dedup keys, leaves subscription checkpoints unchanged, and refuses truncated/deleted+  history, active rebuilds, slice drift, incomplete serving bindings, or a locked event+  count above the request's positive `maxEvents` admission limit. Oversized work refuses+  before the group-wide writer fence.+- `ProjectionCatalogOperations` adds database-backed targeted-reprojection preview and+  outcome reports. Preview v2 exposes event count, expected dedup claims, and the+  reviewed maximum; outcome v2 records the admitted maximum. Jitsurei demonstrates a V2+  serving-row repair that leaves unrelated streams unchanged.++- Projection catalogs now declare versioned all-row and keyed external read contracts,+  including validated query/shape/revision compatibility, immutable SQL signatures,+  application-owned keyed implementation identity, and monotonic surface generations.+  Canonical identity advances to `catalog-v5:` and `slice-v4:`.+- `Keiro.ReadModel.External` reconciles those declarations into execute-only,+  security-definer functions in `keiro_read`, backed by private managed bindings and a+  lifecycle guard with stable `KR001`/`KR002`/`KR003` SQLSTATEs. The adversarial release+  pass makes crossed-promotion snapshots fail retryably with `KR001`, caps all-row+  results at 100 with `KR004`, verifies exact keyed set-result types, and reports grants+  for the selected overload only. Registration,+  reviewed adoption, versioned-rebuild start, and promotion perform reconciliation in+  their own transaction; retirement is explicit and dependency/grant previewed.+  All-row bindings project only the stable composite type's attributes, candidate+  versions remain metadata-only until promotion, and an explicit implementation-backed+  compatibility wrapper may retain an old zero-argument signature after a breaking+  cutover.+- `ProjectionCatalogOperations` exposes external-read inspection and retirement reports+  with stable JSON envelopes over the same dependency/grant preview used by the runtime.+- `ProjectionGroupStatusV1`, `ServingPositionBasis`,+  `listProjectionGroupStatuses`, and `lookupProjectionGroupStatus` decode the frozen+  public SQL status contract. Catalog registration and reviewed adoption now reconcile+  per-group append/checkpoint cursor authority transactionally.+- Projection catalogs now declare executable `ProjectionRevision` bridges, total+  `PhysicalTargets` mappings, per-target schema/provisioner/validator contracts, and+  ordered promotion names. Candidate Language 5 accepts `projection-revision` blocks and scaffolds+  transaction-local provision, validation, live, replay, and verification holes.+- `Keiro.ReadModel.Rebuild` now implements durable schema-versioned target generations,+  converging candidate replay beside a live serving revision, renewable Kiroku history+  retention, resumable writer-fence/final-head phases, bounded atomic multi-target+  promotion, async dedup/checkpoint reconciliation, restricted exact-shape cloning, and+  dependency-aware retired-generation preview/drop. `ProjectionCatalogOperations`+  exposes dedicated versioned run and retirement reports without widening the legacy+  offline rebuild protocol.+- `Keiro.DeterministicId.deterministicIdProbes` centralizes the unchanged+  current-first, legacy-only-for-moved-seeds compatibility order shared by+  process-manager preflights and generation-0 awakeable adoption.+- `QueryFreshness`, `HeadScope`, `QueryCursorAuthority`, `ReadModelBlueprint`, truthful+  read-model builders, and `runQueryWithFreshness`. Immediate reads need no cursor;+  captured-head and caller-position waits require one durable cursor and fail with typed+  missing-cursor or missing-position errors before polling. Candidate Language 5 generated+  code now constructs only through `immediateReadModel` or `headWaitingReadModel`, deriving+  cursor authority from its validated projection owner.+- Catalog query inventory now records normalized freshness and the optional cursor derived+  from the validated projection owner. Validation rejects waiting queries with zero or+  several compatible durable cursors, and canonical identity normalizes set-valued owned+  targets.+- `ProjectionHandlerCapability`, `ResolvedQuerySupply`, and+  `resolvedQuerySupplies` expose the closure-free relationship from each validated+  query model to the single projection owner of its complete observed-target set.+  Validation rejects empty, missing, and split suppliers with stable diagnostic codes;+  several queries may resolve to one owner without duplicating its handler.++- `DomainDecision`, `DomainCommandOutcome`, `SilentCommandContext`,+  `SilentDomainDecision`, and `DomainCommandHandler`, plus `runDomainCommand`+  and `forgetDomainDecision`. Accepted decisions carry the exact non-empty+  event batch; explicitly selected state-preserving silent edges carry typed+  rejection/no-op payloads; unmatched commands and infrastructure failures+  remain `CommandError`.+- Domain-aware SQL and projection runners, including controlled transaction and+  catalog-fenced outcomes. Rejection/no-op opens no append transaction and runs+  no callback or inline projection; an optimistic conflict returns only the+  final rehydrated decision.+- Additive `DomainRouter` and `DomainProcessManager` configurations, detailed+  one-shot result families, and configurable/default workers. Accepted,+  rejection, and no-op are handled; accepted duplicates remain distinct; only+  genuine `CommandError` enters existing failure policy. Workers use strict+  payload-free summaries rather than retaining detailed fan-out results.+- The `keiro.command.decision` span attribute and+  `keiro.command.decisions` counter, with the closed value set `accepted`,+  `rejected`, and `no_op`. Application payloads never become telemetry labels+  or error descriptions.+- `subscriptionPositionFromInventory` derives a subscription's durable floor+  across all matching consumer-group members, and `readSubscriptionPosition`+  consumes Kiroku's public one-statement checkpoint inventory instead of+  querying the owned table. `storeHeadPosition` delegates to Kiroku 0.6's+  public payload-free visible-global-head effect; transactional rebuild+  completion uses its matching public statement.+- `recordProjectionGlobalPositionDistance` records the preferred+  `keiro.projection.global_position_distance` gauge and the deprecated+  compatibility `keiro.projection.lag` gauge from the visible head and durable+  member floor. Both use `{position}` and neither claims to count relevant+  events.+- Projection catalog subscriptions now carry Kiroku's+  `MissingCheckpointPolicy` through registration, inventory, stable rendering,+  ordering, fingerprints, and operator JSON. Validation rejects+  `FromCurrentHead` for replayable clear-before-replay ownership.+- Group rebuild uses `resetSubscriptionCheckpointsTx`, returns the exact reset+  member keys, and reports `RebuildSubscriptionCheckpointsMissing` while+  condemning the entire preparation transaction if a declared subscription has+  no persisted member. The legacy unmanaged rebuild also uses the public API.+- Projection catalog fingerprints now use an injective, length-prefixed+  canonical preimage and explicit `catalog-v3:` / `slice-v2:` prefixes. Group+  registration and rebuild lifecycle fences use only the affected group slice,+  while rebuild runs retain the whole catalog fingerprint as provenance.+- `previewCatalogAdoption` and `adoptCatalogGroups` provide a read-only plan and+  an all-or-nothing path for adopting reviewed slice changes and reconciling+  query-model registration metadata. Adoption normally requires a live group;+  a failed stale-format group may adopt while remaining fenced for recovery.+- `CatalogRebuildRunPreCanonical` and `preCanonicalRunSliceSentinel` make the+  migration-0024 recovery boundary explicit. Sentinel runs are never resumable+  but are inspectable and idempotently abandonable while active; failed+  stale-format groups can be adopted without lifting their fence, and a fresh+  rebuild can then start from `failed`.+- `CatalogAsyncDedupSpec`, `catalogAsyncIdempotencyKeys`,+  `AsyncDedupBackfill`, `collectAsyncDedupBackfill`,+  `resetDeclaredSubscriptions`, `insertProjectionDedupBatchStmt`, and+  `CatalogRebuildPromotionCheckpointsMissing` expose the catalog-derived+  redelivery-safety inputs and transactional primitives used by rebuild+  promotion.+- `Keiro.Workflow.Resume.resumeWorkflowsOnceUpTo` runs a resume pass over at+  most the requested number of candidates. `resumeWorkflowsOnce` retains its+  unbounded compatibility behavior and delegates to the bounded function.++- `Keiro.Projection.Catalog.Operations` derives versioned JSON inventory,+  pure/registered rebuild previews, and start/inspect/resume/abandon actions+  from one `ValidatedProjectionCatalog`. Callers cannot provide replacement+  targets, sources, handlers, subscriptions, or dedup lists.++- `Keiro.ReadModel.Rebuild.abandonCatalogRebuild` records explicit failure+  evidence against both the durable run and its catalog group while retaining+  the writer fence.++- `Keiro.Workflow.Schema.terminalMarkers` / `terminalMarkersTx` report which+  stopping terminal markers a workflow generation carries, in one query.++- `Keiro.Workflow.Schema.workflowStepLockKey` exposes the per-step advisory-lock+  key derivation shared by the append path and the suspend write.++- `Keiro.Workflow.Gc.runWorkflowGcWorkerWith` takes a `Text -> IO ()` logging+  hook, mirroring the resume worker's `logEvent`. It reports both a failed pass+  and a partial one (fewer workflows collected than scanned).++- A resume pass can advance several workflows at once. Set+  `WorkflowResumeOptions.maxConcurrentAdvances` above 1 and `resumeWorkflowsOnce`+  advances that many candidates concurrently, so one slow step body no longer+  delays every other workflow in the pass. It is safe by construction —+  discovery returns one row per instance, each advance holds its own lease, and+  the append path's per-step advisory lock already serializes same-step writers+  across processes — but it multiplies in-flight database traffic, so size it+  against the store's connection-pool headroom. The default of 1 preserves the+  previous sequential behaviour exactly. `logEvent` may now be called from+  several threads and must be thread-safe when concurrency is enabled.++- `Keiro.Workflow.Resume.ResumeSummary` has `Semigroup` and `Monoid` instances+  that add fields, so per-candidate deltas combine into a pass summary that does+  not depend on the order candidates finish in.++- `Keiro.Timer.drainDueTimersWith` / `drainDueTimers` claim and fire up to a+  caller-supplied number of due timers in one pass, returning how many were+  processed. Per-timer semantics are `runTimerWorkerWith`'s, unchanged; the+  requeue-and-gauge preamble now runs once per batch instead of once per timer,+  so a backlog of due timers no longer drains at one row per poll tick.+  `Keiro.Workflow.Sleep.drainWorkflowSleepTimers` is the batched sibling of+  `runWorkflowTimerWorker`, routing sleeps and process-manager timers the same+  way. `runTimerWorker` / `runTimerWorkerWith` are unchanged.++### Bug Fixes++- `Keiro.version` now renders Cabal's generated package metadata instead of a stale+  hand-maintained literal, so diagnostics and telemetry automatically follow each release.+- The durable-workflow reference and worked guide now document at-least-once+  step actions, opaque awakeable-id publication, fresh publication after+  `continueAsNew`, and the real `IOE` constraints. Compile-owned forwarding+  signatures keep the displayed workflow API aligned with the public modules.+- Fresh workflow awakeables are now opaque allocation results. Generation-0+  coordinate probes are isolated behind `Keiro.Workflow.Awakeable.Compatibility`,+  while runtime adoption and the compatibility surface share one internal identity+  implementation; ordinary workflow and generated-code APIs no longer expose a+  coordinate-derived candidate for a fresh awakeable.+- Schema-versioned rebuilds now enforce an absolute database-clock deadline for+  writer-fence and promotion lock attempts, acquire every target relation in one+  cumulative lock statement, and return typed phase-specific deadline failures.+  Async redelivery evidence is staged incrementally in PostgreSQL and admitted against+  a persisted operator limit; candidate verification, set-based dedup installation,+  checkpoint reconciliation, and lease release complete in a resumable preparation+  phase before target relations are locked.+- Cursorless read models built through `immediateReadModel` with `NoQueryCursor`+  now fail fast with `ReadModelMissingCursor` on every public wait path. The+  exported `waitFor` and deprecated `runQueryWith` waiting overrides no longer+  poll the private cursor sentinel for the full timeout or record a spurious+  `keiro.projection.wait.timeouts` increment. Models with durable cursors,+  including all directly constructed 0.11 records, retain their behavior.+- `Keiro.ReadModel.Rebuild.startRebuild` now recognizes a cursorless model through+  `readModelCursorAuthority` and skips the subscription-checkpoint reset because+  there is no cursor to reset. It no longer passes the private NUL-prefixed+  compatibility sentinel into Kiroku, while preserving the documented fence,+  truncate, and dedup clear used by generated inline Language-5 rebuild helpers.+- A workflow suspended on a due sleep while no timer worker ran no longer makes+  the documented `ResumeSummary.advanced > 0` drain loop spin forever. It now+  reports `advanced = 0` and `sleepDue = 1`, preserving discovery while naming+  the blocked remedy.+- Offline catalog rebuild promotion now backfills replayable async projection+  dedup rows for each subscription's replayed redelivery window and advances+  every declared checkpoint member to the captured head in the promotion+  transaction. Previously the reset checkpoints and deleted dedup rows caused+  every replayed event to be redelivered and re-applied after promotion,+  corrupting non-idempotent async read models.+- Catalog adoption no longer silently succeeds after a zero-row query-registration+  update. It updates or inserts every selected catalog registration and deletes a+  previewed renamed-model row only when no registration in the complete catalog claims+  the old name, all in the slice-adoption transaction.+- A database upgraded by migration 0024 while a catalog rebuild was+  `rebuilding` or `failed` can now recover entirely through supported APIs:+  abandon the pre-canonical run, adopt the fenced stale-format group, and start+  a fresh canonical rebuild.+- Resuming an interrupted catalog rebuild after a deploy reorders the group's replayable+  projection declarations now refuses with `CatalogRebuildContractMismatch` instead of+  silently applying the remaining history in a different adapter order.+- Multi-source catalog rebuilds again apply events in strictly ascending global position+  across sources. Buffered chunks are clamped to the smallest safe source horizon, and+  the runner records `replay.global-position-regression` or+  `replay.buffer-horizon-stalled` invariant evidence instead of promoting if ordering+  would regress or the merge cannot advance. Per-event source-read counts are unchanged.+- Upgrades with non-ASCII process-manager correlations, router keys, or+  awakeable labels now deduplicate against IDs written before deterministic seed+  encoding switched to UTF-8. The runtime probes the frozen historical identity+  alongside the current one, with no extra database probe for ASCII seeds, and+  adopts in-flight generation-0 awakeables rather than orphaning them. See ADR+  0024 for the operator-attested removal criteria.++- Awakeable cancellation now serializes with a concurrent suspend write under+  the awaited step's advisory lock. Suspend arbitration also consults a valid+  `awk:` awakeable row after an absent step-index result, keeping the instance+  `running` when the awakeable is already completed or cancelled. A cancellation+  that committed just before the stale suspend write can therefore no longer+  strand the workflow as undiscoverable `suspended` work.++- A workflow that goes terminal while the resume worker is recording its crash+  no longer aborts the rest of the pass. The crash-recording `UPDATE` matches no+  row once the workflow is terminal, which used to fail a single-row decoder;+  because the crash record sits outside the per-advance error handling, that+  store error escaped the whole pass and every remaining candidate was skipped+  until the next tick. The race is now logged as `ResumeCrashRecordSkipped`,+  counted under `transientErrors`, and the pass continues.++- Workflow garbage collection survives errors. A failing deletion is isolated to+  its own workflow instead of aborting the batch, and `WorkflowGcSummary`'s+  `deleted` now counts workflows actually collected rather than restating+  `scanned`. `runWorkflowGcWorker`'s loop catches store errors and synchronous+  exceptions per pass and continues on the next tick — previously a bare+  `forever` loop that the first transient error ended until process restart.++- Deterministic ids are derived from the UTF-8 bytes of their seed text rather+  than each character's codepoint truncated to eight bits. The old encoding gave+  two different seeds the same id whenever their characters agreed modulo 256+  (`"ā"` and `"\SOH"`, and many CJK pairs), which wedged the workflow journal —+  the colliding step's append was refused as a duplicate event id on every+  retry, until the resume worker marked the workflow failed — and silently+  suppressed a legitimate process-manager command. Affects+  `Keiro.Workflow.deterministicJournalId`, `Keiro.Workflow.Sleep.sleepTimerId`,+  `Keiro.Workflow.Awakeable.deterministicAwakeableId`, and+  `Keiro.ProcessManager.deterministicCommandId`.++  **For ASCII seeds the two encodings are byte-identical, so every id in a+  deployment that uses ASCII workflow names, ids, step names, sleep names,+  awakeable labels, patch ids, and correlation ids is unchanged.** There is no+  migration. Only non-ASCII seeds derive new ids; in-flight consequences are+  bounded (a journal still replays, a sleep may arm one duplicate timer whose+  fire collapses idempotently, a legacy generation-0 awakeable id is no longer+  adopted, and a retried process-manager emission may emit one duplicate+  command). The derivation is now frozen and pinned by fixtures: see+  `docs/adr/0024-deterministic-ids-hash-utf-8-seed-bytes-and-are-frozen-replay-identity.md`.++### Other Changes++- `ConsistencyMode`, `StrongScope`, `Strong`, `Eventual`, `PositionWait`,+  `defaultStrongWaitOptions`, `runQueryWith`, and the legacy `ReadModel` waiting/cursor+  record fields remain source-compatible in 0.12 and are scheduled for removal in 0.13.+  Use the truthful freshness/cursor façade; legacy `PositionWait` with no target retains+  its historical immediate behavior during the migration window.++- The source distribution now includes the BSD-3-Clause license file.++- Bounded workflow drains repeat while `ResumeSummary.advanced > 0`, not while+  `discovered > 0`. `discovered` remains the admitted pool size; `advanced`+  counts only fresh journal appends, crash-ceiling terminal failures, and+  externally delivered wakes observed mid-pass. Replay-only re-suspensions,+  paced retries, unregistered workflow names, foreign leases, transient errors,+  and due sleeps remain blocked in place; due sleeps are reported separately as+  `sleepDue`.++- Workflow discovery is now exact: `findUnfinishedWorkflowIds` returns an+  instance only when its status is `running`, or `suspended` with a due+  `wake_after`. A workflow parked on an awakeable, a child, or a future-dated+  sleep is no longer re-claimed, replayed, and re-suspended on every resume+  pass, so idle cost no longer scales with the number of parked workflows.+  Every path that resolves or abandons a wake writes the instance row in the+  same transaction; a third-party wake source that transitions its own durable+  row without appending to the journal must now flip the owning instance row+  itself. See `docs/adr/0023-workflow-discovery-is-exact-and-the-instance-row-is-the-complete-wake-ledger.md`.++- `Keiro.Workflow.Awakeable.cancelAwakeable` flips the owning workflow's+  instance row to `running` in the same transaction as the cancellation, so the+  workflow is discovered and can observe the cancellation. Its signature is+  unchanged; `Keiro.Workflow.Awakeable.Schema.cancelAwakeableTx` now returns+  `Maybe (Text, Text)` (the owner's name and id) instead of `Bool`.++- `Keiro.Workflow.Sleep.workflowSleepFireAction` clears `wake_after` only when+  its journal append is fresh, so a stale re-fire can no longer erase the wake+  hint written by a later sleep's first arm.++- The resume worker no longer unions `findRunningChildIds` into discovery; a+  freshly spawned child is already discovered through the instance row+  `spawnChild` writes. The query remains exported for operator inspection.++- Fewer database round-trips per workflow step: the run-entry terminal probe is+  one query instead of two, the terminal boundary check rides the append+  transaction instead of costing a separate query before and after each action,+  and `claimInstance` no longer resolves `MAX(generation)` on every claim.++- `Keiro.Workflow`'s overview gains a "Writing a custom wake source" section+  stating the four obligations a third-party wake source owes — a durable row+  keyed by the logical workflow, delivery under the awaited step name, an arm+  that re-checks the row and re-delivers, and an instance-row write on every+  lifecycle transition — with the rotation race spelled out on+  `appendJournalEntryReturningId`. The same contract is written for adopters in+  `docs/guides/durable-workflows.md` and `docs/user/durable-workflows.md`.++- `continueAsNew` documents that rotating abandons any awakeable id already+  handed out: the next generation re-runs the allocation step and hands out a+  fresh one, so the holder must be re-notified from that step. Stated on+  `continueAsNew`, on `Keiro.Workflow.Awakeable.awakeableNamed`, and in the+  guide.++- A "what suspension costs" section in both durable-workflow documents, the+  roadmap, and the production-status page: parked workflows are free, and the+  costs that remain are due sleeps awaiting a timer worker, crash retries, and+  journal replay under the default `snapshotPolicy = Never`.++- Corrected drift: `recordStepTx`'s haddock named a two-column conflict key that+  has been four columns since migration 0008, and `Keiro.Workflow.Gc` now states+  that collecting a terminal parent deliberately detaches its still-running+  children. ## [0.11.0.0] - 2026-08-05  ### Breaking Changes

@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2026, Nadeem Bitar++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+   may be used to endorse or promote products derived from this software without+   specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS+OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT INCLUDING+NEGLIGENCE OR OTHERWISE ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN+IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -7,13 +7,35 @@ where  import Control.Concurrent (threadDelay)+import Data.Aeson qualified as Aeson import Data.ByteString qualified as BS+import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.Int (Int32) import Data.Text qualified as Text import Data.Time (UTCTime (..), secondsToDiffTime) import Data.Time.Calendar (Day (ModifiedJulianDay)) import Data.UUID qualified as UUID import Effectful (Eff, IOE, (:>)) import Effectful.Error.Static (Error)+import Keiki.Core+  ( Edge (..),+    HsPred,+    InCtor,+    RegFile (..),+    SymTransducer (..),+    Update (..),+    WireCtor,+    inpCtor,+    lit,+    matchInCtor,+    oNil,+    pack,+    unavailableInCtor,+    unavailableWireCtor,+    (*:),+  )+import Keiki.Core qualified as Keiki+import Keiro import Keiro.Inbox   ( InboxDedupePolicy (..),     InboxPersistence (..),@@ -33,15 +55,57 @@     publishClaimedOutbox,   ) import Keiro.Prelude+import Keiro.ProcessManager+  ( DomainProcessManager (..),+    PMCommand (..),+    ProcessManagerAction (..),+    runDomainProcessManagerWorker,+  )+import Keiro.Projection (InlineProjection (..))+import Keiro.ReadModel.Rebuild+  ( RebuildOptions (..),+    RebuildRequest (..),+    RebuildRunId,+    RebuildRunStatus (..),+    defaultRebuildOptions,+    mkRebuildRunId,+    registerProjectionCatalog,+    startCatalogRebuild,+  ) import Keiro.Telemetry qualified as Telemetry-import Keiro.Test.Postgres (withFreshStore, withMigratedSuite)+import Keiro.Test.Postgres (StoreRunner (..), withFreshResourceStore, withMigratedSuite) import Kiroku.Store qualified as Store import Kiroku.Store.Effect (Store)+import Kiroku.Store.Effect.Resource (KirokuStoreResource)+import Kiroku.Store.Lifecycle qualified as Lifecycle+import Kiroku.Store.Types+  ( CategoryName (..),+    EventData (..),+    EventId (..),+    ExpectedVersion (..),+    GlobalPosition (..),+    RecordedEvent (..),+    StreamId (..),+    StreamName (..),+    StreamVersion (..),+  ) import OpenTelemetry.MeterProvider (createMeterProvider, defaultSdkMeterProviderOptions) import OpenTelemetry.Metric.Core (getMeter) import OpenTelemetry.Resource (emptyMaterializedResources)-import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, nfIO)+import ReadModelBench+  ( readModelBenchmarks,+    runReadModelExplainEvidenceIfRequested,+    runReadModelLatencyEvidenceIfRequested,+    setupReadModelBench,+  )+import Shibuya.Adapter (Adapter (..))+import Shibuya.Core.AckHandle (AckHandle (..))+import Shibuya.Core.Ingested (Ingested (..))+import Shibuya.Core.Types (Envelope (..))+import Streamly.Data.Stream qualified as Streamly+import Test.Tasty.Bench (Benchmark, bcompareWithin, bench, bgroup, defaultMain, nfIO) import "hasql-transaction" Hasql.Transaction qualified as Tx+import Prelude  workloadSize :: Int workloadSize = 2000@@ -81,17 +145,23 @@ main :: IO () main =   withMigratedSuite \fixture ->-    withFreshStore fixture \store -> do-      (provider, _env) <--        createMeterProvider-          emptyMaterializedResources-          defaultSdkMeterProviderOptions-      meter <- getMeter provider Telemetry.keiroInstrumentationLibrary-      metrics <- Telemetry.newKeiroMetrics meter-      defaultMain (benchmarks store metrics)+    withFreshResourceStore fixture \(store, runner) -> do+      withFreshResourceStore fixture \(readModelStore, readModelRunner) -> do+        (provider, _env) <-+          createMeterProvider+            emptyMaterializedResources+            defaultSdkMeterProviderOptions+        meter <- getMeter provider Telemetry.keiroInstrumentationLibrary+        metrics <- Telemetry.newKeiroMetrics meter+        rebuildRunCounter <- newIORef 0+        runStoreChecked store (Store.runTransaction (Tx.sql rebuildBenchSql))+        readModelFixture <- setupReadModelBench readModelStore readModelRunner+        runReadModelExplainEvidenceIfRequested readModelFixture+        runReadModelLatencyEvidenceIfRequested readModelFixture+        defaultMain (benchmarks store runner metrics rebuildRunCounter <> readModelBenchmarks readModelFixture) -benchmarks :: Store.KirokuStore -> Telemetry.KeiroMetrics -> [Benchmark]-benchmarks store metrics =+benchmarks :: Store.KirokuStore -> StoreRunner -> Telemetry.KeiroMetrics -> IORef Int -> [Benchmark]+benchmarks store runner metrics rebuildRunCounter =   [ bgroup       "outbox"       [ scenarioBench store hotKey,@@ -104,7 +174,55 @@         inboxScenarioBench store singleNoMetrics,         inboxScenarioBench store batch100,         inboxScenarioBench store singleSlim-      ]+      ],+    bgroup+      "command"+      [ bgroup+          "legacy"+          [commandScenarioBench store "accepted-1" legacyAcceptedOneStream legacyAcceptedOneTarget EmitOne],+        bgroup+          "control"+          [commandScenarioBench store "accepted-1" legacyAcceptedOneStream legacyAcceptedOneTarget EmitOne],+        bgroup+          "domain-warmup"+          [domainCommandScenarioBench store "accepted-1" domainAcceptedOneHandler domainAcceptedOneTarget EmitOne],+        bgroup+          "domain"+          [ bcompareWithin 0 1.25 acceptedOneControlPattern $+              domainCommandScenarioBench store "accepted-1" domainAcceptedOneHandler domainAcceptedOneTarget EmitOne+          ],+        bgroup+          "legacy"+          [commandScenarioBench store "accepted-large" legacyAcceptedLargeStream legacyAcceptedLargeTarget EmitLarge],+        bgroup+          "domain"+          [ bcompareWithin 0 1.25 legacyAcceptedLargePattern $+              domainCommandScenarioBench store "accepted-large" domainAcceptedLargeHandler domainAcceptedLargeTarget EmitLarge+          ],+        bgroup+          "legacy"+          [commandScenarioBench store "no-op" legacyNoOpStream legacyNoOpTarget SelectNoOp],+        bgroup+          "domain"+          [ bcompareWithin 0 1.25 legacyNoOpPattern $+              domainCommandScenarioBench store "rejected" domainRejectedHandler domainRejectedTarget SelectNoOp,+            bcompareWithin 0 1.25 legacyNoOpPattern $+              domainCommandScenarioBench store "no-op" domainNoOpHandler domainNoOpTarget SelectNoOp,+            bgroup+              "router-fanout"+              [ domainRouterFanoutBench runner fanout+              | fanout <- coordinatorFanouts+              ],+            bgroup+              "process-manager-fanout"+              [ domainProcessManagerFanoutBench runner fanout+              | fanout <- coordinatorFanouts+              ]+          ]+      ],+    bgroup+      "rebuild"+      [rebuildScenarioBench store rebuildRunCounter]   ]   where     hotKey =@@ -166,7 +284,7 @@ runScenario :: Store.KirokuStore -> OutboxScenario -> IO () runScenario store scenario = do   runStoreChecked store do-    Store.runTransaction (Tx.sql "TRUNCATE keiro_outbox")+    Store.runTransaction (Tx.sql "TRUNCATE keiro.keiro_outbox")   seedOutbox store scenario.messages   runStoreChecked store (drainOutbox scenario.brokerModel 0) @@ -178,7 +296,7 @@ runInboxScenario :: Store.KirokuStore -> InboxScenario -> IO () runInboxScenario store scenario = do   runStoreChecked store do-    Store.runTransaction (Tx.sql "TRUNCATE keiro_inbox")+    Store.runTransaction (Tx.sql "TRUNCATE keiro.keiro_inbox")   runStoreChecked store $     case scenario.inboxBatchSize of       Nothing ->@@ -296,6 +414,640 @@       case splitAt n xs of         ([], _) -> []         (chunk, rest) -> chunk : chunksOf n rest++-- * Command runner benchmark fixture ----------------------------------------++data BenchCommand+  = EmitOne+  | EmitLarge+  | SelectNoOp+  deriving stock (Eq, Show)++data BenchEvent+  = BenchOneEmitted !Text+  | BenchLargeEmitted !Text+  deriving stock (Eq, Show)++data BenchState = BenchReady+  deriving stock (Bounded, Enum, Eq, Ord, Show)++type BenchEventStream = EventStream (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent++type ValidatedBenchEventStream = ValidatedEventStream (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent++largeCommandBatchSize :: Int+largeCommandBatchSize = 100++fixedCommandPayload :: Text+fixedCommandPayload = Text.replicate payloadSize "a"++legacyAcceptedOneTarget :: Stream BenchEventStream+legacyAcceptedOneTarget = stream "bench-command-legacy-accepted-1"++legacyAcceptedLargeTarget :: Stream BenchEventStream+legacyAcceptedLargeTarget = stream "bench-command-legacy-accepted-large"++legacyNoOpTarget :: Stream BenchEventStream+legacyNoOpTarget = stream "bench-command-legacy-no-op"++domainAcceptedOneTarget :: Stream BenchEventStream+domainAcceptedOneTarget = legacyAcceptedOneTarget++domainAcceptedLargeTarget :: Stream BenchEventStream+domainAcceptedLargeTarget = legacyAcceptedLargeTarget++domainRejectedTarget :: Stream BenchEventStream+domainRejectedTarget = legacyNoOpTarget++domainNoOpTarget :: Stream BenchEventStream+domainNoOpTarget = legacyNoOpTarget++legacyAcceptedOneStream :: ValidatedBenchEventStream+legacyAcceptedOneStream = mkEventStreamOrThrow "bench-command-legacy-accepted-1" (benchEventStream oneTransducer)++legacyAcceptedLargeStream :: ValidatedBenchEventStream+legacyAcceptedLargeStream = mkEventStreamOrThrow "bench-command-legacy-accepted-large" (benchEventStream largeTransducer)++legacyNoOpStream :: ValidatedBenchEventStream+legacyNoOpStream = mkEventStreamOrThrow "bench-command-legacy-no-op" (benchEventStream noOpTransducer)++domainAcceptedOneHandler :: DomainCommandHandler (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent Text Text+domainAcceptedOneHandler =+  DomainCommandHandler+    { eventStream = legacyAcceptedOneStream,+      classifySilent = \_ -> error "domainAcceptedOneHandler: eventful edge classified as silent"+    }++domainAcceptedLargeHandler :: DomainCommandHandler (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent Text Text+domainAcceptedLargeHandler =+  DomainCommandHandler+    { eventStream = legacyAcceptedLargeStream,+      classifySilent = \_ -> error "domainAcceptedLargeHandler: eventful edge classified as silent"+    }++domainRejectedHandler :: DomainCommandHandler (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent Text Text+domainRejectedHandler =+  DomainCommandHandler+    { eventStream = legacyNoOpStream,+      classifySilent = \_ -> SilentRejected "benchmark rejection"+    }++domainNoOpHandler :: DomainCommandHandler (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent Text Text+domainNoOpHandler =+  DomainCommandHandler+    { eventStream = legacyNoOpStream,+      classifySilent = \_ -> SilentNoOp "benchmark no-op"+    }++acceptedOneControlPattern :: String+acceptedOneControlPattern = "$NF == \"accepted-1\" && $(NF-1) == \"control\" && $(NF-2) == \"command\""++legacyAcceptedLargePattern :: String+legacyAcceptedLargePattern = "$NF == \"accepted-large\" && $(NF-1) == \"legacy\" && $(NF-2) == \"command\""++legacyNoOpPattern :: String+legacyNoOpPattern = "$NF == \"no-op\" && $(NF-1) == \"legacy\" && $(NF-2) == \"command\""++benchEventStream :: SymTransducer (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent -> BenchEventStream+benchEventStream transducer =+  EventStream+    { transducer,+      initialState = BenchReady,+      initialRegisters = RNil,+      eventCodec = benchEventCodec,+      resolveStreamName = streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++oneTransducer :: SymTransducer (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent+oneTransducer = singleEdgeTransducer emitOneCtor [pack emitOneCtor oneEventCtor (lit fixedCommandPayload *: oNil)]++largeTransducer :: SymTransducer (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent+largeTransducer =+  singleEdgeTransducer+    emitLargeCtor+    (Prelude.replicate largeCommandBatchSize (pack emitLargeCtor largeEventCtor (lit fixedCommandPayload *: oNil)))++noOpTransducer :: SymTransducer (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent+noOpTransducer = singleEdgeTransducer selectNoOpCtor []++singleEdgeTransducer :: InCtor BenchCommand '[] -> [Keiki.OutTerm '[] BenchCommand BenchEvent] -> SymTransducer (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent+singleEdgeTransducer commandCtor emitted =+  SymTransducer+    { edgesOut = \BenchReady ->+        [ Edge+            { guard = matchInCtor commandCtor,+              update = UKeep,+              output = emitted,+              target = BenchReady,+              mode = Keiki.Live+            }+        ],+      initial = BenchReady,+      initialRegs = RNil,+      isFinal = \_ -> False+    }++emitOneCtor :: InCtor BenchCommand '[]+emitOneCtor =+  unavailableInCtor+    "EmitOne"+    (\case EmitOne -> Just RNil; _ -> Nothing)+    (\RNil -> EmitOne)++emitLargeCtor :: InCtor BenchCommand '[]+emitLargeCtor =+  unavailableInCtor+    "EmitLarge"+    (\case EmitLarge -> Just RNil; _ -> Nothing)+    (\RNil -> EmitLarge)++selectNoOpCtor :: InCtor BenchCommand '[]+selectNoOpCtor =+  unavailableInCtor+    "SelectNoOp"+    (\case SelectNoOp -> Just RNil; _ -> Nothing)+    (\RNil -> SelectNoOp)++oneEventCtor :: WireCtor BenchEvent (Text, ())+oneEventCtor =+  unavailableWireCtor+    "BenchOneEmitted"+    (\case BenchOneEmitted value -> Just (value, ()); _ -> Nothing)+    (\(value, ()) -> BenchOneEmitted value)++largeEventCtor :: WireCtor BenchEvent (Text, ())+largeEventCtor =+  unavailableWireCtor+    "BenchLargeEmitted"+    (\case BenchLargeEmitted value -> Just (value, ()); _ -> Nothing)+    (\(value, ()) -> BenchLargeEmitted value)++benchEventCodec :: Codec BenchEvent+benchEventCodec =+  Codec+    { eventTypes = EventType "BenchOneEmitted" :| [EventType "BenchLargeEmitted"],+      eventType = \case+        BenchOneEmitted {} -> EventType "BenchOneEmitted"+        BenchLargeEmitted {} -> EventType "BenchLargeEmitted",+      schemaVersion = 1,+      encode = \case+        BenchOneEmitted value -> toJSON value+        BenchLargeEmitted value -> toJSON value,+      decode = \(EventType eventTypeName) _ ->+        case eventTypeName of+          "BenchOneEmitted" -> Right (BenchOneEmitted fixedCommandPayload)+          "BenchLargeEmitted" -> Right (BenchLargeEmitted fixedCommandPayload)+          other -> Left ("unknown command benchmark event type: " <> other),+      upcasters = []+    }++commandScenarioBench :: Store.KirokuStore -> String -> ValidatedBenchEventStream -> Stream BenchEventStream -> BenchCommand -> Benchmark+commandScenarioBench store benchmarkName validatedStream target command =+  bench benchmarkName $ nfIO $ runStoreChecked store do+    void (Lifecycle.hardDeleteStream (streamName target))+    result <- runCommand defaultRunCommandOptions validatedStream target command+    case result of+      Right _ -> pure ()+      Left err -> liftIO (fail ("unexpected command benchmark result: " <> show err))++domainCommandScenarioBench :: Store.KirokuStore -> String -> DomainCommandHandler (HsPred '[] BenchCommand) '[] BenchState BenchCommand BenchEvent Text Text -> Stream BenchEventStream -> BenchCommand -> Benchmark+domainCommandScenarioBench store benchmarkName handler target command =+  bench benchmarkName $ nfIO $ runStoreChecked store do+    void (Lifecycle.hardDeleteStream (streamName target))+    result <- runDomainCommand defaultRunCommandOptions handler target command+    case result of+      Right DomainCommandOutcome {} -> pure ()+      Left err -> liftIO (fail ("unexpected typed command benchmark result: " <> show err))++-- * Projection rebuild benchmark fixtures ---------------------------------++rebuildEventsPerCategory :: Int+rebuildEventsPerCategory = 200++rebuildPageSize :: Int32+rebuildPageSize = 16++rebuildScenarioBench :: Store.KirokuStore -> IORef Int -> Benchmark+rebuildScenarioBench store runCounter =+  bench "three-categories-200" $ nfIO $ runStoreChecked store do+    traverse_ (void . Lifecycle.hardDeleteStream) rebuildStreams+    traverse_ seedRebuildStream rebuildStreams+    registered <- registerProjectionCatalog rebuildCatalog+    case registered of+      Left err -> liftIO (fail ("unexpected rebuild catalog registration result: " <> show err))+      Right _ -> pure ()+    runNumber <- liftIO $ atomicModifyIORef' runCounter (\current -> let next = current + 1 in (next, next))+    let request =+          RebuildRequest+            { rebuildRunId = benchmarkRebuildRunId runNumber,+              requestedBy = "keiro-bench",+              requestReason = "measure buffered projection replay",+              replayFrom = GlobalPosition 0+            }+        options =+          (defaultRebuildOptions request)+            { replayPageSize = rebuildPageSize+            }+    startCatalogRebuild rebuildCatalog benchmarkRebuildGroupId options >>= \case+      Left err -> liftIO (fail ("unexpected rebuild benchmark result: " <> show err))+      Right report+        | report ^. #runStatus == RebuildRunPromoted -> pure ()+        | otherwise -> liftIO (fail ("rebuild benchmark did not promote: " <> show (report ^. #runStatus)))++seedRebuildStream :: (Store :> es) => StreamName -> Eff es ()+seedRebuildStream streamName' =+  void $+    Store.appendToStream+      streamName'+      NoStream+      [ EventData+          { eventId = Nothing,+            eventType = EventType "BenchRebuildEvent",+            payload = Aeson.toJSON eventNumber,+            metadata = Nothing,+            causationId = Nothing,+            correlationId = Nothing+          }+      | eventNumber <- [1 .. rebuildEventsPerCategory]+      ]++rebuildStreams :: [StreamName]+rebuildStreams =+  [ StreamName "orders-bench-rebuild",+    StreamName "customers-bench-rebuild",+    StreamName "billing-bench-rebuild"+  ]++rebuildCatalog :: ValidatedProjectionCatalog+rebuildCatalog =+  case validateProjectionCatalog rebuildCatalogDeclaration of+    Success catalog -> catalog+    Failure diagnostics -> error ("invalid rebuild benchmark catalog: " <> show diagnostics)++rebuildCatalogDeclaration :: ProjectionCatalog+rebuildCatalogDeclaration =+  ProjectionCatalog+    { sources =+        [ source "orders" ordersRebuildSourceId,+          source "customers" customersRebuildSourceId,+          source "billing" billingRebuildSourceId+        ],+      targets =+        [ target ordersRebuildTargetId "bench_rebuild_orders",+          target customersRebuildTargetId "bench_rebuild_customers",+          target billingRebuildTargetId "bench_rebuild_billing"+        ],+      rebuildGroups =+        [ RebuildGroupDeclaration+            { rebuildGroupId = benchmarkRebuildGroupId,+              orderedTargets = [ordersRebuildTargetId, customersRebuildTargetId, billingRebuildTargetId],+              verificationHooks = [],+              claimSite = rebuildSite "bench:rebuild-group"+            }+        ],+      projectionRevisions = [],+      externalReadContracts = [],+      subscriptions = [],+      dedupKeys = [],+      queryModels = [],+      projectionSets =+        [ projectionSet "orders" ordersRebuildSourceId ordersRebuildProjectionId ordersRebuildTargetId,+          projectionSet "customers" customersRebuildSourceId customersRebuildProjectionId customersRebuildTargetId,+          projectionSet "billing" billingRebuildSourceId billingRebuildProjectionId billingRebuildTargetId+        ]+    }+  where+    source sourceCategory sourceId =+      SourceDeclaration+        { sourceId,+          sourceScope = CategorySource (CategoryName sourceCategory),+          codecFingerprint = "bench-rebuild-v1",+          claimSite = rebuildSite ("bench:rebuild-source:" <> sourceCategory)+        }+    target targetId tableName =+      TargetDeclaration+        { targetId,+          qualifiedTable = QualifiedTable "app" tableName,+          resetPolicy = ClearBeforeReplay,+          dependsOn = [],+          claimSite = rebuildSite ("bench:rebuild-target:" <> tableName)+        }+    projectionSet label sourceId projectionId targetId =+      SomeProjectionSet+        ProjectionSet+          { projectionSource = sourceId,+            projectionDefinitions =+              ProjectionDefinition+                { projectionId,+                  rebuildGroup = benchmarkRebuildGroupId,+                  ownedTargets = targetId :| [],+                  replayPolicy =+                    Replayable+                      ReplayAdapter+                        { decodeForReplay = const ReplayIrrelevant,+                          applyForReplay = \() _ -> pure ()+                        },+                  handlers =+                    InlineHandler+                      InlineProjection+                        { name = "bench-rebuild-live-" <> label,+                          apply = \_ _ -> pure ()+                        }+                      (rebuildSite ("bench:rebuild-handler:" <> label))+                      :| [],+                  claimSite = rebuildSite ("bench:rebuild-projection:" <> label)+                }+                :| [],+            claimSite = rebuildSite ("bench:rebuild-set:" <> label)+          }++benchmarkRebuildRunId :: Int -> RebuildRunId+benchmarkRebuildRunId runNumber =+  either (error . Text.unpack) id (mkRebuildRunId ("bench-rebuild-" <> Text.pack (show runNumber)))++rebuildSite :: Text -> ClaimSite+rebuildSite raw = either (error . show) id (mkClaimSite raw)++rebuildIdentity :: (Text -> Either CatalogIdentityError value) -> Text -> value+rebuildIdentity constructor raw = either (error . show) id (constructor raw)++ordersRebuildSourceId, customersRebuildSourceId, billingRebuildSourceId :: SourceId+ordersRebuildSourceId = rebuildIdentity mkSourceId "bench-orders-source"+customersRebuildSourceId = rebuildIdentity mkSourceId "bench-customers-source"+billingRebuildSourceId = rebuildIdentity mkSourceId "bench-billing-source"++ordersRebuildTargetId, customersRebuildTargetId, billingRebuildTargetId :: TargetId+ordersRebuildTargetId = rebuildIdentity mkTargetId "bench-orders-target"+customersRebuildTargetId = rebuildIdentity mkTargetId "bench-customers-target"+billingRebuildTargetId = rebuildIdentity mkTargetId "bench-billing-target"++ordersRebuildProjectionId, customersRebuildProjectionId, billingRebuildProjectionId :: ProjectionId+ordersRebuildProjectionId = rebuildIdentity mkProjectionId "bench-orders-projection"+customersRebuildProjectionId = rebuildIdentity mkProjectionId "bench-customers-projection"+billingRebuildProjectionId = rebuildIdentity mkProjectionId "bench-billing-projection"++benchmarkRebuildGroupId :: RebuildGroupId+benchmarkRebuildGroupId = rebuildIdentity mkRebuildGroupId "bench-rebuild-group"++rebuildBenchSql :: BS.ByteString+rebuildBenchSql =+  "CREATE SCHEMA IF NOT EXISTS app; \+  \CREATE TABLE IF NOT EXISTS app.bench_rebuild_orders (marker bigint); \+  \CREATE TABLE IF NOT EXISTS app.bench_rebuild_customers (marker bigint); \+  \CREATE TABLE IF NOT EXISTS app.bench_rebuild_billing (marker bigint)"++-- * Domain coordinator worker benchmark fixtures ---------------------------++data FanoutInput = FanoutInput !Text !Int++data FanoutCommand = EmitFanout !Int+  deriving stock (Eq, Show)++data FanoutEvent = FanoutEmitted !Int !Text+  deriving stock (Eq, Show)++data FanoutState = FanoutReady+  deriving stock (Bounded, Enum, Eq, Ord, Show)++type ValidatedFanoutEventStream = ValidatedEventStream (HsPred '[] FanoutCommand) '[] FanoutState FanoutCommand FanoutEvent++type FanoutCommandFields = '[ '("targetIndex", Int)]++fanoutCommandCtor :: InCtor FanoutCommand FanoutCommandFields+fanoutCommandCtor =+  unavailableInCtor+    "EmitFanout"+    (\case EmitFanout targetIndex -> Just (RCons Proxy targetIndex RNil))+    (\(RCons _ targetIndex RNil) -> EmitFanout targetIndex)++fanoutEventCtor :: WireCtor FanoutEvent (Int, ())+fanoutEventCtor =+  unavailableWireCtor+    "FanoutEmitted"+    ( \case+        FanoutEmitted targetIndex payload+          | payload == fanoutPayload targetIndex -> Just (targetIndex, ())+        _ -> Nothing+    )+    (\(targetIndex, ()) -> FanoutEmitted targetIndex (fanoutPayload targetIndex))++fanoutTransducer :: SymTransducer (HsPred '[] FanoutCommand) '[] FanoutState FanoutCommand FanoutEvent+fanoutTransducer =+  SymTransducer+    { edgesOut = \FanoutReady ->+        [ Edge+            { guard = matchInCtor fanoutCommandCtor,+              update = UKeep,+              output = [pack fanoutCommandCtor fanoutEventCtor (inpCtor fanoutCommandCtor #targetIndex *: oNil)],+              target = FanoutReady,+              mode = Keiki.Live+            }+        ],+      initial = FanoutReady,+      initialRegs = RNil,+      isFinal = const False+    }++fanoutEventCodec :: Codec FanoutEvent+fanoutEventCodec =+  Codec+    { eventTypes = EventType "FanoutEmitted" :| [],+      eventType = const (EventType "FanoutEmitted"),+      schemaVersion = 1,+      encode = \(FanoutEmitted targetIndex payload) -> toJSON (targetIndex, payload),+      decode = \(EventType eventTypeName) payload ->+        case eventTypeName of+          "FanoutEmitted" ->+            case Aeson.fromJSON payload of+              Aeson.Success (targetIndex, value) -> Right (FanoutEmitted targetIndex value)+              Aeson.Error err -> Left (Text.pack err)+          other -> Left ("unknown fan-out benchmark event type: " <> other),+      upcasters = []+    }++fanoutEventStream :: ValidatedFanoutEventStream+fanoutEventStream =+  mkEventStreamOrThrow+    "bench-command-domain-fanout"+    EventStream+      { transducer = fanoutTransducer,+        initialState = FanoutReady,+        initialRegisters = RNil,+        eventCodec = fanoutEventCodec,+        resolveStreamName = streamName,+        snapshotPolicy = Never,+        stateCodec = Nothing+      }++fanoutDomainHandler :: DomainCommandHandler (HsPred '[] FanoutCommand) '[] FanoutState FanoutCommand FanoutEvent Text Text+fanoutDomainHandler =+  DomainCommandHandler+    { eventStream = fanoutEventStream,+      classifySilent = \_ -> error "fanoutDomainHandler: eventful edge classified as silent"+    }++fanoutPayload :: Int -> Text+fanoutPayload targetIndex =+  Text.take payloadSize (Text.replicate repetitions seed)+  where+    seed = Text.pack (show targetIndex) <> ":"+    repetitions = payloadSize `div` Text.length seed + 1++coordinatorFanouts :: [Int]+coordinatorFanouts = [10, 100, 1000]++domainRouterFanoutBench :: StoreRunner -> Int -> Benchmark+domainRouterFanoutBench runner fanout =+  bench (show fanout) $ nfIO $ do+    let correlationId = "router-" <> Text.pack (show fanout)+        input = FanoutInput correlationId fanout+    runResourceStoreChecked runner do+      resetFanoutTargets "router" correlationId fanout+      runDomainRouterWorker+        defaultRunCommandOptions+        fanoutDomainRouter+        (fanoutAdapter input)+        (\message -> Just (fanoutSourceEvent, message))++domainProcessManagerFanoutBench :: StoreRunner -> Int -> Benchmark+domainProcessManagerFanoutBench runner fanout =+  bench (show fanout) $ nfIO $ do+    let correlationId = "process-manager-" <> Text.pack (show fanout)+        input = FanoutInput correlationId fanout+    runResourceStoreChecked runner do+      resetFanoutTargets "process-manager" correlationId fanout+      void (Lifecycle.hardDeleteStream (StreamName ("bench-command-domain-process-manager:" <> correlationId)))+      runDomainProcessManagerWorker+        defaultRunCommandOptions+        fanoutDomainProcessManager+        (fanoutAdapter input)+        (\message -> Just (fanoutSourceEvent, message))++fanoutDomainRouter ::+  DomainRouter+    FanoutInput+    (HsPred '[] FanoutCommand)+    '[]+    FanoutState+    FanoutCommand+    FanoutEvent+    Text+    Text+    es+fanoutDomainRouter =+  DomainRouter+    { name = "bench-domain-router",+      key = \(FanoutInput correlationId _) -> correlationId,+      resolve = \(FanoutInput correlationId fanout) -> pure (fanoutCommands "router" correlationId fanout),+      targetHandler = fanoutDomainHandler,+      targetProjections = const []+    }++fanoutDomainProcessManager ::+  DomainProcessManager+    FanoutInput+    (HsPred '[] BenchCommand)+    '[]+    BenchState+    BenchCommand+    BenchEvent+    (HsPred '[] FanoutCommand)+    '[]+    FanoutState+    FanoutCommand+    FanoutEvent+    Text+    Text+fanoutDomainProcessManager =+  DomainProcessManager+    { name = "bench-domain-process-manager",+      correlate = \(FanoutInput correlationId _) -> correlationId,+      eventStream = legacyNoOpStream,+      streamFor = \correlationId -> stream ("bench-command-domain-process-manager:" <> correlationId),+      targetHandler = fanoutDomainHandler,+      targetProjections = const [],+      handle = \(FanoutInput correlationId fanout) ->+        ProcessManagerAction+          { command = SelectNoOp,+            commands = fanoutCommands "process-manager" correlationId fanout,+            timers = []+          }+    }++fanoutCommands :: Text -> Text -> Int -> [PMCommand FanoutCommand]+fanoutCommands coordinator correlationId fanout =+  [ PMCommand+      { target = stream (fanoutTargetName coordinator correlationId targetIndex),+        command = EmitFanout targetIndex+      }+  | targetIndex <- [0 .. fanout - 1]+  ]++fanoutTargetName :: Text -> Text -> Int -> Text+fanoutTargetName coordinator correlationId targetIndex =+  "bench-command-domain-"+    <> coordinator+    <> ":"+    <> correlationId+    <> ":"+    <> Text.pack (show targetIndex)++resetFanoutTargets :: (Store :> es) => Text -> Text -> Int -> Eff es ()+resetFanoutTargets coordinator correlationId fanout =+  traverse_+    (\targetIndex -> void (Lifecycle.hardDeleteStream (StreamName (fanoutTargetName coordinator correlationId targetIndex))))+    [0 .. fanout - 1]++fanoutSourceEvent :: RecordedEvent+fanoutSourceEvent =+  RecordedEvent+    { eventId = EventId (UUID.fromWords64 0x018f0f1800007000 0x8000000000000abc),+      eventType = EventType "BenchFanoutSource",+      streamVersion = StreamVersion 1,+      globalPosition = GlobalPosition 1,+      originalStreamId = StreamId 1,+      originalVersion = StreamVersion 1,+      payload = toJSON ("fanout" :: Text),+      metadata = Nothing,+      causationId = Nothing,+      correlationId = Nothing,+      createdAt = fixedOccurredAt+    }++fanoutAdapter :: FanoutInput -> Adapter es FanoutInput+fanoutAdapter input =+  Adapter+    { adapterName = "bench-domain-coordinator",+      source =+        Streamly.fromList+          [ Ingested+              { envelope =+                  Envelope+                    { messageId = "bench-domain-fanout",+                      cursor = Nothing,+                      partition = Nothing,+                      enqueuedAt = Nothing,+                      traceContext = Nothing,+                      headers = Nothing,+                      attempt = Nothing,+                      attributes = mempty,+                      payload = input+                    },+                ack = AckHandle (\_ -> pure ()),+                lease = Nothing+              }+          ],+      shutdown = pure ()+    }++runResourceStoreChecked :: StoreRunner -> Eff '[Store, Error Store.StoreError, KirokuStoreResource, IOE] a -> IO a+runResourceStoreChecked (StoreRunner runner) action = do+  result <- runner action+  case result of+    Left err -> fail (show err)+    Right value -> pure value  runStoreChecked :: Store.KirokuStore -> Eff [Store, Error Store.StoreError, IOE] a -> IO a runStoreChecked store action = do

@@ -0,0 +1,1442 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedRecordDot #-}++module ReadModelBench+  ( ReadModelBenchFixture,+    readModelBenchmarks,+    runReadModelExplainEvidenceIfRequested,+    runReadModelLatencyEvidenceIfRequested,+    setupReadModelBench,+  )+where++import Control.Monad (forM, replicateM_)+import Data.Aeson qualified as Aeson+import Data.ByteString qualified as ByteString+import Data.Foldable (toList)+import Data.IORef (IORef, atomicModifyIORef', newIORef)+import Data.List qualified as List+import Data.Map.Strict qualified as Map+import Data.Maybe (listToMaybe)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Time (UTCTime (..), secondsToDiffTime)+import Data.Time.Calendar (Day (ModifiedJulianDay))+import Data.UUID qualified as UUID+import Data.UUID.V5 qualified as UUID.V5+import Data.Word (Word64)+import Effectful (Eff, IOE)+import Effectful.Error.Static (Error)+import GHC.Clock (getMonotonicTimeNSec)+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Statement (Statement, preparable)+import Keiki.Core+  ( Edge (..),+    HsPred,+    InCtor,+    RegFile (..),+    SymTransducer (..),+    Update (..),+    WireCtor,+    matchInCtor,+    oNil,+    pack,+    unavailableInCtor,+    unavailableWireCtor,+  )+import Keiki.Core qualified as Keiki+import Keiro+import Keiro.Connection (qualifyTable)+import Keiro.Prelude+import Keiro.Projection+  ( AsyncProjection (..),+    CatalogAsyncApplyOutcome (..),+    InlineProjection (..),+    ProjectionCommandOutcome (..),+    applyAsyncProjectionFromCatalog,+    runCommandWithCatalogProjections,+  )+import Keiro.ReadModel+  ( QueryCursorAuthority (NoQueryCursor),+    ReadModelBlueprint (..),+    immediateReadModel,+  )+import Keiro.ReadModel.External (reconcileExternalReadContracts)+import Keiro.ReadModel.Rebuild+  ( RebuildRunId,+    StreamReprojectionRequest (..),+    VersionedRebuildPhase (..),+    VersionedRebuildRequest (..),+    VersionedTargetMode (..),+    beginVersionedRebuild,+    listProjectionGroupStatuses,+    lookupProjectionGroupStatus,+    mkRebuildRunId,+    rebuildRunIdText,+    registerProjectionCatalog,+    reprojectStream,+    resumeVersionedRebuild,+  )+import Keiro.Stream qualified as Keiro.Stream+import Keiro.Test.Postgres (StoreRunner (..))+import Kiroku.Store qualified as Store+import Kiroku.Store.Effect (Store)+import Kiroku.Store.Effect.Resource (KirokuStoreResource)+import Kiroku.Store.HistoryRetention+  ( HistoryRetentionLeaseRequest (..),+    mkHistoryRetentionLeaseDuration,+    mkHistoryRetentionLeaseOwner,+    mkHistoryRetentionLeaseReason,+  )+import Kiroku.Store.Subscription.Types (MissingCheckpointPolicy (FromBeginning))+import Kiroku.Store.Types+  ( CategoryName (..),+    EventData (..),+    EventId (..),+    ExpectedVersion (..),+    GlobalPosition (..),+    RecordedEvent (..),+    StreamId (..),+    StreamName (..),+    StreamVersion (..),+  )+import System.Environment (lookupEnv)+import Test.Tasty.Bench (Benchmark, bcompareWithin, bench, bgroup, nfIO)+import "hasql-transaction" Hasql.Transaction qualified as Tx+import Prelude++data ProjectionBenchCommand = EmitProjection+  deriving stock (Eq, Show)++data ProjectionBenchEvent = ProjectionBenchEvent+  deriving stock (Eq, Show)++data ProjectionBenchState = ProjectionBenchReady+  deriving stock (Bounded, Enum, Eq, Ord, Show)++type ProjectionBenchEventStream = EventStream (HsPred '[] ProjectionBenchCommand) '[] ProjectionBenchState ProjectionBenchCommand ProjectionBenchEvent++type ValidatedProjectionBenchEventStream = ValidatedEventStream (HsPred '[] ProjectionBenchCommand) '[] ProjectionBenchState ProjectionBenchCommand ProjectionBenchEvent++data ScenarioGroup = ScenarioGroup+  { groupId :: !RebuildGroupId,+    targets :: ![(TargetId, QualifiedTable)],+    revisions :: ![ProjectionRevision]+  }++data ProjectionScenario = ProjectionScenario+  { key :: !Text,+    sourceDeclaration :: !SourceDeclaration,+    targetDeclarations :: ![TargetDeclaration],+    groupDeclarations :: ![RebuildGroupDeclaration],+    projectionSet :: !(ProjectionSet ProjectionBenchEvent),+    subscriptions :: ![SubscriptionDeclaration],+    dedupKeys :: ![DedupKeyDeclaration],+    scenarioGroups :: ![ScenarioGroup],+    asyncDelivery :: !(Maybe (ProjectionId, AsyncProjection)),+    versionManaged :: !Bool+  }++data ReadModelBenchFixture = ReadModelBenchFixture+  { store :: !Store.KirokuStore,+    runner :: !StoreRunner,+    catalog :: !ValidatedProjectionCatalog,+    scenarios :: !(Map.Map Text ProjectionScenario),+    commandCounter :: !(IORef Int64),+    asyncCounter :: !(IORef Int64),+    runCounter :: !(IORef Int64),+    promotionRevision :: !(IORef Bool)+  }++scenarioDefinitions :: [ProjectionScenario]+scenarioDefinitions =+  [ mkInlineScenario "bench-legacy-one" False [1] 0,+    mkInlineScenario "bench-versioned-one" True [1] 0,+    mkInlineScenario "bench-legacy-three" False [3] 0,+    mkInlineScenario "bench-versioned-three" True [3] 0,+    mkInlineScenario "bench-legacy-groups" False [1, 1, 1] 0,+    mkInlineScenario "bench-versioned-groups" True [1, 1, 1] 0,+    mkInlineScenario "bench-legacy-many-revisions" False [1] 0,+    mkInlineScenario "bench-versioned-many-revisions" True [1] 30,+    mkMixedScenario "bench-legacy-mixed" False,+    mkMixedScenario "bench-versioned-mixed" True,+    mkInlineScenario "bench-versioned-allrows" True [1] 0,+    mkInlineScenario "bench-versioned-keyed" True [1] 0,+    mkRepairScenario+  ]++setupReadModelBench :: Store.KirokuStore -> StoreRunner -> IO ReadModelBenchFixture+setupReadModelBench store runner = do+  runStoreChecked store (Store.runTransaction setupTables)+  catalog <-+    case validateProjectionCatalog projectionBenchCatalog of+      Failure diagnostics -> fail ("invalid read-model benchmark catalog: " <> show diagnostics)+      Success value -> pure value+  registration <- runStoreChecked store (registerProjectionCatalog catalog)+  case registration of+    Left err -> fail ("read-model benchmark catalog registration failed: " <> show err)+    Right _ -> pure ()+  runStoreChecked store (Store.runTransaction (bootstrapVersionedGroups scenarioDefinitions))+  reconciliation <- runStoreChecked store (reconcileExternalReadContracts catalog)+  case reconciliation of+    Left err -> fail ("read-model benchmark external contract reconciliation failed: " <> show err)+    Right () -> pure ()+  runStoreChecked store (Store.runTransaction seedStatusScale)+  seedStabilizingHistory store+  seedRepairStreams store+  commandCounter <- newIORef 0+  asyncCounter <- newIORef 0+  runCounter <- newIORef 0+  promotionRevision <- newIORef False+  pure+    ReadModelBenchFixture+      { store,+        runner,+        catalog,+        scenarios = Map.fromList [(scenario.key, scenario) | scenario <- scenarioDefinitions],+        commandCounter,+        asyncCounter,+        runCounter,+        promotionRevision+      }++readModelBenchmarks :: ReadModelBenchFixture -> [Benchmark]+readModelBenchmarks fixture =+  [ bgroup+      "projection"+      [ bgroup+          "inline"+          [ bgroup+              "legacy"+              [ inlineScenarioBench fixture "one-target" "bench-legacy-one",+                inlineScenarioBench fixture "three-target" "bench-legacy-three",+                inlineScenarioBench fixture "three-groups" "bench-legacy-groups",+                inlineScenarioBench fixture "many-revisions" "bench-legacy-many-revisions",+                inlineScenarioBench fixture "mixed-delivery" "bench-legacy-mixed"+              ],+            bgroup+              "versioned"+              [ comparedInline "one-target" "bench-versioned-one",+                comparedInline "three-target" "bench-versioned-three",+                comparedInline "three-groups" "bench-versioned-groups",+                comparedInline "many-revisions" "bench-versioned-many-revisions",+                comparedInline "mixed-delivery" "bench-versioned-mixed"+              ]+          ],+        bgroup+          "async"+          [ bgroup "legacy" [asyncScenarioBench fixture "mixed-delivery" "bench-legacy-mixed"],+            bgroup+              "versioned"+              [ bcompareWithin 0 projectionDiagnosticTimeBudget asyncLegacyPattern $+                  asyncScenarioBench fixture "mixed-delivery" "bench-versioned-mixed"+              ]+          ]+      ],+    bgroup+      "read-model-lifecycle"+      [ bgroup+          "serving-binding"+          [ bench "legacy-three" (nfIO (runServingBindingLookup fixture "bench-legacy-three")),+            bench "versioned-three" (nfIO (runServingBindingLookup fixture "bench-versioned-three"))+          ],+        bgroup+          "promotion"+          [bench "three-target-end-to-end" (nfIO (runPromotionScenario fixture))],+        bgroup+          "repair"+          [ repairScenarioBench fixture eventCount+          | eventCount <- repairEventCounts+          ]+      ],+    bgroup+      "read-model-reads"+      [ bgroup+          "status"+          [ bench "list-1000-synthetic-groups" (nfIO (runStatusList fixture)),+            bench "lookup-among-1000-synthetic-groups" (nfIO (runStatusLookup fixture))+          ],+        bgroup+          "guarded"+          [ bench "all-rows-100" (nfIO (runGuardedAllRows fixture)),+            bench "keyed-10000" (nfIO (runGuardedKeyed fixture))+          ]+      ]+  ]+  where+    comparedInline benchmarkName scenarioKey =+      bcompareWithin 0 projectionDiagnosticTimeBudget (inlineLegacyPattern benchmarkName) $+        inlineScenarioBench fixture benchmarkName scenarioKey++runServingBindingLookup :: ReadModelBenchFixture -> Text -> IO Int+runServingBindingLookup fixture scenarioKey = do+  scenario <- requireScenario fixture scenarioKey+  let groupId = (firstOrError "binding benchmark scenario group" scenario.scenarioGroups).groupId+  row <-+    runStoreChecked fixture.store $+      Store.runTransaction $+        Tx.statement (rebuildGroupIdText groupId) servingBindingStatement+  pure (maybe 0 (\(_, _, _, _, bindings) -> length bindings) row)++runStatusList :: ReadModelBenchFixture -> IO Int+runStatusList fixture =+  length <$> runStoreChecked fixture.store listProjectionGroupStatuses++runStatusLookup :: ReadModelBenchFixture -> IO Bool+runStatusLookup fixture =+  isJust+    <$> runStoreChecked+      fixture.store+      (lookupProjectionGroupStatus (identity mkRebuildGroupId "bench-status-1000"))++runGuardedAllRows :: ReadModelBenchFixture -> IO Int+runGuardedAllRows fixture = do+  rows <-+    runStoreChecked+      fixture.store+      (Store.runTransaction (Tx.statement () guardedAllRowsStatement))+  unless (length rows == 100) $+    fail ("guarded all-row benchmark fixture drifted: " <> show (length rows))+  pure (length rows)++runGuardedKeyed :: ReadModelBenchFixture -> IO Int+runGuardedKeyed fixture = do+  rows <-+    runStoreChecked+      fixture.store+      (Store.runTransaction (Tx.statement 5_000 guardedKeyedStatement))+  unless (rows == [(5_000, 50_000)]) $+    fail ("guarded keyed benchmark fixture drifted: " <> show rows)+  pure (length rows)++-- Sequential tasty-bench cases share and grow one event store, so this is a+-- broad diagnostic tripwire. The warmed, alternating sampler below owns the+-- release requirement: >=90% throughput and <=1.25x p95 for three targets.+projectionDiagnosticTimeBudget :: Double+projectionDiagnosticTimeBudget = 2++inlineLegacyPattern :: String -> String+inlineLegacyPattern benchmarkName =+  "$NF == \""+    <> benchmarkName+    <> "\" && $(NF-1) == \"legacy\" && $(NF-2) == \"inline\" && $(NF-3) == \"projection\""++asyncLegacyPattern :: String+asyncLegacyPattern =+  "$NF == \"mixed-delivery\" && $(NF-1) == \"legacy\" && $(NF-2) == \"async\" && $(NF-3) == \"projection\""++inlineScenarioBench :: ReadModelBenchFixture -> String -> Text -> Benchmark+inlineScenarioBench fixture benchmarkName scenarioKey =+  bench benchmarkName $ nfIO (runInlineScenario fixture scenarioKey)++runInlineScenario :: ReadModelBenchFixture -> Text -> IO ()+runInlineScenario fixture scenarioKey = do+  scenario <- requireScenario fixture scenarioKey+  invocation <- nextCounter fixture.commandCounter+  let target = stream ("bench-projection-command-" <> scenarioKey <> "-" <> Text.pack (show invocation))+  result <-+    runResourceStoreChecked fixture.runner $+      runCommandWithCatalogProjections+        defaultRunCommandOptions+        projectionBenchEventStream+        target+        EmitProjection+        fixture.catalog+        scenario.projectionSet+  case result of+    Right ProjectionCommandApplied {} -> pure ()+    other -> fail ("unexpected inline projection benchmark result: " <> show other)++asyncScenarioBench :: ReadModelBenchFixture -> String -> Text -> Benchmark+asyncScenarioBench fixture benchmarkName scenarioKey =+  bench benchmarkName $ nfIO (runAsyncScenario fixture scenarioKey)++runAsyncScenario :: ReadModelBenchFixture -> Text -> IO ()+runAsyncScenario fixture scenarioKey = do+  scenario <- requireScenario fixture scenarioKey+  (projectionId, projection) <-+    maybe (fail ("scenario has no async delivery: " <> Text.unpack scenarioKey)) pure scenario.asyncDelivery+  invocation <- nextCounter fixture.asyncCounter+  outcome <-+    runStoreChecked fixture.store $+      Store.runTransaction+        ( applyAsyncProjectionFromCatalog+            fixture.catalog+            projectionId+            projection+            (syntheticRecordedEvent invocation)+        )+  case outcome of+    CatalogAsyncApplied -> pure ()+    other -> fail ("unexpected async projection benchmark result: " <> show other)++repairEventCounts :: [Int]+repairEventCounts = [10, 100, 1000]++repairScenarioBench :: ReadModelBenchFixture -> Int -> Benchmark+repairScenarioBench fixture eventCount =+  bench (show eventCount) $ nfIO $ do+    scenario <- requireScenario fixture "benchrepair"+    let projectionId = identity mkProjectionId "benchrepair-g1-inline"+        request =+          StreamReprojectionRequest+            { rebuildGroupId = (firstOrError "repair scenario group" scenario.scenarioGroups).groupId,+              projectionId,+              streamName = repairStreamName eventCount,+              pageSize = 64,+              maxEvents = fromIntegral eventCount+            }+    runStoreChecked fixture.store (reprojectStream fixture.catalog request) >>= \case+      Right report+        | report ^. #replayedEvents == fromIntegral eventCount -> pure ()+      other -> fail ("unexpected targeted repair benchmark result: " <> show other)++runPromotionScenario :: ReadModelBenchFixture -> IO ()+runPromotionScenario fixture = do+  scenario <- requireScenario fixture "bench-versioned-three"+  runNumber <- nextCounter fixture.runCounter+  promoteToV1 <- atomicModifyIORef' fixture.promotionRevision (\current -> (not current, current))+  let group = firstOrError "promotion scenario group" scenario.scenarioGroups+      revisionIds = map (^. #revisionId) group.revisions+      (servingRevisionId, candidateRevisionId) =+        if promoteToV1+          then (revisionIds !! 1, revisionIds !! 0)+          else (revisionIds !! 0, revisionIds !! 1)+      runId = identity mkRebuildRunId ("bench-promotion-" <> Text.pack (show runNumber))+      request =+        VersionedRebuildRequest+          { rebuildRunId = runId,+            rebuildGroupId = group.groupId,+            servingRevisionId,+            candidateRevisionId,+            servingTargets = physicalTargetsFor group.targets,+            targetMode = ApplicationProvisioned,+            replayPageSize = 128,+            cutoverThreshold = 0,+            cutoverLockTimeoutMs = 2_000,+            promotionDedupLimit = 10_000,+            retentionLeaseRequest = retentionRequest runId,+            requestedBy = "keiro-bench",+            requestReason = "measure schema-versioned promotion"+          }+  runStoreChecked fixture.store (beginVersionedRebuild fixture.catalog request) >>= \case+    Left err -> fail ("promotion benchmark begin failed: " <> show err)+    Right _ -> drivePromotion 20 runId+  where+    drivePromotion :: Int -> RebuildRunId -> IO ()+    drivePromotion 0 runId = fail ("promotion benchmark exceeded resume cap: " <> show runId)+    drivePromotion remaining runId = do+      runStoreChecked fixture.store (resumeVersionedRebuild fixture.catalog runId) >>= \case+        Left err -> fail ("promotion benchmark resume failed: " <> show err)+        Right report+          | report ^. #phase == VersionedPromoted -> pure ()+          | otherwise -> drivePromotion (remaining - 1) runId++runReadModelLatencyEvidenceIfRequested :: ReadModelBenchFixture -> IO ()+runReadModelLatencyEvidenceIfRequested fixture =+  lookupEnv "KEIRO_READ_MODEL_P95" >>= \case+    Nothing -> pure ()+    Just _ -> do+      replicateM_ latencyWarmupCount $ do+        runInlineScenario fixture "bench-legacy-three"+        runInlineScenario fixture "bench-versioned-three"+      runs <- forM [1 .. latencyRunCount] $ \runNumber -> do+        (legacy, versioned) <-+          samplePairedLatency+            latencySampleCount+            (runInlineScenario fixture "bench-legacy-three")+            (runInlineScenario fixture "bench-versioned-three")+        let legacyP95 = percentile95 legacy+            versionedP95 = percentile95 versioned+            p95Ratio = fromIntegral versionedP95 / fromIntegral legacyP95 :: Double+            timeRatio = fromIntegral (sum versioned) / fromIntegral (sum legacy) :: Double+            throughputRatio = 1 / timeRatio+        putStrLn+          ( "read-model-latency-run="+              <> show runNumber+              <> " samples="+              <> show latencySampleCount+              <> " legacy_p95_ns="+              <> show legacyP95+              <> " versioned_p95_ns="+              <> show versionedP95+              <> " p95_ratio="+              <> show p95Ratio+              <> " throughput_ratio="+              <> show throughputRatio+          )+        pure (p95Ratio, throughputRatio)+      let medianP95Ratio = median (map fst runs)+          medianThroughputRatio = median (map snd runs)+      putStrLn+        ( "read-model-latency-median runs="+            <> show latencyRunCount+            <> " samples_per_run="+            <> show latencySampleCount+            <> " p95_ratio="+            <> show medianP95Ratio+            <> " p95_budget=1.25 throughput_ratio="+            <> show medianThroughputRatio+            <> " throughput_budget=0.90"+        )+      when (medianP95Ratio > 1.25) $+        fail ("versioned three-target median p95 exceeded 1.25x legacy: " <> show medianP95Ratio)+      when (medianThroughputRatio < 0.90) $+        fail ("versioned three-target median throughput fell below 90% of legacy: " <> show medianThroughputRatio)++runReadModelExplainEvidenceIfRequested :: ReadModelBenchFixture -> IO ()+runReadModelExplainEvidenceIfRequested fixture =+  lookupEnv "KEIRO_READ_MODEL_EXPLAIN" >>= \case+    Nothing -> pure ()+    Just _ -> do+      for_ ["bench-legacy-three", "bench-versioned-three"] $ \scenarioKey -> do+        scenario <- requireScenario fixture scenarioKey+        let groupId = (firstOrError "explain scenario group" scenario.scenarioGroups).groupId+        plan <-+          runStoreChecked fixture.store $+            Store.runTransaction $+              Tx.statement (rebuildGroupIdText groupId) explainServingBindingStatement+        putStrLn ("read-model-serving-binding-plan-json scenario=" <> Text.unpack scenarioKey <> " groups=1")+        print plan+      statusListPlan <- runStoreChecked fixture.store (Store.runTransaction (Tx.statement () explainStatusListStatement))+      putStrLn "read-model-status-list-plan-json synthetic_groups=1000"+      print statusListPlan+      statusLookupPlan <- runStoreChecked fixture.store (Store.runTransaction (Tx.statement () explainStatusLookupStatement))+      putStrLn "read-model-status-lookup-plan-json synthetic_groups=1000"+      print statusLookupPlan+      allRowsPlan <- runStoreChecked fixture.store (Store.runTransaction (Tx.statement () explainGuardedAllRowsStatement))+      putStrLn "read-model-guarded-all-rows-plan-json rows=100"+      print allRowsPlan+      keyedPlan <- runStoreChecked fixture.store (Store.runTransaction (Tx.statement () explainGuardedKeyedStatement))+      putStrLn "read-model-guarded-keyed-wrapper-plan-json rows=10000 requested_id=5000"+      print keyedPlan+      keyedIndexPlan <- runStoreChecked fixture.store (Store.runTransaction (Tx.statement () explainKeyedIndexStatement))+      putStrLn "read-model-guarded-keyed-index-plan-json rows=10000 requested_id=5000"+      print keyedIndexPlan++latencySampleCount :: Int+latencySampleCount = 500++latencyRunCount :: Int+latencyRunCount = 5++latencyWarmupCount :: Int+latencyWarmupCount = 25++sampleOneLatency :: IO () -> IO Word64+sampleOneLatency action = do+  started <- getMonotonicTimeNSec+  action+  finished <- getMonotonicTimeNSec+  pure (finished - started)++samplePairedLatency :: Int -> IO () -> IO () -> IO ([Word64], [Word64])+samplePairedLatency count legacyAction versionedAction = do+  pairs <- forM [0 .. count - 1] $ \sampleIndex ->+    if even sampleIndex+      then do+        legacy <- sampleOneLatency legacyAction+        versioned <- sampleOneLatency versionedAction+        pure (legacy, versioned)+      else do+        versioned <- sampleOneLatency versionedAction+        legacy <- sampleOneLatency legacyAction+        pure (legacy, versioned)+  pure (map fst pairs, map snd pairs)++percentile95 :: [Word64] -> Word64+percentile95 samples =+  sorted !! max 0 (ceiling (0.95 * fromIntegral (length sorted) :: Double) - 1)+  where+    sorted = List.sort samples++median :: (Ord value) => [value] -> value+median values =+  sorted !! (length sorted `div` 2)+  where+    sorted = List.sort values++projectionBenchCatalog :: ProjectionCatalog+projectionBenchCatalog =+  ProjectionCatalog+    { sources = map (\scenario -> scenario.sourceDeclaration) scenarioDefinitions,+      targets = concatMap (\scenario -> scenario.targetDeclarations) scenarioDefinitions,+      rebuildGroups = concatMap (\scenario -> scenario.groupDeclarations) scenarioDefinitions,+      projectionRevisions = concatMap (concatMap (\group -> group.revisions) . (\scenario -> scenario.scenarioGroups)) scenarioDefinitions,+      externalReadContracts = benchmarkExternalReadContracts,+      subscriptions = concatMap (\scenario -> scenario.subscriptions) scenarioDefinitions,+      dedupKeys = concatMap (\scenario -> scenario.dedupKeys) scenarioDefinitions,+      queryModels = concatMap scenarioQueryModels scenarioDefinitions,+      projectionSets = SomeProjectionSet . (\scenario -> scenario.projectionSet) <$> scenarioDefinitions+    }++scenarioQueryModels :: ProjectionScenario -> [SomeQueryModelBinding]+scenarioQueryModels scenario =+  asyncModels <> externalModels+  where+    asyncModels = case scenario.asyncDelivery of+      Nothing -> []+      Just (_, projection) ->+        let group = firstOrError "async query-model group" scenario.scenarioGroups+            (targetId, table) = lastOrError "async query-model target" group.targets+         in [queryModelBinding scenario group targetId table (scenario.key <> "-async-query") (projection ^. #readModelName) (scenario.key <> "-async-query-v1")]+    externalModels+      | scenario.key == "bench-versioned-allrows" =+          [externalBinding "bench-all-rows-query" "bench-all-rows-model" "bench-all-rows-v1"]+      | scenario.key == "bench-versioned-keyed" =+          [externalBinding "bench-keyed-query" "bench-keyed-model" "bench-keyed-v1"]+      | otherwise = []+    externalBinding queryId registryName shapeHash =+      let group = firstOrError "external query-model group" scenario.scenarioGroups+          (targetId, table) = firstOrError "external query-model target" group.targets+       in queryModelBinding scenario group targetId table queryId registryName shapeHash++queryModelBinding :: ProjectionScenario -> ScenarioGroup -> TargetId -> QualifiedTable -> Text -> Text -> Text -> SomeQueryModelBinding+queryModelBinding scenario group targetId table queryId registryName shapeHash =+  SomeQueryModelBinding+    QueryModelBinding+      { queryModelId = identity mkQueryModelId queryId,+        readModel = model,+        rebuildGroup = group.groupId,+        observedTargets = [targetId],+        claimSite = claim (scenario.key <> ":query:" <> queryId)+      }+  where+    model =+      immediateReadModel+        ReadModelBlueprint+          { name = registryName,+            tableName = table ^. #tableName,+            schema = table ^. #schemaName,+            version = 1,+            shapeHash,+            cursorAuthority = NoQueryCursor,+            query = \() -> pure ()+          }++benchmarkExternalReadContracts :: [ExternalReadContract]+benchmarkExternalReadContracts =+  [ AllRowsExternalRead+      { readContractId = identity mkExternalReadContractId "bench_all_rows",+        contractVersion = ExternalReadContractVersion 1,+        queryModelId = identity mkQueryModelId "bench-all-rows-query",+        resultContractType = QualifiedSqlType "app_contract" "bench_all_row_v1",+        resultShapeHash = "bench-all-rows-v1",+        compatibleRevisions =+          identity mkProjectionRevisionId "bench-versioned-allrows-g1-r0"+            :| [identity mkProjectionRevisionId "bench-versioned-allrows-g1-r1"],+        surfaceGeneration = 1,+        claimSite = claim "bench:external:all-rows"+      },+    KeyedExternalRead+      { readContractId = identity mkExternalReadContractId "bench_keyed",+        contractVersion = ExternalReadContractVersion 1,+        queryModelId = identity mkQueryModelId "bench-keyed-query",+        arguments = [SqlFunctionArgument "requested_id" (QualifiedSqlType "pg_catalog" "int8")],+        resultContractType = QualifiedSqlType "app_contract" "bench_keyed_row_v1",+        privateImplementation = QualifiedFunction "app_private" "bench_keyed_lookup",+        privateImplementationVersion = 1,+        resultShapeHash = "bench-keyed-v1",+        compatibleRevisions =+          identity mkProjectionRevisionId "bench-versioned-keyed-g1-r0"+            :| [identity mkProjectionRevisionId "bench-versioned-keyed-g1-r1"],+        surfaceGeneration = 1,+        claimSite = claim "bench:external:keyed"+      }+  ]++mkInlineScenario :: Text -> Bool -> [Int] -> Int -> ProjectionScenario+mkInlineScenario key versionManaged targetCounts extraRevisions =+  scenarioFrom key versionManaged extraRevisions False targetCounts Nothing++mkMixedScenario :: Text -> Bool -> ProjectionScenario+mkMixedScenario key versionManaged =+  scenarioFrom key versionManaged 0 True [3] Nothing++mkRepairScenario :: ProjectionScenario+mkRepairScenario =+  scenarioFrom "benchrepair" True 0 False [1] (Just repairPolicy)++scenarioFrom :: Text -> Bool -> Int -> Bool -> [Int] -> Maybe (TargetId -> StreamScopedReplay) -> ProjectionScenario+scenarioFrom key versionManaged extraRevisions mixed targetCounts streamPolicy =+  ProjectionScenario+    { key,+      sourceDeclaration =+        SourceDeclaration+          { sourceId,+            sourceScope = CategorySource (CategoryName key),+            codecFingerprint = key <> "-codec-v1",+            claimSite = claim (key <> ":source")+          },+      targetDeclarations = targetDeclarations,+      groupDeclarations = groupDeclarations,+      projectionSet =+        ProjectionSet+          { projectionSource = sourceId,+            projectionDefinitions = nonEmptyOrError "scenario definitions" definitions,+            claimSite = claim (key <> ":set")+          },+      subscriptions = asyncSubscriptions,+      dedupKeys = asyncDedupKeys,+      scenarioGroups = groups,+      asyncDelivery = listToMaybe asyncDeliveries,+      versionManaged+    }+  where+    sourceId = identity mkSourceId (key <> "-source")+    groupFacts =+      [ let groupId = identity mkRebuildGroupId (key <> "-g" <> indexText groupIndex)+            targets =+              [ ( identity mkTargetId (key <> "-g" <> indexText groupIndex <> "-t" <> indexText targetIndex),+                  QualifiedTable "app" (sqlName key <> "_g" <> indexText groupIndex <> "_t" <> indexText targetIndex)+                )+              | targetIndex <- [1 .. targetCount]+              ]+         in (groupIndex, groupId, targets)+      | (groupIndex, targetCount) <- zip [1 ..] targetCounts+      ]+    targetDeclarations =+      [ TargetDeclaration+          { targetId,+            qualifiedTable = table,+            resetPolicy = PreserveAndReconcile,+            dependsOn = [],+            claimSite = claim (key <> ":target:" <> targetIdText targetId)+          }+      | (_, _, targets) <- groupFacts,+        (targetId, table) <- targets+      ]+    groupDeclarations =+      [ RebuildGroupDeclaration+          { rebuildGroupId = groupId,+            orderedTargets = map fst targets,+            verificationHooks = [],+            claimSite = claim (key <> ":group:" <> rebuildGroupIdText groupId)+          }+      | (_, groupId, targets) <- groupFacts+      ]+    groupDefinitions = concatMap definitionsForGroup groupFacts+    definitions = [definition | (definition, _, _, _) <- groupDefinitions]+    asyncSubscriptions = [subscription | (_, _, Just subscription, _) <- groupDefinitions]+    asyncDedupKeys = [dedupKey | (_, _, _, Just dedupKey) <- groupDefinitions]+    asyncDeliveries =+      [ (definition ^. #projectionId, projection)+      | (definition, Just projection, _, _) <- groupDefinitions+      ]+    groups =+      [ ScenarioGroup+          { groupId,+            targets,+            revisions =+              if versionManaged+                then+                  [ scenarioRevision key groupIndex groupId targets groupDefinitions revisionIndex streamPolicy+                  | revisionIndex <- [0 .. 1 + extraRevisions]+                  ]+                else []+          }+      | (groupIndex, groupId, targets) <- groupFacts+      ]++    definitionsForGroup (groupIndex, groupId, targets)+      | mixed =+          let (inlineTargets, asyncTargets) = splitAt (length targets - 1) targets+              inline = inlineDefinition key groupIndex groupId inlineTargets+              async = asyncDefinition key groupIndex groupId asyncTargets+           in [inline, async]+      | otherwise = [inlineDefinition key groupIndex groupId targets]++inlineDefinition :: Text -> Int -> RebuildGroupId -> [(TargetId, QualifiedTable)] -> (ProjectionDefinition ProjectionBenchEvent, Maybe AsyncProjection, Maybe SubscriptionDeclaration, Maybe DedupKeyDeclaration)+inlineDefinition key groupIndex groupId targets =+  ( ProjectionDefinition+      { projectionId,+        rebuildGroup = groupId,+        ownedTargets = nonEmptyOrError "inline targets" (map fst targets),+        replayPolicy = benchReplayPolicy,+        handlers = InlineHandler projection (claim (key <> ":inline-handler:" <> indexText groupIndex)) :| [],+        claimSite = claim (key <> ":inline:" <> indexText groupIndex)+      },+    Nothing,+    Nothing,+    Nothing+  )+  where+    projectionId = identity mkProjectionId (key <> "-g" <> indexText groupIndex <> "-inline")+    projection = logicalInlineProjection (key <> "-inline") targets++asyncDefinition :: Text -> Int -> RebuildGroupId -> [(TargetId, QualifiedTable)] -> (ProjectionDefinition ProjectionBenchEvent, Maybe AsyncProjection, Maybe SubscriptionDeclaration, Maybe DedupKeyDeclaration)+asyncDefinition key groupIndex groupId targets =+  ( ProjectionDefinition+      { projectionId,+        rebuildGroup = groupId,+        ownedTargets = nonEmptyOrError "async targets" (map fst targets),+        replayPolicy = benchReplayPolicy,+        handlers = AsyncHandler projection subscriptionId dedupKeyId (claim (key <> ":async-handler")) :| [],+        claimSite = claim (key <> ":async")+      },+    Just projection,+    Just subscriptionDeclaration,+    Just dedupDeclaration+  )+  where+    projectionId = identity mkProjectionId (key <> "-g" <> indexText groupIndex <> "-async")+    subscriptionId = identity mkSubscriptionId (key <> "-subscription")+    dedupKeyId = identity mkDedupKeyId (key <> "-dedup")+    subscriptionName = key <> "-subscription"+    projectionName = key <> "-async"+    projection =+      AsyncProjection+        { name = projectionName,+          readModelName = key <> "-async-model",+          subscriptionName,+          applyRecorded = \_ -> updateLogicalTargets targets,+          idempotencyKey = (^. #eventId)+        }+    subscriptionDeclaration =+      SubscriptionDeclaration+        { subscriptionId,+          subscriptionName,+          subscriptionSource = identity mkSourceId (key <> "-source"),+          checkpointOnMissing = FromBeginning,+          claimSite = claim (key <> ":subscription")+        }+    dedupDeclaration =+      DedupKeyDeclaration+        { dedupKeyId,+          dedupName = projectionName,+          claimSite = claim (key <> ":dedup")+        }++scenarioRevision :: Text -> Int -> RebuildGroupId -> [(TargetId, QualifiedTable)] -> [(ProjectionDefinition ProjectionBenchEvent, Maybe AsyncProjection, Maybe SubscriptionDeclaration, Maybe DedupKeyDeclaration)] -> Int -> Maybe (TargetId -> StreamScopedReplay) -> ProjectionRevision+scenarioRevision key groupIndex groupId targets allDefinitions revisionIndex streamPolicy =+  ProjectionRevision+    { revisionId = identity mkProjectionRevisionId revisionName,+      rebuildGroup = groupId,+      targetProvisioners = Map.fromList [(targetId, targetProvisioner key targetId revisionName) | (targetId, _) <- targets],+      liveHandlers = concatMap revisionHandlers relevantDefinitions,+      replayAdapters =+        [ RevisionReplayAdapter+            (revisionName <> "-replay")+            1+            (map fst targets)+            (\_ _ -> pure (Right False))+        ],+      revisionVerifications = [],+      streamScopedReplays = maybe [] (\makePolicy -> [makePolicy (fst (firstOrError "revision target" targets))]) streamPolicy,+      claimSite = claim (key <> ":revision:" <> revisionName)+    }+  where+    revisionName = key <> "-g" <> indexText groupIndex <> "-r" <> indexText revisionIndex+    relevantDefinitions =+      [ definition+      | entry@(definition, _, _, _) <- allDefinitions,+        definition ^. #rebuildGroup == groupId,+        let _ = entry+      ]+    revisionHandlers definition =+      [ case handler of+          InlineHandler projection _ ->+            RevisionLiveHandler+              (revisionName <> "-" <> projection ^. #name)+              1+              (RevisionInlineDelivery (definition ^. #projectionId) (projection ^. #name))+              (toList (definition ^. #ownedTargets))+              (\physicalTargets _ -> updatePhysicalTargets physicalTargets (toList (definition ^. #ownedTargets)))+          AsyncHandler projection subscriptionId dedupKeyId _ ->+            RevisionLiveHandler+              (revisionName <> "-" <> projection ^. #name)+              1+              (RevisionSubscriptionDelivery (definition ^. #projectionId) subscriptionId dedupKeyId)+              (toList (definition ^. #ownedTargets))+              (\physicalTargets _ -> updatePhysicalTargets physicalTargets (toList (definition ^. #ownedTargets)))+      | handler <- toList (definition ^. #handlers)+      ]++logicalInlineProjection :: Text -> [(TargetId, QualifiedTable)] -> InlineProjection ProjectionBenchEvent+logicalInlineProjection name targets =+  InlineProjection+    { name,+      apply = \_ _ -> updateLogicalTargets targets+    }++benchReplayPolicy :: ProjectionReplayPolicy ProjectionBenchEvent+benchReplayPolicy =+  Replayable+    ReplayAdapter+      { decodeForReplay = const ReplayIrrelevant,+        applyForReplay = \_ _ -> pure ()+      }++targetProvisioner :: Text -> TargetId -> Text -> TargetProvisioner+targetProvisioner key targetId revisionName =+  TargetProvisioner+    { provisionerId = revisionName <> "-" <> targetIdText targetId <> "-provisioner",+      provisionerVersion = 1,+      schemaVersion = TargetSchemaVersion "bench-v1",+      expectedShapeId = "bench-shape-v1",+      provisionTarget = \context -> do+        let table = context ^. #stagingTable+        createProjectionTable table+        seedProvisionedBenchmarkTable key targetId table,+      validatorId = revisionName <> "-" <> targetIdText targetId <> "-validator",+      validatorVersion = 1,+      validateTarget = Just validateProjectionTable,+      promotionObjectNames = []+    }+  where+    validateProjectionTable context = do+      relationOid <- Tx.statement () (relationOidStatement (context ^. #stagingTable))+      pure+        ( Right+            TargetSchemaEvidence+              { relationOid,+                observedShapeFingerprint = "bench-shape-v1",+                observedPromotionObjects = [],+                catalogSnapshot = "bench-catalog-v1"+              }+        )++seedProvisionedBenchmarkTable :: Text -> TargetId -> QualifiedTable -> Tx.Transaction ()+seedProvisionedBenchmarkTable key targetId table+  | key == "bench-versioned-allrows",+    targetIdText targetId == "bench-versioned-allrows-g1-t1" =+      insertGeneratedRows table 100+  | key == "bench-versioned-keyed",+    targetIdText targetId == "bench-versioned-keyed-g1-t1" =+      insertGeneratedRows table 10_000+  | otherwise = pure ()++insertGeneratedRows :: QualifiedTable -> Int -> Tx.Transaction ()+insertGeneratedRows table upperBound =+  Tx.sql+    ( Text.Encoding.encodeUtf8+        ( "INSERT INTO "+            <> qualified table+            <> " (id, value) SELECT id, id * 10 FROM generate_series(2, "+            <> Text.pack (show upperBound)+            <> ") AS ids(id)"+        )+    )++repairPolicy :: TargetId -> StreamScopedReplay+repairPolicy targetId =+  StreamScopedReplay+    { streamProjectionId = identity mkProjectionId "benchrepair-g1-inline",+      streamOwnedTargets = targetId :| [],+      clearerId = "benchrepair-clear",+      clearerVersion = 1,+      clearStreamRows = \physicalTargets _ -> do+        let table = requirePhysicalTarget physicalTargets targetId+        cleared <- Tx.statement () (deleteProjectionRowsStatement table)+        pure (Right [StreamClearCount targetId cleared]),+      streamReplayId = "benchrepair-replay",+      streamReplayVersion = 1,+      replayStreamEvent = \physicalTargets _ -> do+        updateProjectionTable (requirePhysicalTarget physicalTargets targetId)+        pure (Right True),+      streamVerificationId = "benchrepair-verify",+      streamVerificationVersion = 1,+      verifyStreamRows = \physicalTargets _ -> do+        rows <- Tx.statement () (countProjectionRowsStatement (requirePhysicalTarget physicalTargets targetId))+        pure (if rows == 1 then Right () else Left "repair target must contain one row"),+      affectedAsyncDedup = [],+      claimSite = claim "benchrepair:policy"+    }++setupTables :: Tx.Transaction ()+setupTables = do+  Tx.sql "CREATE SCHEMA IF NOT EXISTS app"+  Tx.sql "CREATE SCHEMA app_contract"+  Tx.sql "CREATE SCHEMA app_private"+  traverse_ (createProjectionTable . (^. #qualifiedTable)) allTargets+  Tx.sql "CREATE TYPE app_contract.bench_all_row_v1 AS (id bigint, value bigint)"+  Tx.sql "CREATE TYPE app_contract.bench_keyed_row_v1 AS (id bigint, value bigint)"+  Tx.sql+    """+    INSERT INTO app.bench_versioned_allrows_g1_t1 (id, value)+    SELECT id, id * 10 FROM generate_series(2, 100) AS ids(id)+    """+  Tx.sql+    """+    INSERT INTO app.bench_versioned_keyed_g1_t1 (id, value)+    SELECT id, id * 10 FROM generate_series(2, 10000) AS ids(id)+    """+  Tx.sql+    """+    CREATE FUNCTION app_private.bench_keyed_lookup(requested_id bigint)+    RETURNS SETOF app_contract.bench_keyed_row_v1+    LANGUAGE sql+    STABLE+    AS $lookup$+      SELECT ROW(model.id, model.value)::app_contract.bench_keyed_row_v1+      FROM app.bench_versioned_keyed_g1_t1 AS model+      WHERE model.id = requested_id+    $lookup$+    """+  where+    allTargets = concatMap (\scenario -> scenario.targetDeclarations) scenarioDefinitions++statusScaleGroupCount :: Int+statusScaleGroupCount = 1_000++seedStatusScale :: Tx.Transaction ()+seedStatusScale = do+  Tx.sql+    ( Text.Encoding.encodeUtf8+        ( "INSERT INTO keiro.keiro_projection_rebuild_groups (group_id, slice_fingerprint, status) "+            <> "SELECT 'bench-status-' || ordinal::text, 'slice-v6:bench-status', 'live' "+            <> "FROM generate_series(1, "+            <> Text.pack (show statusScaleGroupCount)+            <> ") AS ordinals(ordinal)"+        )+    )+  Tx.sql+    """+    INSERT INTO keiro.keiro_projection_group_cursors+      (group_id, position_basis, subscription_names)+    SELECT group_id, 'append', ARRAY[]::text[]+    FROM keiro.keiro_projection_rebuild_groups+    WHERE group_id LIKE 'bench-status-%'+    """++createProjectionTable :: QualifiedTable -> Tx.Transaction ()+createProjectionTable table =+  do+    Tx.sql+      ( Text.Encoding.encodeUtf8+          ( "CREATE TABLE "+              <> qualified table+              <> " (id bigint PRIMARY KEY, value bigint NOT NULL)"+          )+      )+    Tx.sql+      ( Text.Encoding.encodeUtf8+          ( "INSERT INTO "+              <> qualified table+              <> " (id, value) VALUES (1, 0)"+          )+      )++bootstrapVersionedGroups :: [ProjectionScenario] -> Tx.Transaction ()+bootstrapVersionedGroups scenarios =+  traverse_ bootstrapScenario [scenario | scenario <- scenarios, scenario.versionManaged]+  where+    bootstrapScenario scenario = traverse_ bootstrapGroup scenario.scenarioGroups+    bootstrapGroup group = do+      let servingRevision = group.revisions ^?! ix 0 . #revisionId+      traverse_ (insertGeneration group.groupId servingRevision) (zip [1 :: Int64 ..] group.targets)+      Tx.sql+        ( Text.Encoding.encodeUtf8+            ( "UPDATE keiro.keiro_projection_rebuild_groups SET status = 'serving-versioned', "+                <> "serving_revision_id = "+                <> literal (projectionRevisionIdText servingRevision)+                <> ", serving_epoch = 1, reads_allowed = TRUE, writes_allowed = TRUE "+                <> "WHERE group_id = "+                <> literal (rebuildGroupIdText group.groupId)+            )+        )+    insertGeneration groupId revisionId (ordinal, (targetId, table)) =+      let generationId = generationUuid groupId targetId ordinal+       in Tx.sql+            ( Text.Encoding.encodeUtf8+                ( "INSERT INTO keiro.keiro_projection_target_generations "+                    <> "(generation_id, group_id, target_id, revision_id, schema_name, relation_name, relation_oid, "+                    <> "schema_version, expected_shape_id, observed_shape_fingerprint, observed_catalog_snapshot, lifecycle, served_at) VALUES ("+                    <> literal (UUID.toText generationId)+                    <> "::uuid, "+                    <> literal (rebuildGroupIdText groupId)+                    <> ", "+                    <> literal (targetIdText targetId)+                    <> ", "+                    <> literal (projectionRevisionIdText revisionId)+                    <> ", "+                    <> literal (table ^. #schemaName)+                    <> ", "+                    <> literal (table ^. #tableName)+                    <> ", "+                    <> literal (table ^. #schemaName <> "." <> table ^. #tableName)+                    <> "::regclass::oid, 'bench-v1', 'bench-shape-v1', 'bench-shape-v1', 'bench-catalog-v1', 'serving', now())"+                )+            )++generationUuid :: RebuildGroupId -> TargetId -> Int64 -> UUID.UUID+generationUuid groupId targetId ordinal =+  UUID.V5.generateNamed+    UUID.V5.namespaceURL+    ( ByteString.unpack+        ( Text.Encoding.encodeUtf8+            (rebuildGroupIdText groupId <> ":" <> targetIdText targetId <> ":" <> Text.pack (show ordinal))+        )+    )++updateLogicalTargets :: [(TargetId, QualifiedTable)] -> Tx.Transaction ()+updateLogicalTargets = traverse_ (updateProjectionTable . snd)++updatePhysicalTargets :: PhysicalTargets -> [TargetId] -> Tx.Transaction ()+updatePhysicalTargets physicalTargets =+  traverse_ (updateProjectionTable . requirePhysicalTarget physicalTargets)++updateProjectionTable :: QualifiedTable -> Tx.Transaction ()+updateProjectionTable table =+  Tx.sql+    ( Text.Encoding.encodeUtf8+        ( "INSERT INTO "+            <> qualified table+            <> " (id, value) VALUES (1, 1) "+            <> "ON CONFLICT (id) DO UPDATE SET value = "+            <> quoteIdentifier (table ^. #tableName)+            <> ".value + 1"+        )+    )++requirePhysicalTarget :: PhysicalTargets -> TargetId -> QualifiedTable+requirePhysicalTarget targets targetId =+  fromMaybe+    (error ("missing benchmark physical target: " <> Text.unpack (targetIdText targetId)))+    (resolvePhysicalTarget targetId targets)++physicalTargetsFor :: [(TargetId, QualifiedTable)] -> PhysicalTargets+physicalTargetsFor targets =+  case mkPhysicalTargets (map fst targets) (Map.fromList targets) of+    Left errors -> error (show errors)+    Right value -> value++seedRepairStreams :: Store.KirokuStore -> IO ()+seedRepairStreams store =+  traverse_ seed repairEventCounts+  where+    seed count =+      runStoreChecked store $+        void $+          Store.appendToStream+            (repairStreamName count)+            NoStream+            [ EventData+                { eventId = Nothing,+                  eventType = EventType "BenchRepairEvent",+                  payload = Aeson.Null,+                  metadata = Nothing,+                  causationId = Nothing,+                  correlationId = Nothing+                }+            | _ <- [1 .. count]+            ]++stabilizingHistoryEventCount :: Int+stabilizingHistoryEventCount = 25_000++seedStabilizingHistory :: Store.KirokuStore -> IO ()+seedStabilizingHistory store =+  runStoreChecked store $+    void $+      Store.appendToStream+        (StreamName "benchseed-history")+        NoStream+        [ EventData+            { eventId = Nothing,+              eventType = EventType "BenchSeedEvent",+              payload = Aeson.Null,+              metadata = Nothing,+              causationId = Nothing,+              correlationId = Nothing+            }+        | _ <- [1 .. stabilizingHistoryEventCount]+        ]++repairStreamName :: Int -> StreamName+repairStreamName count = StreamName ("benchrepair-" <> Text.pack (show count))++retentionRequest :: RebuildRunId -> HistoryRetentionLeaseRequest+retentionRequest runId =+  HistoryRetentionLeaseRequest+    { owner = requireRight (mkHistoryRetentionLeaseOwner ("keiro-rebuild/" <> rebuildRunIdText runId)),+      reason = requireRight (mkHistoryRetentionLeaseReason "benchmark schema-versioned promotion"),+      duration = requireRight (mkHistoryRetentionLeaseDuration (secondsToDiffTime 600))+    }++syntheticRecordedEvent :: Int64 -> RecordedEvent+syntheticRecordedEvent value =+  RecordedEvent+    { eventId = EventId (UUID.fromWords64 0x018f0f1800007000 (0x8000000000000000 + fromIntegral value)),+      eventType = EventType "ProjectionBenchEvent",+      streamVersion = StreamVersion value,+      globalPosition = GlobalPosition value,+      originalStreamId = StreamId value,+      originalVersion = StreamVersion value,+      payload = Aeson.Null,+      metadata = Nothing,+      causationId = Nothing,+      correlationId = Nothing,+      createdAt = fixedOccurredAt+    }++projectionBenchEventStream :: ValidatedProjectionBenchEventStream+projectionBenchEventStream =+  case mkEventStream "read-model-benchmark" projectionBenchRawEventStream of+    Left errors -> error (show errors)+    Right value -> value++projectionBenchRawEventStream :: ProjectionBenchEventStream+projectionBenchRawEventStream =+  EventStream+    { transducer =+        SymTransducer+          { edgesOut = \ProjectionBenchReady ->+              [ Edge+                  { guard = matchInCtor projectionCommandCtor,+                    update = UKeep,+                    output = [pack projectionCommandCtor projectionEventCtor oNil],+                    target = ProjectionBenchReady,+                    mode = Keiki.Live+                  }+              ],+            initial = ProjectionBenchReady,+            initialRegs = RNil,+            isFinal = const False+          },+      initialState = ProjectionBenchReady,+      initialRegisters = RNil,+      eventCodec =+        Codec+          { eventTypes = EventType "ProjectionBenchEvent" :| [],+            eventType = const (EventType "ProjectionBenchEvent"),+            schemaVersion = 1,+            encode = const Aeson.Null,+            decode = \(EventType eventTypeName) _ ->+              if eventTypeName == "ProjectionBenchEvent"+                then Right ProjectionBenchEvent+                else Left ("unknown projection benchmark event: " <> eventTypeName),+            upcasters = []+          },+      resolveStreamName = Keiro.Stream.streamName,+      snapshotPolicy = Never,+      stateCodec = Nothing+    }++projectionCommandCtor :: InCtor ProjectionBenchCommand '[]+projectionCommandCtor =+  unavailableInCtor+    "EmitProjection"+    (\case EmitProjection -> Just RNil)+    (\RNil -> EmitProjection)++projectionEventCtor :: WireCtor ProjectionBenchEvent ()+projectionEventCtor =+  unavailableWireCtor+    "ProjectionBenchEvent"+    (const (Just ()))+    (const ProjectionBenchEvent)++deleteProjectionRowsStatement :: QualifiedTable -> Statement () Int64+deleteProjectionRowsStatement table =+  preparable+    ("DELETE FROM " <> qualified table)+    E.noParams+    D.rowsAffected++countProjectionRowsStatement :: QualifiedTable -> Statement () Int64+countProjectionRowsStatement table =+  preparable+    ("SELECT count(*) FROM " <> qualified table)+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.int8)))++relationOidStatement :: QualifiedTable -> Statement () Int64+relationOidStatement table =+  preparable+    ("SELECT " <> literal (table ^. #schemaName <> "." <> table ^. #tableName) <> "::regclass::oid::bigint")+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.int8)))++guardedAllRowsStatement :: Statement () [(Int64, Int64)]+guardedAllRowsStatement =+  preparable+    "SELECT id, value FROM keiro_read.bench_all_rows_v1() ORDER BY id"+    E.noParams+    (D.rowList ((,) <$> D.column (D.nonNullable D.int8) <*> D.column (D.nonNullable D.int8)))++guardedKeyedStatement :: Statement Int64 [(Int64, Int64)]+guardedKeyedStatement =+  preparable+    "SELECT id, value FROM keiro_read.bench_keyed_v1($1)"+    (E.param (E.nonNullable E.int8))+    (D.rowList ((,) <$> D.column (D.nonNullable D.int8) <*> D.column (D.nonNullable D.int8)))++explainServingBindingStatement :: Statement Text Aeson.Value+explainServingBindingStatement =+  preparable+    """+    EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON)+    SELECT locked_group.status,+           locked_group.active_run_id,+           locked_group.serving_revision_id,+           locked_group.writes_allowed,+           COALESCE(array_agg(generations.target_id ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.revision_id ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.schema_name ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.relation_name ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[])+    FROM (+      SELECT status, active_run_id, serving_revision_id, writes_allowed+      FROM keiro.keiro_projection_rebuild_groups+      WHERE group_id = $1+      FOR SHARE+    ) AS locked_group+    LEFT JOIN LATERAL (+      SELECT target_id, revision_id, schema_name, relation_name+      FROM keiro.keiro_projection_target_generations+      WHERE group_id = $1 AND lifecycle = 'serving'+    ) AS generations ON TRUE+    GROUP BY locked_group.status,+             locked_group.active_run_id,+             locked_group.serving_revision_id,+             locked_group.writes_allowed+    """+    (E.param (E.nonNullable E.text))+    (D.singleRow (D.column (D.nonNullable D.json)))++explainStatusListStatement :: Statement () Aeson.Value+explainStatusListStatement =+  explainJsonNoParams+    "EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON) SELECT * FROM keiro_read.projection_group_status_v1 ORDER BY group_id"++explainStatusLookupStatement :: Statement () Aeson.Value+explainStatusLookupStatement =+  explainJsonNoParams+    "EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON) SELECT * FROM keiro_read.projection_group_status_v1 WHERE group_id = 'bench-status-1000'"++explainGuardedAllRowsStatement :: Statement () Aeson.Value+explainGuardedAllRowsStatement =+  explainJsonNoParams+    "EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON) SELECT id, value FROM keiro_read.bench_all_rows_v1() ORDER BY id"++explainGuardedKeyedStatement :: Statement () Aeson.Value+explainGuardedKeyedStatement =+  explainJsonNoParams+    "EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON) SELECT id, value FROM keiro_read.bench_keyed_v1(5000)"++explainKeyedIndexStatement :: Statement () Aeson.Value+explainKeyedIndexStatement =+  explainJsonNoParams+    """+    EXPLAIN (ANALYZE, BUFFERS, FORMAT JSON)+    SELECT ROW(model.id, model.value)::app_contract.bench_keyed_row_v1+    FROM app.bench_versioned_keyed_g1_t1 AS model+    WHERE model.id = 5000+    """++explainJsonNoParams :: Text -> Statement () Aeson.Value+explainJsonNoParams sql =+  preparable+    sql+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.json)))++servingBindingStatement :: Statement Text (Maybe (Text, Maybe Text, Maybe Text, Bool, [(Text, Text, Text, Text)]))+servingBindingStatement =+  preparable+    """+    SELECT locked_group.status,+           locked_group.active_run_id,+           locked_group.serving_revision_id,+           locked_group.writes_allowed,+           COALESCE(array_agg(generations.target_id ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.revision_id ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.schema_name ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[]),+           COALESCE(array_agg(generations.relation_name ORDER BY generations.target_id)+             FILTER (WHERE generations.target_id IS NOT NULL), ARRAY[]::text[])+    FROM (+      SELECT status, active_run_id, serving_revision_id, writes_allowed+      FROM keiro.keiro_projection_rebuild_groups+      WHERE group_id = $1+      FOR SHARE+    ) AS locked_group+    LEFT JOIN LATERAL (+      SELECT target_id, revision_id, schema_name, relation_name+      FROM keiro.keiro_projection_target_generations+      WHERE group_id = $1 AND lifecycle = 'serving'+    ) AS generations ON TRUE+    GROUP BY locked_group.status,+             locked_group.active_run_id,+             locked_group.serving_revision_id,+             locked_group.writes_allowed+    """+    (E.param (E.nonNullable E.text))+    ( D.rowMaybe+        ( (,,,,)+            <$> D.column (D.nonNullable D.text)+            <*> D.column (D.nullable D.text)+            <*> D.column (D.nullable D.text)+            <*> D.column (D.nonNullable D.bool)+            <*> ( List.zip4+                    <$> D.column (D.nonNullable (D.listArray (D.nonNullable D.text)))+                    <*> D.column (D.nonNullable (D.listArray (D.nonNullable D.text)))+                    <*> D.column (D.nonNullable (D.listArray (D.nonNullable D.text)))+                    <*> D.column (D.nonNullable (D.listArray (D.nonNullable D.text)))+                )+        )+    )++qualified :: QualifiedTable -> Text+qualified table = qualifyTable (table ^. #schemaName) (table ^. #tableName)++quoteIdentifier :: Text -> Text+quoteIdentifier value = "\"" <> Text.replace "\"" "\"\"" value <> "\""++literal :: Text -> Text+literal value = "'" <> Text.replace "'" "''" value <> "'"++sqlName :: Text -> Text+sqlName = Text.map (\character -> if character == '-' then '_' else character)++indexText :: (Show value) => value -> Text+indexText = Text.pack . show++claim :: Text -> ClaimSite+claim = identity mkClaimSite++identity :: (Show error) => (Text -> Either error value) -> Text -> value+identity constructor value = requireRight (constructor value)++requireRight :: (Show error) => Either error value -> value+requireRight = either (error . show) id++nonEmptyOrError :: Text -> [value] -> NonEmpty value+nonEmptyOrError label = \case+  [] -> error (Text.unpack label <> " must not be empty")+  first : rest -> first :| rest++firstOrError :: Text -> [value] -> value+firstOrError label = \case+  [] -> error (Text.unpack label <> " must not be empty")+  first : _ -> first++lastOrError :: Text -> [value] -> value+lastOrError label = \case+  [] -> error (Text.unpack label <> " must not be empty")+  values -> List.last values++requireScenario :: ReadModelBenchFixture -> Text -> IO ProjectionScenario+requireScenario fixture scenarioKey =+  maybe (fail ("unknown read-model benchmark scenario: " <> Text.unpack scenarioKey)) pure (Map.lookup scenarioKey fixture.scenarios)++nextCounter :: IORef Int64 -> IO Int64+nextCounter counter = atomicModifyIORef' counter (\current -> let next = current + 1 in (next, next))++fixedOccurredAt :: UTCTime+fixedOccurredAt = UTCTime (ModifiedJulianDay 61000) (secondsToDiffTime 0)++runResourceStoreChecked :: StoreRunner -> Eff '[Store, Error Store.StoreError, KirokuStoreResource, IOE] value -> IO value+runResourceStoreChecked (StoreRunner runner) action =+  runner action >>= either (fail . show) pure++runStoreChecked :: Store.KirokuStore -> Eff '[Store, Error Store.StoreError, IOE] value -> IO value+runStoreChecked store action =+  Store.runStoreIO store action >>= either (fail . show) pure

@@ -1,12 +1,13 @@ cabal-version:   3.0 name:            keiro-version:         0.11.0.0+version:         0.12.0.0 synopsis:        Event sourcing framework and workflow engine description:   A library that composes kiroku, keiki, and shibuya into an   event-sourcing and workflow-orchestration framework.  license:         BSD-3-Clause+license-file:    LICENSE author:          Nadeem Bitar maintainer:      nadeem@gmail.com copyright:       2026 Nadeem Bitar@@ -41,6 +42,7 @@  library   import:             warnings, shared+  autogen-modules:    Paths_keiro   exposed-modules:     Keiro     Keiro.Command@@ -48,6 +50,7 @@     Keiro.DeadLetter     Keiro.DeadLetter.Replay     Keiro.DeadLetter.Schema+    Keiro.DeterministicId     Keiro.Inbox     Keiro.Inbox.Kafka     Keiro.Inbox.Schema@@ -58,11 +61,16 @@     Keiro.Outbox.Types     Keiro.ProcessManager     Keiro.Projection+    Keiro.Projection.Catalog+    Keiro.Projection.Catalog.Operations+    Keiro.Projection.Catalog.Preimage     Keiro.ReadModel+    Keiro.ReadModel.External     Keiro.ReadModel.Rebuild     Keiro.ReadModel.Schema     Keiro.ReplayAudit     Keiro.Router+    Keiro.Router.Selection     Keiro.Snapshot     Keiro.Snapshot.Codec     Keiro.Snapshot.Schema@@ -76,6 +84,7 @@     Keiro.Wake     Keiro.Workflow     Keiro.Workflow.Awakeable+    Keiro.Workflow.Awakeable.Compatibility     Keiro.Workflow.Awakeable.Schema     Keiro.Workflow.Child     Keiro.Workflow.Child.Schema@@ -87,7 +96,21 @@     Keiro.Workflow.Snapshot     Keiro.Workflow.Types -  other-modules:      Keiro.ReplayDigest+  other-modules:+    Keiro.Command.Domain+    Keiro.Projection.Types+    Keiro.ReadModel.Rebuild.Group+    Keiro.ReadModel.Rebuild.Runner+    Keiro.ReadModel.Rebuild.Status+    Keiro.ReadModel.Rebuild.Stream+    Keiro.ReadModel.Rebuild.Versioned+    Keiro.ReplayDigest+    Keiro.Workflow.Awakeable.Internal.Identity+    Keiro.Workflow.Child.Cancel+    Keiro.Workflow.Instance.Schema+    Keiro.Workflow.Journal+    Paths_keiro+   reexported-modules:     keiro-core:Keiro.Codec,     keiro-core:Keiro.Codec.IdDomain,@@ -123,13 +146,13 @@     , hs-opentelemetry-semantic-conventions  >=1.40      && <2     , keiki                                  >=0.9       && <0.10     , keiki-codec-json                       >=0.9       && <0.10-    , keiro-core                             ^>=0.11.0.0-    , kiroku-store                           >=0.3       && <0.4+    , keiro-core                             ^>=0.12.0.0+    , kiroku-store                           >=0.7       && <0.8     , lens                                   >=5.2       && <5.4     , mmzk-typeid                            >=0.7       && <0.8     , random                                 >=1.2.1     && <1.4     , scientific                             >=0.3       && <0.4-    , shibuya-core                           >=0.8.0.1   && <0.9+    , shibuya-core                           ^>=0.9.0.0     , stm                                    >=2.5       && <2.6     , streamly                               >=0.11      && <0.12     , streamly-core                          >=0.3       && <0.4@@ -140,60 +163,83 @@     , vector                                 >=0.13      && <0.14  test-suite keiro-test-  import:         warnings, shared-  type:           exitcode-stdio-1.0-  hs-source-dirs: test-  main-is:        Main.hs-  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  import:          warnings, shared+  type:            exitcode-stdio-1.0+  hs-source-dirs:  test+  main-is:         Main.hs+  autogen-modules: Paths_keiro+  other-modules:+    CatalogEvolutionSpec+    CatalogOperationsSpec+    CatalogSpec+    Compatibility.ReadModel011+    ExternalReadSpec+    GroupRebuildSpec+    Paths_keiro+    PreCanonicalRecoverySpec+    PreimageSpec+    ProjectionReplaySpec+    ReadModelSpec+    VersionedRebuildSpec+    VersionedTargetPostgresSpec++  ghc-options:     -threaded -rtsopts -with-rtsopts=-N   build-depends:-    , aeson                                  >=2.2     && <2.3-    , base                                   >=4.21    && <5-    , bytestring                             >=0.11    && <0.13-    , containers                             >=0.6     && <0.8-    , contravariant-extras                   >=0.3     && <0.4-    , effectful                              >=2.6     && <2.7-    , effectful-core                         >=2.6     && <2.7-    , hasql                                  >=1.10    && <1.11-    , hasql-pool                             >=1.2     && <1.5-    , hasql-transaction                      >=1.1     && <1.3-    , hs-opentelemetry-api                   >=1.0     && <1.1-    , hs-opentelemetry-exporter-in-memory    >=1.0     && <1.1-    , hs-opentelemetry-propagator-w3c        >=1.0     && <1.1-    , hs-opentelemetry-sdk                   >=1.0     && <1.1-    , hs-opentelemetry-semantic-conventions  >=1.40    && <2+    , aeson                                  >=2.2      && <2.3+    , base                                   >=4.21     && <5+    , bytestring                             >=0.11     && <0.13+    , containers                             >=0.6      && <0.8+    , contravariant-extras                   >=0.3      && <0.4+    , effectful                              >=2.6      && <2.7+    , effectful-core                         >=2.6      && <2.7+    , hasql                                  >=1.10     && <1.11+    , hasql-pool                             >=1.2      && <1.5+    , hasql-transaction                      >=1.1      && <1.3+    , hs-opentelemetry-api                   >=1.0      && <1.1+    , hs-opentelemetry-exporter-in-memory    >=1.0      && <1.1+    , hs-opentelemetry-propagator-w3c        >=1.0      && <1.1+    , hs-opentelemetry-sdk                   >=1.0      && <1.1+    , hs-opentelemetry-semantic-conventions  >=1.40     && <2     , hspec                                  >=2.11     , keiki     , keiki-codec-json     , keiro     , keiro-test-support-    , kiroku-store                           >=0.3     && <0.4-    , process                                >=1.6     && <1.7-    , shibuya-core                           >=0.8.0.1 && <0.9-    , stm                                    >=2.5     && <2.6-    , streamly-core                          >=0.3     && <0.4-    , text                                   >=2.1     && <2.2-    , time                                   >=1.12    && <1.15-    , unliftio-core                          >=0.2     && <0.3-    , uuid                                   >=1.3     && <1.4-    , vector                                 >=0.13    && <0.14+    , kiroku-store                           >=0.7      && <0.8+    , process                                >=1.6      && <1.7+    , shibuya-core                           ^>=0.9.0.0+    , stm                                    >=2.5      && <2.6+    , streamly-core                          >=0.3      && <0.4+    , text                                   >=2.1      && <2.2+    , time                                   >=1.12     && <1.15+    , unliftio-core                          >=0.2      && <0.3+    , uuid                                   >=1.3      && <1.4+    , vector                                 >=0.13     && <0.14  benchmark keiro-bench   import:         warnings, shared   type:           exitcode-stdio-1.0   hs-source-dirs: bench   main-is:        Main.hs+  other-modules:  ReadModelBench   ghc-options:    -threaded -rtsopts -with-rtsopts=-N   build-depends:+    , aeson                 >=2.2.2     && <2.3     , base                  >=4.21      && <5     , bytestring            >=0.11      && <0.13+    , containers            >=0.6       && <0.8     , effectful             >=2.6       && <2.7+    , hasql                 >=1.10      && <1.11     , hasql-transaction     >=1.1       && <1.3     , hs-opentelemetry-api  >=1.0       && <1.1     , hs-opentelemetry-sdk  >=1.0       && <1.1+    , keiki                 >=0.9       && <0.10     , keiro-    , keiro-core            ^>=0.11.0.0+    , keiro-core            ^>=0.12.0.0     , keiro-test-support-    , kiroku-store          >=0.3       && <0.4+    , kiroku-store          >=0.7       && <0.8+    , shibuya-core          ^>=0.9.0.0+    , streamly-core         >=0.3       && <0.4     , tasty-bench           >=0.4     , text                  >=2.1       && <2.2     , time                  >=1.12      && <1.15

@@ -4,11 +4,12 @@ -- one go: the command runner ("Keiro.Command"), event 'Codec's -- ("Keiro.Codec"), the 'EventStream' definition and its snapshot policy -- ("Keiro.EventStream"), the content-based 'Router' ("Keiro.Router"),--- snapshot helpers ("Keiro.Snapshot"), and typed 'Stream' handles--- ("Keiro.Stream").+-- snapshot helpers ("Keiro.Snapshot"), typed 'Stream' handles+-- ("Keiro.Stream"), and the validated projection-catalog facade+-- ("Keiro.Projection.Catalog"). -- -- The more specialized subsystems are not re-exported here and are imported--- directly when needed: read models ("Keiro.ReadModel"), projections+-- directly when needed: read models ("Keiro.ReadModel"), low-level projections -- ("Keiro.Projection"), process managers ("Keiro.ProcessManager"), the -- integration in/outbox ("Keiro.Inbox", "Keiro.Outbox"), timers -- ("Keiro.Timer"), and telemetry ("Keiro.Telemetry").@@ -39,20 +40,25 @@     -- * Routing and snapshots     module Keiro.Router,     module Keiro.Snapshot,++    -- * Projection catalogs+    module Keiro.Projection.Catalog,   ) where +import Data.Text qualified as Text+import Data.Version (showVersion) import Keiro.Codec import Keiro.Command import Keiro.EventStream import Keiro.EventStream.Validate import Keiro.Prelude+import Keiro.Projection.Catalog hiding (AllStreams, version) import Keiro.Router import Keiro.Snapshot import Keiro.Stream+import Paths_keiro qualified as Package --- | The Keiro library version, as a 'Text' for display and telemetry.--- Keep in lockstep with the @version:@ field in @keiro/keiro.cabal@ when--- cutting a release.+-- | The Cabal package version, rendered as 'Text' for display and telemetry. version :: Text-version = "0.4.0.0"+version = Text.pack (showVersion Package.version)

@@ -51,6 +51,11 @@ module Keiro.Command   ( -- * Results and errors     CommandResult (..),+    DomainDecision (..),+    DomainCommandOutcome (..),+    SilentCommandContext (..),+    SilentDomainDecision (..),+    DomainCommandHandler (..),     CommandError (..),     HydrationReplayReason (..),     commandErrorClass,@@ -61,8 +66,17 @@      -- * Running commands     runCommand,+    runDomainCommand,+    forgetDomainDecision,     runCommandWithSql,     runCommandWithSqlEvents,+    SqlTransactionDecision (..),+    SqlCommandOutcome (..),+    runCommandWithSqlEventsControlled,+    runDomainCommandWithSql,+    runDomainCommandWithSqlEvents,+    DomainSqlCommandOutcome (..),+    runDomainCommandWithSqlEventsControlled,      -- * Hydration primitives (replay audit)     Hydrated (..),@@ -78,7 +92,9 @@ import Data.ByteString.Lazy.Char8 qualified as LazyByteString import Data.Functor (($>)) import Data.Int (Int32)+import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text+import Data.Void (Void) import Effectful (Eff, IOE, (:>)) import Effectful.Concurrent (runConcurrent) import Effectful.Concurrent.Async qualified as Async@@ -89,6 +105,7 @@ import Keiki.Core (BoolAlg, RegFile) import Keiki.Core qualified as Keiki import Keiro.Codec (Codec, CodecError, decodeRecorded, encodeForAppendWithMetadata)+import Keiro.Command.Domain (SilentCommandContext (..), SilentDomainDecision (..)) import Keiro.EventStream (EventStream, StateCodec, Terminality (..)) import Keiro.EventStream.Validate (ValidatedEventStream, unvalidated) import Keiro.Prelude@@ -104,11 +121,15 @@ import Keiro.Snapshot.Policy (shouldSnapshotSpan) import Keiro.Stream (Stream) import Keiro.Telemetry-  ( KeiroMetrics,+  ( CommandDecisionClass (..),+    KeiroMetrics,+    commandDecisionClassText,+    keiro_command_decision,     keiro_events_appended,     keiro_replay_divergence,     keiro_retry_attempt,     recordCommandConflicts,+    recordCommandDecision,     recordCommandDuplicates,     recordCommandRetries,     recordSnapshotApplyDivergence,@@ -169,6 +190,52 @@   }   deriving stock (Generic, Eq, Show) +-- | The application-level decision made by one selected live edge.+-- Infrastructure failures and commands for which no edge was selected remain+-- 'CommandError's outside this value.+data DomainDecision co rejection noOp+  = -- | The exact non-empty event batch that was encoded and appended.+    DomainAccepted !(NonEmpty co)+  | -- | An explicitly selected silent edge classified as a rejection.+    DomainRejected !rejection+  | -- | An explicitly selected silent edge classified as a successful no-op.+    DomainNoOp !noOp+  deriving stock (Generic, Eq, Show)++-- | A typed domain decision paired with the ordinary persistence metadata.+data DomainCommandOutcome target co rejection noOp = DomainCommandOutcome+  { decision :: !(DomainDecision co rejection noOp),+    result :: !(CommandResult target)+  }+  deriving stock (Generic, Eq, Show)++-- | A validated stream plus pure application policy for selected silent edges.+-- The classifier does not select an edge and is invoked only after Keiki has+-- selected exactly one live edge whose output word is empty.+data DomainCommandHandler phi rs s ci co rejection noOp = DomainCommandHandler+  { eventStream :: !(ValidatedEventStream phi rs s ci co),+    classifySilent :: !(SilentCommandContext rs s ci -> SilentDomainDecision rejection noOp)+  }+  deriving stock (Generic)++-- Internal adapter for the historical command API. Every selected silent edge+-- is a successful no-op; the rejection type is uninhabited because this+-- classifier never constructs 'SilentRejected'.+silentNoOpHandler ::+  ValidatedEventStream phi rs s ci co ->+  DomainCommandHandler phi rs s ci co Void ()+silentNoOpHandler eventStream =+  DomainCommandHandler+    { eventStream,+      classifySilent = \_ -> SilentNoOp ()+    }++-- | Erase the typed domain decision while retaining historical command+-- persistence metadata. This is a collapse of successful matched decisions;+-- unmatched commands remain an outer 'Left' and never reach this adapter.+forgetDomainDecision :: DomainCommandOutcome target co rejection noOp -> CommandResult target+forgetDomainDecision DomainCommandOutcome {result} = result+ -- | Why a command did not complete. data CommandError   = -- | A stored event could not be decoded while rehydrating the aggregate.@@ -207,6 +274,40 @@     ConflictFixpoint !StreamVersion !StoreError   deriving stock (Generic, Eq, Show) +-- | Whether an in-transaction command callback accepts the append or asks the+-- runner to roll the whole transaction back while retaining a typed outcome.+data SqlTransactionDecision a+  = CommitSqlTransaction !a+  | RollbackSqlTransaction !a+  deriving stock (Generic, Eq, Show)++-- | Result of a controlled transactional command. A rolled-back outcome has no+-- 'CommandResult' because neither its event append nor its SQL effects exist.+data SqlCommandOutcome target a+  = SqlCommandNoOp !(CommandResult target)+  | SqlCommandCommitted !(CommandResult target) !a+  | SqlCommandRolledBack !a+  deriving stock (Generic, Eq, Show)++-- | Result of a controlled transactional domain command. Selected silent+-- decisions perform no transaction callback. A rolled-back accepted append has+-- no 'DomainCommandOutcome' because neither its append nor its SQL effects+-- exist.+data DomainSqlCommandOutcome target co rejection noOp a+  = DomainSqlCommandSilent !(DomainCommandOutcome target co rejection noOp)+  | DomainSqlCommandCommitted !(DomainCommandOutcome target co rejection noOp) !a+  | DomainSqlCommandRolledBack !a+  deriving stock (Generic, Eq, Show)++forgetDomainSqlOutcome ::+  DomainSqlCommandOutcome target co rejection noOp a ->+  SqlCommandOutcome target a+forgetDomainSqlOutcome = \case+  DomainSqlCommandSilent outcome -> SqlCommandNoOp (forgetDomainDecision outcome)+  DomainSqlCommandCommitted outcome userValue ->+    SqlCommandCommitted (forgetDomainDecision outcome) userValue+  DomainSqlCommandRolledBack userValue -> SqlCommandRolledBack userValue+ -- | Why replay of stored events stalled, projected from keiki's structured -- failure types onto a monomorphic vocabulary suitable for 'CommandError'. data HydrationReplayReason@@ -228,8 +329,10 @@ -- * 'eventIds' — caller-supplied ids assigned to the emitted events in order; --   the basis for deterministic, idempotent appends (see 'Keiro.Router' and --   'Keiro.ProcessManager').--- * 'beforeAppend' — a hook run immediately before each append attempt,---   primarily a test seam for injecting concurrent writes.+-- * 'beforeAppend' — an observation/test hook run immediately before each+--   append attempt, primarily for injecting concurrent writes. It is not an+--   application transaction callback: it may run for an accepted decision that+--   later conflicts and is discarded. -- * 'retryBackoffMicros' — base delay before the k-th OCC retry, capped at --   100 ms and jittered. Set to 0 to disable backoff. -- * 'metrics' — optional metrics handle for command and snapshot counters.@@ -294,9 +397,9 @@   }   deriving stock (Generic) -data CommandPlan target rs s co-  = CommandNoOp !(CommandResult target)-  | CommandAppend !(Hydrated rs s) ![co] ![EventData]+data DomainCommandPlan target rs s co rejection noOp+  = DomainCommandSilent !(SilentDomainDecision rejection noOp) !(CommandResult target)+  | DomainCommandAppend !(Hydrated rs s) !(NonEmpty co) ![EventData]   deriving stock (Generic)  hydrate ::@@ -652,40 +755,125 @@   Eff es (Either CommandError (CommandResult (EventStream phi rs s ci co))) runCommand options validatedEventStream targetStream command =   withCommandSpan (options ^. #tracer) (resolvedStreamName eventStream targetStream) Nothing $ \mSpan -> do-    (result, attemptNo) <- attempt mSpan 1 Nothing+    (outcome, attemptNo) <-+      domainCommandAttempts+        options+        (silentNoOpHandler validatedEventStream)+        targetStream+        command+        mSpan+    let result = fmap forgetDomainDecision outcome     recordCommandOutcome mSpan (^. #eventsAppended) attemptNo result     pure result   where     eventStream = unvalidated validatedEventStream -    attempt mSpan attemptNo lastConflict = do-      hydrated <- hydrate options eventStream targetStream-      either (\err -> pure (Left err, attemptNo)) (runPlan mSpan attemptNo lastConflict) hydrated+-- | Hydrate, select and evaluate one live edge, then return the exact typed+-- domain decision from the successful final optimistic-concurrency attempt.+-- Eventful decisions append the same non-empty batch carried by+-- 'DomainAccepted'. Selected silent edges are classified purely and perform no+-- append. No matching edge and every infrastructure failure remain+-- 'CommandError's.+runDomainCommand ::+  forall phi rs s ci co rejection noOp es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  Eff es (Either CommandError (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp))+runDomainCommand options handler@DomainCommandHandler {eventStream = validatedEventStream} targetStream command =+  withCommandSpan (options ^. #tracer) (resolvedStreamName (unvalidated validatedEventStream) targetStream) Nothing $ \mSpan -> do+    (outcome, attemptNo) <- domainCommandAttempts options handler targetStream command mSpan+    recordDomainCommandOutcome options mSpan attemptNo outcome+    pure outcome -    runPlan mSpan attemptNo lastConflict current =+-- | The optimistic-concurrency attempt loop shared by the plain and+-- transactional domain command runners: hydrate, detect a conflict fixpoint,+-- prepare the plan, classify a silent decision, or hand an accepted batch to+-- the caller's append action. The append action receives the retry+-- continuation so 'retryOrFail' can re-enter the loop.+domainCommandAttemptLoop ::+  forall phi rs s ci co rejection noOp outcome es.+  (HasCallStack, IOE :> es, Store :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp -> outcome) ->+  ( (Int -> Maybe (StoreError, StreamVersion) -> Eff es (Either CommandError outcome, Int)) ->+    Int ->+    Hydrated rs s ->+    NonEmpty co ->+    [EventData] ->+    Eff es (Either CommandError outcome, Int)+  ) ->+  Eff es (Either CommandError outcome, Int)+domainCommandAttemptLoop options handler@DomainCommandHandler {eventStream = validatedEventStream} targetStream command wrapSilent appendAction =+  attempt 1 Nothing+  where+    eventStream' = unvalidated validatedEventStream++    attempt attemptNo lastConflict = do+      hydrated <- hydrate options eventStream' targetStream+      either (\err -> pure (Left err, attemptNo)) (runPlan attemptNo lastConflict) hydrated++    runPlan attemptNo lastConflict current =       case conflictFixpoint lastConflict (current ^. #streamVersion) of         Just err -> pure (Left err, attemptNo)         Nothing ->-          case prepareCommandPlan options eventStream targetStream current command of+          case prepareDomainCommandPlan options handler eventStream' targetStream current command of             Left err -> pure (Left err, attemptNo)-            Right (CommandNoOp result) -> pure (Right result, attemptNo)-            Right (CommandAppend current' events encoded) ->-              appendOnce mSpan attemptNo current' events encoded+            Right (DomainCommandSilent silentDecision result) ->+              pure+                ( Right+                    ( wrapSilent+                        DomainCommandOutcome+                          { decision = domainDecisionFromSilent silentDecision,+                            result+                          }+                    ),+                  attemptNo+                )+            Right (DomainCommandAppend current' events encoded) ->+              appendAction attempt attemptNo current' events encoded+{-# INLINE domainCommandAttemptLoop #-} -    appendOnce mSpan attemptNo current events encoded = do+domainCommandAttempts ::+  forall phi rs s ci co rejection noOp es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  Maybe Span ->+  Eff es (Either CommandError (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp), Int)+domainCommandAttempts options handler@DomainCommandHandler {eventStream = validatedEventStream} targetStream command mSpan =+  domainCommandAttemptLoop options handler targetStream command Prelude.id appendOnce+  where+    eventStream' = unvalidated validatedEventStream++    appendOnce retry attemptNo current events encoded = do       liftIO (options ^. #beforeAppend)       appended <-         tryError @StoreError           $ appendToStream-            ((eventStream ^. #resolveStreamName) targetStream)+            ((eventStream' ^. #resolveStreamName) targetStream)             (expectedVersion (current ^. #streamVersion))             encoded       case appended of         Right appendResult -> do-          verifyAndSnapshot options mSpan eventStream current events appendResult-          pure (Right (appendedResult targetStream appendResult (Prelude.length encoded)), attemptNo)+          verifyAndSnapshot options mSpan eventStream' current (NonEmpty.toList events) appendResult+          pure+            ( Right+                DomainCommandOutcome+                  { decision = DomainAccepted events,+                    result = appendedResult targetStream appendResult (Prelude.length encoded)+                  },+              attemptNo+            )         Left (_, storeError) ->-          retryOrFail options (attempt mSpan) attemptNo (current ^. #streamVersion) storeError+          retryOrFail options retry attemptNo (current ^. #streamVersion) storeError  -- | Like 'runCommand', but run @afterAppend@ inside the /same/ transaction -- as the append, so a read-model write commits atomically with the events.@@ -731,34 +919,137 @@   ([(co, RecordedEvent)] -> AppendResult -> Tx.Transaction a) ->   Eff es (Either CommandError (CommandResult (EventStream phi rs s ci co), Maybe a)) runCommandWithSqlEvents options validatedEventStream targetStream command afterAppend =+  fmap (fmap collapse)+    $ runCommandWithSqlEventsControlled+      options+      validatedEventStream+      targetStream+      command+      (\pairs appendResult -> CommitSqlTransaction <$> afterAppend pairs appendResult)+  where+    collapse = \case+      SqlCommandNoOp result -> (result, Nothing)+      SqlCommandCommitted result userValue -> (result, Just userValue)+      SqlCommandRolledBack _ ->+        error "runCommandWithSqlEvents: an always-commit callback rolled back"++-- | Variant of 'runCommandWithSqlEvents' whose callback may condemn the whole+-- append transaction and still return a typed result. Rolled-back attempts do+-- not run replay verification or snapshot writes. Catalog-derived projection+-- fencing uses this boundary so discovering a rebuilding group after the append+-- SQL has taken its locks cannot leave the event or a partial projection write.+runCommandWithSqlEventsControlled ::+  forall phi rs s ci co a es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  ValidatedEventStream phi rs s ci co ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ([(co, RecordedEvent)] -> AppendResult -> Tx.Transaction (SqlTransactionDecision a)) ->+  Eff es (Either CommandError (SqlCommandOutcome (EventStream phi rs s ci co) a))+runCommandWithSqlEventsControlled options validatedEventStream targetStream command afterAppend =   withCommandSpan (options ^. #tracer) (resolvedStreamName eventStream targetStream) Nothing $ \mSpan -> do-    (result, attemptNo) <- attempt mSpan 1 Nothing-    recordCommandOutcome mSpan (\(r, _) -> r ^. #eventsAppended) attemptNo result+    (outcome, attemptNo) <-+      domainSqlCommandAttempts+        options+        (silentNoOpHandler validatedEventStream)+        targetStream+        command+        afterAppend+        mSpan+    let result = fmap forgetDomainSqlOutcome outcome+    recordCommandOutcome mSpan eventCount attemptNo result     pure result   where     eventStream = unvalidated validatedEventStream -    attempt mSpan attemptNo lastConflict = do-      hydrated <- hydrate options eventStream targetStream-      either (\err -> pure (Left err, attemptNo)) (runPlan mSpan attemptNo lastConflict) hydrated+    eventCount = \case+      SqlCommandNoOp result -> result ^. #eventsAppended+      SqlCommandCommitted result _ -> result ^. #eventsAppended+      SqlCommandRolledBack _ -> 0 -    runPlan mSpan attemptNo lastConflict current =-      case conflictFixpoint lastConflict (current ^. #streamVersion) of-        Just err -> pure (Left err, attemptNo)-        Nothing ->-          case prepareCommandPlan options eventStream targetStream current command of-            Left err -> pure (Left err, attemptNo)-            Right (CommandNoOp result) -> pure (Right (result, Nothing), attemptNo)-            Right (CommandAppend current' events encoded) ->-              appendWithSqlOnce mSpan attemptNo current' events encoded+-- | Domain-aware counterpart to 'runCommandWithSql'. The callback runs only+-- for an accepted non-empty event batch and commits atomically with it. A typed+-- rejection or no-op returns 'Nothing' and opens no SQL transaction.+runDomainCommandWithSql ::+  forall phi rs s ci co rejection noOp a es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  (AppendResult -> Tx.Transaction a) ->+  Eff es (Either CommandError (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp, Maybe a))+runDomainCommandWithSql options handler targetStream command afterAppend =+  runDomainCommandWithSqlEvents options handler targetStream command (\_ appendResult -> afterAppend appendResult) -    appendWithSqlOnce mSpan attemptNo current events encoded = do+-- | Domain-aware counterpart to 'runCommandWithSqlEvents'. Accepted commands+-- pass the exact typed events paired with their reconstructed persisted events+-- to the callback in append order. Selected silent decisions never invoke it.+runDomainCommandWithSqlEvents ::+  forall phi rs s ci co rejection noOp a es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ([(co, RecordedEvent)] -> AppendResult -> Tx.Transaction a) ->+  Eff es (Either CommandError (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp, Maybe a))+runDomainCommandWithSqlEvents options handler targetStream command afterAppend =+  fmap (fmap collapse)+    $ runDomainCommandWithSqlEventsControlled+      options+      handler+      targetStream+      command+      (\pairs appendResult -> CommitSqlTransaction <$> afterAppend pairs appendResult)+  where+    collapse = \case+      DomainSqlCommandSilent outcome -> (outcome, Nothing)+      DomainSqlCommandCommitted outcome userValue -> (outcome, Just userValue)+      DomainSqlCommandRolledBack _ ->+        error "runDomainCommandWithSqlEvents: an always-commit callback rolled back"++-- | Controlled domain transaction variant used by catalog projection fences.+-- A rollback discards the accepted batch and callback effects and therefore+-- cannot fabricate a successful 'DomainCommandOutcome'.+runDomainCommandWithSqlEventsControlled ::+  forall phi rs s ci co rejection noOp a es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ([(co, RecordedEvent)] -> AppendResult -> Tx.Transaction (SqlTransactionDecision a)) ->+  Eff es (Either CommandError (DomainSqlCommandOutcome (EventStream phi rs s ci co) co rejection noOp a))+runDomainCommandWithSqlEventsControlled options handler@DomainCommandHandler {eventStream = validatedEventStream} targetStream command afterAppend =+  withCommandSpan (options ^. #tracer) (resolvedStreamName (unvalidated validatedEventStream) targetStream) Nothing $ \mSpan -> do+    (outcome, attemptNo) <- domainSqlCommandAttempts options handler targetStream command afterAppend mSpan+    recordDomainSqlCommandOutcome options mSpan attemptNo outcome+    pure outcome++domainSqlCommandAttempts ::+  forall phi rs s ci co rejection noOp a es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ([(co, RecordedEvent)] -> AppendResult -> Tx.Transaction (SqlTransactionDecision a)) ->+  Maybe Span ->+  Eff es (Either CommandError (DomainSqlCommandOutcome (EventStream phi rs s ci co) co rejection noOp a), Int)+domainSqlCommandAttempts options handler@DomainCommandHandler {eventStream = validatedEventStream} targetStream command afterAppend mSpan =+  domainCommandAttemptLoop options handler targetStream command DomainSqlCommandSilent appendWithSqlOnce+  where+    eventStream' = unvalidated validatedEventStream++    appendWithSqlOnce retry attemptNo current events encoded = do       liftIO (options ^. #beforeAppend)       store <- getKirokuStore       enriched <- liftIO (enrichEventsIO store encoded)       prepared <- prepareEventsIO enriched       now <- liftIO getCurrentTime-      let streamName = (eventStream ^. #resolveStreamName) targetStream+      let streamName = (eventStream' ^. #resolveStreamName) targetStream           expected = expectedVersion (current ^. #streamVersion)           body = do             appended <- appendToStreamTx streamName expected prepared now@@ -766,39 +1057,85 @@               Left conflict ->                 Tx.condemn $> Left (appendConflictToStoreError conflict)               Right appendResult -> do-                let recordeds = reconstructRecorded appendResult now prepared-                userValue <- afterAppend (Prelude.zip events recordeds) appendResult-                pure (Right (appendResult, userValue))+                let typedEvents = NonEmpty.toList events+                    recordeds = reconstructRecorded appendResult now prepared+                sqlDecision <- afterAppend (Prelude.zip typedEvents recordeds) appendResult+                case sqlDecision of+                  CommitSqlTransaction userValue ->+                    pure (Right (appendResult, Right userValue))+                  RollbackSqlTransaction userValue -> do+                    Tx.condemn+                    pure (Right (appendResult, Left userValue))       outcome <- tryError @StoreError (runTransaction body)       case outcome of-        Right (Right (appendResult, userValue)) -> do-          verifyAndSnapshot options mSpan eventStream current events appendResult-          pure (Right (appendedResult targetStream appendResult (Prelude.length encoded), Just userValue), attemptNo)+        Right (Right (appendResult, Right userValue)) -> do+          verifyAndSnapshot options mSpan eventStream' current (NonEmpty.toList events) appendResult+          pure+            ( Right+                ( DomainSqlCommandCommitted+                    DomainCommandOutcome+                      { decision = DomainAccepted events,+                        result = appendedResult targetStream appendResult (Prelude.length encoded)+                      }+                    userValue+                ),+              attemptNo+            )+        Right (Right (_, Left userValue)) ->+          pure (Right (DomainSqlCommandRolledBack userValue), attemptNo)         Right (Left storeError) ->-          retryOrFail options (attempt mSpan) attemptNo (current ^. #streamVersion) storeError+          retryOrFail options retry attemptNo (current ^. #streamVersion) storeError         Left (_, storeError) ->-          retryOrFail options (attempt mSpan) attemptNo (current ^. #streamVersion) storeError+          retryOrFail options retry attemptNo (current ^. #streamVersion) storeError -prepareCommandPlan ::+prepareDomainCommandPlan ::   (BoolAlg phi (RegFile rs, ci)) =>   RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->   EventStream phi rs s ci co ->   Stream (EventStream phi rs s ci co) ->   Hydrated rs s ->   ci ->-  Either CommandError (CommandPlan (EventStream phi rs s ci co) rs s co)-prepareCommandPlan options eventStream targetStream current command =-  case evaluateCommand eventStream current command of-    Left err -> Left err-    Right events -> toPlan events-  where-    toPlan [] =-      Right (CommandNoOp (noOpResult targetStream current))-    toPlan events =-      CommandAppend current events-        . assignEventIds (options ^. #eventIds)-        <$> encodeEvents (eventStream ^. #eventCodec) (options ^. #metadata) events+  Either CommandError (DomainCommandPlan (EventStream phi rs s ci co) rs s co rejection noOp)+prepareDomainCommandPlan options DomainCommandHandler {classifySilent} eventStream targetStream current command =+  case Keiki.stepDetailedEither (eventStream ^. #transducer) (current ^. #state, current ^. #registers) command of+    Left failure -> Left (commandStepFailure failure)+    Right success ->+      case Keiki.stepSuccessOutputs success of+        [] ->+          Right+            ( DomainCommandSilent+                ( classifySilent+                    SilentCommandContext+                      { state = current ^. #state,+                        registers = current ^. #registers,+                        command,+                        selectedEdge = Keiki.stepSuccessEdge success+                      }+                )+                (noOpResult targetStream current)+            )+        event : events ->+          let batch = event :| events+           in DomainCommandAppend current batch+                . assignEventIds (options ^. #eventIds)+                <$> encodeEvents (eventStream ^. #eventCodec) (options ^. #metadata) (NonEmpty.toList batch) +domainDecisionFromSilent :: SilentDomainDecision rejection noOp -> DomainDecision co rejection noOp+domainDecisionFromSilent = \case+  SilentRejected reason -> DomainRejected reason+  SilentNoOp explanation -> DomainNoOp explanation++commandStepFailure :: Keiki.StepFailure s -> CommandError+commandStepFailure = \case+  Keiki.NoOutgoingEdges {} -> CommandRejected+  Keiki.NoMatchingEdge {} -> CommandRejected+  Keiki.AmbiguousEdges _ matches ->+    CommandAmbiguous+      [ Keiki.edgeIndex (Keiki.matchedEdge matched)+      | matched <- matches+      ]+ -- | Render the stream that the command targets as plain 'Text', for use -- as a span name. resolvedStreamName ::@@ -834,6 +1171,60 @@       addAttribute sp (unkey error_type) (commandErrorClass err)       setStatus sp (Error (Text.take 256 (Text.pack (show err)))) +recordDomainCommandOutcome ::+  (IOE :> es) =>+  RunCommandOptions ->+  Maybe Span ->+  Int ->+  Either CommandError (DomainCommandOutcome target co rejection noOp) ->+  Eff es ()+recordDomainCommandOutcome options mSpan attemptNo outcome = do+  recordCommandOutcome mSpan ((^. #eventsAppended) . forgetDomainDecision) attemptNo outcome+  case outcome of+    Left _ -> pure ()+    Right DomainCommandOutcome {decision} ->+      recordDomainDecision options mSpan decision++recordDomainSqlCommandOutcome ::+  (IOE :> es) =>+  RunCommandOptions ->+  Maybe Span ->+  Int ->+  Either CommandError (DomainSqlCommandOutcome target co rejection noOp a) ->+  Eff es ()+recordDomainSqlCommandOutcome options mSpan attemptNo outcome = do+  recordCommandOutcome mSpan eventsAppended attemptNo outcome+  case outcome of+    Right (DomainSqlCommandSilent DomainCommandOutcome {decision}) ->+      recordDomainDecision options mSpan decision+    Right (DomainSqlCommandCommitted DomainCommandOutcome {decision} _) ->+      recordDomainDecision options mSpan decision+    Right (DomainSqlCommandRolledBack _) -> pure ()+    Left _ -> pure ()+  where+    eventsAppended = \case+      DomainSqlCommandSilent DomainCommandOutcome {result} -> result ^. #eventsAppended+      DomainSqlCommandCommitted DomainCommandOutcome {result} _ -> result ^. #eventsAppended+      DomainSqlCommandRolledBack _ -> 0++recordDomainDecision ::+  (IOE :> es) =>+  RunCommandOptions ->+  Maybe Span ->+  DomainDecision co rejection noOp ->+  Eff es ()+recordDomainDecision options mSpan domainDecision = do+  let decisionClass = domainDecisionClass domainDecision+  for_ mSpan $ \sp ->+    addAttribute sp (unkey keiro_command_decision) (commandDecisionClassText decisionClass)+  recordCommandDecision (options ^. #metrics) decisionClass++domainDecisionClass :: DomainDecision co rejection noOp -> CommandDecisionClass+domainDecisionClass = \case+  DomainAccepted _ -> DecisionAccepted+  DomainRejected _ -> DecisionRejected+  DomainNoOp _ -> DecisionNoOp+ -- | Low-cardinality classifier for a 'CommandError'. Used as the -- @error.type@ attribute value on the command span. commandErrorClass :: CommandError -> Text@@ -947,25 +1338,6 @@ conflictFixpoint (Just (previousError@StreamAlreadyExists {}, previousVersion)) currentVersion   | currentVersion == previousVersion = Just (ConflictFixpoint currentVersion previousError) conflictFixpoint _ _ = Nothing--evaluateCommand ::-  (BoolAlg phi (RegFile rs, ci)) =>-  EventStream phi rs s ci co ->-  Hydrated rs s ->-  ci ->-  Either CommandError [co]-evaluateCommand eventStream current command =-  case Keiki.stepEither (eventStream ^. #transducer) (state current, registers current) command of-    Left Keiki.NoOutgoingEdges {} -> Left CommandRejected-    Left Keiki.NoMatchingEdge {} -> Left CommandRejected-    Left (Keiki.AmbiguousEdges _ matches) ->-      Left-        ( CommandAmbiguous-            [ Keiki.edgeIndex (Keiki.matchedEdge matched)-            | matched <- matches-            ]-        )-    Right (_, _, events) -> Right events  encodeEvents :: Codec co -> Maybe Value -> [co] -> Either CommandError [EventData] encodeEvents codec md =

@@ -0,0 +1,29 @@+{-# LANGUAGE NoFieldSelectors #-}++-- | Pure domain-decision values that need ordinary record labels without+-- adding selector functions which collide with the established command API.+module Keiro.Command.Domain+  ( SilentCommandContext (..),+    SilentDomainDecision (..),+  )+where++import Keiki.Core (EdgeRef, RegFile)+import Keiro.Prelude++-- | Pre-command values supplied to the pure classifier for an already-selected+-- output-free live edge. The edge reference is local to this exact transducer+-- construction and must not be persisted as an application identifier.+data SilentCommandContext rs s ci = SilentCommandContext+  { state :: !s,+    registers :: !(RegFile rs),+    command :: !ci,+    selectedEdge :: !(EdgeRef s)+  }+  deriving stock (Generic)++-- | Total classification of one explicitly selected output-free edge.+data SilentDomainDecision rejection noOp+  = SilentRejected !rejection+  | SilentNoOp !noOp+  deriving stock (Generic, Eq, Show)

@@ -0,0 +1,69 @@+-- | The seed encoding shared by Keiro's deterministic (version-5 UUID)+-- identifiers.+--+-- A deterministic id is a pure function of a seed text, so that an+-- at-least-once writer collapses to exactly one row: the workflow journal's+-- event ids, sleep timer ids, legacy awakeable ids, and process-manager+-- command ids are all derived this way. That makes the seed encoding /replay+-- identity/ — it must yield the same bytes for the same text on every deploy,+-- forever. The rule is recorded in+-- @docs\/adr\/0024-deterministic-ids-hash-utf-8-seed-bytes-and-are-frozen-replay-identity.md@.+module Keiro.DeterministicId+  ( identitySeedBytes,+    legacySeedBytes,+    seedMovedAcrossEncodings,+    deterministicIdProbes,+  )+where++import Data.ByteString qualified as ByteString+import Data.Char (isAscii)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.UUID (UUID)+import Data.UUID.V5 qualified as UUID.V5+import Data.Word (Word8)+import Keiro.Prelude++-- | The UTF-8 bytes of a deterministic-id seed, in the @[Word8]@ shape+-- @Data.UUID.V5.generateNamed@ expects.+--+-- UTF-8 rather than the codepoints themselves: the original derivations fed+-- @fromIntegral . fromEnum@ over @Text.unpack@ into the hash, which truncated+-- every character to its codepoint modulo 256, so @"\x0101"@ and @"\SOH"@ (and+-- countless CJK pairs) hashed identically and could be assigned one id. For+-- pure-ASCII seeds UTF-8 bytes /are/ the codepoint values, so every id derived+-- from an ASCII seed is byte-identical to what the truncating encoding+-- produced; only non-ASCII seeds move, and they move off a collision.+--+-- This function is frozen. Changing it renames every deterministic id in every+-- deployment, which no amount of retrying recovers from, so a future change+-- needs an explicit versioned derivation and a migration story rather than an+-- edit here.+identitySeedBytes :: Text -> [Word8]+identitySeedBytes = ByteString.unpack . Text.Encoding.encodeUtf8++-- | The pre-0.12 deterministic-id seed encoding.+--+-- This deliberately reproduces the historical @Char -> Word8@ truncation so+-- deployed identifiers can be probed during the compatibility window. It is a+-- frozen reader for old identity, not an encoding for new writes.+legacySeedBytes :: Text -> [Word8]+legacySeedBytes = fmap (fromIntegral . fromEnum) . Text.unpack++-- | Whether UTF-8 and the historical seed encoding can produce different+-- bytes for this seed. ASCII is byte-identical under both encodings.+seedMovedAcrossEncodings :: Text -> Bool+seedMovedAcrossEncodings = not . Text.all isAscii++-- | Ordered candidate ids for one deterministic-id seed under the ADR 24+-- compatibility bridge: the current UTF-8-derived id first, the frozen+-- pre-UTF-8 id second only when the seed's bytes differ across encodings.+-- This is the single source of truth for the dual-probe policy; call sites+-- must not restate the ordering or the moved-seed condition.+deterministicIdProbes :: Text -> NonEmpty UUID+deterministicIdProbes seed =+  UUID.V5.generateNamed UUID.V5.namespaceURL (identitySeedBytes seed)+    :| [ UUID.V5.generateNamed UUID.V5.namespaceURL (legacySeedBytes seed)+       | seedMovedAcrossEncodings seed+       ]

@@ -27,6 +27,7 @@     -- * Storage primitives     lookupInbox,     listInbox,+    listCompletedInboxGcCandidates,     garbageCollectCompleted,     countInboxBacklog,     markFailedTx,

@@ -12,6 +12,7 @@     recordFailedAttemptTx,     lookupInbox,     listInbox,+    listCompletedInboxGcCandidates,     garbageCollectCompleted,     countInboxBacklog,   )@@ -115,6 +116,17 @@   runTransaction $     Tx.statement src listBySourceStmt +-- | List completed rows a retention pass would delete, oldest first.+-- This is a read-only operator preview for 'garbageCollectCompleted'.+listCompletedInboxGcCandidates ::+  (Store :> es) =>+  NominalDiffTime ->+  UTCTime ->+  Eff es [InboxRow]+listCompletedInboxGcCandidates keepFor now =+  runTransaction $+    Tx.statement (addUTCTime (negate keepFor) now) listCompletedGcCandidatesStmt+ -- | Count inbox rows in a non-terminal state (backlog gauge source). -- -- Backlog = rows still @processing@ (in flight) or @failed@ (awaiting a@@ -431,6 +443,13 @@   preparable     (selectAllSql <> " WHERE source = $1 ORDER BY received_at, dedupe_key")     (E.param (E.nonNullable E.text))+    (D.rowList inboxRowDecoder)++listCompletedGcCandidatesStmt :: Statement UTCTime [InboxRow]+listCompletedGcCandidatesStmt =+  preparable+    (selectAllSql <> " WHERE status = 'completed' AND completed_at < $1 ORDER BY completed_at, source, dedupe_key")+    (E.param (E.nonNullable E.timestamptz))     (D.rowList inboxRowDecoder)  countInboxBacklogStmt :: Statement () Int

@@ -40,6 +40,8 @@     markOutboxSent,     lookupOutbox,     listOutbox,+    listStuckOutbox,+    listSentOutboxGcCandidates,     countOutboxBacklog,     garbageCollectSent, 

@@ -15,6 +15,8 @@     markOutboxSkippedTx,     lookupOutbox,     listOutbox,+    listStuckOutbox,+    listSentOutboxGcCandidates,     countOutboxBacklog,     garbageCollectSent,   )@@ -72,6 +74,28 @@   runTransaction $     Tx.statement source listOutboxStmt +-- | List rows a stale-publisher recovery pass would consider, oldest first.+-- This is a read-only operator preview for 'requeueStuckOutbox'.+listStuckOutbox ::+  (Store :> es) =>+  NominalDiffTime ->+  UTCTime ->+  Eff es [OutboxRow]+listStuckOutbox olderThan now =+  runTransaction $+    Tx.statement (addUTCTime (negate olderThan) now) listStuckOutboxStmt++-- | List sent rows a retention pass would delete, oldest first.+-- This is a read-only operator preview for 'garbageCollectSent'.+listSentOutboxGcCandidates ::+  (Store :> es) =>+  NominalDiffTime ->+  UTCTime ->+  Eff es [OutboxRow]+listSentOutboxGcCandidates keepFor now =+  runTransaction $+    Tx.statement (addUTCTime (negate keepFor) now) listSentOutboxGcCandidatesStmt+ -- | Count outbox rows awaiting publish (backlog gauge source). -- -- Backlog = rows in a claimable, non-terminal state. Mirrors the claim@@ -661,6 +685,20 @@   preparable     (selectAllSql <> " WHERE source = $1 ORDER BY created_at, outbox_id")     (E.param (E.nonNullable E.text))+    (D.rowList outboxRowDecoder)++listStuckOutboxStmt :: Statement UTCTime [OutboxRow]+listStuckOutboxStmt =+  preparable+    (selectAllSql <> " WHERE status = 'publishing' AND updated_at < $1 ORDER BY updated_at, outbox_id")+    (E.param (E.nonNullable E.timestamptz))+    (D.rowList outboxRowDecoder)++listSentOutboxGcCandidatesStmt :: Statement UTCTime [OutboxRow]+listSentOutboxGcCandidatesStmt =+  preparable+    (selectAllSql <> " WHERE status = 'sent' AND published_at < $1 ORDER BY published_at, outbox_id")+    (E.param (E.nonNullable E.timestamptz))     (D.rowList outboxRowDecoder)  selectAllSql :: Text

@@ -99,13 +99,17 @@ module Keiro.ProcessManager   ( -- * Definition     ProcessManager (..),+    DomainProcessManager (..),     ProcessManagerAction (..),     PMCommand (..),      -- * Results     ProcessManagerResult (..),     PMCommandResult (..),+    DomainPMCommandResult (..),     PMStateResult (..),+    DomainProcessManagerResult (..),+    DomainDispatchSummary (..),      -- * Running     PoisonPolicy (..),@@ -118,18 +122,28 @@     isRejectionClass,     decideForFailures,     ackForCommandError,+    ackForDomainSummary,+    summarizeDomainCommandResult,     runProcessManagerOnce,     runProcessManagerWorkerWith,     runProcessManagerWorker,+    runDomainProcessManagerOnce,+    runDomainProcessManagerWorkerWith,+    runDomainProcessManagerWorker,      -- * Idempotency primitives     deterministicCommandId,+    legacyDeterministicCommandId,+    deterministicCommandIdProbes,+    dispatchDeduplicatedCommand,+    firstExistingEventId,     eventAlreadyIn,     confirmBenignDuplicate,   ) where  import Data.Coerce (coerce)+import Data.List.NonEmpty qualified as NonEmpty import Data.Text qualified as Text import Data.UUID qualified as UUID import Data.UUID.V5 qualified as UUID.V5@@ -137,12 +151,21 @@ import Effectful.Error.Static (Error, tryError) import GHC.Stack (HasCallStack) import Keiki.Core (BoolAlg, RegFile)-import Keiro.Command (CommandError (..), CommandResult, RunCommandOptions, commandErrorClass, runCommandWithSql)+import Keiro.Command+  ( CommandError (..),+    CommandResult,+    DomainCommandHandler,+    DomainCommandOutcome,+    RunCommandOptions,+    commandErrorClass,+    runCommandWithSql,+  ) import Keiro.DeadLetter (DispatchDeadLetter (..), DispatcherKind (..), recordDispatchDeadLetter)+import Keiro.DeterministicId (deterministicIdProbes, legacySeedBytes) import Keiro.EventStream (EventStream) import Keiro.EventStream.Validate (ValidatedEventStream, unvalidated) import Keiro.Prelude-import Keiro.Projection (InlineProjection, runCommandWithProjections)+import Keiro.Projection (InlineProjection, runCommandWithProjections, runDomainCommandWithProjections) import Keiro.Stream (Stream) import Keiro.Telemetry (KeiroMetrics, recordDispatchDeadLettered, recordDispatchDuplicate, recordDispatchFailed, recordDispatchPoison) import Keiro.Timer (TimerRequest, scheduleTimerTx)@@ -160,7 +183,7 @@ import Shibuya.Core.Types (Attempt (..), Envelope (..)) import Streamly.Data.Fold qualified as Fold import Streamly.Data.Stream qualified as Streamly-import Prelude (any, filter, fromIntegral, length, not, uncurry, zip, (&&), (+))+import Prelude (any, filter, fromIntegral, length, not, reverse, seq, uncurry, zip, (&&), (+))  -- | A process manager wiring together a manager state machine and the target -- aggregate it drives.@@ -191,6 +214,20 @@   }   deriving stock (Generic) +-- | Process-manager configuration whose target aggregate returns typed domain+-- decisions. The manager's own state stream retains the legacy command result;+-- only dispatched target commands use 'DomainCommandHandler'.+data DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp = DomainProcessManager+  { name :: !Text,+    correlate :: !(input -> Text),+    eventStream :: !(ValidatedEventStream phi rs s ci co),+    streamFor :: !(Text -> Stream (EventStream phi rs s ci co)),+    targetHandler :: !(DomainCommandHandler targetPhi targetRs targetState targetCi targetCo rejection noOp),+    targetProjections :: !(Stream targetCi -> [InlineProjection targetCo]),+    handle :: !(input -> ProcessManagerAction ci targetCi)+  }+  deriving stock (Generic)+ -- | What a process manager decides to do for one input event: advance its own -- state with 'command', dispatch zero or more target 'commands', and schedule -- zero or more 'timers'. All three are applied atomically with crash-safe@@ -222,6 +259,16 @@     PMCommandFailed !StoreTypes.StreamName !CommandError   deriving stock (Generic, Eq, Show) +-- | Outcome of one domain-aware target dispatch. A duplicate proves only that+-- the deterministic accepted event id already exists; it cannot reconstruct+-- the original in-memory event batch. Selected rejection/no-op decisions are+-- 'DomainPMCommandHandled' values and are never failures.+data DomainPMCommandResult target co rejection noOp+  = DomainPMCommandHandled !(DomainCommandOutcome target co rejection noOp)+  | DomainPMCommandDuplicate !EventId+  | DomainPMCommandFailed !StoreTypes.StreamName !CommandError+  deriving stock (Generic, Eq, Show)+ -- | Outcome of the manager's own state append. Unlike 'PMCommandResult' there -- is no failure case — a manager-state append that genuinely errors aborts the -- whole reaction via an outer @Left@ 'CommandError'.@@ -240,6 +287,24 @@   }   deriving stock (Generic, Eq, Show) +-- | Detailed domain-aware process-manager result. Its command result list owns+-- every returned accepted event batch; callers interested only in worker+-- acknowledgement should use the worker APIs, which retain only a strict+-- payload-free summary.+data DomainProcessManagerResult managerTarget commandTarget co rejection noOp = DomainProcessManagerResult+  { managerResult :: !(PMStateResult managerTarget),+    commandResults :: ![DomainPMCommandResult commandTarget co rejection noOp],+    timersScheduled :: !Int+  }+  deriving stock (Generic, Eq, Show)++-- | Strict payload-free accumulator used by domain coordinator workers.+data DomainDispatchSummary = DomainDispatchSummary+  { duplicates :: !Int64,+    failures :: ![DispatchFailure]+  }+  deriving stock (Generic, Eq, Show)+ -- | What a worker does with a message its decoder cannot parse. data PoisonPolicy es msg   = PoisonHalt@@ -291,6 +356,7 @@   StreamAlreadyExists {} -> True   EmptyAppendBatch {} -> False   StreamNotFound {} -> False+  HistoryRetentionActive {} -> True   ReservedStreamName {} -> False   StreamNameTooLong {} -> False   DuplicateEvent {} -> False@@ -402,22 +468,54 @@ -- order for the same input. The effectful router uses -- 'Keiro.Router.deterministicRouterCommandId' instead, retaining this positional -- id only as a transition probe for pre-upgrade router dispatches.+--+-- The seed is hashed as UTF-8 bytes+-- ('Keiro.DeterministicId.identitySeedBytes'), which is+-- byte-identical to the original codepoint encoding for ASCII seeds and+-- collision-free for the rest; see+-- @docs\/adr\/0024-deterministic-ids-hash-utf-8-seed-bytes-and-are-frozen-replay-identity.md@.+-- During ADR 0024's operator-attested compatibility window, dispatch preflights+-- also consult 'deterministicCommandIdProbes'; this function remains the only+-- append identity.+-- Unlike 'Keiro.Router.deterministicRouterCommandId' the fields are joined with+-- a delimiter rather than length-prefixed, so a manager name or correlation id+-- containing @\":\"@ can still alias; new derivations should follow the router's+-- length-prefixed encoding. deterministicCommandId :: Text -> Text -> EventId -> Int -> EventId deterministicCommandId managerName correlationId sourceEventId emitIndex =+  NonEmpty.head (deterministicCommandIdProbes managerName correlationId sourceEventId emitIndex)++-- | Reproduce the deterministic command id written before Keiro switched its+-- seed encoding to UTF-8. This exists only for compatibility probes; all new+-- writes continue to use 'deterministicCommandId'. It is removed together with+-- the positional-router probe only under ADR 0024's operator-attested criteria.+legacyDeterministicCommandId :: Text -> Text -> EventId -> Int -> EventId+legacyDeterministicCommandId managerName correlationId sourceEventId emitIndex =   EventId     $ UUID.V5.generateNamed UUID.V5.namespaceURL-    $ fmap (fromIntegral . fromEnum)-    $ Text.unpack-    $ Text.intercalate-      ":"-      [ "keiro",-        "process-manager",-        managerName,-        correlationId,-        UUID.toText (eventIdToUuid sourceEventId),-        Text.pack (show emitIndex)-      ]+    $ legacySeedBytes+    $ commandIdSeed managerName correlationId sourceEventId emitIndex +-- | Candidate ids for a process-manager write, ordered with the current UTF-8+-- append id first and the frozen legacy id second only when the seed contains+-- non-ASCII text. 'deterministicIdProbes' is the single source of truth for+-- the compatibility probe described by ADR 0024.+deterministicCommandIdProbes :: Text -> Text -> EventId -> Int -> NonEmpty EventId+deterministicCommandIdProbes managerName correlationId sourceEventId emitIndex =+  fmap EventId (deterministicIdProbes (commandIdSeed managerName correlationId sourceEventId emitIndex))++commandIdSeed :: Text -> Text -> EventId -> Int -> Text+commandIdSeed managerName correlationId sourceEventId emitIndex =+  Text.intercalate+    ":"+    [ "keiro",+      "process-manager",+      managerName,+      correlationId,+      UUID.toText (eventIdToUuid sourceEventId),+      Text.pack (show emitIndex)+    ]+ -- | React to a single source event: advance the manager's state, dispatch -- its target commands, and schedule its timers — each under a deterministic, -- idempotent write id.@@ -450,13 +548,14 @@   let correlationId = (manager ^. #correlate) input       action = (manager ^. #handle) input       managerStream = (manager ^. #streamFor) correlationId-      managerEventId = deterministicCommandId (manager ^. #name) correlationId (sourceEvent ^. #eventId) (-1)+      managerProbes = deterministicCommandIdProbes (manager ^. #name) correlationId (sourceEvent ^. #eventId) (-1)+      managerEventId = NonEmpty.head managerProbes       managerOptions = options & #eventIds .~ [managerEventId]       managerStreamName = ((unvalidated (manager ^. #eventStream)) ^. #resolveStreamName) managerStream-  managerAlreadyProcessed <- eventAlreadyIn options managerStreamName managerEventId-  if managerAlreadyProcessed-    then finish correlationId (PMStateDuplicate managerEventId) action-    else do+  existingManagerId <- firstExistingEventId options managerStreamName managerProbes+  case existingManagerId of+    Just matchedId -> finish correlationId (PMStateDuplicate matchedId) action+    Nothing -> do       managerOutcome <-         runCommandWithSql           managerOptions@@ -494,30 +593,336 @@         (zip [0 ..] commands)      dispatchCommand correlationId sourceEventId emitIndex command = do-      let commandId = deterministicCommandId (manager ^. #name) correlationId sourceEventId emitIndex+      let commandProbes = deterministicCommandIdProbes (manager ^. #name) correlationId sourceEventId emitIndex+          commandId = NonEmpty.head commandProbes           targetOptions = options & #eventIds .~ [commandId]           targetStream = retarget (command ^. #target)           targetStreamName = ((unvalidated (manager ^. #targetEventStream)) ^. #resolveStreamName) targetStream-      commandAlreadyProcessed <- eventAlreadyIn options targetStreamName commandId-      if commandAlreadyProcessed-        then pure (PMCommandDuplicate commandId)-        else do-          outcome <--            runCommandWithProjections-              targetOptions-              (manager ^. #targetEventStream)-              targetStream-              (command ^. #command)-              ((manager ^. #targetProjections) (command ^. #target))-          case outcome of-            Right result -> pure (PMCommandAppended result)-            Left err -> do-              benign <- confirmBenignDuplicate targetStreamName commandId err-              pure $ if benign then PMCommandDuplicate commandId else PMCommandFailed targetStreamName err+      dispatchDeduplicatedCommand+        options+        targetStreamName+        commandProbes+        PMCommandDuplicate+        (PMCommandFailed targetStreamName)+        PMCommandAppended+        ( runCommandWithProjections+            targetOptions+            (manager ^. #targetEventStream)+            targetStream+            (command ^. #command)+            ((manager ^. #targetProjections) (command ^. #target))+        )      retarget :: Stream targetCi -> Stream (EventStream targetPhi targetRs targetState targetCi targetCo)     retarget = coerce +-- | Detailed domain-aware process-manager runner. Accepted target commands+-- retain their exact event batches; selected rejection/no-op commands are+-- handled results; deterministic accepted redelivery is a separate duplicate+-- result because the original typed batch is not reconstructible from its id.+runDomainProcessManagerOnce ::+  forall input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg phi (RegFile rs, ci),+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq co,+    Eq targetCo+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  RecordedEvent ->+  input ->+  Eff+    es+    ( Either+        CommandError+        ( DomainProcessManagerResult+            (EventStream phi rs s ci co)+            (EventStream targetPhi targetRs targetState targetCi targetCo)+            targetCo+            rejection+            noOp+        )+    )+runDomainProcessManagerOnce options manager sourceEvent input = do+  advanced <- advanceDomainProcessManager options manager sourceEvent input+  case advanced of+    Left err -> pure (Left err)+    Right (correlationId, managerResult, action) -> do+      commandResults <-+        dispatchDomainProcessManagerCommands+          options+          manager+          correlationId+          (sourceEvent ^. #eventId)+          (action ^. #commands)+      pure+        ( Right+            DomainProcessManagerResult+              { managerResult,+                commandResults,+                timersScheduled = length (action ^. #timers)+              }+        )++advanceDomainProcessManager ::+  forall input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg phi (RegFile rs, ci),+    Eq co+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  RecordedEvent ->+  input ->+  Eff es (Either CommandError (Text, PMStateResult (EventStream phi rs s ci co), ProcessManagerAction ci targetCi))+advanceDomainProcessManager options manager sourceEvent input = do+  let correlationId = (manager ^. #correlate) input+      action = (manager ^. #handle) input+      managerStream = (manager ^. #streamFor) correlationId+      managerProbes = deterministicCommandIdProbes (manager ^. #name) correlationId (sourceEvent ^. #eventId) (-1)+      managerEventId = NonEmpty.head managerProbes+      managerOptions = options & #eventIds .~ [managerEventId]+      managerStreamName = ((unvalidated (manager ^. #eventStream)) ^. #resolveStreamName) managerStream+      finish managerResult = pure (Right (correlationId, managerResult, action))+  existingManagerId <- firstExistingEventId options managerStreamName managerProbes+  case existingManagerId of+    Just matchedId -> finish (PMStateDuplicate matchedId)+    Nothing -> do+      managerOutcome <-+        runCommandWithSql+          managerOptions+          (manager ^. #eventStream)+          managerStream+          (action ^. #command)+          (\_ -> traverse_ scheduleTimerTx (action ^. #timers))+      case managerOutcome of+        Left err -> do+          benign <- confirmBenignDuplicate managerStreamName managerEventId err+          if benign+            then finish (PMStateDuplicate managerEventId)+            else pure (Left err)+        Right (managerResult, scheduledInAppend) -> do+          case scheduledInAppend of+            Nothing -> runTransaction (traverse_ scheduleTimerTx (action ^. #timers))+            Just () -> pure ()+          finish (PMStateAppended managerResult)++dispatchDomainProcessManagerCommands ::+  forall input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq targetCo+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  Text ->+  EventId ->+  [PMCommand targetCi] ->+  Eff es [DomainPMCommandResult (EventStream targetPhi targetRs targetState targetCi targetCo) targetCo rejection noOp]+dispatchDomainProcessManagerCommands options manager correlationId sourceEventId commands =+  traverse+    (uncurry (dispatchDomainProcessManagerCommand options manager correlationId sourceEventId))+    (zip [0 ..] commands)++dispatchDomainProcessManagerSummary ::+  forall input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq targetCo+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  Text ->+  EventId ->+  [PMCommand targetCi] ->+  Eff es DomainDispatchSummary+dispatchDomainProcessManagerSummary options manager correlationId sourceEventId =+  go (DomainDispatchSummary 0 []) . zip [0 ..]+  where+    go summary = \case+      [] -> pure summary {failures = reverse (summary ^. #failures)}+      (emitIndex, command) : rest -> do+        result <- dispatchDomainProcessManagerCommand options manager correlationId sourceEventId emitIndex command+        let next = summarizeDomainCommandResult emitIndex result summary+        next `seq` go next rest++dispatchDomainProcessManagerCommand ::+  forall input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq targetCo+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  Text ->+  EventId ->+  Int ->+  PMCommand targetCi ->+  Eff es (DomainPMCommandResult (EventStream targetPhi targetRs targetState targetCi targetCo) targetCo rejection noOp)+dispatchDomainProcessManagerCommand options manager correlationId sourceEventId emitIndex command = do+  let commandProbes = deterministicCommandIdProbes (manager ^. #name) correlationId sourceEventId emitIndex+      commandId = NonEmpty.head commandProbes+      targetOptions = options & #eventIds .~ [commandId]+      handler = manager ^. #targetHandler+      targetEventStream = handler ^. #eventStream+      targetStream = retarget (command ^. #target)+      targetStreamName = ((unvalidated targetEventStream) ^. #resolveStreamName) targetStream+  dispatchDeduplicatedCommand+    options+    targetStreamName+    commandProbes+    DomainPMCommandDuplicate+    (DomainPMCommandFailed targetStreamName)+    DomainPMCommandHandled+    ( runDomainCommandWithProjections+        targetOptions+        handler+        targetStream+        (command ^. #command)+        ((manager ^. #targetProjections) (command ^. #target))+    )+  where+    retarget :: Stream targetCi -> Stream (EventStream targetPhi targetRs targetState targetCi targetCo)+    retarget = coerce++summarizeDomainCommandResult ::+  Int ->+  DomainPMCommandResult target co rejection noOp ->+  DomainDispatchSummary ->+  DomainDispatchSummary+summarizeDomainCommandResult emitIndex result summary =+  case result of+    DomainPMCommandHandled _ -> summary+    DomainPMCommandDuplicate _ ->+      summary {duplicates = summary ^. #duplicates + 1}+    DomainPMCommandFailed targetStreamName commandError ->+      summary+        { failures =+            DispatchFailure+              { emitIndex,+                targetStreamName,+                commandError+              }+              : summary ^. #failures+        }++-- | Domain-aware process-manager worker with default policy. It dispatches+-- through a strict summary fold and does not retain handled domain payloads.+runDomainProcessManagerWorker ::+  forall msg input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg phi (RegFile rs, ci),+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq co,+    Eq targetCo+  ) =>+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  Adapter es msg ->+  (msg -> Maybe (RecordedEvent, input)) ->+  Eff es ()+runDomainProcessManagerWorker =+  runDomainProcessManagerWorkerWith defaultWorkerOptions++-- | Configurable domain-aware process-manager worker. Typed rejection/no-op is+-- handled and acknowledges normally; only 'CommandError' reaches failure+-- policy. Accepted payloads are released after each target is summarized.+runDomainProcessManagerWorkerWith ::+  forall msg input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp es.+  ( HasCallStack,+    IOE :> es,+    Store :> es,+    Error StoreError :> es,+    KirokuStoreResource :> es,+    BoolAlg phi (RegFile rs, ci),+    BoolAlg targetPhi (RegFile targetRs, targetCi),+    Eq co,+    Eq targetCo+  ) =>+  WorkerOptions es msg ->+  RunCommandOptions ->+  DomainProcessManager input phi rs s ci co targetPhi targetRs targetState targetCi targetCo rejection noOp ->+  Adapter es msg ->+  (msg -> Maybe (RecordedEvent, input)) ->+  Eff es ()+runDomainProcessManagerWorkerWith workerOptions options manager Adapter {source = adapterSource} decodeMessage =+  Streamly.fold Fold.drain+    $ Streamly.mapM handleIngested adapterSource+  where+    handleIngested :: Ingested es msg -> Eff es AckDecision+    handleIngested Ingested {envelope = env@Envelope {payload = message}, ack = AckHandle finalizeAck} = do+      decision <- case decodeMessage message of+        Nothing -> decideForPoison workerOptions "domain process-manager worker could not decode message" env+        Just (recorded, input) -> do+          let correlationId = (manager ^. #correlate) input+              managerStream = (manager ^. #streamFor) correlationId+              managerStreamName = ((unvalidated (manager ^. #eventStream)) ^. #resolveStreamName) managerStream+              attemptCount = envelopeAttemptCount env+          outcome <- tryError @StoreError $ do+            advanced <- advanceDomainProcessManager options manager recorded input+            case advanced of+              Left err -> pure (Left err)+              Right (_, managerResult, action) -> do+                summary <-+                  dispatchDomainProcessManagerSummary+                    options+                    manager+                    correlationId+                    (recorded ^. #eventId)+                    (action ^. #commands)+                pure (Right (managerResult, summary))+          case outcome of+            Left (_, storeError) -> do+              recordDispatchFailed (workerOptions ^. #metrics) 1+              pure (ackForThrownStoreError (workerOptions ^. #transientRetryDelay) storeError)+            Right (Left err) -> do+              recordDispatchFailed (workerOptions ^. #metrics) 1+              decideForFailures+                workerOptions+                DispatcherProcessManager+                (manager ^. #name)+                correlationId+                recorded+                attemptCount+                [DispatchFailure (-1) managerStreamName err]+            Right (Right (managerResult, summary)) ->+              ackForDomainSummary+                workerOptions+                DispatcherProcessManager+                (manager ^. #name)+                correlationId+                recorded+                attemptCount+                (stateDuplicateCount managerResult)+                summary+      finalizeAck decision+      pure decision+ -- | Run a process manager as a live subscription draining a Shibuya adapter with -- 'defaultWorkerOptions'. --@@ -642,6 +1047,32 @@     attemptCount     failures +-- | Convert a strict payload-free domain dispatch summary into worker metrics+-- and one acknowledgement decision.+ackForDomainSummary ::+  (IOE :> es, Store :> es) =>+  WorkerOptions es msg ->+  DispatcherKind ->+  Text ->+  Text ->+  RecordedEvent ->+  Int ->+  Int64 ->+  DomainDispatchSummary ->+  Eff es AckDecision+ackForDomainSummary workerOptions dispatcherKind dispatcherName correlationId sourceEvent attemptCount extraDuplicates summary = do+  let dispatchFailures = summary ^. #failures+  recordDispatchDuplicate (workerOptions ^. #metrics) (extraDuplicates + summary ^. #duplicates)+  recordDispatchFailed (workerOptions ^. #metrics) (fromIntegral (length dispatchFailures))+  decideForFailures+    workerOptions+    dispatcherKind+    dispatcherName+    correlationId+    sourceEvent+    attemptCount+    dispatchFailures+ stateDuplicateCount :: PMStateResult target -> Int64 stateDuplicateCount = \case   PMStateDuplicate {} -> 1@@ -693,6 +1124,48 @@   Eff es Bool eventAlreadyIn _options streamName eventId =   eventExistsInStream streamName eventId++-- | Return the first candidate id already present in the target stream.+-- Candidate order is significant: callers put the current append id first and+-- immutable historical identities after it.+firstExistingEventId ::+  (Store :> es) =>+  RunCommandOptions ->+  StoreTypes.StreamName ->+  NonEmpty EventId ->+  Eff es (Maybe EventId)+firstExistingEventId options streamName = go . NonEmpty.toList+  where+    go = \case+      [] -> pure Nothing+      candidate : rest -> do+        exists <- eventAlreadyIn options streamName candidate+        if exists then pure (Just candidate) else go rest++-- | Probe deterministic identities in order, dispatch only when none exists,+-- and fold a concurrent append of the primary identity into a duplicate.+dispatchDeduplicatedCommand ::+  (Store :> es) =>+  RunCommandOptions ->+  StoreTypes.StreamName ->+  NonEmpty EventId ->+  (EventId -> result) ->+  (CommandError -> result) ->+  (value -> result) ->+  Eff es (Either CommandError value) ->+  Eff es result+dispatchDeduplicatedCommand options streamName probes duplicate failure success dispatch = do+  existing <- firstExistingEventId options streamName probes+  case existing of+    Just matchedId -> pure (duplicate matchedId)+    Nothing -> do+      outcome <- dispatch+      case outcome of+        Right value -> pure (success value)+        Left err -> do+          let primaryId = NonEmpty.head probes+          benign <- confirmBenignDuplicate streamName primaryId err+          pure (if benign then duplicate primaryId else failure err)  -- | Decide whether a failed append is a benign duplicate of the write just -- attempted: whether @ourId@ is genuinely present in @streamName@.

@@ -20,18 +20,30 @@   ( -- * Inline projections     InlineProjection (..),     runCommandWithProjections,+    runDomainCommandWithProjections,+    ProjectionCommandOutcome (..),+    runCommandWithCatalogProjections,+    DomainProjectionCommandOutcome (..),+    runDomainCommandWithCatalogProjections,      -- * Asynchronous projections     AsyncProjection (..),     AsyncApplyOutcome (..),+    CatalogAsyncApplyOutcome (..),     applyAsyncProjection,+    applyAsyncProjectionFromCatalog,     applyAsyncProjectionUnfenced,     pruneAsyncProjectionDedupBefore,+    countAsyncProjectionDedupForBefore,+    pruneAsyncProjectionDedupForBefore,+    recordProjectionGlobalPositionDistance,     recordProjectionLag,   ) where  import Contravariant.Extras (contrazip2)+import Data.List qualified as List+import Data.List.NonEmpty qualified as NonEmpty import Data.UUID (UUID) import Effectful (Eff, IOE, (:>)) import Effectful.Error.Static (Error)@@ -40,50 +52,62 @@ import Hasql.Encoders qualified as E import Hasql.Statement (Statement, preparable) import Keiki.Core (BoolAlg, RegFile)-import Keiro.Command (CommandError, CommandResult, RunCommandOptions, runCommandWithSqlEvents)+import Keiro.Command+  ( CommandError,+    CommandResult,+    DomainCommandHandler,+    DomainCommandOutcome,+    DomainSqlCommandOutcome (..),+    RunCommandOptions,+    SqlCommandOutcome (..),+    SqlTransactionDecision (..),+    runCommandWithSqlEvents,+    runCommandWithSqlEventsControlled,+    runDomainCommandWithSqlEvents,+    runDomainCommandWithSqlEventsControlled,+  ) import Keiro.EventStream (EventStream) import Keiro.EventStream.Validate (ValidatedEventStream) import Keiro.Prelude-import Keiro.ReadModel (readSubscriptionPosition, storeHeadPosition)+import Keiro.Projection.Catalog+  ( PhysicalTargets,+    ProjectionHandler (..),+    ProjectionId,+    ProjectionRevisionId,+    ProjectionSet,+    RebuildGroupId,+    RevisionLiveDelivery (..),+    RevisionLiveHandler (..),+    SourceId,+    ValidatedProjectionCatalog,+    asyncProjectionRebuildGroup,+    asyncProjectionRegistrations,+    catalogRevisionLiveHandler,+    typedInlineProjectionsForGroup,+    typedProjectionRebuildGroups,+  )+import Keiro.Projection.Types+import Keiro.ReadModel (storeHeadPosition, subscriptionPositionFromInventory)+import Keiro.ReadModel.Rebuild.Group+  ( ProjectionWriteFence (..),+    RebuildRunId,+    lockProjectionGroupsTx,+  ) import Keiro.Stream (Stream) import Keiro.Telemetry (KeiroMetrics) import Keiro.Telemetry qualified as Telemetry import Kiroku.Store.Effect (Store) import Kiroku.Store.Effect.Resource (KirokuStoreResource) import Kiroku.Store.Error (StoreError)+import Kiroku.Store.Subscription+  ( SubscriptionName (..),+    subscriptionCheckpointInventory,+  ) import Kiroku.Store.Transaction (runTransaction) import Kiroku.Store.Types (EventId (..), GlobalPosition (..), RecordedEvent) import "hasql-transaction" Hasql.Transaction qualified as Tx import Prelude qualified --- | A read-model update applied synchronously with the command that emits--- the event. 'apply' receives both the decoded event @co@ and the--- 'RecordedEvent' the store persisted, and runs in the append transaction.--- 'name' identifies the projection for diagnostics.-data InlineProjection co = InlineProjection-  { name :: !Text,-    apply :: !(co -> RecordedEvent -> Tx.Transaction ())-  }-  deriving stock (Generic)---- | A read-model update applied asynchronously by a subscription worker.------ * 'name' — identifies the projection for diagnostics.--- * 'readModelName' — names the registry row for the model this projection writes.--- * 'subscriptionName' — the cursor under which the worker checkpoints its---   progress through the event log.--- * 'applyRecorded' — folds one 'RecordedEvent' into the read model.--- * 'idempotencyKey' — the 'EventId' used to suppress duplicate application on---   redelivery, making the projection safe to retry.-data AsyncProjection = AsyncProjection-  { name :: !Text,-    readModelName :: !Text,-    subscriptionName :: !Text,-    applyRecorded :: !(RecordedEvent -> Tx.Transaction ()),-    idempotencyKey :: !(RecordedEvent -> EventId)-  }-  deriving stock (Generic)- -- | The database-visible result of one asynchronous projection attempt. data AsyncApplyOutcome   = AsyncApplied@@ -91,10 +115,48 @@   | AsyncFenced   deriving stock (Generic, Eq, Show) +-- | Result of a catalog-fenced inline command. A fenced result proves the+-- append transaction was rolled back, so neither its events nor any projection+-- SQL committed.+data ProjectionCommandOutcome target+  = ProjectionCommandApplied !(CommandResult target)+  | ProjectionCommandFenced !RebuildGroupId !RebuildRunId+  | ProjectionCommandGroupUnregistered !RebuildGroupId+  | ProjectionCommandServingRevisionUnavailable !RebuildGroupId !ProjectionRevisionId+  | ProjectionCommandServingBindingInvalid !RebuildGroupId !ProjectionRevisionId !Text+  | ProjectionCommandCatalogMismatch !SourceId+  deriving stock (Generic, Eq, Show)++-- | Outcome-aware counterpart to 'ProjectionCommandOutcome'. Successful+-- selected silent decisions are applied outcomes even though no projection+-- handler ran. Fence outcomes prove an accepted append was rolled back.+data DomainProjectionCommandOutcome target co rejection noOp+  = DomainProjectionCommandApplied !(DomainCommandOutcome target co rejection noOp)+  | DomainProjectionCommandFenced !RebuildGroupId !RebuildRunId+  | DomainProjectionCommandGroupUnregistered !RebuildGroupId+  | DomainProjectionCommandServingRevisionUnavailable !RebuildGroupId !ProjectionRevisionId+  | DomainProjectionCommandServingBindingInvalid !RebuildGroupId !ProjectionRevisionId !Text+  | DomainProjectionCommandCatalogMismatch !SourceId+  deriving stock (Generic, Eq, Show)++-- | Catalog-aware result of one asynchronous projection application.+data CatalogAsyncApplyOutcome+  = CatalogAsyncApplied+  | CatalogAsyncDuplicate+  | CatalogAsyncFenced !RebuildGroupId !RebuildRunId+  | CatalogAsyncGroupUnregistered !RebuildGroupId+  | CatalogAsyncServingRevisionUnavailable !RebuildGroupId !ProjectionRevisionId+  | CatalogAsyncServingBindingInvalid !RebuildGroupId !ProjectionRevisionId !Text+  | CatalogAsyncProjectionUnknown !ProjectionId+  deriving stock (Generic, Eq, Show)+ -- | Run a command and apply every supplied 'InlineProjection' to the events -- it emits, all inside the command's append transaction. A projection failure -- aborts the whole transaction, so the events and the read-model update commit -- together or not at all.+--+-- This compatibility runner does not consult catalog rebuild-group fences. New+-- managed callers should use 'runCommandWithCatalogProjections'. runCommandWithProjections ::   forall phi rs s ci co es.   (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>@@ -122,6 +184,165 @@       )   pure (fmap Prelude.fst result) +-- | Run a domain command and apply every supplied inline projection to an+-- accepted event batch in the append transaction. Typed rejection and no-op+-- decisions return directly without invoking any projection.+runDomainCommandWithProjections ::+  forall phi rs s ci co rejection noOp es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  [InlineProjection co] ->+  Eff es (Either CommandError (DomainCommandOutcome (EventStream phi rs s ci co) co rejection noOp))+runDomainCommandWithProjections options handler targetStream command projections = do+  outcome <-+    runDomainCommandWithSqlEvents+      options+      handler+      targetStream+      command+      ( \pairs _appendResult ->+          traverse_+            ( \projection ->+                traverse_+                  (\(event, recorded) -> (projection ^. #apply) event recorded)+                  pairs+            )+            projections+      )+  pure (fmap Prelude.fst outcome)++-- | Run a command through the typed source view derived from one validated+-- catalog. Every distinct rebuild group is locked in stable ID order inside the+-- append transaction before any projection handler runs. A rebuilding or failed+-- group condemns that transaction and returns a typed fence outcome.+runCommandWithCatalogProjections ::+  forall phi rs s ci co es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  ValidatedEventStream phi rs s ci co ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ValidatedProjectionCatalog ->+  ProjectionSet co ->+  Eff es (Either CommandError (ProjectionCommandOutcome (EventStream phi rs s ci co)))+runCommandWithCatalogProjections options eventStream targetStream command catalog projectionSet = do+  if Prelude.null groups+    then pure (Right (ProjectionCommandCatalogMismatch (projectionSet ^. #projectionSource)))+    else do+      outcome <-+        runCommandWithSqlEventsControlled+          options+          eventStream+          targetStream+          command+          (\pairs _appendResult -> applyCatalogProjectionsTx catalog projectionSet groups pairs)+      pure (fmap toProjectionOutcome outcome)+  where+    groups = typedProjectionRebuildGroups catalog projectionSet++    toProjectionOutcome = \case+      SqlCommandNoOp result -> ProjectionCommandApplied result+      SqlCommandCommitted result _ -> ProjectionCommandApplied result+      SqlCommandRolledBack fence -> fenceOutcome fence++    fenceOutcome = \case+      ProjectionWritesAllowed _ ->+        error "runCommandWithCatalogProjections: rolled back with writes allowed"+      ProjectionWriteFenced groupId runId -> ProjectionCommandFenced groupId runId+      ProjectionWriteGroupUnregistered groupId -> ProjectionCommandGroupUnregistered groupId+      ProjectionServingRevisionUnavailable groupId revisionId ->+        ProjectionCommandServingRevisionUnavailable groupId revisionId+      ProjectionServingBindingInvalid groupId revisionId detail ->+        ProjectionCommandServingBindingInvalid groupId revisionId detail++-- | Domain-aware catalog projection runner. Accepted commands retain existing+-- catalog fence semantics. Typed rejection/no-op decisions invoke neither the+-- fence transaction nor projection handlers and carry no fabricated projection+-- result.+runDomainCommandWithCatalogProjections ::+  forall phi rs s ci co rejection noOp es.+  (HasCallStack, IOE :> es, Store :> es, Error StoreError :> es, KirokuStoreResource :> es, BoolAlg phi (RegFile rs, ci), Eq co) =>+  RunCommandOptions ->+  DomainCommandHandler phi rs s ci co rejection noOp ->+  Stream (EventStream phi rs s ci co) ->+  ci ->+  ValidatedProjectionCatalog ->+  ProjectionSet co ->+  Eff es (Either CommandError (DomainProjectionCommandOutcome (EventStream phi rs s ci co) co rejection noOp))+runDomainCommandWithCatalogProjections options handler targetStream command catalog projectionSet = do+  if Prelude.null groups+    then pure (Right (DomainProjectionCommandCatalogMismatch (projectionSet ^. #projectionSource)))+    else do+      outcome <-+        runDomainCommandWithSqlEventsControlled+          options+          handler+          targetStream+          command+          (\pairs _appendResult -> applyCatalogProjectionsTx catalog projectionSet groups pairs)+      pure (fmap toProjectionOutcome outcome)+  where+    groups = typedProjectionRebuildGroups catalog projectionSet++    toProjectionOutcome = \case+      DomainSqlCommandSilent outcome -> DomainProjectionCommandApplied outcome+      DomainSqlCommandCommitted outcome _ -> DomainProjectionCommandApplied outcome+      DomainSqlCommandRolledBack fence -> fenceOutcome fence++    fenceOutcome = \case+      ProjectionWritesAllowed _ ->+        error "runDomainCommandWithCatalogProjections: rolled back with writes allowed"+      ProjectionWriteFenced groupId runId -> DomainProjectionCommandFenced groupId runId+      ProjectionWriteGroupUnregistered groupId -> DomainProjectionCommandGroupUnregistered groupId+      ProjectionServingRevisionUnavailable groupId revisionId ->+        DomainProjectionCommandServingRevisionUnavailable groupId revisionId+      ProjectionServingBindingInvalid groupId revisionId detail ->+        DomainProjectionCommandServingBindingInvalid groupId revisionId detail++applyCatalogProjectionsTx ::+  ValidatedProjectionCatalog ->+  ProjectionSet co ->+  [RebuildGroupId] ->+  [(co, RecordedEvent)] ->+  Tx.Transaction (SqlTransactionDecision ProjectionWriteFence)+applyCatalogProjectionsTx catalog projectionSet groups pairs = do+  fence <- lockProjectionGroupsTx catalog groups+  case fence of+    ProjectionWritesAllowed bindings -> do+      traverse_ applyBinding bindings+      pure (CommitSqlTransaction fence)+    _ -> pure (RollbackSqlTransaction fence)+  where+    applyBinding binding =+      case binding ^. #writeRevisionId of+        Nothing ->+          traverse_+            ( \projection ->+                traverse_+                  (\(event, recorded) -> (projection ^. #apply) event recorded)+                  pairs+            )+            (typedInlineProjectionsForGroup catalog projectionSet (binding ^. #writeGroupId))+        Just revisionId ->+          traverse_+            ( \wantedDelivery ->+                case catalogRevisionLiveHandler catalog revisionId wantedDelivery of+                  Nothing -> error "applyCatalogProjectionsTx: validated revision delivery disappeared"+                  Just handler ->+                    traverse_+                      (\(_, recorded) -> (handler ^. #runRevisionLive) (binding ^. #writePhysicalTargets) recorded)+                      pairs+            )+            [ RevisionInlineDelivery (definition ^. #projectionId) (projection ^. #name)+            | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions),+              definition ^. #rebuildGroup == binding ^. #writeGroupId,+              handler <- NonEmpty.toList (definition ^. #handlers),+              InlineHandler projection _ <- [handler]+            ]+ -- | Apply one event to a live 'AsyncProjection', returning a distinct outcome -- for a successful application, a retained dedup key, or a rebuild fence. --@@ -132,6 +353,9 @@ -- retry after promotion. Ack-coupled Kiroku delivery preserves the checkpoint -- when its handler does not acknowledge success. --+-- This compatibility path consults only the legacy single-read-model registry.+-- Catalog-managed workers should use 'applyAsyncProjectionFromCatalog'.+-- -- The projection's 'idempotencyKey' is inserted into @keiro_projection_dedup@ -- inside the same transaction as 'applyRecorded'. When that insert conflicts, -- the event was already applied within the retained dedup window and the update@@ -148,6 +372,84 @@     Just "live" -> applyAsyncProjectionUnfenced projection recorded     _ -> pure AsyncFenced +-- | Apply one async handler through its validated catalog identity and the same+-- rebuild-group row lock used by inline commands and rebuild preparation.+-- Fenced outcomes perform no dedup insert or target write; an ack-coupled worker+-- must therefore leave its subscription checkpoint unchanged.+applyAsyncProjectionFromCatalog ::+  ValidatedProjectionCatalog ->+  ProjectionId ->+  AsyncProjection ->+  RecordedEvent ->+  Tx.Transaction CatalogAsyncApplyOutcome+applyAsyncProjectionFromCatalog catalog projectionId projection recorded =+  case List.find matchesRegistration (asyncProjectionRegistrations catalog) of+    Nothing -> pure (CatalogAsyncProjectionUnknown projectionId)+    Just registration -> do+      let groupId =+            fromMaybe+              (error "applyAsyncProjectionFromCatalog: validated async registration has no projection group")+              (asyncProjectionRebuildGroup catalog projectionId (projection ^. #name))+      fence <- lockProjectionGroupsTx catalog [groupId]+      case fence of+        ProjectionWritesAllowed [binding] -> do+          outcome <-+            case binding ^. #writeRevisionId of+              Nothing -> applyAsyncProjectionUnfenced projection recorded+              Just revisionId ->+                case catalogRevisionLiveHandler+                  catalog+                  revisionId+                  ( RevisionSubscriptionDelivery+                      projectionId+                      (registration ^. #subscriptionId)+                      (registration ^. #dedupKeyId)+                  ) of+                  Nothing ->+                    error "applyAsyncProjectionFromCatalog: validated revision delivery disappeared"+                  Just handler ->+                    applyRevisionAsyncProjectionUnfenced+                      projection+                      (binding ^. #writePhysicalTargets)+                      handler+                      recorded+          pure $ case outcome of+            AsyncApplied -> CatalogAsyncApplied+            AsyncDuplicate -> CatalogAsyncDuplicate+            AsyncFenced ->+              error "applyAsyncProjectionUnfenced returned a fenced outcome"+        ProjectionWritesAllowed _ ->+          error "applyAsyncProjectionFromCatalog: one group lock returned an unexpected binding set"+        ProjectionWriteFenced fencedGroup runId ->+          pure (CatalogAsyncFenced fencedGroup runId)+        ProjectionWriteGroupUnregistered missingGroup ->+          pure (CatalogAsyncGroupUnregistered missingGroup)+        ProjectionServingRevisionUnavailable missingGroup revisionId ->+          pure (CatalogAsyncServingRevisionUnavailable missingGroup revisionId)+        ProjectionServingBindingInvalid invalidGroup revisionId detail ->+          pure (CatalogAsyncServingBindingInvalid invalidGroup revisionId detail)+  where+    matchesRegistration registration =+      registration ^. #projectionId == projectionId+        Prelude.&& registration ^. #projectionName == projection ^. #name++applyRevisionAsyncProjectionUnfenced ::+  AsyncProjection ->+  PhysicalTargets ->+  RevisionLiveHandler ->+  RecordedEvent ->+  Tx.Transaction AsyncApplyOutcome+applyRevisionAsyncProjectionUnfenced projection physicalTargets handler recorded = do+  inserted <-+    Tx.statement+      (projection ^. #name, eventIdToUuid ((projection ^. #idempotencyKey) recorded))+      insertProjectionDedupStmt+  if inserted+    then do+      (handler ^. #runRevisionLive) physicalTargets recorded+      pure AsyncApplied+    else pure AsyncDuplicate+ -- | Apply one event without consulting the read-model registry fence. -- -- This is exclusively the rebuild replay entry point: it retains normal dedup@@ -177,30 +479,69 @@   runTransaction     $ Tx.statement cutoff pruneProjectionDedupBeforeStmt --- | Record 'keiro.projection.lag' for one async projection: how many events its--- subscription is behind the global log head, computed as the store head global--- position minus the subscription's checkpoint position (clamped at 0). A no-op--- when no metrics handle is supplied. Call once per drain pass, after applying the--- batch, so the gauge reflects the backlog the worker has left to catch up on.+-- | Count one projection's dedup rows older than a timestamp. This is the+-- read-only operator preview for 'pruneAsyncProjectionDedupForBefore'.+countAsyncProjectionDedupForBefore ::+  (Store :> es) =>+  Text ->+  UTCTime ->+  Eff es Int64+countAsyncProjectionDedupForBefore projectionName cutoff =+  runTransaction+    $ Tx.statement (projectionName, cutoff) countProjectionDedupForBeforeStmt++-- | Age out one named projection's dedup rows older than the supplied+-- timestamp. Scoping the mutation keeps unrelated projection redelivery+-- windows independent.+pruneAsyncProjectionDedupForBefore ::+  (Store :> es) =>+  Text ->+  UTCTime ->+  Eff es Int64+pruneAsyncProjectionDedupForBefore projectionName cutoff =+  runTransaction+    $ Tx.statement (projectionName, cutoff) pruneProjectionDedupForBeforeStmt++-- | Record the non-negative global position distance between the newest visible+-- event and the slowest durable member checkpoint for one async projection. A+-- global position is an opaque cursor, so this is not an exact count of relevant+-- events for filtered, category, or sharded consumers. Tail hard-deletion leaves+-- a caught-up projection at distance zero because an authoritative append+-- counter that includes deleted events is not actionable backlog. -- -- There is no in-library polling drain loop today (the application drives -- 'applyAsyncProjection' per event), so this is the entry point an application--- calls to surface lag for a subscription.+-- calls once per drain pass after applying a batch. The preferred and legacy+-- gauges record the same value during the 0.11 compatibility interval.+recordProjectionGlobalPositionDistance ::+  (IOE :> es, Store :> es) =>+  Maybe KeiroMetrics ->+  AsyncProjection ->+  Eff es ()+recordProjectionGlobalPositionDistance metrics projection = do+  inventory <- subscriptionCheckpointInventory+  visibleHead <- storeHeadPosition+  let checkpoint =+        fromMaybe (GlobalPosition 0)+          $ subscriptionPositionFromInventory+            (SubscriptionName (projection ^. #subscriptionName))+            inventory+      distance = globalPositionDistance visibleHead checkpoint+  Telemetry.recordProjectionGlobalPositionDistance metrics distance+  Telemetry.recordProjectionLag metrics distance++-- | Deprecated compatibility name for 'recordProjectionGlobalPositionDistance'.+{-# DEPRECATED recordProjectionLag "Use recordProjectionGlobalPositionDistance; the value is a global position distance, not an event count." #-} recordProjectionLag ::   (IOE :> es, Store :> es) =>   Maybe KeiroMetrics ->   AsyncProjection ->   Eff es ()-recordProjectionLag metrics projection = do-  headPos <- storeHeadPosition-  checkpoint <--    fromMaybe (GlobalPosition 0)-      <$> readSubscriptionPosition (projection ^. #subscriptionName)-  Telemetry.recordProjectionLag metrics (positionGap headPos checkpoint)+recordProjectionLag = recordProjectionGlobalPositionDistance --- | The non-negative gap between the log head and a checkpoint, in events.-positionGap :: GlobalPosition -> GlobalPosition -> Int64-positionGap (GlobalPosition headP) (GlobalPosition checkP) = max 0 (headP Prelude.- checkP)+-- | The non-negative distance between two opaque global positions.+globalPositionDistance :: GlobalPosition -> GlobalPosition -> Int64+globalPositionDistance (GlobalPosition headP) (GlobalPosition checkP) = max 0 (headP Prelude.- checkP)  insertProjectionDedupStmt :: Statement (Text, UUID) Bool insertProjectionDedupStmt =@@ -236,6 +577,35 @@     WHERE applied_at < $1     """     (E.param (E.nonNullable E.timestamptz))+    D.rowsAffected++countProjectionDedupForBeforeStmt :: Statement (Text, UTCTime) Int64+countProjectionDedupForBeforeStmt =+  preparable+    """+    SELECT count(*)::bigint+    FROM keiro.keiro_projection_dedup+    WHERE projection_name = $1+      AND applied_at < $2+    """+    ( contrazip2+        (E.param (E.nonNullable E.text))+        (E.param (E.nonNullable E.timestamptz))+    )+    (D.singleRow (D.column (D.nonNullable D.int8)))++pruneProjectionDedupForBeforeStmt :: Statement (Text, UTCTime) Int64+pruneProjectionDedupForBeforeStmt =+  preparable+    """+    DELETE FROM keiro.keiro_projection_dedup+    WHERE projection_name = $1+      AND applied_at < $2+    """+    ( contrazip2+        (E.param (E.nonNullable E.text))+        (E.param (E.nonNullable E.timestamptz))+    )     D.rowsAffected  eventIdToUuid :: EventId -> UUID

@@ -0,0 +1,3742 @@+-- | A typed, closed-world declaration of a service's projection fleet.+--+-- A catalog keeps four identities separate:+--+-- * a query model is the typed read contract exposed to callers;+-- * a target is one application-owned PostgreSQL table;+-- * a rebuild group is the set of targets that move through one lifecycle;+-- * a projection is one ordered owner of one or more targets.+--+-- Construct a 'ProjectionCatalog', validate it with+-- 'validateProjectionCatalog', and pass only the resulting+-- 'ValidatedProjectionCatalog' to registration, replay, or operational code.+-- Validation is pure and accumulates deterministic diagnostics. It proves the+-- relationships declared in the supplied catalog; it cannot inspect arbitrary+-- SQL handlers or discover application tables that were not declared.+module Keiro.Projection.Catalog+  ( -- * Validated identities+    ProjectionId,+    TargetId,+    RebuildGroupId,+    SourceId,+    QueryModelId,+    SubscriptionId,+    DedupKeyId,+    ProjectionRevisionId,+    ExternalReadContractId,+    ExternalReadContractVersion (..),+    TargetGenerationId (..),+    TargetSchemaVersion (..),+    ClaimSite,+    CatalogIdentityError (..),+    mkProjectionId,+    mkTargetId,+    mkRebuildGroupId,+    mkSourceId,+    mkQueryModelId,+    mkSubscriptionId,+    mkDedupKeyId,+    mkProjectionRevisionId,+    mkExternalReadContractId,+    mkClaimSite,+    projectionIdText,+    targetIdText,+    rebuildGroupIdText,+    sourceIdText,+    queryModelIdText,+    subscriptionIdText,+    dedupKeyIdText,+    projectionRevisionIdText,+    externalReadContractIdText,+    externalReadContractVersionValue,+    claimSiteText,++    -- * Declarations+    QualifiedTable (..),+    PhysicalTargets,+    PhysicalTargetMapError (..),+    mkPhysicalTargets,+    physicalTargetMap,+    resolvePhysicalTarget,+    PromotionObjectKind (..),+    PromotionObjectName (..),+    TargetSchemaViolation (..),+    TargetSchemaEvidence (..),+    TargetProvisioningContext (..),+    TargetProvisioner (..),+    RevisionLiveDelivery (..),+    RevisionLiveHandler (..),+    RevisionReplayAdapter (..),+    RevisionVerification (..),+    StreamClearCount (..),+    StreamScopedReplay (..),+    ProjectionRevision (..),+    QualifiedFunction (..),+    QualifiedSqlType (..),+    SqlFunctionArgument (..),+    ExternalReadContract (..),+    externalReadFunctionName,+    TargetResetPolicy (..),+    TargetDeclaration (..),+    RebuildVerification (..),+    RebuildGroupDeclaration (..),+    SourceScope (..),+    SourceDeclaration (..),+    SubscriptionDeclaration (..),+    missingCheckpointPolicyText,+    DedupKeyDeclaration (..),+    QueryModelBinding (..),+    SomeQueryModelBinding (..),+    LiveOnlyReason (..),+    ReplayDecodeError (..),+    ReplayDecodeResult (..),+    ReplayAdapter (..),+    replayAdapterFromCodec,+    ProjectionReplayPolicy (..),+    ProjectionHandler (..),+    ProjectionDefinition (..),+    ProjectionSet (..),+    SomeProjectionSet (..),+    ProjectionCatalog (..),+    emptyProjectionCatalog,++    -- * Validation+    Validation (..),+    CatalogDiagnosticCode (..),+    CatalogDiagnostic (..),+    diagnosticCodeText,+    ValidatedProjectionCatalog,+    validateProjectionCatalog,+    useProjectionCatalog,+    useProjectionCatalogM,++    -- * Derived views+    CatalogInventory (..),+    InventorySource (..),+    InventoryTarget (..),+    InventoryGroup (..),+    InventoryProjection (..),+    InventoryQueryModel (..),+    InventoryQueryFreshness (..),+    InventoryQueryCursor (..),+    InventorySubscription (..),+    InventoryDedupKey (..),+    InventoryHandler (..),+    InventoryTargetProvisioner (..),+    InventoryRevisionHandler (..),+    InventoryStreamScopedReplay (..),+    InventoryProjectionRevision (..),+    ExternalReadContractKind (..),+    InventoryExternalReadContract (..),+    ProjectionHandlerCapability (..),+    ResolvedQuerySupply (..),+    CatalogFingerprint,+    catalogFingerprintText,+    GroupSliceFingerprint,+    groupSliceFingerprintText,+    CatalogEvolution (..),+    CatalogRegistration (..),+    AsyncProjectionRegistration (..),+    CatalogAsyncDedupSpec (..),+    ReplayAdapterMetadata (..),+    CatalogReplayAdapter,+    catalogReplayAdapterProjectionId,+    catalogReplayAdapterSourceId,+    catalogReplayAdapterGroupId,+    catalogReplayAdapterOrder,+    runCatalogReplayAdapter,+    typedInlineProjections,+    typedInlineProjectionsForGroup,+    typedProjectionRebuildGroups,+    asyncProjectionRebuildGroup,+    resolvedQuerySupplies,+    catalogInventory,+    catalogFingerprint,+    groupSliceFingerprint,+    catalogRegistrations,+    catalogProjectionRevisions,+    catalogProjectionRevision,+    catalogRevisionLiveHandler,+    catalogStreamScopedReplay,+    catalogExternalReadContracts,+    asyncProjectionRegistrations,+    catalogAsyncIdempotencyKeys,+    replayAdapterMetadata,+    catalogReplayAdapters,+    catalogRebuildVerifications,+    renderCatalogInventory,+    compareCatalogBaseline,++    -- * Explicit unmanaged compatibility boundary+    UnmanagedInlineProjections,+    unmanagedInlineProjections,+    getUnmanagedInlineProjections,+    UnmanagedAsyncProjection,+    unmanagedAsyncProjection,+    getUnmanagedAsyncProjection,+    UnmanagedReadModel,+    unmanagedReadModel,+    getUnmanagedReadModel,+  )+where++import Data.Graph (SCC (..), stronglyConnComp)+import Data.List qualified as List+import Data.List.NonEmpty qualified as NonEmpty+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (mapMaybe)+import Data.Set qualified as Set+import Data.Text qualified as Text+import Data.UUID (UUID)+import Hasql.Transaction qualified as Tx+import Keiro.Codec (Codec (..), decodeRecorded)+import Keiro.Prelude+import Keiro.Projection.Catalog.Preimage (Preimage (..), hashPreimage)+import Keiro.Projection.Types (AsyncProjection, InlineProjection)+import Keiro.ReadModel+  ( HeadScope (..),+    QueryFreshness (..),+    ReadModel,+    readModelDefaultFreshness,+  )+import Kiroku.Store.Subscription.Types (MissingCheckpointPolicy (..))+import Kiroku.Store.Types (CategoryName (..), EventId, RecordedEvent, StreamName)++newtype ProjectionId = ProjectionId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype TargetId = TargetId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype RebuildGroupId = RebuildGroupId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype SourceId = SourceId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype QueryModelId = QueryModelId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype SubscriptionId = SubscriptionId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype DedupKeyId = DedupKeyId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype ProjectionRevisionId = ProjectionRevisionId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype ExternalReadContractId = ExternalReadContractId Text+  deriving stock (Eq, Ord, Show, Generic)++newtype ExternalReadContractVersion = ExternalReadContractVersion Int+  deriving stock (Eq, Ord, Show, Generic)++newtype TargetGenerationId = TargetGenerationId UUID+  deriving stock (Eq, Ord, Show, Generic)++newtype TargetSchemaVersion = TargetSchemaVersion Text+  deriving stock (Eq, Ord, Show, Generic)++newtype ClaimSite = ClaimSite Text+  deriving stock (Eq, Ord, Show, Generic)++-- | A stable catalog identity was empty or contained surrounding whitespace.+data CatalogIdentityError+  = EmptyCatalogIdentity+  | CatalogIdentityHasSurroundingWhitespace !Text+  deriving stock (Eq, Ord, Show, Generic)++mkProjectionId :: Text -> Either CatalogIdentityError ProjectionId+mkProjectionId = mkIdentity ProjectionId++mkTargetId :: Text -> Either CatalogIdentityError TargetId+mkTargetId = mkIdentity TargetId++mkRebuildGroupId :: Text -> Either CatalogIdentityError RebuildGroupId+mkRebuildGroupId = mkIdentity RebuildGroupId++mkSourceId :: Text -> Either CatalogIdentityError SourceId+mkSourceId = mkIdentity SourceId++mkQueryModelId :: Text -> Either CatalogIdentityError QueryModelId+mkQueryModelId = mkIdentity QueryModelId++mkSubscriptionId :: Text -> Either CatalogIdentityError SubscriptionId+mkSubscriptionId = mkIdentity SubscriptionId++mkDedupKeyId :: Text -> Either CatalogIdentityError DedupKeyId+mkDedupKeyId = mkIdentity DedupKeyId++mkProjectionRevisionId :: Text -> Either CatalogIdentityError ProjectionRevisionId+mkProjectionRevisionId = mkIdentity ProjectionRevisionId++mkExternalReadContractId :: Text -> Either CatalogIdentityError ExternalReadContractId+mkExternalReadContractId = mkIdentity ExternalReadContractId++mkClaimSite :: Text -> Either CatalogIdentityError ClaimSite+mkClaimSite = mkIdentity ClaimSite++projectionIdText :: ProjectionId -> Text+projectionIdText (ProjectionId value) = value++targetIdText :: TargetId -> Text+targetIdText (TargetId value) = value++rebuildGroupIdText :: RebuildGroupId -> Text+rebuildGroupIdText (RebuildGroupId value) = value++sourceIdText :: SourceId -> Text+sourceIdText (SourceId value) = value++queryModelIdText :: QueryModelId -> Text+queryModelIdText (QueryModelId value) = value++subscriptionIdText :: SubscriptionId -> Text+subscriptionIdText (SubscriptionId value) = value++dedupKeyIdText :: DedupKeyId -> Text+dedupKeyIdText (DedupKeyId value) = value++projectionRevisionIdText :: ProjectionRevisionId -> Text+projectionRevisionIdText (ProjectionRevisionId value) = value++externalReadContractIdText :: ExternalReadContractId -> Text+externalReadContractIdText (ExternalReadContractId value) = value++externalReadContractVersionValue :: ExternalReadContractVersion -> Int+externalReadContractVersionValue (ExternalReadContractVersion value) = value++claimSiteText :: ClaimSite -> Text+claimSiteText (ClaimSite value) = value++mkIdentity :: (Text -> identity) -> Text -> Either CatalogIdentityError identity+mkIdentity constructor value+  | Text.null value = Left EmptyCatalogIdentity+  | Text.strip value /= value = Left (CatalogIdentityHasSurroundingWhitespace value)+  | otherwise = Right (constructor value)++-- | An application-owned PostgreSQL table. Keiro treats both parts as opaque+-- identifiers and quotes them when later plans execute lifecycle SQL.+data QualifiedTable = QualifiedTable+  { schemaName :: !Text,+    tableName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | A complete logical-target to physical-table binding supplied to every+-- revision handler. Construction is closed-world: missing and unexpected+-- targets are reported together before application SQL can run.+newtype PhysicalTargets = PhysicalTargets (Map TargetId QualifiedTable)+  deriving stock (Eq, Ord, Show, Generic)++data PhysicalTargetMapError+  = MissingPhysicalTarget !TargetId+  | UnexpectedPhysicalTarget !TargetId+  deriving stock (Eq, Ord, Show, Generic)++mkPhysicalTargets :: [TargetId] -> Map TargetId QualifiedTable -> Either (NonEmpty PhysicalTargetMapError) PhysicalTargets+mkPhysicalTargets expected supplied =+  case NonEmpty.nonEmpty errors of+    Nothing -> Right (PhysicalTargets supplied)+    Just failures -> Left failures+  where+    expectedSet = Set.fromList expected+    suppliedSet = Map.keysSet supplied+    errors =+      [ MissingPhysicalTarget targetId+      | targetId <- Set.toAscList (expectedSet `Set.difference` suppliedSet)+      ]+        <> [ UnexpectedPhysicalTarget targetId+           | targetId <- Set.toAscList (suppliedSet `Set.difference` expectedSet)+           ]++physicalTargetMap :: PhysicalTargets -> Map TargetId QualifiedTable+physicalTargetMap (PhysicalTargets targets) = targets++resolvePhysicalTarget :: TargetId -> PhysicalTargets -> Maybe QualifiedTable+resolvePhysicalTarget targetId (PhysicalTargets targets) = Map.lookup targetId targets++data PromotionObjectKind+  = PromotionIndex+  | PromotionConstraint+  | PromotionOwnedSequence+  deriving stock (Eq, Ord, Show, Generic)++-- | One generation-local object name and the canonical serving name it must+-- receive during promotion. Declaration order is durable cutover identity.+data PromotionObjectName = PromotionObjectName+  { objectKind :: !PromotionObjectKind,+    generationName :: !Text,+    canonicalName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data TargetSchemaViolation = TargetSchemaViolation+  { violationCode :: !Text,+    violationDetail :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | PostgreSQL evidence captured after provisioning and compared again under+-- cutover locks. The catalog snapshot is canonically rendered by the+-- application validator and intentionally remains opaque to Keiro.+data TargetSchemaEvidence = TargetSchemaEvidence+  { relationOid :: !Int64,+    observedShapeFingerprint :: !Text,+    observedPromotionObjects :: ![PromotionObjectName],+    catalogSnapshot :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data TargetProvisioningContext = TargetProvisioningContext+  { targetId :: !TargetId,+    generationId :: !TargetGenerationId,+    servingTable :: !QualifiedTable,+    stagingTable :: !QualifiedTable+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Application-owned schema provisioning and validation for one logical+-- target under one projection revision. A missing validator is representable+-- only so closed-world catalog validation can produce a stable diagnostic.+data TargetProvisioner = TargetProvisioner+  { provisionerId :: !Text,+    provisionerVersion :: !Int,+    schemaVersion :: !TargetSchemaVersion,+    expectedShapeId :: !Text,+    provisionTarget :: !(TargetProvisioningContext -> Tx.Transaction ()),+    validatorId :: !Text,+    validatorVersion :: !Int,+    validateTarget :: !(Maybe (TargetProvisioningContext -> Tx.Transaction (Either [TargetSchemaViolation] TargetSchemaEvidence))),+    promotionObjectNames :: ![PromotionObjectName]+  }+  deriving stock (Generic)++-- | The exact catalog delivery boundary implemented by one revision handler.+-- Revision selection may change physical SQL, but it must not turn an async+-- subscription effect into command-time work (or vice versa).+data RevisionLiveDelivery+  = RevisionInlineDelivery !ProjectionId !Text+  | RevisionSubscriptionDelivery !ProjectionId !SubscriptionId !DedupKeyId+  deriving stock (Eq, Ord, Show, Generic)++data RevisionLiveHandler = RevisionLiveHandler+  { handlerId :: !Text,+    handlerVersion :: !Int,+    delivery :: !RevisionLiveDelivery,+    requiredTargets :: ![TargetId],+    runRevisionLive :: !(PhysicalTargets -> RecordedEvent -> Tx.Transaction ())+  }+  deriving stock (Generic)++data RevisionReplayAdapter = RevisionReplayAdapter+  { adapterId :: !Text,+    adapterVersion :: !Int,+    requiredTargets :: ![TargetId],+    runRevisionReplay :: !(PhysicalTargets -> RecordedEvent -> Tx.Transaction (Either ReplayDecodeError Bool))+  }+  deriving stock (Generic)++data RevisionVerification = RevisionVerification+  { revisionVerificationId :: !Text,+    revisionVerificationVersion :: !Int,+    requiredTargets :: ![TargetId],+    runRevisionVerification :: !(PhysicalTargets -> Tx.Transaction (Either Text ()))+  }+  deriving stock (Generic)++-- | One target row-count observation returned by a stream-scoped clearer.+-- The runner requires exactly the targets declared by the policy so previews+-- and outcomes cannot silently omit a physical target.+data StreamClearCount = StreamClearCount+  { targetId :: !TargetId,+    clearedRows :: !Int64+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Application-owned row-per-stream repair policy for one projection under a+-- projection revision. Keiro owns the transaction, locks, history admission,+-- ordering, and deduplication backfill; the application owns row selection,+-- event decoding/application, and semantic verification.+data StreamScopedReplay = StreamScopedReplay+  { streamProjectionId :: !ProjectionId,+    streamOwnedTargets :: !(NonEmpty TargetId),+    clearerId :: !Text,+    clearerVersion :: !Int,+    clearStreamRows :: !(PhysicalTargets -> StreamName -> Tx.Transaction (Either Text [StreamClearCount])),+    streamReplayId :: !Text,+    streamReplayVersion :: !Int,+    replayStreamEvent :: !(PhysicalTargets -> RecordedEvent -> Tx.Transaction (Either ReplayDecodeError Bool)),+    streamVerificationId :: !Text,+    streamVerificationVersion :: !Int,+    verifyStreamRows :: !(PhysicalTargets -> StreamName -> Tx.Transaction (Either Text ())),+    affectedAsyncDedup :: ![DedupKeyId],+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++data ProjectionRevision = ProjectionRevision+  { revisionId :: !ProjectionRevisionId,+    rebuildGroup :: !RebuildGroupId,+    targetProvisioners :: !(Map TargetId TargetProvisioner),+    liveHandlers :: ![RevisionLiveHandler],+    replayAdapters :: ![RevisionReplayAdapter],+    revisionVerifications :: ![RevisionVerification],+    streamScopedReplays :: ![StreamScopedReplay],+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++-- | A fully qualified application-owned PostgreSQL function. Keiro quotes both+-- identifiers when generating a keyed wrapper and never accepts raw SQL here.+data QualifiedFunction = QualifiedFunction+  { functionSchema :: !Text,+    functionName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | A fully qualified PostgreSQL type used in a public function signature.+-- Keeping schema and type names separate lets the SQL generator quote them+-- independently instead of interpolating an unchecked type expression.+data QualifiedSqlType = QualifiedSqlType+  { typeSchema :: !Text,+    typeName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data SqlFunctionArgument = SqlFunctionArgument+  { argumentName :: !Text,+    argumentType :: !QualifiedSqlType+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | One versioned, privilege-enforced SQL read surface. The public function+-- name is derived from the contract identity and version so it cannot drift+-- from catalog identity. Keyed implementations remain application-owned;+-- Keiro owns only the guarded outer wrapper.+data ExternalReadContract+  = AllRowsExternalRead+      { readContractId :: !ExternalReadContractId,+        contractVersion :: !ExternalReadContractVersion,+        queryModelId :: !QueryModelId,+        resultContractType :: !QualifiedSqlType,+        resultShapeHash :: !Text,+        compatibleRevisions :: !(NonEmpty ProjectionRevisionId),+        surfaceGeneration :: !Int,+        claimSite :: !ClaimSite+      }+  | KeyedExternalRead+      { readContractId :: !ExternalReadContractId,+        contractVersion :: !ExternalReadContractVersion,+        queryModelId :: !QueryModelId,+        arguments :: ![SqlFunctionArgument],+        resultContractType :: !QualifiedSqlType,+        privateImplementation :: !QualifiedFunction,+        privateImplementationVersion :: !Int,+        resultShapeHash :: !Text,+        compatibleRevisions :: !(NonEmpty ProjectionRevisionId),+        surfaceGeneration :: !Int,+        claimSite :: !ClaimSite+      }+  deriving stock (Eq, Ord, Show, Generic)++-- | Stable public function name in @keiro_read@. Contract identifiers are+-- validated as lower-case SQL identifiers before this value reaches SQL.+externalReadFunctionName :: ExternalReadContract -> Text+externalReadFunctionName contract =+  externalReadContractIdText (contract ^. #readContractId)+    <> "_v"+    <> Text.pack (show (externalReadContractVersionValue (contract ^. #contractVersion)))++-- | How a target is prepared before replay. This is deliberately independent+-- from whether a projection handler is replay-safe.+data TargetResetPolicy+  = ClearBeforeReplay+  | PreserveAndReconcile+  deriving stock (Eq, Ord, Show, Generic)++data TargetDeclaration = TargetDeclaration+  { targetId :: !TargetId,+    qualifiedTable :: !QualifiedTable,+    resetPolicy :: !TargetResetPolicy,+    dependsOn :: ![TargetId],+    claimSite :: !ClaimSite+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | An application-owned, read-only proof run after replay and before+-- promotion. Identity and version are durable parts of the catalog contract;+-- the transaction closure is deliberately excluded from rendered inventory.+data RebuildVerification = RebuildVerification+  { verificationId :: !Text,+    verificationVersion :: !Text,+    verifyRebuild :: !(Tx.Transaction (Either Text ()))+  }+  deriving stock (Generic)++-- | Targets are listed in their declared deterministic preparation order.+-- Validation rejects an empty list, duplicates, unknown targets, and a list+-- inconsistent with target dependencies.+data RebuildGroupDeclaration = RebuildGroupDeclaration+  { rebuildGroupId :: !RebuildGroupId,+    orderedTargets :: ![TargetId],+    verificationHooks :: ![RebuildVerification],+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++data SourceScope+  = AllStreams+  | CategorySource !CategoryName+  deriving stock (Eq, Ord, Show, Generic)++-- | A source's codec fingerprint is stable application metadata, normally a+-- schema version plus the owning codec/fold identity. Function closures are+-- never included in catalog fingerprints.+data SourceDeclaration = SourceDeclaration+  { sourceId :: !SourceId,+    sourceScope :: !SourceScope,+    codecFingerprint :: !Text,+    claimSite :: !ClaimSite+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Catalog identity and startup lifecycle for one async subscription.+data SubscriptionDeclaration = SubscriptionDeclaration+  { subscriptionId :: !SubscriptionId,+    subscriptionName :: !Text,+    subscriptionSource :: !SourceId,+    -- | Kiroku policy used only when the exact durable member row is absent.+    checkpointOnMissing :: !MissingCheckpointPolicy,+    claimSite :: !ClaimSite+  }+  deriving stock (Eq, Show, Generic)++instance Ord SubscriptionDeclaration where+  compare left right =+    compare+      ( left ^. #subscriptionId,+        left ^. #subscriptionName,+        left ^. #subscriptionSource,+        missingCheckpointPolicyRank (left ^. #checkpointOnMissing),+        left ^. #claimSite+      )+      ( right ^. #subscriptionId,+        right ^. #subscriptionName,+        right ^. #subscriptionSource,+        missingCheckpointPolicyRank (right ^. #checkpointOnMissing),+        right ^. #claimSite+      )++-- | Stable runtime spelling used by fingerprints and operator reports.+missingCheckpointPolicyText :: MissingCheckpointPolicy -> Text+missingCheckpointPolicyText = \case+  FromBeginning -> "FromBeginning"+  FromCurrentHead -> "FromCurrentHead"+  FailIfMissing -> "FailIfMissing"++missingCheckpointPolicyRank :: MissingCheckpointPolicy -> Int+missingCheckpointPolicyRank = \case+  FromBeginning -> 0+  FromCurrentHead -> 1+  FailIfMissing -> 2++data DedupKeyDeclaration = DedupKeyDeclaration+  { dedupKeyId :: !DedupKeyId,+    dedupName :: !Text,+    claimSite :: !ClaimSite+  }+  deriving stock (Eq, Ord, Show, Generic)++data QueryModelBinding q r = QueryModelBinding+  { queryModelId :: !QueryModelId,+    readModel :: !(ReadModel q r),+    rebuildGroup :: !RebuildGroupId,+    observedTargets :: ![TargetId],+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++data SomeQueryModelBinding+  = forall q r. SomeQueryModelBinding (QueryModelBinding q r)++newtype LiveOnlyReason = LiveOnlyReason Text+  deriving stock (Eq, Ord, Show, Generic)++newtype ReplayDecodeError = ReplayDecodeError Text+  deriving stock (Eq, Ord, Show, Generic)++-- | A replay decoder is total over every event read from its declared source.+data ReplayDecodeResult event+  = ReplayIrrelevant+  | ReplayRelevant !event+  | ReplayDecodeFailure !ReplayDecodeError+  deriving stock (Eq, Show, Generic)++data ReplayAdapter event = ReplayAdapter+  { decodeForReplay :: !(RecordedEvent -> ReplayDecodeResult event),+    applyForReplay :: !(event -> RecordedEvent -> Tx.Transaction ())+  }+  deriving stock (Generic)++-- | Build a total replay adapter from the same authoritative codec used by the+-- event stream. Event types outside the codec are irrelevant; owned event types+-- that fail decoding are structured replay failures.+replayAdapterFromCodec ::+  Codec event ->+  (event -> RecordedEvent -> Tx.Transaction ()) ->+  ReplayAdapter event+replayAdapterFromCodec codec replayApply =+  ReplayAdapter+    { decodeForReplay = \recorded ->+        if recorded ^. #eventType `List.elem` NonEmpty.toList (codec ^. #eventTypes)+          then case decodeRecorded codec recorded of+            Left err -> ReplayDecodeFailure (ReplayDecodeError (Text.pack (show err)))+            Right event -> ReplayRelevant event+          else ReplayIrrelevant,+      applyForReplay = replayApply+    }++data ProjectionReplayPolicy event+  = Replayable !(ReplayAdapter event)+  | LiveOnly !LiveOnlyReason+  deriving stock (Generic)++-- | One projection definition may contain several explicitly ordered handlers.+-- This is composed ownership: the definition is still the single owner of all+-- its targets.+data ProjectionHandler event+  = InlineHandler !(InlineProjection event) !ClaimSite+  | AsyncHandler !AsyncProjection !SubscriptionId !DedupKeyId !ClaimSite+  deriving stock (Generic)++data ProjectionDefinition event = ProjectionDefinition+  { projectionId :: !ProjectionId,+    rebuildGroup :: !RebuildGroupId,+    ownedTargets :: !(NonEmpty TargetId),+    replayPolicy :: !(ProjectionReplayPolicy event),+    handlers :: !(NonEmpty (ProjectionHandler event)),+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++-- | A typed handle retained by the application. Passing this same value to+-- 'typedInlineProjections' preserves the event type without 'Typeable' casts.+data ProjectionSet event = ProjectionSet+  { projectionSource :: !SourceId,+    projectionDefinitions :: !(NonEmpty (ProjectionDefinition event)),+    claimSite :: !ClaimSite+  }+  deriving stock (Generic)++data SomeProjectionSet+  = forall event. SomeProjectionSet (ProjectionSet event)++data ProjectionCatalog = ProjectionCatalog+  { sources :: ![SourceDeclaration],+    targets :: ![TargetDeclaration],+    rebuildGroups :: ![RebuildGroupDeclaration],+    projectionRevisions :: ![ProjectionRevision],+    externalReadContracts :: ![ExternalReadContract],+    subscriptions :: ![SubscriptionDeclaration],+    dedupKeys :: ![DedupKeyDeclaration],+    queryModels :: ![SomeQueryModelBinding],+    projectionSets :: ![SomeProjectionSet]+  }+  deriving stock (Generic)++emptyProjectionCatalog :: ProjectionCatalog+emptyProjectionCatalog =+  ProjectionCatalog+    { sources = [],+      targets = [],+      rebuildGroups = [],+      projectionRevisions = [],+      externalReadContracts = [],+      subscriptions = [],+      dedupKeys = [],+      queryModels = [],+      projectionSets = []+    }++data Validation err value+  = Failure !err+  | Success !value+  deriving stock (Eq, Show, Generic)++data CatalogDiagnosticCode+  = DuplicateProjectionId+  | DuplicateProjectionRevisionId+  | DuplicateTargetId+  | DuplicateQualifiedTable+  | DuplicateRebuildGroupId+  | DuplicateSourceId+  | DuplicateQueryModelId+  | DuplicateQueryModelRegistryName+  | EmptyQueryObservedTargets+  | QueryModelWithoutSupplier+  | QueryModelWithMultipleSuppliers+  | QueryWaitWithoutCompatibleCursor+  | QueryWaitWithAmbiguousCursor+  | DuplicateSubscriptionId+  | DuplicateSubscriptionName+  | DuplicateDedupKeyId+  | DuplicateDedupName+  | DuplicateGroupTarget+  | UnknownSourceReference+  | UnknownTargetReference+  | UnknownGroupReference+  | UnknownTargetDependency+  | UnknownSubscriptionReference+  | UnknownDedupKeyReference+  | UnknownQueryModelReference+  | UnknownRevisionReference+  | UnknownTargetProvisioner+  | AsyncHandlerSubscriptionMismatch+  | AsyncHandlerDedupMismatch+  | TargetWithoutOwner+  | TargetWithMultipleOwners+  | ProjectionCrossesRebuildGroups+  | TargetDependencyCycle+  | TargetOrderViolatesDependency+  | EmptyRebuildGroup+  | QueryModelOutsideRebuildGroup+  | ClearTargetRequiresReplayableOwner+  | ReplayableClearTargetStartsAtCurrentHead+  | MixedResetGroupRequiresReplayAdapter+  | AmbiguousSourceOrdering+  | DuplicateRebuildVerificationId+  | InvalidRebuildVerificationIdentity+  | ProjectionRevisionWithoutLiveHandler+  | ProjectionRevisionWithoutReplayAdapter+  | ProjectionRevisionTargetSetDrift+  | ProjectionRevisionMissingSchemaValidation+  | ProjectionRevisionPhysicalTargetsNotTotal+  | ProjectionRevisionLiveCapabilityMismatch+  | ProjectionRevisionLiveTargetOwnershipMismatch+  | InvalidProjectionRevisionIdentity+  | DuplicateExternalReadContractVersion+  | DuplicateExternalReadFunctionName+  | UnknownExternalReadQueryModel+  | ExternalReadShapeMismatch+  | ExternalReadRevisionOwnershipMismatch+  | InvalidExternalReadContractIdentity+  | InvalidExternalReadSqlIdentifier+  | InvalidExternalReadSqlType+  | ExternalReadImplementationCollision+  | ExternalReadSurfaceGenerationRegression+  | ExternalReadImmutableSignatureDrift+  | DuplicateStreamScopedReplayProjection+  | UnknownStreamScopedReplayProjection+  | StreamScopedReplayGroupMismatch+  | StreamScopedReplayTargetSetMismatch+  | StreamScopedReplayDedupMismatch+  | InvalidStreamScopedReplayIdentity+  deriving stock (Eq, Ord, Show, Enum, Bounded, Generic)++diagnosticCodeText :: CatalogDiagnosticCode -> Text+diagnosticCodeText = \case+  DuplicateProjectionId -> "catalog.duplicate-projection-id"+  DuplicateProjectionRevisionId -> "catalog.duplicate-projection-revision-id"+  DuplicateTargetId -> "catalog.duplicate-target-id"+  DuplicateQualifiedTable -> "catalog.duplicate-qualified-table"+  DuplicateRebuildGroupId -> "catalog.duplicate-rebuild-group-id"+  DuplicateSourceId -> "catalog.duplicate-source-id"+  DuplicateQueryModelId -> "catalog.duplicate-query-model-id"+  DuplicateQueryModelRegistryName -> "catalog.duplicate-query-model-registry-name"+  EmptyQueryObservedTargets -> "catalog.query-model-empty-observed-targets"+  QueryModelWithoutSupplier -> "catalog.query-model-without-supplier"+  QueryModelWithMultipleSuppliers -> "catalog.query-model-with-multiple-suppliers"+  QueryWaitWithoutCompatibleCursor -> "catalog.query-wait-without-compatible-cursor"+  QueryWaitWithAmbiguousCursor -> "catalog.query-wait-with-ambiguous-cursor"+  DuplicateSubscriptionId -> "catalog.duplicate-subscription-id"+  DuplicateSubscriptionName -> "catalog.duplicate-subscription-name"+  DuplicateDedupKeyId -> "catalog.duplicate-dedup-key-id"+  DuplicateDedupName -> "catalog.duplicate-dedup-name"+  DuplicateGroupTarget -> "catalog.duplicate-group-target"+  UnknownSourceReference -> "catalog.unknown-source-reference"+  UnknownTargetReference -> "catalog.unknown-target-reference"+  UnknownGroupReference -> "catalog.unknown-group-reference"+  UnknownTargetDependency -> "catalog.unknown-target-dependency"+  UnknownSubscriptionReference -> "catalog.unknown-subscription-reference"+  UnknownDedupKeyReference -> "catalog.unknown-dedup-key-reference"+  UnknownQueryModelReference -> "catalog.unknown-query-model-reference"+  UnknownRevisionReference -> "catalog.unknown-revision-reference"+  UnknownTargetProvisioner -> "catalog.unknown-target-provisioner"+  AsyncHandlerSubscriptionMismatch -> "catalog.async-handler-subscription-mismatch"+  AsyncHandlerDedupMismatch -> "catalog.async-handler-dedup-mismatch"+  TargetWithoutOwner -> "catalog.target-without-owner"+  TargetWithMultipleOwners -> "catalog.target-with-multiple-owners"+  ProjectionCrossesRebuildGroups -> "catalog.projection-crosses-rebuild-groups"+  TargetDependencyCycle -> "catalog.target-dependency-cycle"+  TargetOrderViolatesDependency -> "catalog.target-order-violates-dependency"+  EmptyRebuildGroup -> "catalog.empty-rebuild-group"+  QueryModelOutsideRebuildGroup -> "catalog.query-model-outside-rebuild-group"+  ClearTargetRequiresReplayableOwner -> "catalog.clear-target-requires-replayable-owner"+  ReplayableClearTargetStartsAtCurrentHead -> "catalog.replayable-clear-target-starts-at-current-head"+  MixedResetGroupRequiresReplayAdapter -> "catalog.mixed-reset-group-requires-replay-adapter"+  AmbiguousSourceOrdering -> "catalog.ambiguous-source-ordering"+  DuplicateRebuildVerificationId -> "catalog.duplicate-rebuild-verification-id"+  InvalidRebuildVerificationIdentity -> "catalog.invalid-rebuild-verification-identity"+  ProjectionRevisionWithoutLiveHandler -> "catalog.projection-revision-without-live-handler"+  ProjectionRevisionWithoutReplayAdapter -> "catalog.projection-revision-without-replay-adapter"+  ProjectionRevisionTargetSetDrift -> "catalog.projection-revision-target-set-drift"+  ProjectionRevisionMissingSchemaValidation -> "catalog.projection-revision-missing-schema-validation"+  ProjectionRevisionPhysicalTargetsNotTotal -> "catalog.projection-revision-physical-targets-not-total"+  ProjectionRevisionLiveCapabilityMismatch -> "catalog.projection-revision-live-capability-mismatch"+  ProjectionRevisionLiveTargetOwnershipMismatch -> "catalog.projection-revision-live-target-ownership-mismatch"+  InvalidProjectionRevisionIdentity -> "catalog.invalid-projection-revision-identity"+  DuplicateExternalReadContractVersion -> "catalog.external-read-duplicate-contract-version"+  DuplicateExternalReadFunctionName -> "catalog.external-read-duplicate-function-name"+  UnknownExternalReadQueryModel -> "catalog.external-read-unknown-query-model"+  ExternalReadShapeMismatch -> "catalog.external-read-shape-mismatch"+  ExternalReadRevisionOwnershipMismatch -> "catalog.external-read-revision-ownership-mismatch"+  InvalidExternalReadContractIdentity -> "catalog.external-read-invalid-contract-identity"+  InvalidExternalReadSqlIdentifier -> "catalog.external-read-invalid-sql-identifier"+  InvalidExternalReadSqlType -> "catalog.external-read-invalid-sql-type"+  ExternalReadImplementationCollision -> "catalog.external-read-implementation-collision"+  ExternalReadSurfaceGenerationRegression -> "catalog.external-read-surface-generation-regression"+  ExternalReadImmutableSignatureDrift -> "catalog.external-read-immutable-signature-drift"+  DuplicateStreamScopedReplayProjection -> "catalog.stream-replay-duplicate-projection"+  UnknownStreamScopedReplayProjection -> "catalog.stream-replay-unknown-projection"+  StreamScopedReplayGroupMismatch -> "catalog.stream-replay-group-mismatch"+  StreamScopedReplayTargetSetMismatch -> "catalog.stream-replay-target-set-mismatch"+  StreamScopedReplayDedupMismatch -> "catalog.stream-replay-dedup-mismatch"+  InvalidStreamScopedReplayIdentity -> "catalog.stream-replay-invalid-identity"++data CatalogDiagnostic = CatalogDiagnostic+  { diagnosticCode :: !CatalogDiagnosticCode,+    diagnosticIdentity :: !Text,+    diagnosticSites :: ![ClaimSite],+    diagnosticMessage :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventorySource = InventorySource+  { sourceId :: !SourceId,+    sourceScope :: !SourceScope,+    codecFingerprint :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryTarget = InventoryTarget+  { targetId :: !TargetId,+    qualifiedTable :: !QualifiedTable,+    resetPolicy :: !TargetResetPolicy,+    dependsOn :: ![TargetId],+    owner :: !ProjectionId+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryGroup = InventoryGroup+  { rebuildGroupId :: !RebuildGroupId,+    orderedTargets :: ![TargetId],+    verifications :: ![(Text, Text)]+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryHandler+  = InventoryInlineHandler !Text+  | InventoryAsyncHandler !Text !SubscriptionId !DedupKeyId+  deriving stock (Eq, Ord, Show, Generic)++data InventoryProjection = InventoryProjection+  { projectionId :: !ProjectionId,+    sourceId :: !SourceId,+    rebuildGroupId :: !RebuildGroupId,+    ownedTargets :: ![TargetId],+    replayDisposition :: !Text,+    handlers :: ![InventoryHandler]+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryTargetProvisioner = InventoryTargetProvisioner+  { targetId :: !TargetId,+    provisionerId :: !Text,+    provisionerVersion :: !Int,+    schemaVersion :: !TargetSchemaVersion,+    expectedShapeId :: !Text,+    validatorId :: !Text,+    validatorVersion :: !Int,+    promotionObjectNames :: ![PromotionObjectName]+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryRevisionHandler = InventoryRevisionHandler+  { handlerId :: !Text,+    handlerVersion :: !Int,+    delivery :: !(Maybe RevisionLiveDelivery),+    requiredTargets :: ![TargetId]+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryStreamScopedReplay = InventoryStreamScopedReplay+  { projectionId :: !ProjectionId,+    ownedTargets :: ![TargetId],+    clearerId :: !Text,+    clearerVersion :: !Int,+    replayId :: !Text,+    replayVersion :: !Int,+    verificationId :: !Text,+    verificationVersion :: !Int,+    affectedAsyncDedup :: ![DedupKeyId]+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryProjectionRevision = InventoryProjectionRevision+  { revisionId :: !ProjectionRevisionId,+    rebuildGroupId :: !RebuildGroupId,+    targetProvisioners :: ![InventoryTargetProvisioner],+    liveHandlers :: ![InventoryRevisionHandler],+    replayAdapters :: ![InventoryRevisionHandler],+    verifications :: ![InventoryRevisionHandler],+    streamScopedReplays :: ![InventoryStreamScopedReplay]+  }+  deriving stock (Eq, Ord, Show, Generic)++data ExternalReadContractKind+  = InventoryAllRowsExternalRead+  | InventoryKeyedExternalRead+  deriving stock (Eq, Ord, Show, Generic)++data InventoryExternalReadContract = InventoryExternalReadContract+  { readContractId :: !ExternalReadContractId,+    contractVersion :: !ExternalReadContractVersion,+    queryModelId :: !QueryModelId,+    rebuildGroupId :: !RebuildGroupId,+    functionName :: !Text,+    contractKind :: !ExternalReadContractKind,+    arguments :: ![SqlFunctionArgument],+    resultContractType :: !QualifiedSqlType,+    privateImplementation :: !(Maybe QualifiedFunction),+    privateImplementationVersion :: !(Maybe Int),+    resultShapeHash :: !Text,+    compatibleRevisions :: !(NonEmpty ProjectionRevisionId),+    surfaceGeneration :: !Int+  }+  deriving stock (Eq, Ord, Show, Generic)++data InventoryQueryModel = InventoryQueryModel+  { queryModelId :: !QueryModelId,+    registryName :: !Text,+    version :: !Int,+    shapeHash :: !Text,+    rebuildGroupId :: !RebuildGroupId,+    observedTargets :: ![TargetId],+    freshness :: !InventoryQueryFreshness,+    cursor :: !(Maybe InventoryQueryCursor)+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Canonical query freshness. Position targets and polling durations are+-- per-call execution data, so the catalog records only the position-wait kind.+data InventoryQueryFreshness+  = InventoryImmediate+  | InventoryWaitForHead !HeadScope+  | InventoryWaitForPosition+  deriving stock (Eq, Ord, Show, Generic)++-- | The one durable cursor derived from the supplying projection, when that+-- projection exposes exactly one compatible subscription authority.+data InventoryQueryCursor = InventoryQueryCursor+  { subscriptionId :: !SubscriptionId,+    subscriptionName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Operator-visible subscription identity, source, and absent-row policy.+data InventorySubscription = InventorySubscription+  { subscriptionId :: !SubscriptionId,+    subscriptionName :: !Text,+    sourceId :: !SourceId,+    checkpointOnMissing :: !MissingCheckpointPolicy+  }+  deriving stock (Eq, Show, Generic)++instance Ord InventorySubscription where+  compare left right =+    compare+      ( left ^. #subscriptionId,+        left ^. #subscriptionName,+        left ^. #sourceId,+        missingCheckpointPolicyRank (left ^. #checkpointOnMissing)+      )+      ( right ^. #subscriptionId,+        right ^. #subscriptionName,+        right ^. #sourceId,+        missingCheckpointPolicyRank (right ^. #checkpointOnMissing)+      )++data InventoryDedupKey = InventoryDedupKey+  { dedupKeyId :: !DedupKeyId,+    dedupName :: !Text+  }+  deriving stock (Eq, Ord, Show, Generic)++data CatalogInventory = CatalogInventory+  { inventorySources :: ![InventorySource],+    inventoryTargets :: ![InventoryTarget],+    inventoryGroups :: ![InventoryGroup],+    inventoryProjections :: ![InventoryProjection],+    inventoryProjectionRevisions :: ![InventoryProjectionRevision],+    inventoryExternalReadContracts :: ![InventoryExternalReadContract],+    inventoryQueryModels :: ![InventoryQueryModel],+    inventorySubscriptions :: ![InventorySubscription],+    inventoryDedupKeys :: ![InventoryDedupKey]+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | One live-handler capability retained by the supplying projection. This+-- normalized view contains identities and policies only; executable closures+-- stay in the original typed catalog.+data ProjectionHandlerCapability+  = InlineCapability+      { capabilityHandlerName :: !Text+      }+  | SubscriptionCapability+      { capabilityHandlerName :: !Text,+        capabilitySubscriptionId :: !SubscriptionId,+        capabilitySubscriptionName :: !Text,+        capabilitySourceId :: !SourceId,+        capabilityCheckpointOnMissing :: !MissingCheckpointPolicy,+        capabilityDedupKeyId :: !DedupKeyId,+        capabilityDedupName :: !Text+      }+  deriving stock (Eq, Show, Generic)++-- | The single catalog projection that supplies a typed query model. Target+-- ownership is authoritative: all observed targets must resolve to this owner+-- in the same rebuild group before validation succeeds.+data ResolvedQuerySupply = ResolvedQuerySupply+  { resolvedQueryModelId :: !QueryModelId,+    resolvedProjectionId :: !ProjectionId,+    resolvedRebuildGroupId :: !RebuildGroupId,+    resolvedObservedTargets :: !(NonEmpty TargetId),+    resolvedSourceId :: !SourceId,+    resolvedHandlerCapabilities :: !(NonEmpty ProjectionHandlerCapability),+    resolvedQueryFreshness :: !InventoryQueryFreshness,+    resolvedQueryCursor :: !(Maybe InventoryQueryCursor)+  }+  deriving stock (Eq, Show, Generic)++newtype CatalogFingerprint = CatalogFingerprint Text+  deriving stock (Eq, Ord, Show, Generic)++catalogFingerprintText :: CatalogFingerprint -> Text+catalogFingerprintText (CatalogFingerprint value) = value++-- | Identity of the catalog facts owned by one rebuild group.+newtype GroupSliceFingerprint = GroupSliceFingerprint Text+  deriving stock (Eq, Ord, Show, Generic)++groupSliceFingerprintText :: GroupSliceFingerprint -> Text+groupSliceFingerprintText (GroupSliceFingerprint value) = value++data ValidatedProjectionCatalog = ValidatedProjectionCatalog+  { originalCatalog :: !ProjectionCatalog,+    validatedInventory :: !CatalogInventory,+    validatedFingerprint :: !CatalogFingerprint,+    projectionFacts :: ![ProjectionFacts],+    validatedQuerySupplies :: ![ResolvedQuerySupply],+    validatedProjectionIdsBySource :: !(Map SourceId (Set.Set ProjectionId)),+    validatedRevisionIndex :: !(Map ProjectionRevisionId ProjectionRevision),+    validatedRevisionLiveHandlerIndex :: !(Map (ProjectionRevisionId, RevisionLiveDelivery) RevisionLiveHandler),+    validatedAsyncRegistrations :: ![AsyncProjectionRegistration]+  }+  deriving stock (Generic)++data CatalogEvolution+  = SourceRemoved !SourceId+  | TargetRemoved !TargetId+  | RebuildGroupRemoved !RebuildGroupId+  | ProjectionRemoved !ProjectionId+  | ProjectionRevisionRemoved !ProjectionRevisionId+  | ExternalReadContractRemoved !ExternalReadContractId !ExternalReadContractVersion+  | QueryModelRemoved !QueryModelId+  | SubscriptionRemoved !SubscriptionId+  | DedupKeyRemoved !DedupKeyId+  | TargetOwnerChanged !TargetId !ProjectionId !ProjectionId+  | TargetGroupChanged !TargetId !RebuildGroupId !RebuildGroupId+  deriving stock (Eq, Ord, Show, Generic)++data CatalogRegistration = CatalogRegistration+  { queryModelId :: !QueryModelId,+    registryName :: !Text,+    version :: !Int,+    shapeHash :: !Text,+    rebuildGroupId :: !RebuildGroupId+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | Runtime async registration projected from a validated catalog.+data AsyncProjectionRegistration = AsyncProjectionRegistration+  { projectionId :: !ProjectionId,+    projectionName :: !Text,+    subscriptionId :: !SubscriptionId,+    subscriptionName :: !Text,+    checkpointOnMissing :: !MissingCheckpointPolicy,+    dedupKeyId :: !DedupKeyId,+    dedupName :: !Text+  }+  deriving stock (Eq, Show, Generic)++instance Ord AsyncProjectionRegistration where+  compare left right =+    compare+      ( left ^. #projectionId,+        left ^. #projectionName,+        left ^. #subscriptionId,+        left ^. #subscriptionName,+        missingCheckpointPolicyRank (left ^. #checkpointOnMissing),+        left ^. #dedupKeyId,+        left ^. #dedupName+      )+      ( right ^. #projectionId,+        right ^. #projectionName,+        right ^. #subscriptionId,+        right ^. #subscriptionName,+        missingCheckpointPolicyRank (right ^. #checkpointOnMissing),+        right ^. #dedupKeyId,+        right ^. #dedupName+      )++-- | One replayable async handler's redelivery identity. Promotion uses this+-- to re-seed dedup rows and advance the declared checkpoint for one rebuild+-- group. Membership matches rebuild preparation: every replayable definition+-- in the group, independent of target reset policy. Plan 256 consumes this+-- same view for versioned cutover.+data CatalogAsyncDedupSpec = CatalogAsyncDedupSpec+  { specDedupKeyId :: !DedupKeyId,+    specSubscriptionName :: !Text,+    specDedupName :: !Text,+    specSourceId :: !SourceId,+    specSourceScope :: !SourceScope,+    specIdempotencyKey :: !(RecordedEvent -> EventId)+  }+  deriving stock (Generic)++data ReplayAdapterMetadata = ReplayAdapterMetadata+  { projectionId :: !ProjectionId,+    sourceId :: !SourceId,+    rebuildGroupId :: !RebuildGroupId,+    replayable :: !Bool+  }+  deriving stock (Eq, Ord, Show, Generic)++-- | One existential replay closure in deterministic catalog order. The event+-- type stays sealed inside this value, so the runner can route raw history+-- without weakening the typed live projection API.+data CatalogReplayAdapter+  = forall event.+    CatalogReplayAdapter+      !ProjectionId+      !SourceId+      !RebuildGroupId+      !Int+      !(ReplayAdapter event)++catalogReplayAdapterProjectionId :: CatalogReplayAdapter -> ProjectionId+catalogReplayAdapterProjectionId (CatalogReplayAdapter projectionId _ _ _ _) = projectionId++catalogReplayAdapterSourceId :: CatalogReplayAdapter -> SourceId+catalogReplayAdapterSourceId (CatalogReplayAdapter _ sourceId _ _ _) = sourceId++catalogReplayAdapterGroupId :: CatalogReplayAdapter -> RebuildGroupId+catalogReplayAdapterGroupId (CatalogReplayAdapter _ _ groupId _ _) = groupId++catalogReplayAdapterOrder :: CatalogReplayAdapter -> Int+catalogReplayAdapterOrder (CatalogReplayAdapter _ _ _ adapterOrder _) = adapterOrder++-- | Evaluate a raw event through one total adapter. @Right False@ is an+-- irrelevant event; @Right True@ means the replay transaction applied it.+runCatalogReplayAdapter ::+  CatalogReplayAdapter ->+  RecordedEvent ->+  Tx.Transaction (Either ReplayDecodeError Bool)+runCatalogReplayAdapter (CatalogReplayAdapter _ _ _ _ adapter) recorded =+  case (adapter ^. #decodeForReplay) recorded of+    ReplayIrrelevant -> pure (Right False)+    ReplayRelevant event -> do+      (adapter ^. #applyForReplay) event recorded+      pure (Right True)+    ReplayDecodeFailure decodeError -> pure (Left decodeError)++data ProjectionFacts = ProjectionFacts+  { factProjectionId :: !ProjectionId,+    factSourceId :: !SourceId,+    factGroupId :: !RebuildGroupId,+    factTargets :: ![TargetId],+    factReplayable :: !Bool,+    factHandlers :: ![HandlerFacts],+    factSite :: !ClaimSite+  }++data HandlerFacts+  = InlineFacts !Text !ClaimSite+  | AsyncFacts !Text !Text !Text !SubscriptionId !DedupKeyId !ClaimSite++data QueryFacts = QueryFacts+  { factQueryModelId :: !QueryModelId,+    factRegistryName :: !Text,+    factVersion :: !Int,+    factShapeHash :: !Text,+    factQueryGroup :: !RebuildGroupId,+    factObservedTargets :: ![TargetId],+    factQueryFreshness :: !QueryFreshness,+    factQuerySite :: !ClaimSite+  }++validateProjectionCatalog ::+  ProjectionCatalog ->+  Validation (NonEmpty CatalogDiagnostic) ValidatedProjectionCatalog+validateProjectionCatalog catalog =+  case NonEmpty.nonEmpty diagnostics of+    Just errors -> Failure errors+    Nothing ->+      let inventory = buildInventory catalog facts queryFacts+          querySupplies = buildResolvedQuerySupplies inventory+          projectionIdsBySource =+            Map.fromListWith+              Set.union+              [ (factSourceId fact, Set.singleton (factProjectionId fact))+              | fact <- facts+              ]+       in Success+            ValidatedProjectionCatalog+              { originalCatalog = catalog,+                validatedInventory = inventory,+                validatedFingerprint = fingerprintInventory inventory,+                projectionFacts = facts,+                validatedQuerySupplies = querySupplies,+                validatedProjectionIdsBySource = projectionIdsBySource,+                validatedRevisionIndex =+                  Map.fromList+                    [ (revision ^. #revisionId, revision)+                    | revision <- catalog ^. #projectionRevisions+                    ],+                validatedRevisionLiveHandlerIndex =+                  Map.fromList+                    [ ((revision ^. #revisionId, handler ^. #delivery), handler)+                    | revision <- catalog ^. #projectionRevisions,+                      handler <- revision ^. #liveHandlers+                    ],+                validatedAsyncRegistrations = deriveAsyncProjectionRegistrations facts inventory+              }+  where+    facts = collectProjectionFacts (catalog ^. #projectionSets)+    queryFacts = collectQueryFacts (catalog ^. #queryModels)+    diagnostics =+      List.sort+        ( duplicateDiagnostics catalog facts queryFacts+            <> referenceDiagnostics catalog facts queryFacts+            <> ownershipDiagnostics catalog facts+            <> groupDiagnostics catalog facts queryFacts+            <> querySupplyDiagnostics catalog facts queryFacts+            <> queryFreshnessDiagnostics catalog facts queryFacts+            <> replayDiagnostics catalog facts+            <> sourceOrderingDiagnostics catalog facts+            <> verificationDiagnostics catalog+            <> projectionRevisionDiagnostics catalog facts+            <> streamScopedReplayDiagnostics catalog facts+            <> externalReadContractDiagnostics catalog queryFacts+        )++-- | Validate and invoke a consumer only on success. This is the pure boundary+-- used by startup code to ensure invalid catalogs trigger no registration or+-- rebuild callback.+useProjectionCatalog ::+  ProjectionCatalog ->+  (ValidatedProjectionCatalog -> result) ->+  Validation (NonEmpty CatalogDiagnostic) result+useProjectionCatalog catalog consume =+  case validateProjectionCatalog catalog of+    Failure errors -> Failure errors+    Success validated -> Success (consume validated)++-- | Monadic form of 'useProjectionCatalog'. The callback is not evaluated when+-- validation fails, so startup registration and rebuild effects stay behind the+-- validated boundary.+useProjectionCatalogM ::+  (Monad effect) =>+  ProjectionCatalog ->+  (ValidatedProjectionCatalog -> effect result) ->+  effect (Validation (NonEmpty CatalogDiagnostic) result)+useProjectionCatalogM catalog consume =+  case validateProjectionCatalog catalog of+    Failure errors -> pure (Failure errors)+    Success validated -> Success <$> consume validated++typedInlineProjections ::+  ValidatedProjectionCatalog ->+  ProjectionSet event ->+  [InlineProjection event]+typedInlineProjections validated projectionSet+  | projectionSetBelongs validated projectionSet =+      [ projection+      | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions),+        handler <- NonEmpty.toList (definition ^. #handlers),+        InlineHandler projection _ <- [handler]+      ]+  | otherwise = []++-- | Typed compatibility handlers owned by one rebuild group. Revision-aware+-- writers use this only for a legacy group; version-managed groups dispatch+-- through the selected 'RevisionLiveHandler' instead.+typedInlineProjectionsForGroup ::+  ValidatedProjectionCatalog ->+  ProjectionSet event ->+  RebuildGroupId ->+  [InlineProjection event]+typedInlineProjectionsForGroup validated projectionSet wantedGroup+  | projectionSetBelongs validated projectionSet =+      [ projection+      | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions),+        definition ^. #rebuildGroup == wantedGroup,+        handler <- NonEmpty.toList (definition ^. #handlers),+        InlineHandler projection _ <- [handler]+      ]+  | otherwise = []++-- | Distinct rebuild groups touched by the same validated typed source handle,+-- in stable lock order. A handle that does not belong to this catalog yields no+-- groups, matching 'typedInlineProjections'.+typedProjectionRebuildGroups ::+  ValidatedProjectionCatalog ->+  ProjectionSet event ->+  [RebuildGroupId]+typedProjectionRebuildGroups validated projectionSet+  | projectionSetBelongs validated projectionSet =+      List.sort+        . Set.toList+        . Set.fromList+        $ [ definition ^. #rebuildGroup+          | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions)+          ]+  | otherwise = []++-- | Resolve one validated async handler to the group whose fence it must lock.+-- Both the stable projection ID and the existing physical projection name must+-- match, preventing a caller from pairing catalog metadata with another+-- handler closure.+asyncProjectionRebuildGroup ::+  ValidatedProjectionCatalog ->+  ProjectionId ->+  Text ->+  Maybe RebuildGroupId+asyncProjectionRebuildGroup validated wantedProjectionId wantedProjectionName = do+  registration <-+    List.find+      ( \entry ->+          entry ^. #projectionId == wantedProjectionId+            && entry ^. #projectionName == wantedProjectionName+      )+      (asyncProjectionRegistrations validated)+  projection <-+    List.find+      ((== registration ^. #projectionId) . (^. #projectionId))+      (validated ^. #validatedInventory . #inventoryProjections)+  pure (projection ^. #rebuildGroupId)++-- | Resolve every query model to its sole projection owner. Results are sorted+-- by query-model identity and are available only after whole-catalog+-- validation has established the ownership and rebuild-group invariants.+resolvedQuerySupplies :: ValidatedProjectionCatalog -> [ResolvedQuerySupply]+resolvedQuerySupplies = validatedQuerySupplies++projectionSetBelongs ::+  ValidatedProjectionCatalog ->+  ProjectionSet event ->+  Bool+projectionSetBelongs validated projectionSet =+  expectedIds `Set.isSubsetOf` validatedIds+  where+    expectedIds =+      Set.fromList+        [ definition ^. #projectionId+        | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions)+        ]+    validatedIds =+      Map.findWithDefault+        Set.empty+        (projectionSet ^. #projectionSource)+        (validated ^. #validatedProjectionIdsBySource)++catalogInventory :: ValidatedProjectionCatalog -> CatalogInventory+catalogInventory = validatedInventory++catalogFingerprint :: ValidatedProjectionCatalog -> CatalogFingerprint+catalogFingerprint = validatedFingerprint++-- | Fingerprint the catalog facts that preparation, replay, promotion, and+-- query transitions for one rebuild group depend on. Unrelated catalog slices+-- do not affect this identity.+groupSliceFingerprint ::+  ValidatedProjectionCatalog ->+  RebuildGroupId ->+  Maybe GroupSliceFingerprint+groupSliceFingerprint validated wantedGroup = do+  group <- List.find ((== wantedGroup) . (^. #rebuildGroupId)) (inventory ^. #inventoryGroups)+  pure+    . GroupSliceFingerprint+    . hashPreimage "slice-v6"+    $ PRecord+      "keiro/catalog-group-slice/v6"+      [ PText (rebuildGroupIdText wantedGroup),+        groupPreimage group,+        PList (targetPreimage <$> targets),+        PList (projectionPreimage <$> projections),+        PList (projectionRevisionPreimage <$> revisions),+        PList (externalReadContractPreimage <$> externalReadContracts),+        PList (sourcePreimage <$> sources),+        PList (queryPreimage <$> queries),+        PList (subscriptionPreimage <$> subscriptions),+        PList (dedupPreimage <$> dedupKeys)+      ]+  where+    inventory = catalogInventory validated+    groupTargets = maybe [] (^. #orderedTargets) $ List.find ((== wantedGroup) . (^. #rebuildGroupId)) (inventory ^. #inventoryGroups)+    targets =+      mapMaybe+        (\wanted -> List.find ((== wanted) . (^. #targetId)) (inventory ^. #inventoryTargets))+        groupTargets+    projections =+      filter+        ((== wantedGroup) . (^. #rebuildGroupId))+        (inventory ^. #inventoryProjections)+    revisions =+      filter+        ((== wantedGroup) . (^. #rebuildGroupId))+        (inventory ^. #inventoryProjectionRevisions)+    externalReadContracts =+      filter+        ((== wantedGroup) . (^. #rebuildGroupId))+        (inventory ^. #inventoryExternalReadContracts)+    sourceIds = Set.fromList (map (^. #sourceId) projections)+    sources = filter ((`Set.member` sourceIds) . (^. #sourceId)) (inventory ^. #inventorySources)+    queries =+      filter+        ((== wantedGroup) . (^. #rebuildGroupId))+        (inventory ^. #inventoryQueryModels)+    asyncHandlers =+      [ (subscriptionId, dedupId)+      | projection <- projections,+        InventoryAsyncHandler _ subscriptionId dedupId <- projection ^. #handlers+      ]+    subscriptionIds = Set.fromList (map fst asyncHandlers)+    dedupIds = Set.fromList (map snd asyncHandlers)+    subscriptions =+      filter+        ((`Set.member` subscriptionIds) . (^. #subscriptionId))+        (inventory ^. #inventorySubscriptions)+    dedupKeys =+      filter+        ((`Set.member` dedupIds) . (^. #dedupKeyId))+        (inventory ^. #inventoryDedupKeys)++catalogRegistrations :: ValidatedProjectionCatalog -> [CatalogRegistration]+catalogRegistrations validated =+  [ CatalogRegistration+      { queryModelId = binding ^. #queryModelId,+        registryName = binding ^. #registryName,+        version = binding ^. #version,+        shapeHash = binding ^. #shapeHash,+        rebuildGroupId = binding ^. #rebuildGroupId+      }+  | binding <- validated ^. #validatedInventory . #inventoryQueryModels+  ]++-- | Executable revision contracts from the validated catalog. Declaration+-- order is preserved; callers that need one identity should use+-- 'catalogProjectionRevision'.+catalogProjectionRevisions :: ValidatedProjectionCatalog -> [ProjectionRevision]+catalogProjectionRevisions validated =+  validated ^. #originalCatalog . #projectionRevisions++catalogProjectionRevision ::+  ValidatedProjectionCatalog ->+  ProjectionRevisionId ->+  Maybe ProjectionRevision+catalogProjectionRevision validated wanted =+  Map.lookup wanted (validated ^. #validatedRevisionIndex)++catalogRevisionLiveHandler ::+  ValidatedProjectionCatalog ->+  ProjectionRevisionId ->+  RevisionLiveDelivery ->+  Maybe RevisionLiveHandler+catalogRevisionLiveHandler validated revisionId delivery =+  Map.lookup+    (revisionId, delivery)+    (validated ^. #validatedRevisionLiveHandlerIndex)++-- | Resolve one validated stream-scoped policy from the exact projection+-- revision that currently serves a group.+catalogStreamScopedReplay ::+  ValidatedProjectionCatalog ->+  ProjectionRevisionId ->+  ProjectionId ->+  Maybe StreamScopedReplay+catalogStreamScopedReplay validated revisionId wantedProjection = do+  revision <- catalogProjectionRevision validated revisionId+  List.find+    ((== wantedProjection) . (^. #streamProjectionId))+    (revision ^. #streamScopedReplays)++-- | Runtime declarations retained behind the validated boundary. Results are+-- sorted so registration is independent of source declaration order.+catalogExternalReadContracts :: ValidatedProjectionCatalog -> [ExternalReadContract]+catalogExternalReadContracts validated =+  List.sort (validated ^. #originalCatalog . #externalReadContracts)++asyncProjectionRegistrations ::+  ValidatedProjectionCatalog ->+  [AsyncProjectionRegistration]+asyncProjectionRegistrations = validatedAsyncRegistrations++deriveAsyncProjectionRegistrations ::+  [ProjectionFacts] ->+  CatalogInventory ->+  [AsyncProjectionRegistration]+deriveAsyncProjectionRegistrations facts inventory =+  List.sort+    [ AsyncProjectionRegistration+        { projectionId = factProjectionId projection,+          projectionName = projectionName,+          subscriptionId = subscriptionId,+          subscriptionName = subscription ^. #subscriptionName,+          checkpointOnMissing = subscription ^. #checkpointOnMissing,+          dedupKeyId = dedupKeyId,+          dedupName = dedupNameFor dedupKeyId+        }+    | projection <- facts,+      AsyncFacts projectionName _ _ subscriptionId dedupKeyId _ <- factHandlers projection,+      Just subscription <- [subscriptionFor subscriptionId]+    ]+  where+    subscriptionFor ref =+      List.find ((== ref) . (^. #subscriptionId)) (inventory ^. #inventorySubscriptions)+    dedupNameFor ref =+      fromMaybe+        ""+        ( List.lookup+            ref+            [ (entry ^. #dedupKeyId, entry ^. #dedupName)+            | entry <- inventory ^. #inventoryDedupKeys+            ]+        )++-- | Redelivery identities for replayable async definitions in one group,+-- preserving projection-set, definition, and handler declaration order.+catalogAsyncIdempotencyKeys ::+  ValidatedProjectionCatalog ->+  RebuildGroupId ->+  [CatalogAsyncDedupSpec]+catalogAsyncIdempotencyKeys validated wantedGroup =+  concatMap specsForSet (validated ^. #originalCatalog . #projectionSets)+  where+    inventory = validated ^. #validatedInventory++    specsForSet (SomeProjectionSet projectionSet) =+      [ CatalogAsyncDedupSpec+          { specDedupKeyId = dedupKeyId,+            specSubscriptionName = subscriptionNameFor subscriptionId,+            specDedupName = dedupNameFor dedupKeyId,+            specSourceId = sourceId,+            specSourceScope = sourceScopeFor sourceId,+            specIdempotencyKey = projection ^. #idempotencyKey+          }+      | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions),+        definition ^. #rebuildGroup == wantedGroup,+        Replayable {} <- [definition ^. #replayPolicy],+        AsyncHandler projection subscriptionId dedupKeyId _ <-+          NonEmpty.toList (definition ^. #handlers)+      ]+      where+        sourceId = projectionSet ^. #projectionSource++    subscriptionNameFor ref =+      fromMaybe+        (error "catalogAsyncIdempotencyKeys: validated subscription missing from inventory")+        ( (^. #subscriptionName)+            <$> List.find+              ((== ref) . (^. #subscriptionId))+              (inventory ^. #inventorySubscriptions)+        )++    dedupNameFor ref =+      fromMaybe+        (error "catalogAsyncIdempotencyKeys: validated dedup key missing from inventory")+        ( (^. #dedupName)+            <$> List.find+              ((== ref) . (^. #dedupKeyId))+              (inventory ^. #inventoryDedupKeys)+        )++    sourceScopeFor ref =+      fromMaybe+        (error "catalogAsyncIdempotencyKeys: validated source missing from inventory")+        ( (^. #sourceScope)+            <$> List.find+              ((== ref) . (^. #sourceId))+              (inventory ^. #inventorySources)+        )++replayAdapterMetadata :: ValidatedProjectionCatalog -> [ReplayAdapterMetadata]+replayAdapterMetadata validated =+  List.sort+    [ ReplayAdapterMetadata+        { projectionId = factProjectionId fact,+          sourceId = factSourceId fact,+          rebuildGroupId = factGroupId fact,+          replayable = factReplayable fact+        }+    | fact <- validated ^. #projectionFacts+    ]++-- | Replayable definitions for one group, preserving projection-set and+-- definition declaration order. Live-only definitions are intentionally+-- absent from the replay fleet.+catalogReplayAdapters ::+  ValidatedProjectionCatalog ->+  RebuildGroupId ->+  [CatalogReplayAdapter]+catalogReplayAdapters validated wantedGroup =+  List.zipWith assignOrder [0 ..] unordered+  where+    unordered =+      concatMap adaptersForSet (validated ^. #originalCatalog . #projectionSets)++    adaptersForSet (SomeProjectionSet projectionSet) =+      [ CatalogReplayAdapter+          (definition ^. #projectionId)+          (projectionSet ^. #projectionSource)+          (definition ^. #rebuildGroup)+          0+          adapter+      | definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions),+        definition ^. #rebuildGroup == wantedGroup,+        Replayable adapter <- [definition ^. #replayPolicy]+      ]++    assignOrder adapterOrder (CatalogReplayAdapter projectionId sourceId groupId _ adapter) =+      CatalogReplayAdapter projectionId sourceId groupId adapterOrder adapter++catalogRebuildVerifications ::+  ValidatedProjectionCatalog ->+  RebuildGroupId ->+  [RebuildVerification]+catalogRebuildVerifications validated wantedGroup =+  concat+    [ group ^. #verificationHooks+    | group <- validated ^. #originalCatalog . #rebuildGroups,+      group ^. #rebuildGroupId == wantedGroup+    ]++renderCatalogInventory :: ValidatedProjectionCatalog -> Text+renderCatalogInventory = renderInventory . catalogInventory++compareCatalogBaseline :: CatalogInventory -> CatalogInventory -> [CatalogEvolution]+compareCatalogBaseline previous current =+  List.sort+    ( removedEntries SourceRemoved (^. #sourceId) (previous ^. #inventorySources) (current ^. #inventorySources)+        <> removedEntries TargetRemoved (^. #targetId) (previous ^. #inventoryTargets) (current ^. #inventoryTargets)+        <> removedEntries RebuildGroupRemoved (^. #rebuildGroupId) (previous ^. #inventoryGroups) (current ^. #inventoryGroups)+        <> removedEntries ProjectionRemoved (^. #projectionId) (previous ^. #inventoryProjections) (current ^. #inventoryProjections)+        <> removedEntries ProjectionRevisionRemoved (^. #revisionId) (previous ^. #inventoryProjectionRevisions) (current ^. #inventoryProjectionRevisions)+        <> removedEntries+          (uncurry ExternalReadContractRemoved)+          (\entry -> (entry ^. #readContractId, entry ^. #contractVersion))+          (previous ^. #inventoryExternalReadContracts)+          (current ^. #inventoryExternalReadContracts)+        <> removedEntries QueryModelRemoved (^. #queryModelId) (previous ^. #inventoryQueryModels) (current ^. #inventoryQueryModels)+        <> removedEntries SubscriptionRemoved (^. #subscriptionId) (previous ^. #inventorySubscriptions) (current ^. #inventorySubscriptions)+        <> removedEntries DedupKeyRemoved (^. #dedupKeyId) (previous ^. #inventoryDedupKeys) (current ^. #inventoryDedupKeys)+        <> ownerChanges+        <> groupChanges+    )+  where+    previousTargets = Map.fromList [(entry ^. #targetId, entry) | entry <- previous ^. #inventoryTargets]+    currentTargets = Map.fromList [(entry ^. #targetId, entry) | entry <- current ^. #inventoryTargets]+    ownerChanges =+      [ TargetOwnerChanged targetId (old ^. #owner) (new ^. #owner)+      | (targetId, old) <- Map.toList previousTargets,+        Just new <- [Map.lookup targetId currentTargets],+        old ^. #owner /= new ^. #owner+      ]+    previousGroups = targetGroups previous+    currentGroups = targetGroups current+    groupChanges =+      [ TargetGroupChanged targetId oldGroup newGroup+      | (targetId, oldGroup) <- Map.toList previousGroups,+        Just newGroup <- [Map.lookup targetId currentGroups],+        oldGroup /= newGroup+      ]++removedEntries ::+  (Ord key) =>+  (key -> evolution) ->+  (entry -> key) ->+  [entry] ->+  [entry] ->+  [evolution]+removedEntries constructor key previous current =+  [ constructor previousKey+  | previousEntry <- previous,+    let previousKey = key previousEntry,+    previousKey `Set.notMember` currentKeys+  ]+  where+    currentKeys = Set.fromList (map key current)++targetGroups :: CatalogInventory -> Map TargetId RebuildGroupId+targetGroups inventory =+  Map.fromList+    [ (targetId, group ^. #rebuildGroupId)+    | group <- inventory ^. #inventoryGroups,+      targetId <- group ^. #orderedTargets+    ]++duplicateDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> [CatalogDiagnostic]+duplicateDiagnostics catalog facts queryFacts =+  duplicateBy DuplicateSourceId sourceIdText (^. #sourceId) (^. #claimSite) (catalog ^. #sources)+    <> duplicateBy DuplicateTargetId targetIdText (^. #targetId) (^. #claimSite) (catalog ^. #targets)+    <> duplicateBy DuplicateQualifiedTable renderQualifiedTable (^. #qualifiedTable) (^. #claimSite) (catalog ^. #targets)+    <> duplicateBy DuplicateRebuildGroupId rebuildGroupIdText (^. #rebuildGroupId) (^. #claimSite) (catalog ^. #rebuildGroups)+    <> duplicateBy DuplicateSubscriptionId subscriptionIdText (^. #subscriptionId) (^. #claimSite) (catalog ^. #subscriptions)+    <> duplicateBy DuplicateSubscriptionName (\value -> value) (^. #subscriptionName) (^. #claimSite) (catalog ^. #subscriptions)+    <> duplicateBy DuplicateDedupKeyId dedupKeyIdText (^. #dedupKeyId) (^. #claimSite) (catalog ^. #dedupKeys)+    <> duplicateBy DuplicateDedupName (\value -> value) (^. #dedupName) (^. #claimSite) (catalog ^. #dedupKeys)+    <> duplicateBy DuplicateProjectionId projectionIdText factProjectionId factSite facts+    <> duplicateBy DuplicateProjectionRevisionId projectionRevisionIdText (^. #revisionId) (^. #claimSite) (catalog ^. #projectionRevisions)+    <> duplicateBy+      DuplicateExternalReadContractVersion+      renderExternalReadContractKey+      externalReadContractKey+      (^. #claimSite)+      (catalog ^. #externalReadContracts)+    <> duplicateBy+      DuplicateExternalReadFunctionName+      id+      externalReadFunctionName+      (^. #claimSite)+      (catalog ^. #externalReadContracts)+    <> duplicateBy DuplicateQueryModelId queryModelIdText factQueryModelId factQuerySite queryFacts+    <> duplicateBy DuplicateQueryModelRegistryName (\value -> value) factRegistryName factQuerySite queryFacts+    <> concatMap duplicateTargetsInGroup (catalog ^. #rebuildGroups)++renderExternalReadContractKey :: (ExternalReadContractId, ExternalReadContractVersion) -> Text+renderExternalReadContractKey (contractId, version) =+  externalReadContractIdText contractId+    <> "/v"+    <> Text.pack (show (externalReadContractVersionValue version))++externalReadContractKey :: ExternalReadContract -> (ExternalReadContractId, ExternalReadContractVersion)+externalReadContractKey contract =+  (contract ^. #readContractId, contract ^. #contractVersion)++duplicateBy ::+  (Ord key) =>+  CatalogDiagnosticCode ->+  (key -> Text) ->+  (value -> key) ->+  (value -> ClaimSite) ->+  [value] ->+  [CatalogDiagnostic]+duplicateBy code renderKey key site values =+  [ diagnostic code (renderKey duplicateKey) sites "identity is declared more than once"+  | (duplicateKey, claims) <- Map.toList grouped,+    let sites = List.sort (List.nub (map site claims)),+    List.length claims > 1+  ]+  where+    grouped = Map.fromListWith (<>) [(key value, [value]) | value <- values]++duplicateTargetsInGroup :: RebuildGroupDeclaration -> [CatalogDiagnostic]+duplicateTargetsInGroup group =+  [ diagnostic+      DuplicateGroupTarget+      (targetIdText targetId)+      [group ^. #claimSite]+      ("target occurs more than once in rebuild group " <> rebuildGroupIdText (group ^. #rebuildGroupId))+  | targetId <- duplicates (group ^. #orderedTargets)+  ]++referenceDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> [CatalogDiagnostic]+referenceDiagnostics catalog facts queryFacts =+  groupTargetReferences+    <> targetDependencies+    <> subscriptionSourceReferences+    <> projectionReferences+    <> queryReferences+  where+    sourceIds = Set.fromList [source ^. #sourceId | source <- catalog ^. #sources]+    targetIds = Set.fromList [target ^. #targetId | target <- catalog ^. #targets]+    groupIds = Set.fromList [group ^. #rebuildGroupId | group <- catalog ^. #rebuildGroups]+    subscriptionIds = Set.fromList [subscription ^. #subscriptionId | subscription <- catalog ^. #subscriptions]+    dedupIds = Set.fromList [key ^. #dedupKeyId | key <- catalog ^. #dedupKeys]+    subscriptionsById = Map.fromList [(subscription ^. #subscriptionId, subscription) | subscription <- catalog ^. #subscriptions]+    dedupById = Map.fromList [(key ^. #dedupKeyId, key) | key <- catalog ^. #dedupKeys]+    queriesByRegistryName = Map.fromList [(factRegistryName query, query) | query <- queryFacts]+    groupTargetReferences =+      [ diagnostic UnknownTargetReference (targetIdText targetId) [group ^. #claimSite] "rebuild group references an unknown target"+      | group <- catalog ^. #rebuildGroups,+        targetId <- group ^. #orderedTargets,+        targetId `Set.notMember` targetIds+      ]+    targetDependencies =+      [ diagnostic UnknownTargetDependency (targetIdText dependency) [target ^. #claimSite] ("target dependency is unknown for " <> targetIdText (target ^. #targetId))+      | target <- catalog ^. #targets,+        dependency <- target ^. #dependsOn,+        dependency `Set.notMember` targetIds+      ]+    subscriptionSourceReferences =+      [ diagnostic UnknownSourceReference (sourceIdText sourceId) [subscription ^. #claimSite] "subscription references an unknown source"+      | subscription <- catalog ^. #subscriptions,+        let sourceId = subscription ^. #subscriptionSource,+        sourceId `Set.notMember` sourceIds+      ]+    projectionReferences = concatMap projectionReference facts+    projectionReference fact =+      [ diagnostic UnknownSourceReference (sourceIdText (factSourceId fact)) [factSite fact] "projection set references an unknown source"+      | factSourceId fact `Set.notMember` sourceIds+      ]+        <> [ diagnostic UnknownGroupReference (rebuildGroupIdText (factGroupId fact)) [factSite fact] "projection references an unknown rebuild group"+           | factGroupId fact `Set.notMember` groupIds+           ]+        <> [ diagnostic UnknownTargetReference (targetIdText targetId) [factSite fact] ("projection references an unknown target: " <> projectionIdText (factProjectionId fact))+           | targetId <- factTargets fact,+             targetId `Set.notMember` targetIds+           ]+        <> concatMap (handlerReference fact) (factHandlers fact)+    handlerReference _ (InlineFacts _ _) = []+    handlerReference fact (AsyncFacts projectionName readModelName liveSubscriptionName subscriptionId dedupId site) =+      [ diagnostic UnknownSubscriptionReference (subscriptionIdText subscriptionId) [site] "async handler references an unknown subscription"+      | subscriptionId `Set.notMember` subscriptionIds+      ]+        <> [ diagnostic UnknownDedupKeyReference (dedupKeyIdText dedupId) [site] "async handler references an unknown dedup key"+           | dedupId `Set.notMember` dedupIds+           ]+        <> [ diagnostic UnknownQueryModelReference readModelName [site] "async handler references an unknown query-model registry name"+           | readModelName `Map.notMember` queriesByRegistryName+           ]+        <> [ diagnostic AsyncHandlerSubscriptionMismatch projectionName [site, subscription ^. #claimSite] "async handler subscription name or source differs from its catalog declaration"+           | Just subscription <- [Map.lookup subscriptionId subscriptionsById],+             subscription ^. #subscriptionName /= liveSubscriptionName+               || subscription ^. #subscriptionSource /= factSourceId fact+           ]+        <> [ diagnostic AsyncHandlerDedupMismatch projectionName [site, key ^. #claimSite] "async handler name must match its declared deduplication name"+           | Just key <- [Map.lookup dedupId dedupById],+             key ^. #dedupName /= projectionName+           ]+        <> [ diagnostic QueryModelOutsideRebuildGroup readModelName [site, factQuerySite query] "async handler's query model belongs to another rebuild group"+           | Just query <- [Map.lookup readModelName queriesByRegistryName],+             factQueryGroup query /= factGroupId fact+           ]+    queryReferences = concatMap queryReference queryFacts+    queryReference query =+      [ diagnostic UnknownGroupReference (rebuildGroupIdText (factQueryGroup query)) [factQuerySite query] "query model references an unknown rebuild group"+      | factQueryGroup query `Set.notMember` groupIds+      ]+        <> [ diagnostic UnknownTargetReference (targetIdText targetId) [factQuerySite query] "query model references an unknown target"+           | targetId <- factObservedTargets query,+             targetId `Set.notMember` targetIds+           ]++ownershipDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [CatalogDiagnostic]+ownershipDiagnostics catalog facts =+  concatMap targetOwnership (catalog ^. #targets)+  where+    targetOwnership target =+      case [fact | fact <- facts, target ^. #targetId `List.elem` factTargets fact] of+        [] ->+          [ diagnostic TargetWithoutOwner (targetIdText (target ^. #targetId)) [target ^. #claimSite] "declared target has no projection owner"+          ]+        [_] -> []+        owners ->+          [ diagnostic+              TargetWithMultipleOwners+              (targetIdText (target ^. #targetId))+              (map factSite owners)+              ( "target has multiple independent projection owners: "+                  <> Text.intercalate ", " (map (projectionIdText . factProjectionId) owners)+              )+          ]++groupDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> [CatalogDiagnostic]+groupDiagnostics catalog facts queryFacts =+  emptyGroups+    <> groupMembership+    <> crossGroupProjections+    <> dependencyCycles+    <> dependencyOrder+    <> queryCoverage+  where+    groups = catalog ^. #rebuildGroups+    targets = catalog ^. #targets+    groupByTarget =+      Map.fromListWith+        (<>)+        [ (targetId, [group ^. #rebuildGroupId])+        | group <- groups,+          targetId <- group ^. #orderedTargets+        ]+    emptyGroups =+      [ diagnostic EmptyRebuildGroup (rebuildGroupIdText (group ^. #rebuildGroupId)) [group ^. #claimSite] "rebuild group must contain at least one target"+      | group <- groups,+        null (group ^. #orderedTargets)+      ]+    groupMembership =+      [ diagnostic+          ProjectionCrossesRebuildGroups+          (targetIdText (target ^. #targetId))+          (target ^. #claimSite : [group ^. #claimSite | group <- groups, target ^. #targetId `List.elem` group ^. #orderedTargets])+          "target must belong to exactly one rebuild group"+      | target <- targets,+        List.length (Map.findWithDefault [] (target ^. #targetId) groupByTarget) /= 1+      ]+    crossGroupProjections =+      [ diagnostic+          ProjectionCrossesRebuildGroups+          (projectionIdText (factProjectionId fact))+          [factSite fact]+          "one transactional projection may write targets from only its declared rebuild group"+      | fact <- facts,+        let targetGroupsForProjection =+              Set.fromList+                [ groupId+                | targetId <- factTargets fact,+                  groupId <- Map.findWithDefault [] targetId groupByTarget+                ],+        targetGroupsForProjection /= Set.singleton (factGroupId fact)+      ]+    dependencyCycles =+      [ diagnostic+          TargetDependencyCycle+          (Text.intercalate "," (List.sort (map (targetIdText . (^. #targetId)) cycleTargets)))+          (map (^. #claimSite) cycleTargets)+          "target dependencies contain a cycle"+      | CyclicSCC cycleTargets <- stronglyConnComp graph+      ]+    graph =+      [ (target, target ^. #targetId, filter (`Map.member` targetMap) (target ^. #dependsOn))+      | target <- targets+      ]+    targetMap = Map.fromList [(target ^. #targetId, target) | target <- targets]+    dependencyOrder = concatMap groupOrderDiagnostics groups+    groupOrderDiagnostics group =+      [ diagnostic+          TargetOrderViolatesDependency+          (targetIdText (target ^. #targetId))+          [target ^. #claimSite, group ^. #claimSite]+          ("dependency " <> targetIdText dependency <> " must precede target in rebuild group")+      | (position, targetId) <- List.zip [0 :: Int ..] (group ^. #orderedTargets),+        Just target <- [Map.lookup targetId targetMap],+        dependency <- target ^. #dependsOn,+        Just dependencyPosition <- [List.elemIndex dependency (group ^. #orderedTargets)],+        dependencyPosition >= position+      ]+    queryCoverage =+      [ diagnostic+          QueryModelOutsideRebuildGroup+          (queryModelIdText (factQueryModelId query))+          [factQuerySite query]+          "query model observes a target not covered by its rebuild group"+      | query <- queryFacts,+        let covered =+              Set.fromList+                [ targetId+                | group <- groups,+                  group ^. #rebuildGroupId == factQueryGroup query,+                  targetId <- group ^. #orderedTargets+                ],+        any (`Set.notMember` covered) (factObservedTargets query)+      ]++-- | Validate the relation later exposed by 'resolvedQuerySupplies'. Existing+-- declaration/reference/ownership diagnostics remain the primary errors for+-- malformed identities, so this layer stays quiet until those prerequisites+-- are individually valid.+querySupplyDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> [CatalogDiagnostic]+querySupplyDiagnostics catalog facts queryFacts = concatMap diagnosticsForQuery queryFacts+  where+    declaredTargets = Set.fromList [target ^. #targetId | target <- catalog ^. #targets]+    declaredGroups = Set.fromList [group ^. #rebuildGroupId | group <- catalog ^. #rebuildGroups]+    ownersByTarget =+      Map.fromListWith+        (<>)+        [ (targetId, [fact])+        | fact <- facts,+          targetId <- factTargets fact+        ]+    groupsByTarget =+      Map.fromListWith+        (<>)+        [ (targetId, [group ^. #rebuildGroupId])+        | group <- catalog ^. #rebuildGroups,+          targetId <- group ^. #orderedTargets+        ]+    projectionCounts = Map.fromListWith (+) [(factProjectionId fact, 1 :: Int) | fact <- facts]+    queryCounts = Map.fromListWith (+) [(factQueryModelId query, 1 :: Int) | query <- queryFacts]++    diagnosticsForQuery query+      | Map.findWithDefault 0 (factQueryModelId query) queryCounts /= 1 = []+      | null targets =+          [ diagnostic+              EmptyQueryObservedTargets+              queryIdentity+              [factQuerySite query]+              "catalog-bound query model must observe at least one target"+          ]+      | not prerequisitesValid = []+      | otherwise =+          case List.sort (Set.toList supplierIds) of+            [] ->+              [ diagnostic+                  QueryModelWithoutSupplier+                  queryIdentity+                  [factQuerySite query]+                  "query model's observed targets do not resolve to one projection supplier"+              ]+            [_] -> []+            suppliers ->+              [ diagnostic+                  QueryModelWithMultipleSuppliers+                  queryIdentity+                  (factQuerySite query : map factSite supplierFacts)+                  ( "query model's observed targets span several projection suppliers: "+                      <> Text.intercalate ", " (map projectionIdText suppliers)+                  )+              ]+      where+        targets = factObservedTargets query+        queryIdentity = queryModelIdText (factQueryModelId query)+        targetOwners = [owners | targetId <- targets, let owners = Map.findWithDefault [] targetId ownersByTarget]+        supplierFacts = List.nubBy (\left right -> factProjectionId left == factProjectionId right) (concat targetOwners)+        supplierIds = Set.fromList (map factProjectionId supplierFacts)+        prerequisitesValid =+          factQueryGroup query `Set.member` declaredGroups+            && all (`Set.member` declaredTargets) targets+            && all ((== 1) . List.length) targetOwners+            && all+              ( \targetId ->+                  Map.findWithDefault [] targetId groupsByTarget == [factQueryGroup query]+              )+              targets+            && all+              ( \case+                  [owner] -> factGroupId owner == factQueryGroup query+                  _ -> False+              )+              targetOwners+            && all+              ( \case+                  [owner] -> Map.findWithDefault 0 (factProjectionId owner) projectionCounts == 1+                  _ -> False+              )+              targetOwners++data QueryCursorCandidate+  = QueryCursorCandidate+      !SubscriptionId+      !Text+      !SourceScope+      !ClaimSite+  deriving stock (Eq, Ord, Show)++-- | Validate only query policies that actually wait. Immediate queries remain+-- valid for inline, subscription, and composed owners; they merely expose no+-- per-call cursor when the owner has zero or several durable authorities.+queryFreshnessDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> [CatalogDiagnostic]+queryFreshnessDiagnostics catalog facts = concatMap diagnosticsForQuery+  where+    diagnosticsForQuery query =+      case factQueryFreshness query of+        Immediate -> []+        requested ->+          case queryOwner facts query of+            Nothing -> []+            Just owner ->+              let allCandidates = queryCursorCandidates catalog owner+                  compatible = compatibleQueryCursors requested allCandidates+                  sites =+                    List.sort+                      . List.nub+                      $ factQuerySite query+                        : factSite owner+                        : map handlerClaimSite (factHandlers owner)+                  detail = cursorDiagnosticDetail requested owner allCandidates+               in case compatible of+                    [] ->+                      [ diagnostic+                          QueryWaitWithoutCompatibleCursor+                          (queryModelIdText (factQueryModelId query))+                          sites+                          ( "query wait has no compatible durable cursor; "+                              <> detail+                              <> "; remedy: use Immediate or give the supplying owner one compatible subscription"+                          )+                      ]+                    [_] -> []+                    _ ->+                      [ diagnostic+                          QueryWaitWithAmbiguousCursor+                          (queryModelIdText (factQueryModelId query))+                          sites+                          ( "query wait has several compatible durable cursors; "+                              <> detail+                              <> "; remedy: leave exactly one compatible subscription or use Immediate"+                          )+                      ]++queryOwner :: [ProjectionFacts] -> QueryFacts -> Maybe ProjectionFacts+queryOwner facts query =+  case List.nubBy+    (\left right -> factProjectionId left == factProjectionId right)+    [ fact+    | targetId <- factObservedTargets query,+      fact <- facts,+      targetId `List.elem` factTargets fact+    ] of+    [owner]+      | not (null (factObservedTargets query)),+        factGroupId owner == factQueryGroup query,+        all (`List.elem` factTargets owner) (factObservedTargets query) ->+          Just owner+    _ -> Nothing++queryCursorCandidates :: ProjectionCatalog -> ProjectionFacts -> [QueryCursorCandidate]+queryCursorCandidates catalog owner =+  List.nubBy sameCursor+    . List.sortOn candidateKey+    $ mapMaybe candidateFor (factHandlers owner)+  where+    subscriptionsById =+      Map.fromList+        [ (subscription ^. #subscriptionId, subscription)+        | subscription <- catalog ^. #subscriptions+        ]+    sourcesById =+      Map.fromList+        [ (source ^. #sourceId, source)+        | source <- catalog ^. #sources+        ]++    candidateFor (InlineFacts _ _) = Nothing+    candidateFor (AsyncFacts _ _ _ subscriptionId _ site) = do+      subscription <- Map.lookup subscriptionId subscriptionsById+      source <- Map.lookup (subscription ^. #subscriptionSource) sourcesById+      pure+        ( QueryCursorCandidate+            subscriptionId+            (subscription ^. #subscriptionName)+            (source ^. #sourceScope)+            site+        )++    candidateKey (QueryCursorCandidate subscriptionId name scope _) =+      (subscriptionId, name, scope)+    sameCursor left right = candidateKey left == candidateKey right++compatibleQueryCursors :: QueryFreshness -> [QueryCursorCandidate] -> [QueryCursorCandidate]+compatibleQueryCursors freshness =+  case freshness of+    Immediate -> id+    WaitForPosition _ -> id+    WaitForHead scope -> filter (headScopeReachable scope . candidateScope)+  where+    candidateScope (QueryCursorCandidate _ _ scope _) = scope++headScopeReachable :: HeadScope -> SourceScope -> Bool+headScopeReachable EntireVisibleLog AllStreams = True+headScopeReachable EntireVisibleLog CategorySource {} = False+headScopeReachable CategoryVisibleHead {} AllStreams = True+headScopeReachable (CategoryVisibleHead wanted) (CategorySource (CategoryName actual)) =+  wanted == actual++cursorDiagnosticDetail :: QueryFreshness -> ProjectionFacts -> [QueryCursorCandidate] -> Text+cursorDiagnosticDetail requested owner candidates =+  "query freshness="+    <> queryFreshnessText requested+    <> ", owner="+    <> projectionIdText (factProjectionId owner)+    <> ", delivery capabilities="+    <> Text.intercalate "," (map renderHandlerFact (factHandlers owner))+    <> ", cursor candidates="+    <> if null candidates+      then "none"+      else Text.intercalate "," (map renderCursorCandidate candidates)++queryFreshnessText :: QueryFreshness -> Text+queryFreshnessText Immediate = "immediate"+queryFreshnessText (WaitForHead scope) = "wait-for-head(" <> headScopeText scope <> ")"+queryFreshnessText WaitForPosition {} = "wait-for-position"++headScopeText :: HeadScope -> Text+headScopeText EntireVisibleLog = "entire-visible-log"+headScopeText (CategoryVisibleHead category) = "category-visible-head:" <> category++renderHandlerFact :: HandlerFacts -> Text+renderHandlerFact (InlineFacts name _) = "inline:" <> name+renderHandlerFact (AsyncFacts name _ _ subscriptionId _ _) =+  "subscription:" <> name <> "/" <> subscriptionIdText subscriptionId++renderCursorCandidate :: QueryCursorCandidate -> Text+renderCursorCandidate (QueryCursorCandidate subscriptionId name scope _) =+  subscriptionIdText subscriptionId+    <> "/"+    <> name+    <> "/"+    <> renderScope scope++handlerClaimSite :: HandlerFacts -> ClaimSite+handlerClaimSite (InlineFacts _ site) = site+handlerClaimSite (AsyncFacts _ _ _ _ _ site) = site++replayDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [CatalogDiagnostic]+replayDiagnostics catalog facts =+  clearRequiresReplay <> currentHeadAfterClear <> mixedGroupReplay+  where+    ownerFor targetId = List.find (\fact -> targetId `List.elem` factTargets fact) facts+    targets = catalog ^. #targets+    groups = catalog ^. #rebuildGroups+    targetMap = Map.fromList [(target ^. #targetId, target) | target <- targets]+    subscriptionsById = Map.fromList [(subscription ^. #subscriptionId, subscription) | subscription <- catalog ^. #subscriptions]+    clearRequiresReplay =+      [ diagnostic+          ClearTargetRequiresReplayableOwner+          (targetIdText (target ^. #targetId))+          [target ^. #claimSite, factSite owner]+          "a clear-before-replay target requires a replayable owner"+      | target <- targets,+        target ^. #resetPolicy == ClearBeforeReplay,+        Just owner <- [ownerFor (target ^. #targetId)],+        not (factReplayable owner)+      ]+    currentHeadAfterClear =+      [ diagnostic+          ReplayableClearTargetStartsAtCurrentHead+          (subscriptionIdText subscriptionId <> "/" <> targetIdText targetId)+          [subscription ^. #claimSite, target ^. #claimSite, handlerSite, factSite fact]+          ( "subscription "+              <> subscription ^. #subscriptionName+              <> " ("+              <> subscriptionIdText subscriptionId+              <> ") uses FromCurrentHead for replayable target "+              <> targetIdText targetId+              <> " with ClearBeforeReplay; seeding the current head would skip the history required to rebuild the cleared target"+          )+      | fact <- facts,+        factReplayable fact,+        AsyncFacts _ _ _ subscriptionId _ handlerSite <- factHandlers fact,+        Just subscription <- [Map.lookup subscriptionId subscriptionsById],+        subscription ^. #checkpointOnMissing == FromCurrentHead,+        targetId <- factTargets fact,+        Just target <- [Map.lookup targetId targetMap],+        target ^. #resetPolicy == ClearBeforeReplay+      ]+    mixedGroupReplay =+      [ diagnostic+          MixedResetGroupRequiresReplayAdapter+          (projectionIdText (factProjectionId owner))+          [group ^. #claimSite, factSite owner]+          "preserve-and-reconcile targets in a mixed group require explicit replay adapters"+      | group <- groups,+        let groupTargets = mapMaybeTarget group,+        any ((== ClearBeforeReplay) . (^. #resetPolicy)) groupTargets,+        any ((== PreserveAndReconcile) . (^. #resetPolicy)) groupTargets,+        target <- groupTargets,+        target ^. #resetPolicy == PreserveAndReconcile,+        Just owner <- [ownerFor (target ^. #targetId)],+        not (factReplayable owner)+      ]+    mapMaybeTarget group =+      [ target+      | targetId <- group ^. #orderedTargets,+        Just target <- [Map.lookup targetId targetMap]+      ]++sourceOrderingDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [CatalogDiagnostic]+sourceOrderingDiagnostics catalog facts =+  [ diagnostic+      AmbiguousSourceOrdering+      (rebuildGroupIdText groupId)+      (map factSite groupFacts)+      "one rebuild group cannot combine an all-stream source with category sources"+  | groupId <- Set.toList (Set.fromList (map factGroupId facts)),+    let groupFacts = filter ((== groupId) . factGroupId) facts,+    let scopes =+          [ source ^. #sourceScope+          | fact <- groupFacts,+            source <- catalog ^. #sources,+            source ^. #sourceId == factSourceId fact+          ],+    AllStreams `List.elem` scopes,+    any isCategory scopes+  ]+  where+    isCategory (CategorySource _) = True+    isCategory AllStreams = False++verificationDiagnostics :: ProjectionCatalog -> [CatalogDiagnostic]+verificationDiagnostics catalog = concatMap verificationGroupDiagnostics (catalog ^. #rebuildGroups)+  where+    verificationGroupDiagnostics group = duplicateIds group <> invalidIdentities group++    duplicateIds group =+      [ diagnostic+          DuplicateRebuildVerificationId+          verificationId+          [group ^. #claimSite]+          "verification identities must be unique within a rebuild group"+      | verificationId <- duplicates (map (^. #verificationId) (group ^. #verificationHooks))+      ]++    invalidIdentities group =+      [ diagnostic+          InvalidRebuildVerificationIdentity+          (hook ^. #verificationId)+          [group ^. #claimSite]+          "verification identity and version must be non-empty and have no surrounding whitespace"+      | hook <- group ^. #verificationHooks,+        invalid (hook ^. #verificationId) || invalid (hook ^. #verificationVersion)+      ]++    invalid value = Text.null value || Text.strip value /= value++projectionRevisionDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [CatalogDiagnostic]+projectionRevisionDiagnostics catalog facts =+  concatMap revisionDiagnostics revisions+  where+    revisions = catalog ^. #projectionRevisions+    groupsById =+      Map.fromList+        [ (group ^. #rebuildGroupId, group)+        | group <- catalog ^. #rebuildGroups+        ]+    declaredTargets = Set.fromList [target ^. #targetId | target <- catalog ^. #targets]++    revisionDiagnostics revision =+      unknownGroup+        <> unknownProvisioners+        <> targetSetDrift+        <> missingLive+        <> missingReplay+        <> missingValidation+        <> nonTotalMappings+        <> liveCapabilityMismatch+        <> liveTargetOwnershipMismatch+        <> invalidIdentities+      where+        revisionIdentity = projectionRevisionIdText (revision ^. #revisionId)+        site = revision ^. #claimSite+        provisionerEntries = Map.toAscList (revision ^. #targetProvisioners)+        provisionedTargets = Map.keysSet (revision ^. #targetProvisioners)+        maybeGroup = Map.lookup (revision ^. #rebuildGroup) groupsById+        expectedTargets =+          Set.fromList $ maybe [] (^. #orderedTargets) maybeGroup+        groupFacts = filter ((== revision ^. #rebuildGroup) . factGroupId) facts+        expectedLive = List.sort (concatMap factLiveDeliveries groupFacts)+        actualLive = List.sort (map (^. #delivery) (revision ^. #liveHandlers))+        expectedTargetsByDelivery =+          Map.fromList+            [ (deliveryCapability, Set.fromList (factTargets fact))+            | fact <- groupFacts,+              deliveryCapability <- factLiveDeliveries fact+            ]+        unknownGroup =+          [ diagnostic+              UnknownGroupReference+              (rebuildGroupIdText (revision ^. #rebuildGroup))+              [site]+              ("projection revision " <> revisionIdentity <> " references an unknown rebuild group")+          | isNothing maybeGroup+          ]+        unknownProvisioners =+          [ diagnostic+              UnknownTargetProvisioner+              (targetIdText targetId)+              [site]+              ("projection revision " <> revisionIdentity <> " supplies a provisioner for an unknown target")+          | (targetId, _) <- provisionerEntries,+            targetId `Set.notMember` declaredTargets+          ]+        targetSetDrift =+          [ diagnostic+              ProjectionRevisionTargetSetDrift+              revisionIdentity+              [site, group ^. #claimSite]+              ( "projection revision target set differs from rebuild group; expected="+                  <> renderTargetSet expectedTargets+                  <> ", supplied="+                  <> renderTargetSet provisionedTargets+              )+          | Just group <- [maybeGroup],+            provisionedTargets /= expectedTargets+          ]+        missingLive =+          [ diagnostic+              ProjectionRevisionWithoutLiveHandler+              revisionIdentity+              [site]+              "projection revision must supply at least one live handler"+          | null (revision ^. #liveHandlers)+          ]+        missingReplay =+          [ diagnostic+              ProjectionRevisionWithoutReplayAdapter+              revisionIdentity+              [site]+              "projection revision must supply at least one replay adapter"+          | null (revision ^. #replayAdapters)+          ]+        missingValidation =+          [ diagnostic+              ProjectionRevisionMissingSchemaValidation+              (revisionIdentity <> "/" <> targetIdText targetId)+              [site]+              "target provisioner must supply schema validation before replay or promotion"+          | (targetId, provisioner) <- provisionerEntries,+            isNothing (provisioner ^. #validateTarget)+          ]+        nonTotalMappings =+          [ diagnostic+              ProjectionRevisionPhysicalTargetsNotTotal+              (revisionIdentity <> "/" <> handlerIdentity)+              [site]+              ( "revision closure requires a non-total physical target set; expected="+                  <> renderTargetSet expectedTargets+                  <> ", required="+                  <> renderTargetSet required+              )+          | (handlerIdentity, requiredTargets) <- revisionRequirements revision,+            let required = Set.fromList requiredTargets,+            isJust maybeGroup,+            required /= expectedTargets+          ]+        liveCapabilityMismatch =+          [ diagnostic+              ProjectionRevisionLiveCapabilityMismatch+              revisionIdentity+              (site : map factSite groupFacts)+              ( "revision live deliveries differ from the catalog owners; expected="+                  <> renderLiveDeliveries expectedLive+                  <> ", supplied="+                  <> renderLiveDeliveries actualLive+              )+          | expectedLive /= actualLive+          ]+        liveTargetOwnershipMismatch =+          [ diagnostic+              ProjectionRevisionLiveTargetOwnershipMismatch+              (revisionIdentity <> "/" <> handler ^. #handlerId)+              (site : maybe [] (pure . factSite) (factForDelivery (handler ^. #delivery)))+              ( "revision live handler targets differ from its supplying projection; expected="+                  <> renderTargetSet owned+                  <> ", supplied="+                  <> renderTargetSet supplied+              )+          | handler <- revision ^. #liveHandlers,+            Just owned <- [Map.lookup (handler ^. #delivery) expectedTargetsByDelivery],+            let supplied = Set.fromList (handler ^. #requiredTargets),+            supplied /= owned+          ]+        invalidIdentities =+          [ diagnostic+              InvalidProjectionRevisionIdentity+              (revisionIdentity <> "/" <> identity)+              [site]+              "revision, provisioner, validator, handler, adapter, and verification identities must be non-empty and have no surrounding whitespace; numeric versions must be positive"+          | (identity, version) <- revisionIdentities revision,+            invalid identity || version < 1+          ]++    factLiveDeliveries fact =+      [ case handler of+          InlineFacts name _ -> RevisionInlineDelivery (factProjectionId fact) name+          AsyncFacts _ _ _ subscriptionId dedupId _ ->+            RevisionSubscriptionDelivery (factProjectionId fact) subscriptionId dedupId+      | handler <- factHandlers fact+      ]+    factForDelivery wanted =+      List.find (List.elem wanted . factLiveDeliveries) facts+    renderLiveDeliveries = Text.intercalate "," . map renderRevisionLiveDelivery+    invalid value = Text.null value || Text.strip value /= value+    renderTargetSet = Text.intercalate "," . map targetIdText . Set.toAscList++streamScopedReplayDiagnostics :: ProjectionCatalog -> [ProjectionFacts] -> [CatalogDiagnostic]+streamScopedReplayDiagnostics catalog facts =+  concatMap revisionDiagnostics (catalog ^. #projectionRevisions)+  where+    factsById = Map.fromList [(factProjectionId fact, fact) | fact <- facts]++    revisionDiagnostics revision =+      duplicatePolicies <> concatMap (policyDiagnostics revision) policies+      where+        policies = revision ^. #streamScopedReplays+        duplicatePolicies =+          [ diagnostic+              DuplicateStreamScopedReplayProjection+              ( projectionRevisionIdText (revision ^. #revisionId)+                  <> "/"+                  <> projectionIdText projectionId+              )+              (List.sort [policy ^. #claimSite | policy <- policies, policy ^. #streamProjectionId == projectionId])+              "a projection revision may declare at most one stream-scoped repair policy per projection"+          | projectionId <- duplicates (map (^. #streamProjectionId) policies)+          ]++    policyDiagnostics revision policy =+      case Map.lookup (policy ^. #streamProjectionId) factsById of+        Nothing ->+          [ diagnostic+              UnknownStreamScopedReplayProjection+              identity+              [policy ^. #claimSite, revision ^. #claimSite]+              "stream-scoped repair policy references a projection absent from the catalog"+          ]+            <> invalidIdentityDiagnostics+        Just fact ->+          policyGroupDiagnostics fact+            <> targetDiagnostics fact+            <> dedupDiagnostics fact+            <> invalidIdentityDiagnostics+      where+        identity =+          projectionRevisionIdText (revision ^. #revisionId)+            <> "/"+            <> projectionIdText (policy ^. #streamProjectionId)+        invalidIdentityDiagnostics =+          [ diagnostic+              InvalidStreamScopedReplayIdentity+              (identity <> "/" <> stableIdentity)+              [policy ^. #claimSite]+              "stream clearer, replay, and verification identities must be non-empty without surrounding whitespace and versions must be positive"+          | (stableIdentity, version) <-+              [ (policy ^. #clearerId, policy ^. #clearerVersion),+                (policy ^. #streamReplayId, policy ^. #streamReplayVersion),+                (policy ^. #streamVerificationId, policy ^. #streamVerificationVersion)+              ],+            Text.null stableIdentity || Text.strip stableIdentity /= stableIdentity || version < 1+          ]+        policyGroupDiagnostics fact =+          [ diagnostic+              StreamScopedReplayGroupMismatch+              identity+              [policy ^. #claimSite, factSite fact, revision ^. #claimSite]+              "stream-scoped repair projection and projection revision must own the same rebuild group"+          | factGroupId fact /= revision ^. #rebuildGroup+          ]+        targetDiagnostics fact =+          [ diagnostic+              StreamScopedReplayTargetSetMismatch+              identity+              [policy ^. #claimSite, factSite fact, revision ^. #claimSite]+              "stream-scoped repair targets must exactly match the projection-owned targets and be unique"+          | let supplied = NonEmpty.toList (policy ^. #streamOwnedTargets)+                suppliedSet = Set.fromList supplied+                expectedSet = Set.fromList (factTargets fact)+                revisionTargets = Map.keysSet (revision ^. #targetProvisioners),+            suppliedSet /= expectedSet+              || List.length supplied /= Set.size suppliedSet+              || not (suppliedSet `Set.isSubsetOf` revisionTargets)+          ]+        dedupDiagnostics fact =+          [ diagnostic+              StreamScopedReplayDedupMismatch+              identity+              [policy ^. #claimSite, factSite fact]+              "affected async dedup identities must exactly match the projection's async handlers and be unique"+          | let supplied = policy ^. #affectedAsyncDedup+                suppliedSet = Set.fromList supplied+                expectedSet =+                  Set.fromList+                    [ dedupId+                    | AsyncFacts _ _ _ _ dedupId _ <- factHandlers fact+                    ],+            suppliedSet /= expectedSet || List.length supplied /= Set.size suppliedSet+          ]++externalReadContractDiagnostics :: ProjectionCatalog -> [QueryFacts] -> [CatalogDiagnostic]+externalReadContractDiagnostics catalog queryFacts =+  concatMap contractDiagnostics contracts+    <> implementationCollisions+    <> immutableSignatureDrift+    <> surfaceGenerationRegressions+  where+    contracts = catalog ^. #externalReadContracts+    queriesById = Map.fromList [(factQueryModelId query, query) | query <- queryFacts]+    revisionsById =+      Map.fromList+        [ (revision ^. #revisionId, revision)+        | revision <- catalog ^. #projectionRevisions+        ]++    contractDiagnostics contract =+      identityDiagnostics contract+        <> sqlIdentifierDiagnostics contract+        <> sqlTypeDiagnostics contract+        <> queryDiagnostics contract+        <> revisionDiagnostics contract++    identityDiagnostics contract =+      [ diagnostic+          InvalidExternalReadContractIdentity+          (renderExternalReadContractKey (externalReadContractKey contract))+          [contract ^. #claimSite]+          "contract identity, version, surface generation, result shape, and implementation version must be valid positive immutable facts"+      | invalidIdentity contract+      ]++    invalidIdentity contract =+      invalidText (externalReadContractIdText (contract ^. #readContractId))+        || externalReadContractVersionValue (contract ^. #contractVersion) < 1+        || contract ^. #surfaceGeneration < 1+        || invalidText (contract ^. #resultShapeHash)+        || case contract of+          AllRowsExternalRead {} -> False+          KeyedExternalRead {privateImplementationVersion = implementationVersion} ->+            implementationVersion < 1++    sqlIdentifierDiagnostics contract =+      [ diagnostic+          InvalidExternalReadSqlIdentifier+          (renderExternalReadContractKey (externalReadContractKey contract) <> "/" <> identity)+          [contract ^. #claimSite]+          "generated SQL identifiers must be lower-case PostgreSQL identifiers containing only letters, digits, and underscores"+      | identity <- contractSqlIdentifiers contract,+        not (safeSqlIdentifier identity)+      ]++    sqlTypeDiagnostics contract =+      [ diagnostic+          InvalidExternalReadSqlType+          (renderExternalReadContractKey (externalReadContractKey contract) <> "/" <> renderQualifiedType sqlType)+          [contract ^. #claimSite]+          "SQL contract types must be represented by separately validated schema and type identifiers"+      | sqlType <- contractSqlTypes contract,+        not (safeQualifiedType sqlType)+      ]++    queryDiagnostics contract =+      case Map.lookup (contract ^. #queryModelId) queriesById of+        Nothing ->+          [ diagnostic+              UnknownExternalReadQueryModel+              (queryModelIdText (contract ^. #queryModelId))+              [contract ^. #claimSite]+              "external read contract references a query model absent from the catalog"+          ]+        Just query ->+          [ diagnostic+              ExternalReadShapeMismatch+              (renderExternalReadContractKey (externalReadContractKey contract))+              [contract ^. #claimSite, factQuerySite query]+              ( "external read result shape does not match query model; expected="+                  <> factShapeHash query+                  <> ", supplied="+                  <> contract ^. #resultShapeHash+              )+          | contract ^. #resultShapeHash /= factShapeHash query+          ]++    revisionDiagnostics contract =+      concatMap (oneRevision contract) (NonEmpty.toList (contract ^. #compatibleRevisions))++    oneRevision contract revisionId =+      case Map.lookup revisionId revisionsById of+        Nothing ->+          [ diagnostic+              UnknownRevisionReference+              ( externalReadContractIdText (contract ^. #readContractId)+                  <> "/"+                  <> projectionRevisionIdText revisionId+              )+              [contract ^. #claimSite]+              "external read contract references a projection revision absent from the catalog"+          ]+        Just revision ->+          case Map.lookup (contract ^. #queryModelId) queriesById of+            Nothing -> []+            Just query ->+              [ diagnostic+                  ExternalReadRevisionOwnershipMismatch+                  ( externalReadContractIdText (contract ^. #readContractId)+                      <> "/"+                      <> projectionRevisionIdText revisionId+                  )+                  [contract ^. #claimSite, revision ^. #claimSite, factQuerySite query]+                  "compatible revision must own the query model's rebuild group and every observed target"+              | revision ^. #rebuildGroup /= factQueryGroup query+                  || not+                    ( Set.fromList (factObservedTargets query)+                        `Set.isSubsetOf` Map.keysSet (revision ^. #targetProvisioners)+                    )+              ]++    implementationCollisions =+      [ diagnostic+          ExternalReadImplementationCollision+          (renderQualifiedFunction function)+          (List.sort (map (^. #claimSite) claims))+          "a private keyed implementation may be owned by only one external read contract and may not occupy keiro_read"+      | (function, claims) <- Map.toList implementations,+        List.length claims > 1 || function ^. #functionSchema == "keiro_read"+      ]+      where+        implementations =+          Map.fromListWith+            (<>)+            [ (implementation, [contract])+            | contract@KeyedExternalRead {privateImplementation = implementation} <- contracts+            ]++    immutableSignatureDrift =+      [ diagnostic+          ExternalReadImmutableSignatureDrift+          (renderExternalReadContractKey key)+          (List.sort (map (^. #claimSite) claims))+          "the same contract identity/version declares more than one immutable public SQL signature"+      | (key, claims) <- Map.toList contractsByKey,+        List.length (List.nub (map externalReadImmutableSignature claims)) > 1+      ]+      where+        contractsByKey = Map.fromListWith (<>) [(externalReadContractKey contract, [contract]) | contract <- contracts]++    surfaceGenerationRegressions =+      [ diagnostic+          ExternalReadSurfaceGenerationRegression+          ( externalReadContractIdText contractId+              <> "/v"+              <> Text.pack (show (externalReadContractVersionValue (later ^. #contractVersion)))+          )+          [earlier ^. #claimSite, later ^. #claimSite]+          "a later contract version cannot declare a lower surface generation"+      | (contractId, sameId) <- Map.toList contractsById,+        earlier <- sameId,+        later <- sameId,+        earlier ^. #contractVersion < later ^. #contractVersion,+        earlier ^. #surfaceGeneration > later ^. #surfaceGeneration+      ]+      where+        contractsById = Map.fromListWith (<>) [(contract ^. #readContractId, [contract]) | contract <- contracts]++    invalidText value = Text.null value || Text.strip value /= value++contractSqlIdentifiers :: ExternalReadContract -> [Text]+contractSqlIdentifiers contract =+  externalReadContractIdText (contract ^. #readContractId)+    : externalReadFunctionName contract+    : case contract of+      AllRowsExternalRead {} -> []+      KeyedExternalRead {privateImplementation = implementation, arguments = keyedArguments} ->+        implementation ^. #functionSchema+          : implementation ^. #functionName+          : map (^. #argumentName) keyedArguments++contractSqlTypes :: ExternalReadContract -> [QualifiedSqlType]+contractSqlTypes AllRowsExternalRead {resultContractType = resultType} = [resultType]+contractSqlTypes KeyedExternalRead {resultContractType = resultType, arguments = keyedArguments} = resultType : map (^. #argumentType) keyedArguments++safeSqlIdentifier :: Text -> Bool+safeSqlIdentifier value =+  case Text.uncons value of+    Nothing -> False+    Just (first, rest) ->+      lower first && Text.all (\character -> lower character || digit character || character == '_') rest+  where+    lower character = character >= 'a' && character <= 'z'+    digit character = character >= '0' && character <= '9'++safeQualifiedType :: QualifiedSqlType -> Bool+safeQualifiedType sqlType =+  safeSqlIdentifier (sqlType ^. #typeSchema)+    && safeSqlIdentifier (sqlType ^. #typeName)++renderQualifiedType :: QualifiedSqlType -> Text+renderQualifiedType sqlType = sqlType ^. #typeSchema <> "." <> sqlType ^. #typeName++renderQualifiedFunction :: QualifiedFunction -> Text+renderQualifiedFunction function = function ^. #functionSchema <> "." <> function ^. #functionName++externalReadImmutableSignature :: ExternalReadContract -> Preimage+externalReadImmutableSignature contract =+  PRecord+    "external-read-immutable-signature"+    [ PText (externalReadFunctionName contract),+      PText (queryModelIdText (contract ^. #queryModelId)),+      PText (contract ^. #resultShapeHash),+      qualifiedSqlTypePreimage (contract ^. #resultContractType),+      case contract of+        AllRowsExternalRead {} -> PRecord "all-rows" []+        KeyedExternalRead {arguments = keyedArguments} ->+          PRecord+            "keyed"+            [PList (sqlFunctionArgumentPreimage <$> keyedArguments)]+    ]++revisionRequirements :: ProjectionRevision -> [(Text, [TargetId])]+revisionRequirements revision =+  [ (adapter ^. #adapterId, adapter ^. #requiredTargets)+  | adapter <- revision ^. #replayAdapters+  ]+    <> [ (verification ^. #revisionVerificationId, verification ^. #requiredTargets)+       | verification <- revision ^. #revisionVerifications+       ]++revisionIdentities :: ProjectionRevision -> [(Text, Int)]+revisionIdentities revision =+  [ (projectionRevisionIdText (revision ^. #revisionId), 1)+  ]+    <> [ (provisioner ^. #provisionerId, provisioner ^. #provisionerVersion)+       | provisioner <- Map.elems (revision ^. #targetProvisioners)+       ]+    <> [ (targetSchemaVersionText (provisioner ^. #schemaVersion), 1)+       | provisioner <- Map.elems (revision ^. #targetProvisioners)+       ]+    <> [ (provisioner ^. #expectedShapeId, 1)+       | provisioner <- Map.elems (revision ^. #targetProvisioners)+       ]+    <> [ (provisioner ^. #validatorId, provisioner ^. #validatorVersion)+       | provisioner <- Map.elems (revision ^. #targetProvisioners)+       ]+    <> [ (name, 1)+       | provisioner <- Map.elems (revision ^. #targetProvisioners),+         promotionObject <- provisioner ^. #promotionObjectNames,+         name <- [promotionObject ^. #generationName, promotionObject ^. #canonicalName]+       ]+    <> [ (handler ^. #handlerId, handler ^. #handlerVersion)+       | handler <- revision ^. #liveHandlers+       ]+    <> [ (adapter ^. #adapterId, adapter ^. #adapterVersion)+       | adapter <- revision ^. #replayAdapters+       ]+    <> [ (verification ^. #revisionVerificationId, verification ^. #revisionVerificationVersion)+       | verification <- revision ^. #revisionVerifications+       ]++collectProjectionFacts :: [SomeProjectionSet] -> [ProjectionFacts]+collectProjectionFacts projectionSetEntries =+  [ ProjectionFacts+      { factProjectionId = definition ^. #projectionId,+        factSourceId = projectionSet ^. #projectionSource,+        factGroupId = definition ^. #rebuildGroup,+        factTargets = NonEmpty.toList (definition ^. #ownedTargets),+        factReplayable = case definition ^. #replayPolicy of+          Replayable _ -> True+          LiveOnly _ -> False,+        factHandlers = map handlerFacts (NonEmpty.toList (definition ^. #handlers)),+        factSite = definition ^. #claimSite+      }+  | SomeProjectionSet projectionSet <- projectionSetEntries,+    definition <- NonEmpty.toList (projectionSet ^. #projectionDefinitions)+  ]++handlerFacts :: ProjectionHandler event -> HandlerFacts+handlerFacts (InlineHandler projection site) =+  InlineFacts (projection ^. #name) site+handlerFacts (AsyncHandler projection subscriptionId dedupId site) =+  AsyncFacts+    (projection ^. #name)+    (projection ^. #readModelName)+    (projection ^. #subscriptionName)+    subscriptionId+    dedupId+    site++collectQueryFacts :: [SomeQueryModelBinding] -> [QueryFacts]+collectQueryFacts bindings =+  [ QueryFacts+      { factQueryModelId = binding ^. #queryModelId,+        factRegistryName = model ^. #name,+        factVersion = model ^. #version,+        factShapeHash = model ^. #shapeHash,+        factQueryGroup = binding ^. #rebuildGroup,+        factObservedTargets = binding ^. #observedTargets,+        factQueryFreshness = readModelDefaultFreshness model,+        factQuerySite = binding ^. #claimSite+      }+  | SomeQueryModelBinding binding <- bindings,+    let model = binding ^. #readModel+  ]++buildInventory :: ProjectionCatalog -> [ProjectionFacts] -> [QueryFacts] -> CatalogInventory+buildInventory catalog facts queryFacts =+  CatalogInventory+    { inventorySources =+        List.sort+          [ InventorySource (source ^. #sourceId) (source ^. #sourceScope) (source ^. #codecFingerprint)+          | source <- catalog ^. #sources+          ],+      inventoryTargets =+        List.sort+          [ InventoryTarget+              { targetId = target ^. #targetId,+                qualifiedTable = target ^. #qualifiedTable,+                resetPolicy = target ^. #resetPolicy,+                dependsOn = List.sort (target ^. #dependsOn),+                owner = ownerOf (target ^. #targetId)+              }+          | target <- catalog ^. #targets+          ],+      inventoryGroups =+        List.sort+          [ InventoryGroup+              { rebuildGroupId = group ^. #rebuildGroupId,+                orderedTargets = group ^. #orderedTargets,+                verifications =+                  [ (hook ^. #verificationId, hook ^. #verificationVersion)+                  | hook <- group ^. #verificationHooks+                  ]+              }+          | group <- catalog ^. #rebuildGroups+          ],+      inventoryProjections = List.sort (map inventoryProjection facts),+      inventoryProjectionRevisions =+        List.sort (map inventoryProjectionRevision (catalog ^. #projectionRevisions)),+      inventoryExternalReadContracts =+        List.sort+          [ inventoryExternalReadContract (factQueryGroup query) contract+          | contract <- catalog ^. #externalReadContracts,+            let query =+                  fromMaybe+                    (error "buildInventory: validated external read contract has no query model")+                    (List.find ((== contract ^. #queryModelId) . factQueryModelId) queryFacts)+          ],+      inventoryQueryModels =+        List.sort+          [ InventoryQueryModel+              { queryModelId = factQueryModelId query,+                registryName = factRegistryName query,+                version = factVersion query,+                shapeHash = factShapeHash query,+                rebuildGroupId = factQueryGroup query,+                observedTargets = List.sort (factObservedTargets query),+                freshness = inventoryQueryFreshness (factQueryFreshness query),+                cursor = resolvedInventoryCursor catalog owner (factQueryFreshness query)+              }+          | query <- queryFacts,+            let owner =+                  fromMaybe+                    (error "buildInventory: validated query has no projection owner")+                    (queryOwner facts query)+          ],+      inventorySubscriptions =+        List.sort+          [ InventorySubscription+              { subscriptionId = subscription ^. #subscriptionId,+                subscriptionName = subscription ^. #subscriptionName,+                sourceId = subscription ^. #subscriptionSource,+                checkpointOnMissing = subscription ^. #checkpointOnMissing+              }+          | subscription <- catalog ^. #subscriptions+          ],+      inventoryDedupKeys =+        List.sort+          [ InventoryDedupKey (key ^. #dedupKeyId) (key ^. #dedupName)+          | key <- catalog ^. #dedupKeys+          ]+    }+  where+    ownerOf targetId =+      case [factProjectionId fact | fact <- facts, targetId `List.elem` factTargets fact] of+        owner : _ -> owner+        [] -> error "buildInventory: validated target has no owner"++inventoryExternalReadContract :: RebuildGroupId -> ExternalReadContract -> InventoryExternalReadContract+inventoryExternalReadContract groupId contract =+  InventoryExternalReadContract+    { readContractId = contract ^. #readContractId,+      contractVersion = contract ^. #contractVersion,+      queryModelId = contract ^. #queryModelId,+      rebuildGroupId = groupId,+      functionName = externalReadFunctionName contract,+      contractKind = case contract of+        AllRowsExternalRead {} -> InventoryAllRowsExternalRead+        KeyedExternalRead {} -> InventoryKeyedExternalRead,+      arguments = case contract of+        AllRowsExternalRead {} -> []+        KeyedExternalRead {arguments = keyedArguments} -> keyedArguments,+      resultContractType = contract ^. #resultContractType,+      privateImplementation = case contract of+        AllRowsExternalRead {} -> Nothing+        KeyedExternalRead {privateImplementation = implementation} -> Just implementation,+      privateImplementationVersion = case contract of+        AllRowsExternalRead {} -> Nothing+        KeyedExternalRead {privateImplementationVersion = implementationVersion} -> Just implementationVersion,+      resultShapeHash = contract ^. #resultShapeHash,+      compatibleRevisions =+        NonEmpty.fromList (List.sort (NonEmpty.toList (contract ^. #compatibleRevisions))),+      surfaceGeneration = contract ^. #surfaceGeneration+    }++buildResolvedQuerySupplies :: CatalogInventory -> [ResolvedQuerySupply]+buildResolvedQuerySupplies inventory =+  List.sortOn+    (^. #resolvedQueryModelId)+    [ ResolvedQuerySupply+        { resolvedQueryModelId = query ^. #queryModelId,+          resolvedProjectionId = ownerId,+          resolvedRebuildGroupId = query ^. #rebuildGroupId,+          resolvedObservedTargets = requireNonEmpty "query observed targets" (query ^. #observedTargets),+          resolvedSourceId = projection ^. #sourceId,+          resolvedHandlerCapabilities =+            requireNonEmpty+              "projection handler capabilities"+              (map (handlerCapability projection) (projection ^. #handlers)),+          resolvedQueryFreshness = query ^. #freshness,+          resolvedQueryCursor = query ^. #cursor+        }+    | query <- inventory ^. #inventoryQueryModels,+      let ownerId = ownerForQuery query,+      let projection = requireLookup "query projection owner" ownerId projectionById+    ]+  where+    ownerByTarget =+      Map.fromList+        [ (target ^. #targetId, target ^. #owner)+        | target <- inventory ^. #inventoryTargets+        ]+    projectionById =+      Map.fromList+        [ (projection ^. #projectionId, projection)+        | projection <- inventory ^. #inventoryProjections+        ]+    subscriptionById =+      Map.fromList+        [ (subscription ^. #subscriptionId, subscription)+        | subscription <- inventory ^. #inventorySubscriptions+        ]+    dedupById =+      Map.fromList+        [ (dedupKey ^. #dedupKeyId, dedupKey)+        | dedupKey <- inventory ^. #inventoryDedupKeys+        ]++    ownerForQuery query =+      case Set.toList . Set.fromList $ map ownerForTarget (query ^. #observedTargets) of+        [ownerId] -> ownerId+        _ -> error "buildResolvedQuerySupplies: validated query does not have one owner"++    ownerForTarget targetId = requireLookup "observed target owner" targetId ownerByTarget++    handlerCapability projection = \case+      InventoryInlineHandler name ->+        InlineCapability+          { capabilityHandlerName = name+          }+      InventoryAsyncHandler name subscriptionId dedupKeyId ->+        let subscription = requireLookup "handler subscription" subscriptionId subscriptionById+            dedupKey = requireLookup "handler dedup key" dedupKeyId dedupById+         in SubscriptionCapability+              { capabilityHandlerName = name,+                capabilitySubscriptionId = subscriptionId,+                capabilitySubscriptionName = subscription ^. #subscriptionName,+                capabilitySourceId = projection ^. #sourceId,+                capabilityCheckpointOnMissing = subscription ^. #checkpointOnMissing,+                capabilityDedupKeyId = dedupKeyId,+                capabilityDedupName = dedupKey ^. #dedupName+              }++    requireLookup label key values =+      fromMaybe+        (error ("buildResolvedQuerySupplies: missing " <> label))+        (Map.lookup key values)++    requireNonEmpty label values =+      fromMaybe+        (error ("buildResolvedQuerySupplies: empty " <> label))+        (NonEmpty.nonEmpty values)++inventoryQueryFreshness :: QueryFreshness -> InventoryQueryFreshness+inventoryQueryFreshness Immediate = InventoryImmediate+inventoryQueryFreshness (WaitForHead scope) = InventoryWaitForHead scope+inventoryQueryFreshness WaitForPosition {} = InventoryWaitForPosition++resolvedInventoryCursor ::+  ProjectionCatalog ->+  ProjectionFacts ->+  QueryFreshness ->+  Maybe InventoryQueryCursor+resolvedInventoryCursor catalog owner freshness =+  case compatibleQueryCursors freshness (queryCursorCandidates catalog owner) of+    [QueryCursorCandidate subscriptionId name _ _] ->+      Just+        InventoryQueryCursor+          { subscriptionId = subscriptionId,+            subscriptionName = name+          }+    _ -> Nothing++inventoryProjection :: ProjectionFacts -> InventoryProjection+inventoryProjection fact =+  InventoryProjection+    { projectionId = factProjectionId fact,+      sourceId = factSourceId fact,+      rebuildGroupId = factGroupId fact,+      ownedTargets = List.sort (factTargets fact),+      replayDisposition = if factReplayable fact then "replayable" else "live-only",+      handlers = map inventoryHandler (factHandlers fact)+    }++inventoryHandler :: HandlerFacts -> InventoryHandler+inventoryHandler (InlineFacts name _) = InventoryInlineHandler name+inventoryHandler (AsyncFacts name _ _ subscriptionId dedupId _) =+  InventoryAsyncHandler name subscriptionId dedupId++inventoryProjectionRevision :: ProjectionRevision -> InventoryProjectionRevision+inventoryProjectionRevision revision =+  InventoryProjectionRevision+    { revisionId = revision ^. #revisionId,+      rebuildGroupId = revision ^. #rebuildGroup,+      targetProvisioners =+        [ InventoryTargetProvisioner+            { targetId = targetId,+              provisionerId = provisioner ^. #provisionerId,+              provisionerVersion = provisioner ^. #provisionerVersion,+              schemaVersion = provisioner ^. #schemaVersion,+              expectedShapeId = provisioner ^. #expectedShapeId,+              validatorId = provisioner ^. #validatorId,+              validatorVersion = provisioner ^. #validatorVersion,+              promotionObjectNames = provisioner ^. #promotionObjectNames+            }+        | (targetId, provisioner) <- Map.toAscList (revision ^. #targetProvisioners)+        ],+      liveHandlers =+        [ InventoryRevisionHandler+            (handler ^. #handlerId)+            (handler ^. #handlerVersion)+            (Just (handler ^. #delivery))+            (List.sort (handler ^. #requiredTargets))+        | handler <- revision ^. #liveHandlers+        ],+      replayAdapters =+        [ InventoryRevisionHandler+            (adapter ^. #adapterId)+            (adapter ^. #adapterVersion)+            Nothing+            (List.sort (adapter ^. #requiredTargets))+        | adapter <- revision ^. #replayAdapters+        ],+      verifications =+        [ InventoryRevisionHandler+            (verification ^. #revisionVerificationId)+            (verification ^. #revisionVerificationVersion)+            Nothing+            (List.sort (verification ^. #requiredTargets))+        | verification <- revision ^. #revisionVerifications+        ],+      streamScopedReplays =+        List.sort+          [ InventoryStreamScopedReplay+              { projectionId = policy ^. #streamProjectionId,+                ownedTargets = List.sort (NonEmpty.toList (policy ^. #streamOwnedTargets)),+                clearerId = policy ^. #clearerId,+                clearerVersion = policy ^. #clearerVersion,+                replayId = policy ^. #streamReplayId,+                replayVersion = policy ^. #streamReplayVersion,+                verificationId = policy ^. #streamVerificationId,+                verificationVersion = policy ^. #streamVerificationVersion,+                affectedAsyncDedup = List.sort (policy ^. #affectedAsyncDedup)+              }+          | policy <- revision ^. #streamScopedReplays+          ]+    }++fingerprintInventory :: CatalogInventory -> CatalogFingerprint+fingerprintInventory = CatalogFingerprint . hashPreimage "catalog-v7" . inventoryPreimage++inventoryPreimage :: CatalogInventory -> Preimage+inventoryPreimage inventory =+  PRecord+    "keiro/catalog-inventory/v7"+    [ PList (sourcePreimage <$> inventory ^. #inventorySources),+      PList (targetPreimage <$> inventory ^. #inventoryTargets),+      PList (groupPreimage <$> inventory ^. #inventoryGroups),+      PList (projectionPreimage <$> inventory ^. #inventoryProjections),+      PList (projectionRevisionPreimage <$> inventory ^. #inventoryProjectionRevisions),+      PList (externalReadContractPreimage <$> inventory ^. #inventoryExternalReadContracts),+      PList (queryPreimage <$> inventory ^. #inventoryQueryModels),+      PList (subscriptionPreimage <$> inventory ^. #inventorySubscriptions),+      PList (dedupPreimage <$> inventory ^. #inventoryDedupKeys)+    ]++sourcePreimage :: InventorySource -> Preimage+sourcePreimage source =+  PRecord+    "source"+    [ PText (sourceIdText (source ^. #sourceId)),+      PText (renderScope (source ^. #sourceScope)),+      PText (source ^. #codecFingerprint)+    ]++targetPreimage :: InventoryTarget -> Preimage+targetPreimage target =+  PRecord+    "target"+    [ PText (targetIdText (target ^. #targetId)),+      PText (target ^. #qualifiedTable . #schemaName),+      PText (target ^. #qualifiedTable . #tableName),+      PText (renderReset (target ^. #resetPolicy)),+      PList (PText . targetIdText <$> target ^. #dependsOn),+      PText (projectionIdText (target ^. #owner))+    ]++groupPreimage :: InventoryGroup -> Preimage+groupPreimage group =+  PRecord+    "group"+    [ PText (rebuildGroupIdText (group ^. #rebuildGroupId)),+      PList (PText . targetIdText <$> group ^. #orderedTargets),+      PList+        [ PRecord "verification" [PText verificationId, PText verificationVersion]+        | (verificationId, verificationVersion) <- group ^. #verifications+        ]+    ]++projectionPreimage :: InventoryProjection -> Preimage+projectionPreimage projection =+  PRecord+    "projection"+    [ PText (projectionIdText (projection ^. #projectionId)),+      PText (sourceIdText (projection ^. #sourceId)),+      PText (rebuildGroupIdText (projection ^. #rebuildGroupId)),+      PList (PText . targetIdText <$> projection ^. #ownedTargets),+      PText (projection ^. #replayDisposition),+      PList (handlerPreimage <$> projection ^. #handlers)+    ]++projectionRevisionPreimage :: InventoryProjectionRevision -> Preimage+projectionRevisionPreimage revision =+  PRecord+    "projection-revision"+    [ PText (projectionRevisionIdText (revision ^. #revisionId)),+      PText (rebuildGroupIdText (revision ^. #rebuildGroupId)),+      PList (targetProvisionerPreimage <$> revision ^. #targetProvisioners),+      PList (revisionHandlerPreimage "live-handler" <$> revision ^. #liveHandlers),+      PList (revisionHandlerPreimage "replay-adapter" <$> revision ^. #replayAdapters),+      PList (revisionHandlerPreimage "revision-verification" <$> revision ^. #verifications),+      PList (streamScopedReplayPreimage <$> revision ^. #streamScopedReplays)+    ]++streamScopedReplayPreimage :: InventoryStreamScopedReplay -> Preimage+streamScopedReplayPreimage policy =+  PRecord+    "stream-scoped-replay"+    [ PText (projectionIdText (policy ^. #projectionId)),+      PList (PText . targetIdText <$> policy ^. #ownedTargets),+      PText (policy ^. #clearerId),+      PText (Text.pack (show (policy ^. #clearerVersion))),+      PText (policy ^. #replayId),+      PText (Text.pack (show (policy ^. #replayVersion))),+      PText (policy ^. #verificationId),+      PText (Text.pack (show (policy ^. #verificationVersion))),+      PList (PText . dedupKeyIdText <$> policy ^. #affectedAsyncDedup)+    ]++targetProvisionerPreimage :: InventoryTargetProvisioner -> Preimage+targetProvisionerPreimage provisioner =+  PRecord+    "target-provisioner"+    [ PText (targetIdText (provisioner ^. #targetId)),+      PText (provisioner ^. #provisionerId),+      PText (Text.pack (show (provisioner ^. #provisionerVersion))),+      PText (targetSchemaVersionText (provisioner ^. #schemaVersion)),+      PText (provisioner ^. #expectedShapeId),+      PText (provisioner ^. #validatorId),+      PText (Text.pack (show (provisioner ^. #validatorVersion))),+      PList (promotionObjectPreimage <$> provisioner ^. #promotionObjectNames)+    ]++promotionObjectPreimage :: PromotionObjectName -> Preimage+promotionObjectPreimage object =+  PRecord+    "promotion-object"+    [ PText (promotionObjectKindText (object ^. #objectKind)),+      PText (object ^. #generationName),+      PText (object ^. #canonicalName)+    ]++revisionHandlerPreimage :: Text -> InventoryRevisionHandler -> Preimage+revisionHandlerPreimage tag handler =+  PRecord+    tag+    [ PText (handler ^. #handlerId),+      PText (Text.pack (show (handler ^. #handlerVersion))),+      maybe (PRecord "no-delivery" []) revisionLiveDeliveryPreimage (handler ^. #delivery),+      PList (PText . targetIdText <$> handler ^. #requiredTargets)+    ]++revisionLiveDeliveryPreimage :: RevisionLiveDelivery -> Preimage+revisionLiveDeliveryPreimage = \case+  RevisionInlineDelivery projectionId handlerName ->+    PRecord+      "inline-delivery"+      [PText (projectionIdText projectionId), PText handlerName]+  RevisionSubscriptionDelivery projectionId subscriptionId dedupId ->+    PRecord+      "subscription-delivery"+      [ PText (projectionIdText projectionId),+        PText (subscriptionIdText subscriptionId),+        PText (dedupKeyIdText dedupId)+      ]++externalReadContractPreimage :: InventoryExternalReadContract -> Preimage+externalReadContractPreimage contract =+  PRecord+    "external-read-contract"+    [ PText (externalReadContractIdText (contract ^. #readContractId)),+      PText (Text.pack (show (externalReadContractVersionValue (contract ^. #contractVersion)))),+      PText (queryModelIdText (contract ^. #queryModelId)),+      PText (rebuildGroupIdText (contract ^. #rebuildGroupId)),+      PText (contract ^. #functionName),+      PText+        ( case contract ^. #contractKind of+            InventoryAllRowsExternalRead -> "all-rows"+            InventoryKeyedExternalRead -> "keyed"+        ),+      PList (sqlFunctionArgumentPreimage <$> contract ^. #arguments),+      qualifiedSqlTypePreimage (contract ^. #resultContractType),+      maybe (PRecord "no-private-implementation" []) qualifiedFunctionPreimage (contract ^. #privateImplementation),+      maybe (PRecord "no-private-implementation-version" []) (PText . Text.pack . show) (contract ^. #privateImplementationVersion),+      PText (contract ^. #resultShapeHash),+      PList+        ( PText . projectionRevisionIdText+            <$> NonEmpty.toList (contract ^. #compatibleRevisions)+        ),+      PText (Text.pack (show (contract ^. #surfaceGeneration)))+    ]++sqlFunctionArgumentPreimage :: SqlFunctionArgument -> Preimage+sqlFunctionArgumentPreimage argument =+  PRecord+    "sql-function-argument"+    [ PText (argument ^. #argumentName),+      qualifiedSqlTypePreimage (argument ^. #argumentType)+    ]++qualifiedSqlTypePreimage :: QualifiedSqlType -> Preimage+qualifiedSqlTypePreimage sqlType =+  PRecord "qualified-sql-type" [PText (sqlType ^. #typeSchema), PText (sqlType ^. #typeName)]++qualifiedFunctionPreimage :: QualifiedFunction -> Preimage+qualifiedFunctionPreimage function =+  PRecord "qualified-function" [PText (function ^. #functionSchema), PText (function ^. #functionName)]++handlerPreimage :: InventoryHandler -> Preimage+handlerPreimage = \case+  InventoryInlineHandler name -> PRecord "inline" [PText name]+  InventoryAsyncHandler name subscriptionId dedupId ->+    PRecord+      "async"+      [ PText name,+        PText (subscriptionIdText subscriptionId),+        PText (dedupKeyIdText dedupId)+      ]++queryPreimage :: InventoryQueryModel -> Preimage+queryPreimage query =+  PRecord+    "query"+    [ PText (queryModelIdText (query ^. #queryModelId)),+      PText (query ^. #registryName),+      PText (Text.pack (show (query ^. #version))),+      PText (query ^. #shapeHash),+      PText (rebuildGroupIdText (query ^. #rebuildGroupId)),+      PList (PText . targetIdText <$> query ^. #observedTargets),+      inventoryFreshnessPreimage (query ^. #freshness),+      maybe (PRecord "no-cursor" []) inventoryCursorPreimage (query ^. #cursor)+    ]++inventoryFreshnessPreimage :: InventoryQueryFreshness -> Preimage+inventoryFreshnessPreimage InventoryImmediate = PRecord "immediate" []+inventoryFreshnessPreimage (InventoryWaitForHead scope) =+  PRecord "wait-for-head" [PText (headScopeText scope)]+inventoryFreshnessPreimage InventoryWaitForPosition = PRecord "wait-for-position" []++inventoryCursorPreimage :: InventoryQueryCursor -> Preimage+inventoryCursorPreimage queryCursor =+  PRecord+    "durable-cursor"+    [ PText (subscriptionIdText (queryCursor ^. #subscriptionId)),+      PText (queryCursor ^. #subscriptionName)+    ]++subscriptionPreimage :: InventorySubscription -> Preimage+subscriptionPreimage subscription =+  PRecord+    "subscription"+    [ PText (subscriptionIdText (subscription ^. #subscriptionId)),+      PText (subscription ^. #subscriptionName),+      PText (sourceIdText (subscription ^. #sourceId)),+      PText (missingCheckpointPolicyText (subscription ^. #checkpointOnMissing))+    ]++dedupPreimage :: InventoryDedupKey -> Preimage+dedupPreimage key =+  PRecord+    "dedup"+    [ PText (dedupKeyIdText (key ^. #dedupKeyId)),+      PText (key ^. #dedupName)+    ]++-- | Render the inventory for operators. This human-readable text is not the+-- fingerprint preimage; identity uses the canonical tree encoding above.+renderInventory :: CatalogInventory -> Text+renderInventory inventory =+  Text.unlines+    ( map renderSource (inventory ^. #inventorySources)+        <> map renderTarget (inventory ^. #inventoryTargets)+        <> map renderGroup (inventory ^. #inventoryGroups)+        <> map renderProjection (inventory ^. #inventoryProjections)+        <> map renderProjectionRevision (inventory ^. #inventoryProjectionRevisions)+        <> map renderExternalReadContract (inventory ^. #inventoryExternalReadContracts)+        <> map renderQuery (inventory ^. #inventoryQueryModels)+        <> map renderSubscription (inventory ^. #inventorySubscriptions)+        <> map renderDedup (inventory ^. #inventoryDedupKeys)+    )+  where+    renderSource :: InventorySource -> Text+    renderSource source =+      Text.intercalate+        "|"+        [ "source",+          sourceIdText (source ^. #sourceId),+          renderScope (source ^. #sourceScope),+          source ^. #codecFingerprint+        ]+    renderTarget :: InventoryTarget -> Text+    renderTarget target =+      Text.intercalate+        "|"+        [ "target",+          targetIdText (target ^. #targetId),+          target ^. (#qualifiedTable . #schemaName),+          target ^. (#qualifiedTable . #tableName),+          renderReset (target ^. #resetPolicy),+          commaSeparated targetIdText (target ^. #dependsOn),+          projectionIdText (target ^. #owner)+        ]+    renderGroup :: InventoryGroup -> Text+    renderGroup group =+      Text.intercalate+        "|"+        [ "group",+          rebuildGroupIdText (group ^. #rebuildGroupId),+          commaSeparated targetIdText (group ^. #orderedTargets),+          Text.intercalate+            ","+            [ verificationId <> "@" <> verificationVersion+            | (verificationId, verificationVersion) <- group ^. #verifications+            ]+        ]+    renderProjection :: InventoryProjection -> Text+    renderProjection projection =+      Text.intercalate+        "|"+        [ "projection",+          projectionIdText (projection ^. #projectionId),+          sourceIdText (projection ^. #sourceId),+          rebuildGroupIdText (projection ^. #rebuildGroupId),+          commaSeparated targetIdText (projection ^. #ownedTargets),+          projection ^. #replayDisposition,+          Text.intercalate "," (map renderHandler (projection ^. #handlers))+        ]+    renderProjectionRevision :: InventoryProjectionRevision -> Text+    renderProjectionRevision revision =+      Text.intercalate+        "|"+        [ "projection-revision",+          projectionRevisionIdText (revision ^. #revisionId),+          rebuildGroupIdText (revision ^. #rebuildGroupId),+          Text.intercalate "," (map renderTargetProvisioner (revision ^. #targetProvisioners)),+          Text.intercalate "," (map (renderRevisionHandler "live") (revision ^. #liveHandlers)),+          Text.intercalate "," (map (renderRevisionHandler "replay") (revision ^. #replayAdapters)),+          Text.intercalate "," (map (renderRevisionHandler "verify") (revision ^. #verifications))+        ]+    renderExternalReadContract :: InventoryExternalReadContract -> Text+    renderExternalReadContract contract =+      Text.intercalate+        "|"+        [ "external-read-contract",+          externalReadContractIdText (contract ^. #readContractId),+          Text.pack (show (externalReadContractVersionValue (contract ^. #contractVersion))),+          queryModelIdText (contract ^. #queryModelId),+          rebuildGroupIdText (contract ^. #rebuildGroupId),+          contract ^. #functionName,+          case contract ^. #contractKind of+            InventoryAllRowsExternalRead -> "all-rows"+            InventoryKeyedExternalRead -> "keyed",+          Text.intercalate "," (map renderArgument (contract ^. #arguments)),+          renderQualifiedType (contract ^. #resultContractType),+          maybe "-" renderQualifiedFunction (contract ^. #privateImplementation),+          maybe "-" (Text.pack . show) (contract ^. #privateImplementationVersion),+          contract ^. #resultShapeHash,+          Text.intercalate+            ","+            (map projectionRevisionIdText (NonEmpty.toList (contract ^. #compatibleRevisions))),+          Text.pack (show (contract ^. #surfaceGeneration))+        ]+    renderArgument :: SqlFunctionArgument -> Text+    renderArgument argument = argument ^. #argumentName <> ":" <> renderQualifiedType (argument ^. #argumentType)+    renderQuery :: InventoryQueryModel -> Text+    renderQuery query =+      Text.intercalate+        "|"+        [ "query",+          queryModelIdText (query ^. #queryModelId),+          query ^. #registryName,+          Text.pack (show (query ^. #version)),+          query ^. #shapeHash,+          rebuildGroupIdText (query ^. #rebuildGroupId),+          commaSeparated targetIdText (query ^. #observedTargets),+          renderInventoryFreshness (query ^. #freshness),+          maybe "no-cursor" renderInventoryCursor (query ^. #cursor)+        ]+    renderSubscription :: InventorySubscription -> Text+    renderSubscription subscription =+      Text.intercalate+        "|"+        [ "subscription",+          subscriptionIdText (subscription ^. #subscriptionId),+          subscription ^. #subscriptionName,+          sourceIdText (subscription ^. #sourceId),+          missingCheckpointPolicyText (subscription ^. #checkpointOnMissing)+        ]+    renderDedup :: InventoryDedupKey -> Text+    renderDedup key =+      Text.intercalate+        "|"+        ["dedup", dedupKeyIdText (key ^. #dedupKeyId), key ^. #dedupName]++renderInventoryFreshness :: InventoryQueryFreshness -> Text+renderInventoryFreshness InventoryImmediate = "immediate"+renderInventoryFreshness (InventoryWaitForHead scope) =+  "wait-for-head:" <> headScopeText scope+renderInventoryFreshness InventoryWaitForPosition = "wait-for-position"++renderInventoryCursor :: InventoryQueryCursor -> Text+renderInventoryCursor queryCursor =+  "cursor:"+    <> subscriptionIdText (queryCursor ^. #subscriptionId)+    <> "/"+    <> queryCursor ^. #subscriptionName++renderScope :: SourceScope -> Text+renderScope AllStreams = "$all"+renderScope (CategorySource (CategoryName category)) = "category:" <> category++renderReset :: TargetResetPolicy -> Text+renderReset ClearBeforeReplay = "clear-before-replay"+renderReset PreserveAndReconcile = "preserve-and-reconcile"++renderQualifiedTable :: QualifiedTable -> Text+renderQualifiedTable table = table ^. #schemaName <> "." <> table ^. #tableName++renderHandler :: InventoryHandler -> Text+renderHandler (InventoryInlineHandler name) = "inline:" <> name+renderHandler (InventoryAsyncHandler name subscriptionId dedupId) =+  Text.intercalate ":" ["async", name, subscriptionIdText subscriptionId, dedupKeyIdText dedupId]++renderTargetProvisioner :: InventoryTargetProvisioner -> Text+renderTargetProvisioner provisioner =+  Text.intercalate+    "@"+    [ targetIdText (provisioner ^. #targetId),+      provisioner ^. #provisionerId <> ":" <> Text.pack (show (provisioner ^. #provisionerVersion)),+      targetSchemaVersionText (provisioner ^. #schemaVersion),+      provisioner ^. #expectedShapeId,+      provisioner ^. #validatorId <> ":" <> Text.pack (show (provisioner ^. #validatorVersion)),+      Text.intercalate ";" (map renderPromotionObject (provisioner ^. #promotionObjectNames))+    ]++renderRevisionHandler :: Text -> InventoryRevisionHandler -> Text+renderRevisionHandler kind handler =+  Text.intercalate+    ":"+    [ kind,+      handler ^. #handlerId,+      Text.pack (show (handler ^. #handlerVersion)),+      maybe "-" renderRevisionLiveDelivery (handler ^. #delivery),+      commaSeparated targetIdText (handler ^. #requiredTargets)+    ]++renderRevisionLiveDelivery :: RevisionLiveDelivery -> Text+renderRevisionLiveDelivery = \case+  RevisionInlineDelivery projectionId handlerName ->+    Text.intercalate "/" ["inline", projectionIdText projectionId, handlerName]+  RevisionSubscriptionDelivery projectionId subscriptionId dedupId ->+    Text.intercalate+      "/"+      [ "subscription",+        projectionIdText projectionId,+        subscriptionIdText subscriptionId,+        dedupKeyIdText dedupId+      ]++renderPromotionObject :: PromotionObjectName -> Text+renderPromotionObject object =+  Text.intercalate+    ":"+    [ promotionObjectKindText (object ^. #objectKind),+      object ^. #generationName,+      object ^. #canonicalName+    ]++promotionObjectKindText :: PromotionObjectKind -> Text+promotionObjectKindText PromotionIndex = "index"+promotionObjectKindText PromotionConstraint = "constraint"+promotionObjectKindText PromotionOwnedSequence = "owned-sequence"++targetSchemaVersionText :: TargetSchemaVersion -> Text+targetSchemaVersionText (TargetSchemaVersion value) = value++commaSeparated :: (value -> Text) -> [value] -> Text+commaSeparated render = Text.intercalate "," . map render++diagnostic :: CatalogDiagnosticCode -> Text -> [ClaimSite] -> Text -> CatalogDiagnostic+diagnostic code identity sites message =+  CatalogDiagnostic+    { diagnosticCode = code,+      diagnosticIdentity = identity,+      diagnosticSites = List.sort (List.nub sites),+      diagnosticMessage = message+    }++duplicates :: (Ord value) => [value] -> [value]+duplicates =+  map NonEmpty.head+    . filter ((> 1) . NonEmpty.length)+    . NonEmpty.group+    . List.sort++newtype UnmanagedInlineProjections event+  = UnmanagedInlineProjections [InlineProjection event]++-- | Mark an existing hand-maintained inline list as outside catalog validation.+unmanagedInlineProjections :: [InlineProjection event] -> UnmanagedInlineProjections event+unmanagedInlineProjections = UnmanagedInlineProjections++getUnmanagedInlineProjections :: UnmanagedInlineProjections event -> [InlineProjection event]+getUnmanagedInlineProjections (UnmanagedInlineProjections projections) = projections++newtype UnmanagedAsyncProjection+  = UnmanagedAsyncProjection AsyncProjection++-- | Mark a legacy async projection as outside catalog validation.+unmanagedAsyncProjection :: AsyncProjection -> UnmanagedAsyncProjection+unmanagedAsyncProjection = UnmanagedAsyncProjection++getUnmanagedAsyncProjection :: UnmanagedAsyncProjection -> AsyncProjection+getUnmanagedAsyncProjection (UnmanagedAsyncProjection projection) = projection++newtype UnmanagedReadModel q r+  = UnmanagedReadModel (ReadModel q r)++-- | Mark a legacy read model as outside catalog validation.+unmanagedReadModel :: ReadModel q r -> UnmanagedReadModel q r+unmanagedReadModel = UnmanagedReadModel++getUnmanagedReadModel :: UnmanagedReadModel q r -> ReadModel q r+getUnmanagedReadModel (UnmanagedReadModel model) = model