keiro-migrations 0.3.0.0 → 0.4.0.1

raw patch · 13 files changed

+1659/−44 lines, 13 filesdep ~directorydep ~generic-lensdep ~hasqlPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: directory, generic-lens, hasql, hasql-pool, lens, text, time, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +38/−1
• app/Main.hs +334/−11
• expected-schema/native/keiro-v18.txt +300/−0
• keiro-migrations.cabal +16/−10
• migrations.native.lock +20/−0
• migrations/0019-keiro-snapshots-state-shape-hash.sql +9/−0
• migrations/0020-keiro-workflow-children-failure-reason.sql +4/−0
• migrations/manifest +2/−0
• src/Keiro/Migrations.hs +167/−1
• src/Keiro/Migrations/Internal/Definition.hs +9/−0
• src/Keiro/Migrations/SchemaCheck.hs +225/−0
• test/Lint.hs +117/−0
• test/Main.hs +418/−21

@@ -6,7 +6,44 @@  ## [Unreleased] -_No unreleased changes._+## 0.4.0.1 — 2026-07-28++### Other Changes++- Adds PVP upper bounds to every dependency that previously carried a lower+  bound only, so `cabal check` reports no packaging warnings. No API or+  behaviour change from 0.4.0.0, which was tagged but never published.+++## 0.4.0.0 — 2026-07-28++### Breaking Changes++- `keiro-migrate up` now refuses to initialize an absent or empty native+  `pgmigrate` ledger over a detected Codd ledger. Import the verified Codd+  history first, or use `--allow-fresh-ledger-over-codd` only when deliberately+  abandoning that history.++### New Features++- Adds the read-only `missingMigrations` startup handshake so every application+  replica can reject pending, corrupt, or unknown migration history before+  serving traffic.+- Adds a canonical PostgreSQL 18 schema snapshot and `keiro-migrate+  verify-schema`, which reports missing, unexpected, or changed objects in the+  live `keiro` schema.+- Adds `keiro-migrate import-codd-history`, with exact Kiroku/Keiro payload+  mappings, advisory locking, confirmation, structured reports, and recovery+  coverage for interrupted or poisoned imports.++### Bug Fixes++- Embedded migration changes now force GHC recompilation through+  `pg-migrate-embed`, preventing an incremental build from retaining stale SQL+  or manifest bytes.+- Default conformance again lints every embedded migration for schema+  qualification and forbidden `search_path` dependence, and pins the native+  payload lock against accidental edits.  ## 0.3.0.0 — 2026-07-14 

@@ -2,38 +2,361 @@  import Data.Aeson qualified as Aeson import Data.ByteString.Lazy.Char8 qualified as LazyByteString+import Data.Foldable (toList, traverse_)+import Data.Int (Int64) import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO-import Database.PostgreSQL.Migrate (defaultRunOptions)+import Database.PostgreSQL.Migrate (+    Confirmation (..),+    HistoryImportError (..),+    HistoryImportOutcome (..),+    HistoryImportReport (..),+    HistoryImportResult (..),+    MigrationId,+    MigrationPlan,+    connectionProviderFromSettings,+    defaultImportOptions,+    defaultRunOptions,+ ) import Database.PostgreSQL.Migrate.CLI+import Database.PostgreSQL.Migrate.History.Codd (+    CoddImportError (..),+    defaultCoddLockKey,+    importCoddHistory,+    withCoddLockKey,+ )+import Database.PostgreSQL.Migrate.Internal (+    componentNameText,+    migrationIdComponent,+    migrationIdName,+    migrationNameText,+ ) import Hasql.Connection.Settings qualified as Settings-import Keiro.Migrations (frameworkMigrationPlan, keiroMigrations)+import Keiro.Migrations (+    CoddLedgerPreflight (..),+    frameworkMigrationPlan,+    keiroMigrations,+    preflightFreshLedgerOverCodd,+    renderCoddPreflight,+ )+import Keiro.Migrations.History.Codd (+    frameworkCoddHistoryMappings,+    frameworkCoddSourceConfig,+ )+import Keiro.Migrations.SchemaCheck (+    renderSchemaDrift,+    verifyExpectedSchema,+ ) import Kiroku.Store.Migrations qualified as Kiroku+import Numeric qualified import Options.Applicative import System.Environment (lookupEnv) import System.Exit qualified as Exit+import System.IO (stderr)+import Text.Read qualified as Read  main :: IO () main = do     kiroku <- either (fail . show) pure Kiroku.kirokuMigrations     keiro <- either (fail . show) pure keiroMigrations     plan <- either (fail . show) pure (frameworkMigrationPlan kiroku keiro)-    command <-+    invocation <-         execParser             ( info-                (migrationCommandParser plan <**> helper)+                (keiroInvocationParser plan <**> helper)                 (fullDesc <> progDesc "Manage the Kiroku and Keiro migration components")             )     defaultDatabaseUrl <- lookupEnv "DATABASE_URL"     let defaultSettings =             Settings.connectionString (Text.pack (maybe "" id defaultDatabaseUrl))-        environment = cliEnvironment defaultSettings plan defaultRunOptions-    outcome <- runMigrationCommand environment command-    case commandOutputFormat command of-        TextOutput -> Text.IO.putStrLn (renderMigrationCommandText outcome)-        JsonOutput -> LazyByteString.putStrLn (Aeson.encode (renderMigrationCommandJson outcome))-    Exit.exitWith-        (case exitClass outcome of ExitSucceeded -> Exit.ExitSuccess; _ -> Exit.ExitFailure 1)+    runKeiroInvocation defaultSettings plan invocation++data KeiroInvocation = KeiroInvocation+    { allowFreshLedgerOverCodd :: Bool+    , keiroCommand :: KeiroCommand+    }++runKeiroInvocation ::+    Settings.Settings ->+    MigrationPlan ->+    KeiroInvocation ->+    IO ()+runKeiroInvocation+    defaultSettings+    plan+    KeiroInvocation{allowFreshLedgerOverCodd, keiroCommand} = do+        if allowFreshLedgerOverCodd && not (isUpCommand keiroCommand)+            then do+                Text.IO.hPutStrLn+                    stderr+                    "--allow-fresh-ledger-over-codd applies only to up"+                Exit.exitFailure+            else pure ()+        case keiroCommand of+            Framework command -> do+                preflightFrameworkUp defaultSettings allowFreshLedgerOverCodd command+                let environment = cliEnvironment defaultSettings plan defaultRunOptions+                outcome <- runMigrationCommand environment command+                case commandOutputFormat command of+                    TextOutput -> Text.IO.putStrLn (renderMigrationCommandText outcome)+                    JsonOutput -> LazyByteString.putStrLn (Aeson.encode (renderMigrationCommandJson outcome))+                Exit.exitWith+                    (case exitClass outcome of ExitSucceeded -> Exit.ExitSuccess; _ -> Exit.ExitFailure 1)+            VerifySchema options ->+                runVerifySchema defaultSettings options+            ImportCoddHistory options ->+                runImportCoddHistory defaultSettings plan options++isUpCommand :: KeiroCommand -> Bool+isUpCommand keiroCommand =+    case keiroCommand of+        Framework Up{} -> True+        _ -> False++preflightFrameworkUp ::+    Settings.Settings ->+    Bool ->+    MigrationCommand ->+    IO ()+preflightFrameworkUp defaultSettings allowFreshLedgerOverCodd command =+    case command of+        Up UpOptions{connection = ConnectionOptions{databaseSettings}}+            | not allowFreshLedgerOverCodd -> do+                result <-+                    preflightFreshLedgerOverCodd+                        (maybe defaultSettings id databaseSettings)+                case result of+                    Left migrationError -> do+                        Text.IO.hPutStrLn+                            stderr+                            ( "codd-ledger preflight failed: "+                                <> Text.pack (show migrationError)+                            )+                        Exit.exitFailure+                    Right CoddPreflightClear -> pure ()+                    Right blocked@CoddPreflightBlocked{} -> do+                        Text.IO.hPutStrLn stderr (renderCoddPreflight blocked)+                        Exit.exitFailure+        _ -> pure ()++data KeiroCommand+    = Framework MigrationCommand+    | VerifySchema VerifySchemaOptions+    | ImportCoddHistory ImportCoddOptions++newtype VerifySchemaOptions = VerifySchemaOptions+    { verifySchemaDatabaseSettings :: Maybe Settings.Settings+    }++data ImportCoddOptions = ImportCoddOptions+    { importTargetSettings :: Maybe Settings.Settings+    , importSourceSettings :: Maybe Settings.Settings+    , importSourceLockKey :: Int64+    , importReason :: Text.Text+    , importConfirmation :: Confirmation+    , importJsonOutput :: Bool+    }++keiroInvocationParser :: MigrationPlan -> Parser KeiroInvocation+keiroInvocationParser plan =+    KeiroInvocation+        <$> switch+            ( long "allow-fresh-ledger-over-codd"+                <> help+                    "Allow up to initialize native history even when a codd ledger exists"+            )+        <*> keiroCommandParser plan++keiroCommandParser :: MigrationPlan -> Parser KeiroCommand+keiroCommandParser plan =+    (Framework <$> migrationCommandParser plan)+        <|> subparser+            ( commandGroup "Keiro"+                <> Options.Applicative.command+                    "verify-schema"+                    ( info+                        (VerifySchema <$> verifySchemaOptionsParser <**> helper)+                        (progDesc "Compare live keiro schema objects against the embedded expected snapshot")+                    )+                <> Options.Applicative.command+                    "import-codd-history"+                    ( info+                        (ImportCoddHistory <$> importCoddOptionsParser <**> helper)+                        (progDesc "Import verified codd history into the native migration ledger")+                    )+            )++verifySchemaOptionsParser :: Parser VerifySchemaOptions+verifySchemaOptionsParser =+    VerifySchemaOptions+        <$> optional+            ( option+                databaseSettingsReader+                ( long "database-url"+                    <> metavar "URL"+                    <> help "PostgreSQL URI or keyword/value connection string; defaults to DATABASE_URL"+                )+            )++databaseSettingsReader :: ReadM Settings.Settings+databaseSettingsReader =+    Settings.connectionString . Text.pack <$> str++importCoddOptionsParser :: Parser ImportCoddOptions+importCoddOptionsParser =+    ImportCoddOptions+        <$> optional+            ( option+                databaseSettingsReader+                ( long "database-url"+                    <> metavar "URL"+                    <> help "Target PostgreSQL connection string; defaults to DATABASE_URL"+                )+            )+        <*> optional+            ( option+                databaseSettingsReader+                ( long "source-database-url"+                    <> metavar "URL"+                    <> help "Codd source connection string; defaults to the target database"+                )+            )+        <*> option+            lockKeyReader+            ( long "source-lock-key"+                <> metavar "INT64"+                <> value defaultCoddLockKey+                <> showDefault+                <> help "Cooperating legacy wrapper advisory-lock key (decimal or 0x hexadecimal)"+            )+        <*> (Text.pack <$> strOption (long "reason" <> metavar "TEXT" <> help "Audited reason for the history import"))+        <*> flag+            NotConfirmed+            Confirmed+            (long "confirm" <> help "Confirm the checked-in codd source evidence")+        <*> switch (long "json" <> help "Emit JSON schema version 1 conventions")++lockKeyReader :: ReadM Int64+lockKeyReader = eitherReader $ \input ->+    case input of+        '0' : 'x' : hexadecimal ->+            case (Numeric.readHex hexadecimal :: [(Integer, String)]) of+                [(parsed, "")] -> checkedInt64 parsed+                _ -> Left lockKeyError+        _ ->+            case (Read.readMaybe input :: Maybe Integer) of+                Just parsed -> checkedInt64 parsed+                Nothing -> Left lockKeyError+  where+    checkedInt64 parsed+        | parsed < toInteger (minBound :: Int64) = Left lockKeyError+        | parsed > toInteger (maxBound :: Int64) = Left lockKeyError+        | otherwise = Right (fromInteger parsed)++    lockKeyError = "expected an Int64 decimal or 0x hexadecimal advisory-lock key"++runVerifySchema :: Settings.Settings -> VerifySchemaOptions -> IO ()+runVerifySchema defaultSettings VerifySchemaOptions{verifySchemaDatabaseSettings} = do+    result <-+        verifyExpectedSchema+            (maybe defaultSettings id verifySchemaDatabaseSettings)+    case result of+        Left migrationError -> do+            Text.IO.putStrLn+                ("schema verification failed: " <> Text.pack (show migrationError))+            Exit.exitFailure+        Right [] ->+            Text.IO.putStrLn "schema verification succeeded"+        Right drifts -> do+            traverse_ (Text.IO.putStrLn . renderSchemaDrift) drifts+            Exit.exitFailure++runImportCoddHistory ::+    Settings.Settings ->+    MigrationPlan ->+    ImportCoddOptions ->+    IO ()+runImportCoddHistory+    defaultSettings+    plan+    ImportCoddOptions+        { importTargetSettings+        , importSourceSettings+        , importSourceLockKey+        , importReason+        , importConfirmation+        , importJsonOutput+        } = do+        let targetSettings = maybe defaultSettings id importTargetSettings+            sourceSettings = maybe targetSettings id importSourceSettings+            targetProvider = connectionProviderFromSettings targetSettings+            sourceProvider = connectionProviderFromSettings sourceSettings+        case frameworkCoddSourceConfig+            sourceProvider+            True+            importReason+            importConfirmation of+            Left definitionError -> do+                Text.IO.hPutStrLn+                    stderr+                    ("codd history import definition failed: " <> Text.pack (show definitionError))+                Exit.exitFailure+            Right baseConfig -> do+                let config =+                        if importSourceLockKey == defaultCoddLockKey+                            then baseConfig+                            else withCoddLockKey importSourceLockKey baseConfig+                result <-+                    importCoddHistory+                        defaultImportOptions+                        config+                        targetProvider+                        plan+                        frameworkCoddHistoryMappings+                case result of+                    Left importError -> do+                        Text.IO.hPutStrLn stderr (renderCoddImportError importError)+                        Exit.exitFailure+                    Right report+                        | importJsonOutput ->+                            LazyByteString.putStrLn+                                (Aeson.encode (renderHistoryImportJson "codd" report))+                        | otherwise ->+                            Text.IO.putStr (renderHistoryImportText report)++renderHistoryImportText :: HistoryImportReport -> Text.Text+renderHistoryImportText HistoryImportReport{importResults} =+    Text.unlines (renderResult <$> toList importResults)+  where+    renderResult HistoryImportResult{importedMigration, importOutcome} =+        outcomeText importOutcome <> " " <> migrationIdText importedMigration++    outcomeText Imported = "imported"+    outcomeText AlreadyImported = "already imported"++migrationIdText :: MigrationId -> Text.Text+migrationIdText identifier =+    componentNameText (migrationIdComponent identifier)+        <> "/"+        <> migrationNameText (migrationIdName identifier)++renderCoddImportError :: CoddImportError -> Text.Text+renderCoddImportError importError =+    "codd history import failed: "+        <> Text.pack (show importError)+        <> recoveryHint importError+  where+    recoveryHint CoddSelectedFilenameMissing{} = filenameRealignmentHint+    recoveryHint CoddStrictSourceHasUnselected{} = filenameRealignmentHint+    recoveryHint (CoddTargetImportFailed HistoryImportConflict{}) =+        " The native ledger already has rows without import evidence; see the recovery "+            <> "procedure in docs/user/upgrading-to-the-keiro-schema.md."+    recoveryHint _ = ""++    filenameRealignmentHint =+        " If this ledger predates the 2026-07-05 filename realignment, run "+            <> "keiro-migrations/ledger-fixups/"+            <> "2026-07-05-realign-keiro-migration-timestamps.sql first."  commandOutputFormat :: MigrationCommand -> OutputFormat commandOutputFormat command =

@@ -0,0 +1,300 @@+column	keiro_awakeables.awakeable_id	uuid not null+column	keiro_awakeables.completed_at	timestamp with time zone+column	keiro_awakeables.created_at	timestamp with time zone not null default now()+column	keiro_awakeables.owner_workflow_id	text not null+column	keiro_awakeables.owner_workflow_name	text not null+column	keiro_awakeables.payload	jsonb+column	keiro_awakeables.status	text not null default 'pending'::text+column	keiro_awakeables.updated_at	timestamp with time zone not null default now()+column	keiro_dead_letters.attempt_count	integer not null+column	keiro_dead_letters.correlation_id	text not null+column	keiro_dead_letters.created_at	timestamp with time zone not null default now()+column	keiro_dead_letters.dead_letter_id	bigint not null default nextval('keiro.keiro_dead_letters_dead_letter_id_seq'::regclass)+column	keiro_dead_letters.dispatcher_kind	text not null+column	keiro_dead_letters.dispatcher_name	text not null+column	keiro_dead_letters.emit_index	integer not null+column	keiro_dead_letters.error_class	text not null+column	keiro_dead_letters.error_detail	text not null+column	keiro_dead_letters.source_event_id	uuid not null+column	keiro_dead_letters.source_global_position	bigint not null+column	keiro_dead_letters.target_stream_name	text not null+column	keiro_inbox.attempt_count	bigint not null default 0+column	keiro_inbox.attributes	jsonb+column	keiro_inbox.causation_id	uuid+column	keiro_inbox.completed_at	timestamp with time zone+column	keiro_inbox.content_type	text not null+column	keiro_inbox.correlation_id	uuid+column	keiro_inbox.dedupe_key	text not null+column	keiro_inbox.destination	text+column	keiro_inbox.event_type	text+column	keiro_inbox.failed_at	timestamp with time zone+column	keiro_inbox.kafka_offset	bigint+column	keiro_inbox.kafka_partition	bigint+column	keiro_inbox.kafka_topic	text+column	keiro_inbox.last_error	text+column	keiro_inbox.message_id	text+column	keiro_inbox.occurred_at	timestamp with time zone+column	keiro_inbox.payload_bytes	bytea not null+column	keiro_inbox.received_at	timestamp with time zone not null default now()+column	keiro_inbox.schema_fingerprint	text+column	keiro_inbox.schema_id	bigint+column	keiro_inbox.schema_registry	text+column	keiro_inbox.schema_subject	text+column	keiro_inbox.schema_version	bigint+column	keiro_inbox.schema_version_ref	bigint+column	keiro_inbox.source	text not null+column	keiro_inbox.source_event_id	uuid+column	keiro_inbox.source_global_position	bigint+column	keiro_inbox.status	text not null default 'processing'::text+column	keiro_inbox.traceparent	text+column	keiro_inbox.tracestate	text+column	keiro_outbox.attempt_count	bigint not null default 0+column	keiro_outbox.attributes	jsonb+column	keiro_outbox.causation_id	uuid+column	keiro_outbox.content_type	text not null+column	keiro_outbox.correlation_id	uuid+column	keiro_outbox.created_at	timestamp with time zone not null default now()+column	keiro_outbox.destination	text not null+column	keiro_outbox.event_type	text not null+column	keiro_outbox.last_error	text+column	keiro_outbox.message_id	text not null+column	keiro_outbox.message_key	text+column	keiro_outbox.next_attempt_at	timestamp with time zone not null default now()+column	keiro_outbox.occurred_at	timestamp with time zone not null+column	keiro_outbox.outbox_id	uuid not null+column	keiro_outbox.payload_bytes	bytea not null+column	keiro_outbox.published_at	timestamp with time zone+column	keiro_outbox.schema_fingerprint	text+column	keiro_outbox.schema_id	bigint+column	keiro_outbox.schema_registry	text+column	keiro_outbox.schema_subject	text+column	keiro_outbox.schema_version	bigint not null+column	keiro_outbox.schema_version_ref	bigint+column	keiro_outbox.source	text not null+column	keiro_outbox.source_event_id	uuid+column	keiro_outbox.source_global_position	bigint+column	keiro_outbox.status	text not null default 'pending'::text+column	keiro_outbox.traceparent	text+column	keiro_outbox.tracestate	text+column	keiro_outbox.updated_at	timestamp with time zone not null default now()+column	keiro_projection_dedup.applied_at	timestamp with time zone not null default now()+column	keiro_projection_dedup.event_id	uuid not null+column	keiro_projection_dedup.projection_name	text not null+column	keiro_read_models.last_built_at	timestamp with time zone+column	keiro_read_models.name	text not null+column	keiro_read_models.shape_hash	text not null+column	keiro_read_models.status	text not null+column	keiro_read_models.updated_at	timestamp with time zone not null default now()+column	keiro_read_models.version	bigint not null+column	keiro_snapshots.created_at	timestamp with time zone not null default now()+column	keiro_snapshots.regfile_shape_hash	text not null+column	keiro_snapshots.state	jsonb not null+column	keiro_snapshots.state_codec_version	bigint not null+column	keiro_snapshots.state_shape_hash	text not null default ''::text+column	keiro_snapshots.stream_id	bigint not null+column	keiro_snapshots.stream_version	bigint not null+column	keiro_snapshots.updated_at	timestamp with time zone not null default now()+column	keiro_subscription_shards.bucket	integer not null+column	keiro_subscription_shards.heartbeat_at	timestamp with time zone+column	keiro_subscription_shards.lease_expires_at	timestamp with time zone+column	keiro_subscription_shards.owner_worker_id	uuid+column	keiro_subscription_shards.shard_count	integer not null+column	keiro_subscription_shards.subscription_name	text not null+column	keiro_subscription_shards.updated_at	timestamp with time zone not null default now()+column	keiro_timers.attempts	bigint not null default 0+column	keiro_timers.correlation_id	text not null+column	keiro_timers.created_at	timestamp with time zone not null default now()+column	keiro_timers.fire_at	timestamp with time zone not null+column	keiro_timers.fired_event_id	uuid+column	keiro_timers.last_error	text+column	keiro_timers.payload	jsonb not null+column	keiro_timers.process_manager_name	text not null+column	keiro_timers.status	text not null default 'scheduled'::text+column	keiro_timers.timer_id	uuid not null+column	keiro_timers.updated_at	timestamp with time zone not null default now()+column	keiro_workflow_children.await_step	text not null+column	keiro_workflow_children.child_id	text not null+column	keiro_workflow_children.child_name	text not null+column	keiro_workflow_children.completed_at	timestamp with time zone+column	keiro_workflow_children.created_at	timestamp with time zone not null default now()+column	keiro_workflow_children.failure_reason	text+column	keiro_workflow_children.parent_id	text not null+column	keiro_workflow_children.parent_name	text not null+column	keiro_workflow_children.result	jsonb+column	keiro_workflow_children.status	text not null default 'running'::text+column	keiro_workflow_children.updated_at	timestamp with time zone not null default now()+column	keiro_workflow_steps.generation	integer not null default 0+column	keiro_workflow_steps.recorded_at	timestamp with time zone not null default now()+column	keiro_workflow_steps.result	jsonb not null+column	keiro_workflow_steps.step_name	text not null+column	keiro_workflow_steps.workflow_id	text not null+column	keiro_workflow_steps.workflow_name	text not null+column	keiro_workflows.attempts	integer not null default 0+column	keiro_workflows.completed_at	timestamp with time zone+column	keiro_workflows.created_at	timestamp with time zone not null default now()+column	keiro_workflows.generation	integer not null default 0+column	keiro_workflows.last_error	text+column	keiro_workflows.lease_expires_at	timestamp with time zone+column	keiro_workflows.leased_by	text+column	keiro_workflows.next_attempt_at	timestamp with time zone+column	keiro_workflows.status	text not null default 'running'::text+column	keiro_workflows.updated_at	timestamp with time zone not null default now()+column	keiro_workflows.wake_after	timestamp with time zone+column	keiro_workflows.workflow_id	text not null+column	keiro_workflows.workflow_name	text not null+constraint	keiro_awakeables.keiro_awakeables_awakeable_id_not_null	NOT NULL awakeable_id+constraint	keiro_awakeables.keiro_awakeables_created_at_not_null	NOT NULL created_at+constraint	keiro_awakeables.keiro_awakeables_owner_workflow_id_not_null	NOT NULL owner_workflow_id+constraint	keiro_awakeables.keiro_awakeables_owner_workflow_name_not_null	NOT NULL owner_workflow_name+constraint	keiro_awakeables.keiro_awakeables_pkey	PRIMARY KEY (awakeable_id)+constraint	keiro_awakeables.keiro_awakeables_status_chk	CHECK ((status = ANY (ARRAY['pending'::text, 'completed'::text, 'cancelled'::text])))+constraint	keiro_awakeables.keiro_awakeables_status_not_null	NOT NULL status+constraint	keiro_awakeables.keiro_awakeables_updated_at_not_null	NOT NULL updated_at+constraint	keiro_dead_letters.keiro_dead_letters_attempt_count_chk	CHECK ((attempt_count >= 1))+constraint	keiro_dead_letters.keiro_dead_letters_attempt_count_not_null	NOT NULL attempt_count+constraint	keiro_dead_letters.keiro_dead_letters_correlation_id_not_null	NOT NULL correlation_id+constraint	keiro_dead_letters.keiro_dead_letters_created_at_not_null	NOT NULL created_at+constraint	keiro_dead_letters.keiro_dead_letters_dead_letter_id_not_null	NOT NULL dead_letter_id+constraint	keiro_dead_letters.keiro_dead_letters_dispatcher_kind_chk	CHECK ((dispatcher_kind = ANY (ARRAY['process-manager'::text, 'router'::text])))+constraint	keiro_dead_letters.keiro_dead_letters_dispatcher_kind_not_null	NOT NULL dispatcher_kind+constraint	keiro_dead_letters.keiro_dead_letters_dispatcher_name_not_null	NOT NULL dispatcher_name+constraint	keiro_dead_letters.keiro_dead_letters_dispatcher_name_source_event_id_emit_ind_key	UNIQUE (dispatcher_name, source_event_id, emit_index)+constraint	keiro_dead_letters.keiro_dead_letters_emit_index_not_null	NOT NULL emit_index+constraint	keiro_dead_letters.keiro_dead_letters_error_class_not_null	NOT NULL error_class+constraint	keiro_dead_letters.keiro_dead_letters_error_detail_not_null	NOT NULL error_detail+constraint	keiro_dead_letters.keiro_dead_letters_pkey	PRIMARY KEY (dead_letter_id)+constraint	keiro_dead_letters.keiro_dead_letters_source_event_id_not_null	NOT NULL source_event_id+constraint	keiro_dead_letters.keiro_dead_letters_source_global_position_not_null	NOT NULL source_global_position+constraint	keiro_dead_letters.keiro_dead_letters_target_stream_name_not_null	NOT NULL target_stream_name+constraint	keiro_inbox.keiro_inbox_attempt_count_not_null	NOT NULL attempt_count+constraint	keiro_inbox.keiro_inbox_content_type_not_null	NOT NULL content_type+constraint	keiro_inbox.keiro_inbox_dedupe_key_not_null	NOT NULL dedupe_key+constraint	keiro_inbox.keiro_inbox_payload_bytes_not_null	NOT NULL payload_bytes+constraint	keiro_inbox.keiro_inbox_pkey	PRIMARY KEY (source, dedupe_key)+constraint	keiro_inbox.keiro_inbox_received_at_not_null	NOT NULL received_at+constraint	keiro_inbox.keiro_inbox_source_not_null	NOT NULL source+constraint	keiro_inbox.keiro_inbox_status_not_null	NOT NULL status+constraint	keiro_outbox.keiro_outbox_attempt_count_not_null	NOT NULL attempt_count+constraint	keiro_outbox.keiro_outbox_content_type_not_null	NOT NULL content_type+constraint	keiro_outbox.keiro_outbox_created_at_not_null	NOT NULL created_at+constraint	keiro_outbox.keiro_outbox_destination_not_null	NOT NULL destination+constraint	keiro_outbox.keiro_outbox_event_type_not_null	NOT NULL event_type+constraint	keiro_outbox.keiro_outbox_message_id_not_null	NOT NULL message_id+constraint	keiro_outbox.keiro_outbox_next_attempt_at_not_null	NOT NULL next_attempt_at+constraint	keiro_outbox.keiro_outbox_occurred_at_not_null	NOT NULL occurred_at+constraint	keiro_outbox.keiro_outbox_outbox_id_not_null	NOT NULL outbox_id+constraint	keiro_outbox.keiro_outbox_payload_bytes_not_null	NOT NULL payload_bytes+constraint	keiro_outbox.keiro_outbox_pkey	PRIMARY KEY (outbox_id)+constraint	keiro_outbox.keiro_outbox_schema_version_not_null	NOT NULL schema_version+constraint	keiro_outbox.keiro_outbox_source_message_id_key	UNIQUE (source, message_id)+constraint	keiro_outbox.keiro_outbox_source_not_null	NOT NULL source+constraint	keiro_outbox.keiro_outbox_status_not_null	NOT NULL status+constraint	keiro_outbox.keiro_outbox_updated_at_not_null	NOT NULL updated_at+constraint	keiro_projection_dedup.keiro_projection_dedup_applied_at_not_null	NOT NULL applied_at+constraint	keiro_projection_dedup.keiro_projection_dedup_event_id_not_null	NOT NULL event_id+constraint	keiro_projection_dedup.keiro_projection_dedup_pkey	PRIMARY KEY (projection_name, event_id)+constraint	keiro_projection_dedup.keiro_projection_dedup_projection_name_not_null	NOT NULL projection_name+constraint	keiro_read_models.keiro_read_models_name_not_null	NOT NULL name+constraint	keiro_read_models.keiro_read_models_pkey	PRIMARY KEY (name)+constraint	keiro_read_models.keiro_read_models_shape_hash_not_null	NOT NULL shape_hash+constraint	keiro_read_models.keiro_read_models_status_not_null	NOT NULL status+constraint	keiro_read_models.keiro_read_models_updated_at_not_null	NOT NULL updated_at+constraint	keiro_read_models.keiro_read_models_version_not_null	NOT NULL version+constraint	keiro_snapshots.keiro_snapshots_created_at_not_null	NOT NULL created_at+constraint	keiro_snapshots.keiro_snapshots_pkey	PRIMARY KEY (stream_id)+constraint	keiro_snapshots.keiro_snapshots_regfile_shape_hash_not_null	NOT NULL regfile_shape_hash+constraint	keiro_snapshots.keiro_snapshots_state_codec_version_not_null	NOT NULL state_codec_version+constraint	keiro_snapshots.keiro_snapshots_state_not_null	NOT NULL state+constraint	keiro_snapshots.keiro_snapshots_state_shape_hash_not_null	NOT NULL state_shape_hash+constraint	keiro_snapshots.keiro_snapshots_stream_id_not_null	NOT NULL stream_id+constraint	keiro_snapshots.keiro_snapshots_stream_version_not_null	NOT NULL stream_version+constraint	keiro_snapshots.keiro_snapshots_updated_at_not_null	NOT NULL updated_at+constraint	keiro_subscription_shards.keiro_subscription_shards_bucket_not_null	NOT NULL bucket+constraint	keiro_subscription_shards.keiro_subscription_shards_bucket_range_chk	CHECK (((bucket >= 0) AND (bucket < shard_count)))+constraint	keiro_subscription_shards.keiro_subscription_shards_count_chk	CHECK ((shard_count >= 1))+constraint	keiro_subscription_shards.keiro_subscription_shards_pkey	PRIMARY KEY (subscription_name, bucket)+constraint	keiro_subscription_shards.keiro_subscription_shards_shard_count_not_null	NOT NULL shard_count+constraint	keiro_subscription_shards.keiro_subscription_shards_subscription_name_not_null	NOT NULL subscription_name+constraint	keiro_subscription_shards.keiro_subscription_shards_updated_at_not_null	NOT NULL updated_at+constraint	keiro_timers.keiro_timers_attempts_not_null	NOT NULL attempts+constraint	keiro_timers.keiro_timers_correlation_id_not_null	NOT NULL correlation_id+constraint	keiro_timers.keiro_timers_created_at_not_null	NOT NULL created_at+constraint	keiro_timers.keiro_timers_fire_at_not_null	NOT NULL fire_at+constraint	keiro_timers.keiro_timers_payload_not_null	NOT NULL payload+constraint	keiro_timers.keiro_timers_pkey	PRIMARY KEY (timer_id)+constraint	keiro_timers.keiro_timers_process_manager_name_not_null	NOT NULL process_manager_name+constraint	keiro_timers.keiro_timers_status_not_null	NOT NULL status+constraint	keiro_timers.keiro_timers_timer_id_not_null	NOT NULL timer_id+constraint	keiro_timers.keiro_timers_updated_at_not_null	NOT NULL updated_at+constraint	keiro_workflow_children.keiro_workflow_children_await_step_not_null	NOT NULL await_step+constraint	keiro_workflow_children.keiro_workflow_children_child_id_not_null	NOT NULL child_id+constraint	keiro_workflow_children.keiro_workflow_children_child_name_not_null	NOT NULL child_name+constraint	keiro_workflow_children.keiro_workflow_children_created_at_not_null	NOT NULL created_at+constraint	keiro_workflow_children.keiro_workflow_children_parent_id_not_null	NOT NULL parent_id+constraint	keiro_workflow_children.keiro_workflow_children_parent_name_not_null	NOT NULL parent_name+constraint	keiro_workflow_children.keiro_workflow_children_pkey	PRIMARY KEY (child_id, child_name)+constraint	keiro_workflow_children.keiro_workflow_children_status_chk	CHECK ((status = ANY (ARRAY['running'::text, 'completed'::text, 'cancelled'::text, 'failed'::text])))+constraint	keiro_workflow_children.keiro_workflow_children_status_not_null	NOT NULL status+constraint	keiro_workflow_children.keiro_workflow_children_updated_at_not_null	NOT NULL updated_at+constraint	keiro_workflow_steps.keiro_workflow_steps_generation_not_null	NOT NULL generation+constraint	keiro_workflow_steps.keiro_workflow_steps_pkey	PRIMARY KEY (workflow_id, workflow_name, generation, step_name)+constraint	keiro_workflow_steps.keiro_workflow_steps_recorded_at_not_null	NOT NULL recorded_at+constraint	keiro_workflow_steps.keiro_workflow_steps_result_not_null	NOT NULL result+constraint	keiro_workflow_steps.keiro_workflow_steps_step_name_not_null	NOT NULL step_name+constraint	keiro_workflow_steps.keiro_workflow_steps_workflow_id_not_null	NOT NULL workflow_id+constraint	keiro_workflow_steps.keiro_workflow_steps_workflow_name_not_null	NOT NULL workflow_name+constraint	keiro_workflows.keiro_workflows_attempts_not_null	NOT NULL attempts+constraint	keiro_workflows.keiro_workflows_created_at_not_null	NOT NULL created_at+constraint	keiro_workflows.keiro_workflows_generation_not_null	NOT NULL generation+constraint	keiro_workflows.keiro_workflows_pkey	PRIMARY KEY (workflow_id, workflow_name)+constraint	keiro_workflows.keiro_workflows_status_chk	CHECK ((status = ANY (ARRAY['running'::text, 'suspended'::text, 'completed'::text, 'cancelled'::text, 'failed'::text])))+constraint	keiro_workflows.keiro_workflows_status_not_null	NOT NULL status+constraint	keiro_workflows.keiro_workflows_updated_at_not_null	NOT NULL updated_at+constraint	keiro_workflows.keiro_workflows_workflow_id_not_null	NOT NULL workflow_id+constraint	keiro_workflows.keiro_workflows_workflow_name_not_null	NOT NULL workflow_name+index	keiro_awakeables_owner_idx	CREATE INDEX keiro_awakeables_owner_idx ON keiro.keiro_awakeables USING btree (owner_workflow_name, owner_workflow_id)+index	keiro_awakeables_pending_idx	CREATE INDEX keiro_awakeables_pending_idx ON keiro.keiro_awakeables USING btree (status) WHERE (status = 'pending'::text)+index	keiro_awakeables_pkey	CREATE UNIQUE INDEX keiro_awakeables_pkey ON keiro.keiro_awakeables USING btree (awakeable_id)+index	keiro_dead_letters_dispatcher_created_at_idx	CREATE INDEX keiro_dead_letters_dispatcher_created_at_idx ON keiro.keiro_dead_letters USING btree (dispatcher_name, created_at DESC)+index	keiro_dead_letters_dispatcher_name_source_event_id_emit_ind_key	CREATE UNIQUE INDEX keiro_dead_letters_dispatcher_name_source_event_id_emit_ind_key ON keiro.keiro_dead_letters USING btree (dispatcher_name, source_event_id, emit_index)+index	keiro_dead_letters_pkey	CREATE UNIQUE INDEX keiro_dead_letters_pkey ON keiro.keiro_dead_letters USING btree (dead_letter_id)+index	keiro_inbox_backlog_idx	CREATE INDEX keiro_inbox_backlog_idx ON keiro.keiro_inbox USING btree (status) WHERE (status = ANY (ARRAY['processing'::text, 'failed'::text]))+index	keiro_inbox_completed_idx	CREATE INDEX keiro_inbox_completed_idx ON keiro.keiro_inbox USING btree (completed_at) WHERE (status = 'completed'::text)+index	keiro_inbox_pkey	CREATE UNIQUE INDEX keiro_inbox_pkey ON keiro.keiro_inbox USING btree (source, dedupe_key)+index	keiro_outbox_claim_order_idx	CREATE INDEX keiro_outbox_claim_order_idx ON keiro.keiro_outbox USING btree (created_at, outbox_id) WHERE (status = ANY (ARRAY['pending'::text, 'failed'::text]))+index	keiro_outbox_head_of_line_idx	CREATE INDEX keiro_outbox_head_of_line_idx ON keiro.keiro_outbox USING btree (source, message_key, created_at) WHERE ((status <> ALL (ARRAY['sent'::text, 'dead'::text])) AND (message_key IS NOT NULL))+index	keiro_outbox_pending_idx	CREATE INDEX keiro_outbox_pending_idx ON keiro.keiro_outbox USING btree (status, next_attempt_at, created_at)+index	keiro_outbox_pkey	CREATE UNIQUE INDEX keiro_outbox_pkey ON keiro.keiro_outbox USING btree (outbox_id)+index	keiro_outbox_sent_gc_idx	CREATE INDEX keiro_outbox_sent_gc_idx ON keiro.keiro_outbox USING btree (published_at) WHERE (status = 'sent'::text)+index	keiro_outbox_source_message_id_key	CREATE UNIQUE INDEX keiro_outbox_source_message_id_key ON keiro.keiro_outbox USING btree (source, message_id)+index	keiro_outbox_source_order_idx	CREATE INDEX keiro_outbox_source_order_idx ON keiro.keiro_outbox USING btree (source, created_at, outbox_id) WHERE (status <> ALL (ARRAY['sent'::text, 'dead'::text]))+index	keiro_projection_dedup_applied_at_idx	CREATE INDEX keiro_projection_dedup_applied_at_idx ON keiro.keiro_projection_dedup USING btree (applied_at)+index	keiro_projection_dedup_pkey	CREATE UNIQUE INDEX keiro_projection_dedup_pkey ON keiro.keiro_projection_dedup USING btree (projection_name, event_id)+index	keiro_read_models_pkey	CREATE UNIQUE INDEX keiro_read_models_pkey ON keiro.keiro_read_models USING btree (name)+index	keiro_snapshots_compat_idx	CREATE INDEX keiro_snapshots_compat_idx ON keiro.keiro_snapshots USING btree (stream_id, state_codec_version, regfile_shape_hash, stream_version DESC)+index	keiro_snapshots_pkey	CREATE UNIQUE INDEX keiro_snapshots_pkey ON keiro.keiro_snapshots USING btree (stream_id)+index	keiro_subscription_shards_lease_idx	CREATE INDEX keiro_subscription_shards_lease_idx ON keiro.keiro_subscription_shards USING btree (subscription_name, lease_expires_at)+index	keiro_subscription_shards_owner_idx	CREATE INDEX keiro_subscription_shards_owner_idx ON keiro.keiro_subscription_shards USING btree (subscription_name, owner_worker_id)+index	keiro_subscription_shards_pkey	CREATE UNIQUE INDEX keiro_subscription_shards_pkey ON keiro.keiro_subscription_shards USING btree (subscription_name, bucket)+index	keiro_timers_due_idx	CREATE INDEX keiro_timers_due_idx ON keiro.keiro_timers USING btree (status, fire_at, process_manager_name) WHERE (status = ANY (ARRAY['scheduled'::text, 'firing'::text]))+index	keiro_timers_pkey	CREATE UNIQUE INDEX keiro_timers_pkey ON keiro.keiro_timers USING btree (timer_id)+index	keiro_workflow_children_parent_idx	CREATE INDEX keiro_workflow_children_parent_idx ON keiro.keiro_workflow_children USING btree (parent_id, parent_name)+index	keiro_workflow_children_pkey	CREATE UNIQUE INDEX keiro_workflow_children_pkey ON keiro.keiro_workflow_children USING btree (child_id, child_name)+index	keiro_workflow_children_running_idx	CREATE INDEX keiro_workflow_children_running_idx ON keiro.keiro_workflow_children USING btree (status) WHERE (status = 'running'::text)+index	keiro_workflow_steps_pkey	CREATE UNIQUE INDEX keiro_workflow_steps_pkey ON keiro.keiro_workflow_steps USING btree (workflow_id, workflow_name, generation, step_name)+index	keiro_workflow_steps_workflow_idx	CREATE INDEX keiro_workflow_steps_workflow_idx ON keiro.keiro_workflow_steps USING btree (workflow_id, workflow_name, generation)+index	keiro_workflows_active_idx	CREATE INDEX keiro_workflows_active_idx ON keiro.keiro_workflows USING btree (status) WHERE (status = ANY (ARRAY['running'::text, 'suspended'::text]))+index	keiro_workflows_gc_idx	CREATE INDEX keiro_workflows_gc_idx ON keiro.keiro_workflows USING btree (status, completed_at)+index	keiro_workflows_pkey	CREATE UNIQUE INDEX keiro_workflows_pkey ON keiro.keiro_workflows USING btree (workflow_id, workflow_name)+table	keiro_awakeables	kind=r+table	keiro_dead_letters	kind=r+table	keiro_inbox	kind=r+table	keiro_outbox	kind=r+table	keiro_projection_dedup	kind=r+table	keiro_read_models	kind=r+table	keiro_snapshots	kind=r+table	keiro_subscription_shards	kind=r+table	keiro_timers	kind=r+table	keiro_workflow_children	kind=r+table	keiro_workflow_steps	kind=r+table	keiro_workflows	kind=r

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               keiro-migrations-version:            0.3.0.0+version:            0.4.0.1 synopsis:           Schema migrations for keiro description:   Embedded PostgreSQL schema migrations and a migration runner for the Keiro@@ -18,6 +18,7 @@   README.md  extra-source-files:+  expected-schema/native/keiro-v18.txt   expected-schema/v18/db-settings   expected-schema/v18/roles/keiro   expected-schema/v18/schemas/keiro/objrep@@ -289,6 +290,7 @@   migrations/*.sql   migrations/manifest   migrations.lock+  migrations.native.lock   sql-migrations/*.sql  source-repository head@@ -317,6 +319,7 @@   exposed-modules:     Keiro.Migrations     Keiro.Migrations.History.Codd+    Keiro.Migrations.SchemaCheck    other-modules:     Keiro.Migrations.Internal.Definition@@ -327,6 +330,7 @@     , base                     >=4.18     && <5     , bytestring               >=0.11     && <0.13     , containers               >=0.6      && <0.8+    , hasql                    >=1.10     && <1.11     , kiroku-store-migrations  ^>=0.3.0.0     , pg-migrate               ^>=1.1.0.0     , pg-migrate-embed         ^>=1.1.0.0@@ -343,7 +347,7 @@     build-depends:       , codd         >=0.1.8  && <0.2       , codd-extras  >=0.1    && <0.2-      , directory    >=1.3+      , directory    >=1.3    && <1.4       , file-embed   >=0.0.15 && <0.0.17       , filepath     >=1.4    && <1.6       , time         >=1.12   && <1.15@@ -363,6 +367,7 @@     , optparse-applicative     >=0.17     && <0.20     , pg-migrate               ^>=1.1.0.0     , pg-migrate-cli           ^>=1.1.0.0+    , pg-migrate-import-codd   ^>=1.1.0.0     , text                     >=2.0      && <2.2  executable keiro-write-expected-schema@@ -384,6 +389,7 @@   import:         common   type:           exitcode-stdio-1.0   main-is:        Main.hs+  other-modules:  Lint   hs-source-dirs: test   ghc-options:    -threaded -rtsopts -with-rtsopts=-N   build-depends:@@ -391,7 +397,7 @@     , base                     >=4.18     && <5     , bytestring               >=0.11     && <0.13     , containers               >=0.6      && <0.8-    , directory                >=1.3+    , directory                >=1.3      && <1.4     , ephemeral-pg             >=0.2      && <0.3     , filepath                 >=1.4      && <1.6     , hasql                    >=1.10     && <1.11@@ -425,15 +431,15 @@     , directory     , ephemeral-pg             >=0.2     , filepath-    , generic-lens             >=2.2-    , hasql                    >=1.10-    , hasql-pool               >=1.2+    , generic-lens             >=2.2      && <2.4+    , hasql                    >=1.10     && <1.11+    , hasql-pool               >=1.2      && <1.5     , hspec                    >=2.10     , keiro-migrations     , kiroku-store             >=0.3      && <0.4     , kiroku-store-migrations  ^>=0.3.0.0-    , lens                     >=5.2+    , lens                     >=5.2      && <5.4     , temporary-    , text                     >=2.0-    , time                     >=1.12-    , vector                   >=0.13+    , text                     >=2.0      && <2.2+    , time                     >=1.12     && <1.15+    , vector                   >=0.13     && <0.14

@@ -0,0 +1,20 @@+1d15faa7cfb474455c3a1193b454ce493d49589b0f9f62b0b8beff65a00f6403  0001-keiro-bootstrap.sql+4c9c645e7ac9ebc9228638a89580613bd0058444e20047486d4bd7696b9ddb0a  0002-keiro-outbox.sql+71aabbfd93e66b324691ca856ca73245d62d84d984ca162e1388726127daa5e5  0003-keiro-inbox.sql+42f1bbd4fb23b27b2be434f25b559b2e17870f1d8c6efbcf2ae6a702c6136f98  0004-keiro-timer-recovery.sql+e967d41342cddc8cfe8381e5f562603dbc9a10e61232458e24c5cb291cfe9047  0005-keiro-workflow-steps.sql+3b20ba3981ae718cfbb9ed68318131a50ca5ad715b459868b79ac1f4c138fc5c  0006-keiro-awakeables.sql+975c0e6480fa01f2af1e2c45a4396e2588af4560c9803b55e8b574ea2e69b5b2  0007-keiro-workflow-children.sql+f05e8254de4c328f9319db4db8b9a78d6fba552c245acf0e24c6c450d8d71559  0008-keiro-workflow-generation.sql+1a93b4fdad24624b168a0aeeb12c659c59764660cc11fa564e77aa4b32a54fca  0009-keiro-subscription-shards.sql+49a963745a637c8e0248b5b958a719ccc772dbd02ca77cf706fee5de8d8d1a85  0010-keiro-messaging-crash-recovery.sql+7c329c9f439d2bab927debf5dc8b96acb438b4e240ef16292723398ddf005fea  0011-keiro-workflows-instances.sql+77c394334c64ff0631eb1c831f60629123ae255f1be7fb1716748b6ff9d0b701  0012-keiro-workflow-gc-index.sql+a2ea08ce3debec078e89490403241d9fd4e5d4ff3ea64b2c01ab236fb2dda313  0013-keiro-workflows-wake-after.sql+ed5bef75d195df0335b86d36256fd4f1dab30cb1eab4e05f0a321bf8d989503a  0014-keiro-projection-dedup.sql+fd65320576b06e8d30a8308ac790be463c09906e74d81a6fd535e7745ef943c5  0015-keiro-outbox-claim-order-index.sql+50b169c9bc98e7ab6845c74b105d13990af3cdb2e587445fd869e942c28df81d  0016-keiro-inbox-drop-received-idx.sql+e2690e1e2517d28e596330d3bdfcc07f6a8d7e1b6e87b94f726630d221663900  0017-schema-management-comment.sql+be7e510421f983ac2e446ae655d000b810b19cf2667f328dd7caf41a2101d0b6  0018.sql+7a0d0280d8d54f811c33b4bec525d78fe8f172de92b62e4745dcdd217c656209  0019-keiro-snapshots-state-shape-hash.sql+c125e8c32a0848854d94bce1245f349cf7f479326a1bf540e9dba9e222b75a4f  0020-keiro-workflow-children-failure-reason.sql

@@ -0,0 +1,9 @@+-- keiro snapshots: fold-sensitive discriminator component (state shape hash).+--+-- Adds the third snapshot-compatibility column. Existing rows get the empty+-- string, which never equals a real hash, so every pre-existing snapshot is+-- treated as incompatible once: the next hydration falls back to full replay+-- and re-persists a seed carrying the real hash. Snapshots are advisory, so+-- this is a one-time replay cost, not a correctness event.+ALTER TABLE keiro.keiro_snapshots+  ADD COLUMN IF NOT EXISTS state_shape_hash TEXT NOT NULL DEFAULT '';

@@ -0,0 +1,4 @@+-- Preserve terminal child-workflow failures independently of a parent+-- generation's journal so awaitChild can deliver them after continue-as-new.+ALTER TABLE keiro.keiro_workflow_children+  ADD COLUMN IF NOT EXISTS failure_reason TEXT NULL;

@@ -16,3 +16,5 @@ 0016-keiro-inbox-drop-received-idx.sql 0017-schema-management-comment.sql 0018.sql+0019-keiro-snapshots-state-shape-hash.sql+0020-keiro-workflow-children-failure-reason.sql

@@ -1,21 +1,187 @@ module Keiro.Migrations (+    CoddLedgerPreflight (..),+    ConnectionProvider,     DefinitionError,     MigrationComponent,+    MigrationError,+    MigrationId,     MigrationPlan,     PlanError,+    RunOptions,+    StartupHandshake (..),+    VerificationIssue (..),+    connectionProviderFromSettings,+    defaultRunOptions,+    embeddedMigrationEntries,     frameworkMigrationPlan,+    handshakePassed,     keiroMigrations,+    missingMigrations,+    preflightFreshLedgerOverCodd,+    renderCoddPreflight, ) where +import Control.Exception (finally)+import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text) import Database.PostgreSQL.Migrate (+    ConnectionProvider,     DefinitionError,     MigrationComponent,+    MigrationError (..),+    MigrationId,     MigrationPlan,     PlanError,+    RunOptions,+    VerificationIssue (..),+    connectionProviderFromSettings,+    defaultRunOptions,     migrationPlan,+    migrationStatusWith,  )-import Keiro.Migrations.Internal.Definition (keiroMigrations)+import Database.PostgreSQL.Migrate qualified as Migrate+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session (Session)+import Hasql.Session qualified as Session+import Hasql.Statement (Statement)+import Hasql.Statement qualified as Statement+import Keiro.Migrations.Internal.Definition (+    embeddedMigrationEntries,+    keiroMigrations,+ )++-- | Whether a codd ledger makes initializing an empty native ledger unsafe.+data CoddLedgerPreflight+    = CoddPreflightClear+    | CoddPreflightBlocked+        { coddLedgerTable :: Text+        -- ^ The detected @codd.sql_migrations@ table.+        , nativeLedgerAbsent :: Bool+        -- ^ 'True' when @pgmigrate.migrations@ is absent; 'False' when it is empty.+        }+    deriving stock (Eq, Show)++-- | Refuse to initialize a fresh native ledger over a retired codd ledger.+preflightFreshLedgerOverCodd ::+    Settings.Settings ->+    IO (Either MigrationError CoddLedgerPreflight)+preflightFreshLedgerOverCodd settings = do+    acquired <- Connection.acquire settings+    case acquired of+        Left connectionError ->+            pure (Left (ConnectionAcquisitionFailed connectionError))+        Right connection -> do+            result <-+                Connection.use connection coddLedgerPreflightSession+                    `finally` Connection.release connection+            pure $ case result of+                Left sessionError -> Left (DatabaseSessionFailed sessionError)+                Right preflight -> Right preflight++-- | Render the blocked state as an operator-facing refusal.+renderCoddPreflight :: CoddLedgerPreflight -> Text+renderCoddPreflight preflight =+    case preflight of+        CoddPreflightClear -> ""+        CoddPreflightBlocked{coddLedgerTable, nativeLedgerAbsent} ->+            "refusing to run up: this database has a codd migration ledger ("+                <> coddLedgerTable+                <> ") and "+                <> nativeHistoryState nativeLedgerAbsent+                <> ". Running up here would initialize a fresh ledger over the codd one "+                <> "and re-plan every migration. Follow "+                <> "docs/user/upgrading-to-the-keiro-schema.md (import the codd history "+                <> "first), or pass --allow-fresh-ledger-over-codd if a fresh native "+                <> "ledger over the retired codd ledger is genuinely intended."+  where+    nativeHistoryState True = "no native pg-migrate history"+    nativeHistoryState False = "an empty native pg-migrate history"++coddLedgerPreflightSession :: Session CoddLedgerPreflight+coddLedgerPreflightSession = do+    (currentCoddExists, legacyCoddExists, nativeLedgerExists) <-+        Session.statement () ledgerPresenceStatement+    case detectedCoddLedger currentCoddExists legacyCoddExists of+        Nothing -> pure CoddPreflightClear+        Just coddLedgerTable+            | not nativeLedgerExists ->+                pure CoddPreflightBlocked{coddLedgerTable, nativeLedgerAbsent = True}+            | otherwise -> do+                nativeRows <- Session.statement () nativeLedgerCountStatement+                pure $+                    if nativeRows == 0+                        then+                            CoddPreflightBlocked+                                { coddLedgerTable+                                , nativeLedgerAbsent = False+                                }+                        else CoddPreflightClear++detectedCoddLedger :: Bool -> Bool -> Maybe Text+detectedCoddLedger currentCoddExists legacyCoddExists+    | currentCoddExists = Just "codd.sql_migrations"+    | legacyCoddExists = Just "codd_schema.sql_migrations"+    | otherwise = Nothing++ledgerPresenceStatement :: Statement () (Bool, Bool, Bool)+ledgerPresenceStatement =+    Statement.preparable+        """+        SELECT to_regclass('codd.sql_migrations') IS NOT NULL,+               to_regclass('codd_schema.sql_migrations') IS NOT NULL,+               to_regclass('pgmigrate.migrations') IS NOT NULL+        """+        Encoders.noParams+        ( Decoders.singleRow+            ( (,,)+                <$> column Decoders.bool+                <*> column Decoders.bool+                <*> column Decoders.bool+            )+        )+  where+    column = Decoders.column . Decoders.nonNullable++nativeLedgerCountStatement :: Statement () Int64+nativeLedgerCountStatement =+    Statement.preparable+        "SELECT count(*) FROM pgmigrate.migrations"+        Encoders.noParams+        (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++-- | Boot-time answer to "does this database carry every migration this binary expects?".+data StartupHandshake = StartupHandshake+    { pendingMigrations :: [MigrationId]+    -- ^ Declared migrations with no applied ledger row, in plan order.+    , ledgerIssues :: [VerificationIssue]+    -- ^ Checksum, position, kind, gap, status, or unknown-row problems.+    }+    deriving stock (Eq, Show)++-- | Whether the database is safe for this binary to serve requests.+handshakePassed :: StartupHandshake -> Bool+handshakePassed handshake =+    null (pendingMigrations handshake) && null (ledgerIssues handshake)++-- | Read-only boot-time migration check; safe to call from every replica.+missingMigrations ::+    RunOptions ->+    ConnectionProvider ->+    MigrationPlan ->+    IO (Either MigrationError StartupHandshake)+missingMigrations options provider plan =+    fmap toStartupHandshake <$> migrationStatusWith options provider plan+  where+    toStartupHandshake :: Migrate.StatusReport -> StartupHandshake+    toStartupHandshake (Migrate.StatusReport statusIssues _ pending _) =+        StartupHandshake+            { pendingMigrations = pending+            , ledgerIssues = statusIssues+            }  {- | Compose the concrete Kiroku and Keiro components in dependency order. 

@@ -1,4 +1,13 @@ {-# LANGUAGE TemplateHaskell #-}+-- GHC 9.12 has no Template Haskell directory-dependency API, so a sibling SQL+-- file that is added or removed without being listed in the manifest leaves this+-- module looking up to date and silently skips manifest membership validation.+-- The plugin forces GHC to reconsider this module on every build it runs.+-- Note this cannot help when no Haskell source changes at all: cabal then+-- reports "Up to date" and never invokes GHC. A clean build revalidates, and+-- the migrations.native.lock suite test checks directory membership at test+-- runtime regardless.+{-# OPTIONS_GHC -fplugin=Database.PostgreSQL.Migrate.Embed.RecompilePlugin #-}  module Keiro.Migrations.Internal.Definition (     embeddedMigrationEntries,

@@ -0,0 +1,225 @@+{-# LANGUAGE TemplateHaskell #-}++module Keiro.Migrations.SchemaCheck (+    SchemaDrift (..),+    compareSchemaSnapshot,+    expectedSchemaSnapshot,+    renderSchemaDrift,+    snapshotSchema,+    verifyExpectedSchema,+) where++import Control.Exception (finally)+import Data.Int (Int32)+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 (Text)+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate (MigrationError (..))+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session (Session)+import Hasql.Session qualified as Session+import Hasql.Statement (Statement)+import Hasql.Statement qualified as Statement+import Keiro.Migrations.Internal.EmbedFile (embedTextFile)++-- | One named difference between the expected and live schema snapshots.+data SchemaDrift+    = MissingObject Text+    | UnexpectedObject Text+    | ChangedObject+        { driftKey :: Text+        , expectedDefinition :: Text+        , actualDefinition :: Text+        }+    deriving stock (Eq, Show)++-- | Compare canonical snapshots by their @kind<TAB>name@ object identity.+compareSchemaSnapshot :: Text -> Text -> [SchemaDrift]+compareSchemaSnapshot expected actual =+    mapMaybe driftFor allKeys+  where+    expectedObjects = snapshotObjects expected+    actualObjects = snapshotObjects actual+    allKeys =+        Set.toAscList+            (Map.keysSet expectedObjects `Set.union` Map.keysSet actualObjects)++    driftFor key =+        case (Map.lookup key expectedObjects, Map.lookup key actualObjects) of+            (Just (expectedLine, _), Nothing) ->+                Just (MissingObject expectedLine)+            (Nothing, Just (actualLine, _)) ->+                Just (UnexpectedObject actualLine)+            (Just (_, expectedValue), Just (_, actualValue))+                | expectedValue /= actualValue ->+                    Just+                        ChangedObject+                            { driftKey = key+                            , expectedDefinition = expectedValue+                            , actualDefinition = actualValue+                            }+            _ -> Nothing++-- | Render a drift as one operator-facing line with the affected object name.+renderSchemaDrift :: SchemaDrift -> Text+renderSchemaDrift drift =+    case drift of+        MissingObject line ->+            let (kind, name, definition) = splitSnapshotLine line+             in "schema drift: missing "+                    <> kind+                    <> " "+                    <> name+                    <> " (expected: "+                    <> definition+                    <> ")"+        UnexpectedObject line ->+            let (kind, name, definition) = splitSnapshotLine line+             in "schema drift: unexpected "+                    <> kind+                    <> " "+                    <> name+                    <> " (actual: "+                    <> definition+                    <> ")"+        ChangedObject{driftKey, expectedDefinition, actualDefinition} ->+            let (kind, name) = splitSnapshotKey driftKey+             in "schema drift: changed "+                    <> kind+                    <> " "+                    <> name+                    <> " (expected: "+                    <> expectedDefinition+                    <> "; actual: "+                    <> actualDefinition+                    <> ")"++-- | Read a sorted canonical snapshot of tables, columns, constraints, and indexes.+snapshotSchema :: Text -> Session Text+snapshotSchema schema =+    Text.unlines <$> Session.statement schema schemaSnapshotStatement++-- | PostgreSQL 18 snapshot generated from the complete embedded migration plan.+expectedSchemaSnapshot :: Text+expectedSchemaSnapshot =+    $(embedTextFile "expected-schema/native/keiro-v18.txt")++-- | Compare the live @keiro@ schema with the embedded PostgreSQL 18 snapshot.+verifyExpectedSchema ::+    Settings.Settings ->+    IO (Either MigrationError [SchemaDrift])+verifyExpectedSchema settings = do+    acquired <- Connection.acquire settings+    case acquired of+        Left connectionError ->+            pure (Left (ConnectionAcquisitionFailed connectionError))+        Right connection -> do+            result <-+                Connection.use connection liveSnapshotSession+                    `finally` Connection.release connection+            pure $ case result of+                Left sessionError -> Left (DatabaseSessionFailed sessionError)+                Right (Left migrationError) -> Left migrationError+                Right (Right actual) ->+                    Right (compareSchemaSnapshot expectedSchemaSnapshot actual)+  where+    liveSnapshotSession :: Session (Either MigrationError Text)+    liveSnapshotSession = do+        serverVersionNumber <- Session.statement () serverVersionStatement+        let majorVersion = fromIntegral serverVersionNumber `div` 10000+        if majorVersion == (18 :: Int)+            then Right <$> snapshotSchema "keiro"+            else pure (Left (UnsupportedPostgresVersion majorVersion))++snapshotObjects :: Text -> Map Text (Text, Text)+snapshotObjects =+    Map.fromList . mapMaybe parseSnapshotLine . Text.lines+  where+    parseSnapshotLine line =+        case Text.splitOn "\t" line of+            kind : name : definitionParts ->+                Just+                    ( kind <> "\t" <> name+                    , (line, Text.intercalate "\t" definitionParts)+                    )+            _ -> Nothing++splitSnapshotLine :: Text -> (Text, Text, Text)+splitSnapshotLine line =+    case Text.splitOn "\t" line of+        kind : name : definitionParts ->+            (kind, name, Text.intercalate "\t" definitionParts)+        _ -> ("object", line, line)++splitSnapshotKey :: Text -> (Text, Text)+splitSnapshotKey key =+    case Text.splitOn "\t" key of+        [kind, name] -> (kind, name)+        _ -> ("object", key)++schemaSnapshotStatement :: Statement Text [Text]+schemaSnapshotStatement =+    Statement.preparable+        """+        WITH configured AS MATERIALIZED (+          SELECT set_config('search_path', 'pg_catalog', true) AS search_path+        )+        SELECT line+        FROM configured+        CROSS JOIN LATERAL (+          SELECT 'table' || E'\t' || c.relname || E'\t' || 'kind=r' AS line+            FROM pg_class c+            JOIN pg_namespace n ON n.oid = c.relnamespace+            WHERE n.nspname = $1+              AND c.relkind = 'r'+              AND configured.search_path = 'pg_catalog'+          UNION ALL+          SELECT 'column' || E'\t' || c.relname || '.' || a.attname || E'\t'+                 || format_type(a.atttypid, a.atttypmod)+                 || CASE WHEN a.attnotnull THEN ' not null' ELSE '' END+                 || coalesce(' default ' || pg_get_expr(d.adbin, d.adrelid), '')+            FROM pg_attribute a+            JOIN pg_class c ON c.oid = a.attrelid+            JOIN pg_namespace n ON n.oid = c.relnamespace+            LEFT JOIN pg_attrdef d+              ON d.adrelid = a.attrelid AND d.adnum = a.attnum+            WHERE n.nspname = $1+              AND c.relkind = 'r'+              AND a.attnum > 0+              AND NOT a.attisdropped+              AND configured.search_path = 'pg_catalog'+          UNION ALL+          SELECT 'constraint' || E'\t' || rel.relname || '.' || con.conname || E'\t'+                 || pg_get_constraintdef(con.oid)+            FROM pg_constraint con+            JOIN pg_class rel ON rel.oid = con.conrelid+            JOIN pg_namespace n ON n.oid = rel.relnamespace+            WHERE n.nspname = $1+              AND configured.search_path = 'pg_catalog'+          UNION ALL+          SELECT 'index' || E'\t' || ci.relname || E'\t'+                 || pg_get_indexdef(i.indexrelid)+            FROM pg_index i+            JOIN pg_class ci ON ci.oid = i.indexrelid+            JOIN pg_class ct ON ct.oid = i.indrelid+            JOIN pg_namespace n ON n.oid = ct.relnamespace+            WHERE n.nspname = $1+              AND configured.search_path = 'pg_catalog'+        ) snapshot+        ORDER BY line COLLATE "C"+        """+        (Encoders.param (Encoders.nonNullable Encoders.text))+        (Decoders.rowList (Decoders.column (Decoders.nonNullable Decoders.text)))++serverVersionStatement :: Statement () Int32+serverVersionStatement =+    Statement.preparable+        "SELECT current_setting('server_version_num')::integer"+        Encoders.noParams+        (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))

@@ -0,0 +1,117 @@+module Lint (+    LintConfig (..),+    lintViolations,+) where++import Data.ByteString (ByteString)+import Data.List (sortOn)+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text.Encoding+import Data.Text.Encoding.Error (lenientDecode)++{- | Pure migration-body lint, ported from codd-extras (Codd.Extras.Guards) when the+codd toolchain moved behind the legacy-codd-tools flag. The codd-era CONCURRENTLY+check is deliberately dropped: pg-migrate runs transactional migrations inside a+single transaction, and PostgreSQL rejects CREATE INDEX CONCURRENTLY in a+transaction block, so the mistake fails the first fresh-database test run instead+of needing a lint. Genuinely non-transactional migrations must carry pg-migrate's+"-- pg-migrate: no-transaction" leading comment, which review gates.+-}+data LintConfig = LintConfig+    { requiredQualifier :: Text+    , exemptFiles :: [FilePath]+    }+    deriving stock (Eq, Show)++-- | Lint migration bodies with intentionally simple SQL heuristics.+lintViolations :: LintConfig -> [(FilePath, ByteString)] -> [Text]+lintViolations config sources =+    concatMap lintOne (sortOn fst sources)+  where+    lintOne (file, bytes)+        | file `elem` exemptFiles config = []+        | otherwise =+            searchPathViolation file body+                <> concatMap (statementViolations file) statements+      where+        body = Text.Encoding.decodeUtf8With lenientDecode bytes+        statements = map Text.strip . Text.splitOn ";" $ stripCommentLines body++    requiredLower = Text.toCaseFold (requiredQualifier config)++    searchPathViolation file body =+        [ "migration body mentions search_path: " <> Text.pack file+        | "search_path" `Text.isInfixOf` Text.toCaseFold (stripCommentLines body)+        ]++    statementViolations file statement =+        case statementTarget statement of+            Nothing -> []+            Just target+                | requiredLower `Text.isPrefixOf` Text.toCaseFold (cleanTarget target) -> []+                | otherwise ->+                    [ "migration DDL target is not qualified with "+                        <> requiredQualifier config+                        <> " in "+                        <> Text.pack file+                        <> ": "+                        <> Text.take 120 (oneLine statement)+                    ]++statementTarget :: Text -> Maybe Text+statementTarget statement+    | Text.null trimmed = Nothing+    | lower `startsWithWords` ["create", "table"] =+        targetAfter ["create", "table"] wordsOriginal+    | lower `startsWithWords` ["alter", "table"] =+        targetAfter ["alter", "table"] wordsOriginal+    | lower `startsWithWords` ["drop", "index"] =+        targetAfter ["drop", "index"] wordsOriginal+    | lower `startsWithWords` ["create", "index"] =+        targetAfterToken "on" wordsOriginal+    | lower `startsWithWords` ["create", "unique", "index"] =+        targetAfterToken "on" wordsOriginal+    | lower `startsWithWords` ["create", "function"] =+        targetAfter ["create", "function"] wordsOriginal+    | lower `startsWithWords` ["create", "or", "replace", "function"] =+        targetAfter ["create", "or", "replace", "function"] wordsOriginal+    | lower `startsWithWords` ["create", "trigger"] =+        targetAfterToken "on" wordsOriginal+    | otherwise = Nothing+  where+    trimmed = Text.strip statement+    lower = Text.toCaseFold trimmed+    wordsOriginal = Text.words trimmed++startsWithWords :: Text -> [Text] -> Bool+startsWithWords statement wordsExpected =+    wordsExpected == take (length wordsExpected) (Text.words statement)++targetAfter :: [Text] -> [Text] -> Maybe Text+targetAfter prefix wordsOriginal =+    skipIfNotExists (drop (length prefix) wordsOriginal)++targetAfterToken :: Text -> [Text] -> Maybe Text+targetAfterToken token wordsOriginal =+    skipIfNotExists . drop 1 $ dropWhile ((/= token) . Text.toCaseFold) wordsOriginal++skipIfNotExists :: [Text] -> Maybe Text+skipIfNotExists (first : second : third : target : _)+    | map Text.toCaseFold [first, second, third] == ["if", "not", "exists"] = Just target+skipIfNotExists (first : second : target : _)+    | map Text.toCaseFold [first, second] == ["if", "exists"] = Just target+skipIfNotExists (target : _) = Just target+skipIfNotExists [] = Nothing++stripCommentLines :: Text -> Text+stripCommentLines =+    Text.unlines . filter (not . Text.isPrefixOf "--" . Text.strip) . Text.lines++cleanTarget :: Text -> Text+cleanTarget =+    Text.dropAround (`elem` ("\"(),;" :: String))++oneLine :: Text -> Text+oneLine =+    Text.unwords . Text.words

@@ -4,13 +4,13 @@  import Control.Concurrent.Async (concurrently) import Control.Exception (finally)-import Control.Monad (forM_)+import Control.Monad (forM_, unless) import Data.ByteString (ByteString) import Data.ByteString qualified as ByteString import Data.Either (isLeft) import Data.Foldable (toList) import Data.Int (Int64)-import Data.List (sort)+import Data.List (findIndex, sort, (\\)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict qualified as Map import Data.Set qualified as Set@@ -27,6 +27,7 @@     migrationChecksumBytes,     planDescription,  )+import Database.PostgreSQL.Migrate.Internal qualified as Migrate.Internal import Database.PostgreSQL.Migrate.Test (withMigratedDatabase) import EphemeralPg qualified as Pg import Hasql.Connection qualified as Connection@@ -37,18 +38,22 @@ import Hasql.Statement (Statement) import Hasql.Statement qualified as Statement import Keiro.Migrations+import Keiro.Migrations qualified as Keiro import Keiro.Migrations.History.Codd+import Keiro.Migrations.SchemaCheck import Kiroku.Store.Migrations qualified as Kiroku import Kiroku.Store.Migrations.History.Codd qualified as Kiroku.Codd+import Lint import Numeric qualified-import System.Directory (doesDirectoryExist, doesFileExist)-import System.FilePath ((</>))+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory)+import System.Environment (lookupEnv)+import System.FilePath (takeExtension, (</>)) import Test.Hspec  main :: IO () main = hspec $ do     describe "native Keiro migration definition" $ do-        it "tracks eighteen native files in manifest order" $ do+        it "tracks twenty native files in manifest order" $ do             directory <- findMigrationsDirectory             manifest <- Text.lines <$> Text.IO.readFile (directory </> "manifest")             manifest `shouldBe` Text.pack <$> nativeMigrationFiles@@ -61,7 +66,7 @@                 bytes <- ByteString.readFile (directory </> nativeName)                 lookup legacyName lockEntries `shouldBe` Just (checksumText bytes) -        it "builds component keiro with dependency kiroku and eighteen migrations" $ do+        it "builds component keiro with dependency kiroku and twenty migrations" $ do             plan <- requirePlan             let PlanDescription components = planDescription plan             case toList components of@@ -74,7 +79,7 @@                         componentNameText keiroName `shouldBe` "keiro"                         dependencyName <- requireRight (componentName "kiroku")                         keiroDependencies `shouldBe` Set.singleton dependencyName-                        length keiroEntries `shouldBe` 18+                        length keiroEntries `shouldBe` 20                 actual -> expectationFailure ("unexpected plan description: " <> show actual)             validateHistoryMappingTargets plan frameworkCoddHistoryMappings `shouldBe` Right () @@ -84,6 +89,175 @@             migrationPlan (keiro :| []) `shouldSatisfy` isLeft             frameworkMigrationPlan keiro kiroku `shouldSatisfy` isLeft +    describe "native checksum lockfile" $ do+        it "matches the manifest, directory membership, and every payload byte" $ do+            directory <- findMigrationsDirectory+            lockPath <- findNativeLockfile+            lockEntries <- parseLockfile <$> Text.IO.readFile lockPath+            manifestNames <-+                fmap Text.unpack . Text.lines+                    <$> Text.IO.readFile (directory </> "manifest")+            directoryNames <-+                sort+                    . filter ((== ".sql") . takeExtension)+                    <$> listDirectory directory+            let lockNames = fst <$> lockEntries+            assertFileList+                "migrations.native.lock entries differ from migrations/manifest"+                manifestNames+                lockNames+            assertFileList+                "migrations directory entries differ from migrations/manifest"+                (sort manifestNames)+                directoryNames+            forM_ lockEntries $ \(filename, expectedChecksum) -> do+                actualChecksum <-+                    checksumText+                        <$> ByteString.readFile (directory </> filename)+                unless (actualChecksum == expectedChecksum) $+                    expectationFailure+                        ( "migrations.native.lock checksum mismatch for "+                            <> filename+                            <> "\nexpected: "+                            <> Text.unpack expectedChecksum+                            <> "\nactual:   "+                            <> Text.unpack actualChecksum+                        )++    describe "migration body lint" $ do+        let config = LintConfig{requiredQualifier = "keiro.", exemptFiles = []}++        it "flags an unqualified DDL target" $ do+            let violations =+                    lintViolations+                        config+                        [("9999-fixture.sql", "CREATE TABLE widgets (id int);")]+            violations `shouldSatisfy` \case+                [violation] -> "9999-fixture.sql" `Text.isInfixOf` violation+                _ -> False++        it "flags a search_path mention" $ do+            lintViolations+                config+                [("9999-fixture.sql", "SET search_path TO keiro;")]+                `shouldSatisfy` (not . null)++        it "ignores comment-only mentions" $ do+            lintViolations+                config+                [("9999-fixture.sql", "-- Never set search_path in a migration.\nSELECT 1;")]+                `shouldBe` []++        it "passes all 20 embedded native bodies" $ do+            lintViolations config (toList embeddedMigrationEntries) `shouldBe` []++    describe "startup handshake" $ do+        it "reports the full plan on a fresh database" $ do+            plan <- requirePlan+            withKeiroPg $ \database -> do+                handshake <-+                    missingMigrations+                        defaultRunOptions+                        (connectionProviderFromSettings (Pg.connectionSettings database))+                        plan+                        >>= requireRight+                Keiro.pendingMigrations handshake `shouldBe` planMigrationIds plan+                length (Keiro.pendingMigrations handshake) `shouldBe` 28+                Keiro.ledgerIssues handshake `shouldBe` []+                handshakePassed handshake `shouldBe` False++        it "passes on a fully migrated database" $ do+            plan <- requirePlan+            result <- withMigratedDatabase plan $ \connection -> do+                handshake <-+                    missingMigrations defaultRunOptions (providerFor connection) plan+                        >>= requireRight+                Keiro.pendingMigrations handshake `shouldBe` []+                Keiro.ledgerIssues handshake `shouldBe` []+                handshakePassed handshake `shouldBe` True+            either (expectationFailure . show) pure result++        it "reports the Keiro tail after applying only Kiroku" $ do+            plan <- requirePlan+            withKeiroPg $ \database -> do+                kiroku <- requireRight Kiroku.kirokuMigrations+                kirokuOnly <- requireRight (migrationPlan (kiroku :| []))+                let settings = Pg.connectionSettings database+                    provider = connectionProviderFromSettings settings+                _ <- runMigrationPlan defaultRunOptions settings kirokuOnly >>= requireRight+                handshake <-+                    missingMigrations defaultRunOptions provider plan >>= requireRight+                Keiro.pendingMigrations handshake `shouldBe` drop 8 (planMigrationIds plan)+                length (Keiro.pendingMigrations handshake) `shouldBe` 20+                Keiro.ledgerIssues handshake `shouldBe` []+                handshakePassed handshake `shouldBe` False++    describe "native expected schema" $ do+        it "classifies missing, unexpected, and changed objects" $ do+            let expected =+                    Text.unlines+                        [ "column\twidgets.id\tinteger not null"+                        , "index\twidgets_id_idx\tCREATE INDEX widgets_id_idx ON keiro.widgets USING btree (id)"+                        ]+                actual =+                    Text.unlines+                        [ "column\twidgets.id\tbigint not null"+                        , "table\twidgets\tkind=r"+                        ]+            compareSchemaSnapshot expected actual+                `shouldMatchList` [ ChangedObject+                                        { driftKey = "column\twidgets.id"+                                        , expectedDefinition = "integer not null"+                                        , actualDefinition = "bigint not null"+                                        }+                                  , MissingObject+                                        "index\twidgets_id_idx\tCREATE INDEX widgets_id_idx ON keiro.widgets USING btree (id)"+                                  , UnexpectedObject "table\twidgets\tkind=r"+                                  ]++        it "checked-in snapshot matches what the migrations build" $ do+            plan <- requirePlan+            snapshotPath <- findNativeExpectedSchema+            regenerate <- maybe False (const True) <$> lookupEnv "KEIRO_REGENERATE_EXPECTED_SCHEMA"+            result <- withMigratedDatabase plan $ \connection -> do+                actual <- useSession connection (snapshotSchema "keiro")+                if regenerate+                    then do+                        Text.IO.writeFile snapshotPath actual+                        putStrLn ("regenerated " <> snapshotPath)+                    else do+                        expected <- Text.IO.readFile snapshotPath+                        unless (expected == actual) $+                            expectationFailure (snapshotMismatch snapshotPath expected actual)+            either (expectationFailure . show) pure result++        it "detects named drift after a hand-altered database" $ do+            plan <- requirePlan+            withKeiroPg $ \database -> do+                let settings = Pg.connectionSettings database+                _ <- runMigrationPlan defaultRunOptions settings plan >>= requireRight+                clean <- verifyExpectedSchema settings >>= requireRight+                clean `shouldBe` []+                withConnection settings $ \connection ->+                    useSession+                        connection+                        ( Session.script+                            """+                            DROP INDEX keiro.keiro_outbox_pending_idx;+                            ALTER TABLE keiro.keiro_outbox+                              ALTER COLUMN correlation_id TYPE character varying(64)+                              USING correlation_id::text;+                            """+                        )+                drifts <- verifyExpectedSchema settings >>= requireRight+                let rendered = renderSchemaDrift <$> drifts+                rendered+                    `shouldSatisfy` any+                        (Text.isInfixOf "keiro_outbox_pending_idx")+                rendered+                    `shouldSatisfy` any+                        (Text.isInfixOf "keiro_outbox.correlation_id")+     describe "fresh native databases" $ do         it "applies Kiroku then Keiro, verifies strictly, and is repeatable" $ do             plan <- requirePlan@@ -91,12 +265,12 @@                 assertSchema connection                 let provider = providerFor connection                 rerun <- runMigrationPlanWith defaultRunOptions provider plan >>= requireRight-                reportOutcomes rerun `shouldBe` replicate 26 AlreadyApplied+                reportOutcomes rerun `shouldBe` replicate 28 AlreadyApplied                 verified <- verifyMigrationPlanWith defaultRunOptions provider plan >>= requireRight                 case verified of                     VerificationReport verificationIssues applied pending unknown -> do                         verificationIssues `shouldBe` []-                        length applied `shouldBe` 26+                        length applied `shouldBe` 28                         pending `shouldBe` []                         unknown `shouldBe` []             either (expectationFailure . show) pure result@@ -110,8 +284,44 @@                         (runMigrationPlan defaultRunOptions settings plan >>= requireRight)                         (runMigrationPlan defaultRunOptions settings plan >>= requireRight)                 sort [reportOutcomes first, reportOutcomes second]-                    `shouldBe` sort [replicate 26 AppliedNow, replicate 26 AlreadyApplied]+                    `shouldBe` sort [replicate 28 AppliedNow, replicate 28 AlreadyApplied] +    describe "codd-ledger preflight" $ do+        it "blocks a current codd ledger before native history exists" $+            assertBlockedCoddPreflight "codd"++        it "blocks a legacy codd_schema ledger before native history exists" $+            assertBlockedCoddPreflight "codd_schema"++        it "is clear on a fresh database" $+            withKeiroPg $ \database -> do+                preflight <-+                    preflightFreshLedgerOverCodd (Pg.connectionSettings database)+                        >>= requireRight+                preflight `shouldBe` CoddPreflightClear++        it "is clear after codd history has been imported" $ do+            plan <- requirePlan+            withKeiroPg $ \database -> do+                let settings = Pg.connectionSettings database+                    provider = connectionProviderFromSettings settings+                withConnection settings $ \connection -> do+                    applyLegacyPayloads connection+                    installCoddLedger connection "codd" False False+                config <-+                    requireRight+                        (frameworkCoddSourceConfig provider True "preflight fixture" Confirmed)+                _ <-+                    importCoddHistory+                        defaultImportOptions+                        config+                        provider+                        plan+                        frameworkCoddHistoryMappings+                        >>= requireRight+                preflight <- preflightFreshLedgerOverCodd settings >>= requireRight+                preflight `shouldBe` CoddPreflightClear+     describe "combined Codd history import" $ do         it "imports a shared Codd V5 ledger atomically without replaying target SQL" $             importFixture "codd"@@ -156,6 +366,85 @@                     Left CoddStrictSourceHasUnselected{} -> True                     _ -> False +    describe "poisoned-ledger recovery" $ do+        it "up before import poisons the ledger and the documented recovery restores the cutover" $ do+            plan <- requirePlan+            withKeiroPg $ \database -> do+                let settings = Pg.connectionSettings database+                    provider = connectionProviderFromSettings settings+                withConnection settings $ \connection -> do+                    applyLegacyPayloads connection+                    installCoddLedger connection "codd" False False++                incident <- runMigrationPlan defaultRunOptions settings plan+                incident `shouldSatisfy` isLeft+                assertPoisonedLedger settings++                config <-+                    requireRight+                        (frameworkCoddSourceConfig provider True "poisoned-ledger recovery fixture" Confirmed)+                blockedImport <-+                    importCoddHistory+                        defaultImportOptions+                        config+                        provider+                        plan+                        frameworkCoddHistoryMappings+                blockedImport `shouldSatisfy` \case+                    Left (CoddTargetImportFailed HistoryImportConflict{}) -> True+                    _ -> False++                assertPoisonedLedger settings+                withConnection settings $ \connection ->+                    useSession connection (Session.script "DROP SCHEMA pgmigrate CASCADE;")++                recoveredImport <-+                    importCoddHistory+                        defaultImportOptions+                        config+                        provider+                        plan+                        frameworkCoddHistoryMappings+                        >>= requireRight+                importOutcomes recoveredImport `shouldBe` replicate 23 Imported++                expectedPending <- postCoddImportPendingIssues+                verifiedBeforeUp <-+                    verifyMigrationPlan defaultRunOptions settings plan >>= requireRight+                case verifiedBeforeUp of+                    VerificationReport verificationIssues _ _ _ ->+                        verificationIssues `shouldBe` expectedPending++                up <- runMigrationPlan defaultRunOptions settings plan >>= requireRight+                reportOutcomes up+                    `shouldBe` replicate 7 AlreadyApplied+                        <> [AppliedNow]+                        <> replicate 16 AlreadyApplied+                        <> replicate 4 AppliedNow++                verifiedAfterUp <-+                    verifyMigrationPlan defaultRunOptions settings plan >>= requireRight+                case verifiedAfterUp of+                    VerificationReport verificationIssues _ _ _ ->+                        verificationIssues `shouldBe` []+                withConnection settings assertSchema++assertBlockedCoddPreflight :: Text -> Expectation+assertBlockedCoddPreflight sourceSchema =+    withKeiroPg $ \database -> do+        let settings = Pg.connectionSettings database+        withConnection settings $ \connection -> do+            applyLegacyPayloads connection+            installCoddLedger connection sourceSchema False False+        preflight <- preflightFreshLedgerOverCodd settings >>= requireRight+        let expectedTable = sourceSchema <> ".sql_migrations"+        preflight+            `shouldBe` CoddPreflightBlocked+                { coddLedgerTable = expectedTable+                , nativeLedgerAbsent = True+                }+        renderCoddPreflight preflight `shouldSatisfy` Text.isInfixOf expectedTable+ importFixture :: Text -> Expectation importFixture sourceSchema = do     plan <- requirePlan@@ -172,28 +461,22 @@             importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings                 >>= requireRight         importOutcomes first `shouldBe` replicate 23 Imported-        kirokuCanaryId <- requireRight (migrationId "kiroku" "0008-schema-management-comment")-        keiroCanaryId <- requireRight (migrationId "keiro" "0017-schema-management-comment")-        keiroDeadLettersId <- requireRight (migrationId "keiro" "0018")+        expectedPending <- postCoddImportPendingIssues         verifiedBeforeCanaries <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight         case verifiedBeforeCanaries of             VerificationReport verificationIssues _ _ _ ->-                verificationIssues-                    `shouldBe` [ PendingMigration kirokuCanaryId-                               , PendingMigration keiroCanaryId-                               , PendingMigration keiroDeadLettersId-                               ]+                verificationIssues `shouldBe` expectedPending         up <- runMigrationPlan defaultRunOptions settings plan >>= requireRight         reportOutcomes up             `shouldBe` replicate 7 AlreadyApplied                 <> [AppliedNow]                 <> replicate 16 AlreadyApplied-                <> [AppliedNow, AppliedNow]+                <> [AppliedNow, AppliedNow, AppliedNow, AppliedNow]         verifiedAfterCanaries <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight         case verifiedAfterCanaries of             VerificationReport verificationIssues _ _ _ -> verificationIssues `shouldBe` []         rerun <- runMigrationPlan defaultRunOptions settings plan >>= requireRight-        reportOutcomes rerun `shouldBe` replicate 26 AlreadyApplied+        reportOutcomes rerun `shouldBe` replicate 28 AlreadyApplied         second <-             importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings                 >>= requireRight@@ -203,8 +486,32 @@             sourceRows <- useSession connection (Session.statement () (sourceRowCountStatement sourceSchema))             sourceRows `shouldBe` 23             facts <- useSession connection (Session.statement () importFactsStatement)-            facts `shouldBe` (26, 23, True)+            facts `shouldBe` (28, 23, True) +postCoddImportPendingIssues :: IO [VerificationIssue]+postCoddImportPendingIssues =+    traverse pendingMigration pendingNames+  where+    pendingMigration (component, name) =+        PendingMigration <$> requireRight (migrationId component name)++    pendingNames =+        [ ("kiroku", "0008-schema-management-comment")+        , ("keiro", "0017-schema-management-comment")+        , ("keiro", "0018")+        , ("keiro", "0019-keiro-snapshots-state-shape-hash")+        , ("keiro", "0020-keiro-workflow-children-failure-reason")+        ]++assertPoisonedLedger :: Settings.Settings -> Expectation+assertPoisonedLedger settings =+    withConnection settings $ \connection -> do+        facts <-+            useSession+                connection+                (Session.statement () poisonedLedgerFactsStatement)+        facts `shouldBe` (5, 5, 0)+ nativeMigrationFiles :: [FilePath] nativeMigrationFiles =     [ "0001-keiro-bootstrap.sql"@@ -225,6 +532,8 @@     , "0016-keiro-inbox-drop-received-idx.sql"     , "0017-schema-management-comment.sql"     , "0018.sql"+    , "0019-keiro-snapshots-state-shape-hash.sql"+    , "0020-keiro-workflow-children-failure-reason.sql"     ]  findMigrationsDirectory :: IO FilePath@@ -235,6 +544,20 @@ findLockfile =     findFile ["keiro-migrations/migrations.lock", "migrations.lock"] +findNativeLockfile :: IO FilePath+findNativeLockfile =+    findFile+        [ "keiro-migrations/migrations.native.lock"+        , "migrations.native.lock"+        ]++findNativeExpectedSchema :: IO FilePath+findNativeExpectedSchema =+    findFile+        [ "keiro-migrations/expected-schema/native/keiro-v18.txt"+        , "expected-schema/native/keiro-v18.txt"+        ]+ findDirectory :: [FilePath] -> IO FilePath findDirectory candidates = do     existing <- filterM doesDirectoryExist candidates@@ -257,6 +580,51 @@         values <- remaining         pure (if matches then value : values else values) +assertFileList :: String -> [FilePath] -> [FilePath] -> Expectation+assertFileList message expected actual =+    unless (actual == expected) $+        expectationFailure+            ( message+                <> "\nmissing:    "+                <> show (expected \\ actual)+                <> "\nunexpected: "+                <> show (actual \\ expected)+                <> orderDifference+            )+  where+    orderDifference+        | sort expected == sort actual =+            "\norder differs\nexpected: "+                <> show expected+                <> "\nactual:   "+                <> show actual+        | otherwise = ""++snapshotMismatch :: FilePath -> Text -> Text -> String+snapshotMismatch path expected actual =+    "checked-in native schema snapshot differs at "+        <> firstDifference+        <> "\nRegenerate intentionally with "+        <> "KEIRO_REGENERATE_EXPECTED_SCHEMA=1 cabal test keiro-migrations-test "+        <> "--test-options='--match \"checked-in snapshot\"' and review "+        <> path+  where+    expectedLines = Text.lines expected+    actualLines = Text.lines actual+    lineCount = max (length expectedLines) (length actualLines)+    paddedExpected = take lineCount (expectedLines <> repeat "<end of snapshot>")+    paddedActual = take lineCount (actualLines <> repeat "<end of snapshot>")+    firstDifference =+        case findIndex (uncurry (/=)) (zip paddedExpected paddedActual) of+            Nothing -> "an unknown position"+            Just index ->+                "line "+                    <> show (index + 1)+                    <> "\nexpected: "+                    <> Text.unpack (paddedExpected !! index)+                    <> "\nactual:   "+                    <> Text.unpack (paddedActual !! index)+ parseLockfile :: Text -> [(FilePath, Text)] parseLockfile contents =     [ (Text.unpack filename, checksum)@@ -283,6 +651,15 @@     keiro <- requireRight keiroMigrations     requireRight (frameworkMigrationPlan kiroku keiro) +planMigrationIds :: MigrationPlan -> [MigrationId]+planMigrationIds plan =+    [ identifier+    | ComponentDescription{migrations} <- toList components+    , Migrate.Internal.MigrationDescription identifier _ _ _ _ <- toList migrations+    ]+  where+    PlanDescription components = planDescription plan+ requireRight :: (Show error) => Either error value -> IO value requireRight = either failure pure @@ -420,6 +797,26 @@                 <$> column Decoders.int8                 <*> column Decoders.int8                 <*> column Decoders.bool+            )+        )+  where+    column = Decoders.column . Decoders.nonNullable++poisonedLedgerFactsStatement :: Statement () (Int64, Int64, Int64)+poisonedLedgerFactsStatement =+    Statement.preparable+        """+        SELECT+          (SELECT count(*) FROM pgmigrate.migrations),+          (SELECT count(*) FROM pgmigrate.migrations WHERE component = 'kiroku'),+          (SELECT count(*) FROM pgmigrate.history_imports)+        """+        Encoders.noParams+        ( Decoders.singleRow+            ( (,,)+                <$> column Decoders.int8+                <*> column Decoders.int8+                <*> column Decoders.int8             )         )   where