keiro-migrations 0.5.0.0 → 0.6.0.0

raw patch · 15 files changed

+2028/−2023 lines, 15 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• app/Main.hs +266/−266
• app/WriteExpectedSchema.hs +5/−5
• keiro-migrations.cabal +1/−1
• src/Keiro/Migrations.hs +105/−105
• src/Keiro/Migrations/ExpectedSchema.hs +5/−4
• src/Keiro/Migrations/History/Codd.hs +68/−67
• src/Keiro/Migrations/Internal/Definition.hs +12/−11
• src/Keiro/Migrations/Internal/EmbedFile.hs +7/−7
• src/Keiro/Migrations/LegacyCodd.hs +44/−44
• src/Keiro/Migrations/New.hs +26/−26
• src/Keiro/Migrations/SchemaCheck.hs +151/−150
• test-legacy/Main.hs +473/−477
• test/Lint.hs +61/−61
• test/Main.hs +799/−799

@@ -6,6 +6,11 @@  ## [Unreleased] +## 0.6.0.0 — 2026-07-31++No changes this release. Released with the package set for the `keiro-dsl`+0.6.0.0 work.+ ## 0.5.0.0 — 2026-07-31  No changes this release. Released with the package set for the `keiro-dsl`

@@ -6,8 +6,8 @@ import Data.Int (Int64) import Data.Text qualified as Text import Data.Text.IO qualified as Text.IO-import Database.PostgreSQL.Migrate (-    Confirmation (..),+import Database.PostgreSQL.Migrate+  ( Confirmation (..),     HistoryImportError (..),     HistoryImportOutcome (..),     HistoryImportReport (..),@@ -17,36 +17,36 @@     connectionProviderFromSettings,     defaultImportOptions,     defaultRunOptions,- )+  ) import Database.PostgreSQL.Migrate.CLI-import Database.PostgreSQL.Migrate.History.Codd (-    CoddImportError (..),+import Database.PostgreSQL.Migrate.History.Codd+  ( CoddImportError (..),     defaultCoddLockKey,     importCoddHistory,     withCoddLockKey,- )-import Database.PostgreSQL.Migrate.Internal (-    componentNameText,+  )+import Database.PostgreSQL.Migrate.Internal+  ( componentNameText,     migrationIdComponent,     migrationIdName,     migrationNameText,- )+  ) import Hasql.Connection.Settings qualified as Settings-import Keiro.Migrations (-    CoddLedgerPreflight (..),+import Keiro.Migrations+  ( CoddLedgerPreflight (..),     frameworkMigrationPlan,     keiroMigrations,     preflightFreshLedgerOverCodd,     renderCoddPreflight,- )-import Keiro.Migrations.History.Codd (-    frameworkCoddHistoryMappings,+  )+import Keiro.Migrations.History.Codd+  ( frameworkCoddHistoryMappings,     frameworkCoddSourceConfig,- )-import Keiro.Migrations.SchemaCheck (-    renderSchemaDrift,+  )+import Keiro.Migrations.SchemaCheck+  ( renderSchemaDrift,     verifyExpectedSchema,- )+  ) import Kiroku.Store.Migrations qualified as Kiroku import Numeric qualified import Options.Applicative@@ -57,315 +57,315 @@  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)-    invocation <--        execParser-            ( info-                (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))-    runKeiroInvocation defaultSettings plan invocation+  kiroku <- either (fail . show) pure Kiroku.kirokuMigrations+  keiro <- either (fail . show) pure keiroMigrations+  plan <- either (fail . show) pure (frameworkMigrationPlan kiroku keiro)+  invocation <-+    execParser+      ( info+          (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))+  runKeiroInvocation defaultSettings plan invocation  data KeiroInvocation = KeiroInvocation-    { allowFreshLedgerOverCodd :: Bool-    , keiroCommand :: KeiroCommand-    }+  { allowFreshLedgerOverCodd :: Bool,+    keiroCommand :: KeiroCommand+  }  runKeiroInvocation ::-    Settings.Settings ->-    MigrationPlan ->-    KeiroInvocation ->-    IO ()+  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+  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+  case keiroCommand of+    Framework Up {} -> True+    _ -> False  preflightFrameworkUp ::-    Settings.Settings ->-    Bool ->-    MigrationCommand ->-    IO ()+  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 ()+  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+  = Framework MigrationCommand+  | VerifySchema VerifySchemaOptions+  | ImportCoddHistory ImportCoddOptions  newtype VerifySchemaOptions = VerifySchemaOptions-    { verifySchemaDatabaseSettings :: Maybe Settings.Settings-    }+  { verifySchemaDatabaseSettings :: Maybe Settings.Settings+  }  data ImportCoddOptions = ImportCoddOptions-    { importTargetSettings :: Maybe Settings.Settings-    , importSourceSettings :: Maybe Settings.Settings-    , importSourceLockKey :: Int64-    , importReason :: Text.Text-    , importConfirmation :: Confirmation-    , importJsonOutput :: Bool-    }+  { 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+  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")-                    )+  (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"-                )-            )+  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+  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")+  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+  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)+      | 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+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 ()+  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)+  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)+renderHistoryImportText HistoryImportReport {importResults} =+  Text.unlines (renderResult <$> toList importResults)   where-    renderResult HistoryImportResult{importedMigration, importOutcome} =-        outcomeText importOutcome <> " " <> migrationIdText importedMigration+    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)+  componentNameText (migrationIdComponent identifier)+    <> "/"+    <> migrationNameText (migrationIdName identifier)  renderCoddImportError :: CoddImportError -> Text.Text renderCoddImportError importError =-    "codd history import failed: "-        <> Text.pack (show importError)-        <> recoveryHint 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 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."+      " 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 =-    case command of-        Plan PlanOptions{output = OutputOptions format} -> format-        List ListOptions{output = OutputOptions format} -> format-        Check CheckOptions{output = OutputOptions format} -> format-        Status StatusOptions{output = OutputOptions format} -> format-        Verify VerifyOptions{output = OutputOptions format} -> format-        Up UpOptions{output = OutputOptions format} -> format-        Repair RepairOptions{output = OutputOptions format} -> format-        New NewOptions{output = OutputOptions format} -> format+  case command of+    Plan PlanOptions {output = OutputOptions format} -> format+    List ListOptions {output = OutputOptions format} -> format+    Check CheckOptions {output = OutputOptions format} -> format+    Status StatusOptions {output = OutputOptions format} -> format+    Verify VerifyOptions {output = OutputOptions format} -> format+    Up UpOptions {output = OutputOptions format} -> format+    Repair RepairOptions {output = OutputOptions format} -> format+    New NewOptions {output = OutputOptions format} -> format

@@ -1,6 +1,6 @@-module Main (-    main,-)+module Main+  ( main,+  ) where  import Codd.Extras.WriteSchema (writeExpectedSchemaMain)@@ -9,5 +9,5 @@  main :: IO () main =-    writeExpectedSchemaMain "keiro" ["keiro"] "keiro-migrations/expected-schema" $ \settings ->-        runAllKeiroMigrationsNoCheck settings (secondsToDiffTime 5)+  writeExpectedSchemaMain "keiro" ["keiro"] "keiro-migrations/expected-schema" $ \settings ->+    runAllKeiroMigrationsNoCheck settings (secondsToDiffTime 5)

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               keiro-migrations-version:            0.5.0.0+version:            0.6.0.0 synopsis:           Schema migrations for keiro description:   Embedded PostgreSQL schema migrations and a migration runner for the Keiro

@@ -1,5 +1,5 @@-module Keiro.Migrations (-    CoddLedgerPreflight (..),+module Keiro.Migrations+  ( CoddLedgerPreflight (..),     ConnectionProvider,     DefinitionError,     MigrationComponent,@@ -19,14 +19,15 @@     missingMigrations,     preflightFreshLedgerOverCodd,     renderCoddPreflight,-) where+  )+where  import Control.Exception (finally) import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text)-import Database.PostgreSQL.Migrate (-    ConnectionProvider,+import Database.PostgreSQL.Migrate+  ( ConnectionProvider,     DefinitionError,     MigrationComponent,     MigrationError (..),@@ -39,7 +40,7 @@     defaultRunOptions,     migrationPlan,     migrationStatusWith,- )+  ) import Database.PostgreSQL.Migrate qualified as Migrate import Hasql.Connection qualified as Connection import Hasql.Connection.Settings qualified as Settings@@ -49,149 +50,148 @@ import Hasql.Session qualified as Session import Hasql.Statement (Statement) import Hasql.Statement qualified as Statement-import Keiro.Migrations.Internal.Definition (-    embeddedMigrationEntries,+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)+  = CoddPreflightClear+  | CoddPreflightBlocked+      { -- | The detected @codd.sql_migrations@ table.+        coddLedgerTable :: Text,+        -- | 'True' when @pgmigrate.migrations@ is absent; 'False' when it is empty.+        nativeLedgerAbsent :: Bool+      }+  deriving stock (Eq, Show)  -- | Refuse to initialize a fresh native ledger over a retired codd ledger. preflightFreshLedgerOverCodd ::-    Settings.Settings ->-    IO (Either MigrationError CoddLedgerPreflight)+  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+  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."+  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+  (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+  | 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-            )+  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)))+  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)+  { -- | Declared migrations with no applied ledger row, in plan order.+    pendingMigrations :: [MigrationId],+    -- | Checksum, position, kind, gap, status, or unknown-row problems.+    ledgerIssues :: [VerificationIssue]+  }+  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)+  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)+  RunOptions ->+  ConnectionProvider ->+  MigrationPlan ->+  IO (Either MigrationError StartupHandshake) missingMigrations options provider plan =-    fmap toStartupHandshake <$> migrationStatusWith 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.+      StartupHandshake+        { pendingMigrations = pending,+          ledgerIssues = statusIssues+        } -The first argument must be Kiroku's component and the second must be Keiro's.-The native planner validates both identity and ordering, so swapped or unrelated-components fail with a structured 'PlanError'.--}+-- | Compose the concrete Kiroku and Keiro components in dependency order.+--+-- The first argument must be Kiroku's component and the second must be Keiro's.+-- The native planner validates both identity and ordering, so swapped or unrelated+-- components fail with a structured 'PlanError'. frameworkMigrationPlan ::-    MigrationComponent ->-    MigrationComponent ->-    Either PlanError MigrationPlan+  MigrationComponent ->+  MigrationComponent ->+  Either PlanError MigrationPlan frameworkMigrationPlan kiroku keiro =-    migrationPlan (kiroku :| [keiro])+  migrationPlan (kiroku :| [keiro])

@@ -1,9 +1,10 @@ {-# LANGUAGE TemplateHaskell #-} -module Keiro.Migrations.ExpectedSchema (-    expectedSchemaFiles,+module Keiro.Migrations.ExpectedSchema+  ( expectedSchemaFiles,     withMaterializedExpectedSchema,-) where+  )+where  import Codd.Extras.ExpectedSchema qualified as ExpectedSchema import Data.ByteString (ByteString)@@ -16,4 +17,4 @@  withMaterializedExpectedSchema :: (FilePath -> IO a) -> IO a withMaterializedExpectedSchema action =-    ExpectedSchema.withMaterializedExpectedSchema "keiro-expected-schema" expectedSchemaFiles action+  ExpectedSchema.withMaterializedExpectedSchema "keiro-expected-schema" expectedSchemaFiles action

@@ -1,13 +1,14 @@ {-# LANGUAGE TemplateHaskell #-} -module Keiro.Migrations.History.Codd (-    frameworkCoddHistoryMappings,+module Keiro.Migrations.History.Codd+  ( frameworkCoddHistoryMappings,     frameworkCoddSourceConfig,     keiroCoddHistoryMappings,     keiroCoddManifestText,     keiroCoddSourcePayloads,     keiroLegacyMigrationNames,-) where+  )+where  import Data.Bifunctor (first) import Data.ByteString (ByteString)@@ -15,113 +16,113 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict qualified as Map import Data.Text (Text)-import Database.PostgreSQL.Migrate (-    Confirmation,+import Database.PostgreSQL.Migrate+  ( Confirmation,     ConnectionProvider,     EvidenceRequirement (Evidence),     HistoryMapping,     PayloadRelation (SamePayload),     historyMapping,     migrationId,- )-import Database.PostgreSQL.Migrate.History.Codd (-    CoddDefinitionError,+  )+import Database.PostgreSQL.Migrate.History.Codd+  ( CoddDefinitionError,     CoddSourceConfig,     coddEvidenceKey,     coddSourceConfig,     parseCoddManifest,- )+  ) import Keiro.Migrations.Internal.Definition (embeddedMigrationEntries) import Keiro.Migrations.Internal.EmbedFile (embedTextFile) import Kiroku.Store.Migrations.History.Codd qualified as Kiroku  keiroLegacyMigrationNames :: NonEmpty FilePath keiroLegacyMigrationNames =-    "2026-05-17-13-58-15-keiro-bootstrap.sql"-        :| [ "2026-05-19-12-55-02-keiro-outbox.sql"-           , "2026-05-19-13-05-23-keiro-inbox.sql"-           , "2026-06-03-05-14-28-keiro-timer-recovery.sql"-           , "2026-06-03-16-10-05-keiro-workflow-steps.sql"-           , "2026-06-03-18-19-41-keiro-awakeables.sql"-           , "2026-06-03-19-49-23-keiro-workflow-children.sql"-           , "2026-06-04-02-12-28-keiro-workflow-generation.sql"-           , "2026-06-04-03-53-34-keiro-subscription-shards.sql"-           , "2026-06-15-13-22-31-keiro-messaging-crash-recovery.sql"-           , "2026-06-15-15-07-25-keiro-workflows-instances.sql"-           , "2026-06-15-17-53-48-keiro-workflow-gc-index.sql"-           , "2026-06-15-18-01-33-keiro-workflows-wake-after.sql"-           , "2026-06-15-21-49-37-keiro-projection-dedup.sql"-           , "2026-07-02-00-15-48-keiro-outbox-claim-order-index.sql"-           , "2026-07-02-00-58-54-keiro-inbox-drop-received-idx.sql"-           ]+  "2026-05-17-13-58-15-keiro-bootstrap.sql"+    :| [ "2026-05-19-12-55-02-keiro-outbox.sql",+         "2026-05-19-13-05-23-keiro-inbox.sql",+         "2026-06-03-05-14-28-keiro-timer-recovery.sql",+         "2026-06-03-16-10-05-keiro-workflow-steps.sql",+         "2026-06-03-18-19-41-keiro-awakeables.sql",+         "2026-06-03-19-49-23-keiro-workflow-children.sql",+         "2026-06-04-02-12-28-keiro-workflow-generation.sql",+         "2026-06-04-03-53-34-keiro-subscription-shards.sql",+         "2026-06-15-13-22-31-keiro-messaging-crash-recovery.sql",+         "2026-06-15-15-07-25-keiro-workflows-instances.sql",+         "2026-06-15-17-53-48-keiro-workflow-gc-index.sql",+         "2026-06-15-18-01-33-keiro-workflows-wake-after.sql",+         "2026-06-15-21-49-37-keiro-projection-dedup.sql",+         "2026-07-02-00-15-48-keiro-outbox-claim-order-index.sql",+         "2026-07-02-00-58-54-keiro-inbox-drop-received-idx.sql"+       ]  keiroCoddHistoryMappings :: NonEmpty HistoryMapping keiroCoddHistoryMappings =-    zipWithNonEmpty mapping keiroLegacyMigrationNames nativeMigrationNames+  zipWithNonEmpty mapping keiroLegacyMigrationNames nativeMigrationNames   where     mapping sourceFilename targetName =-        historyMapping-            (definitionInvariant (migrationId "keiro" targetName))-            (Evidence sourceKey)-            (SamePayload sourceKey)+      historyMapping+        (definitionInvariant (migrationId "keiro" targetName))+        (Evidence sourceKey)+        (SamePayload sourceKey)       where         sourceKey = definitionInvariant (first show (coddEvidenceKey sourceFilename))  frameworkCoddHistoryMappings :: NonEmpty HistoryMapping frameworkCoddHistoryMappings =-    Kiroku.kirokuCoddHistoryMappings <> keiroCoddHistoryMappings+  Kiroku.kirokuCoddHistoryMappings <> keiroCoddHistoryMappings  frameworkCoddSourceConfig ::-    ConnectionProvider ->-    Bool ->-    Text ->-    Confirmation ->-    Either CoddDefinitionError CoddSourceConfig+  ConnectionProvider ->+  Bool ->+  Text ->+  Confirmation ->+  Either CoddDefinitionError CoddSourceConfig frameworkCoddSourceConfig sourceProvider strictSource reason confirmation =-    coddSourceConfig-        sourceProvider-        (Kiroku.kirokuLegacyMigrationNames <> keiroLegacyMigrationNames)-        strictSource-        (Kiroku.kirokuCoddSourcePayloads <> keiroCoddSourcePayloads)-        (Just combinedManifest)-        reason-        confirmation+  coddSourceConfig+    sourceProvider+    (Kiroku.kirokuLegacyMigrationNames <> keiroLegacyMigrationNames)+    strictSource+    (Kiroku.kirokuCoddSourcePayloads <> keiroCoddSourcePayloads)+    (Just combinedManifest)+    reason+    confirmation   where     combinedManifest =-        definitionInvariant-            (parseCoddManifest (Kiroku.kirokuCoddManifestText <> keiroCoddManifestText))+      definitionInvariant+        (parseCoddManifest (Kiroku.kirokuCoddManifestText <> keiroCoddManifestText))  nativeMigrationNames :: NonEmpty Text nativeMigrationNames =-    "0001-keiro-bootstrap"-        :| [ "0002-keiro-outbox"-           , "0003-keiro-inbox"-           , "0004-keiro-timer-recovery"-           , "0005-keiro-workflow-steps"-           , "0006-keiro-awakeables"-           , "0007-keiro-workflow-children"-           , "0008-keiro-workflow-generation"-           , "0009-keiro-subscription-shards"-           , "0010-keiro-messaging-crash-recovery"-           , "0011-keiro-workflows-instances"-           , "0012-keiro-workflow-gc-index"-           , "0013-keiro-workflows-wake-after"-           , "0014-keiro-projection-dedup"-           , "0015-keiro-outbox-claim-order-index"-           , "0016-keiro-inbox-drop-received-idx"-           ]+  "0001-keiro-bootstrap"+    :| [ "0002-keiro-outbox",+         "0003-keiro-inbox",+         "0004-keiro-timer-recovery",+         "0005-keiro-workflow-steps",+         "0006-keiro-awakeables",+         "0007-keiro-workflow-children",+         "0008-keiro-workflow-generation",+         "0009-keiro-subscription-shards",+         "0010-keiro-messaging-crash-recovery",+         "0011-keiro-workflows-instances",+         "0012-keiro-workflow-gc-index",+         "0013-keiro-workflows-wake-after",+         "0014-keiro-projection-dedup",+         "0015-keiro-outbox-claim-order-index",+         "0016-keiro-inbox-drop-received-idx"+       ]  keiroCoddSourcePayloads :: Map.Map FilePath ByteString keiroCoddSourcePayloads =-    Map.fromList-        (zip (toList keiroLegacyMigrationNames) (snd <$> toList embeddedMigrationEntries))+  Map.fromList+    (zip (toList keiroLegacyMigrationNames) (snd <$> toList embeddedMigrationEntries))  keiroCoddManifestText :: Text keiroCoddManifestText = $(embedTextFile "migrations.lock")  zipWithNonEmpty :: (a -> b -> c) -> NonEmpty a -> NonEmpty b -> NonEmpty c zipWithNonEmpty combine (firstA :| restA) (firstB :| restB) =-    combine firstA firstB :| zipWith combine restA restB+  combine firstA firstB :| zipWith combine restA restB  definitionInvariant :: (Show error) => Either error value -> value definitionInvariant = either (error . ("invalid checked-in Keiro migration definition: " <>) . show) id

@@ -9,28 +9,29 @@ -- runtime regardless. {-# OPTIONS_GHC -fplugin=Database.PostgreSQL.Migrate.Embed.RecompilePlugin #-} -module Keiro.Migrations.Internal.Definition (-    embeddedMigrationEntries,+module Keiro.Migrations.Internal.Definition+  ( embeddedMigrationEntries,     keiroMigrations,-) where+  )+where  import Data.ByteString (ByteString) import Data.List.NonEmpty (NonEmpty) import Data.Set qualified as Set-import Database.PostgreSQL.Migrate (-    DefinitionError,+import Database.PostgreSQL.Migrate+  ( DefinitionError,     MigrationComponent,     migrationComponentFromEmbeddedSql,- )+  ) import Database.PostgreSQL.Migrate.Embed (embedMigrationManifest)  embeddedMigrationEntries :: NonEmpty (FilePath, ByteString) embeddedMigrationEntries =-    $(embedMigrationManifest "migrations/manifest")+  $(embedMigrationManifest "migrations/manifest")  keiroMigrations :: Either DefinitionError MigrationComponent keiroMigrations =-    migrationComponentFromEmbeddedSql-        "keiro"-        (Set.singleton "kiroku")-        embeddedMigrationEntries+  migrationComponentFromEmbeddedSql+    "keiro"+    (Set.singleton "kiroku")+    embeddedMigrationEntries

@@ -10,10 +10,10 @@  embedTextFile :: FilePath -> Q Exp embedTextFile inputPath = do-    path <- TH.makeRelativeToProject inputPath-    TH.addDependentFile path-    bytes <- TH.runIO (ByteString.readFile path)-    case Text.Encoding.decodeUtf8' bytes of-        Left decodeError -> fail ("invalid UTF-8 in " <> path <> ": " <> show decodeError)-        Right contents ->-            pure (AppE (VarE 'Text.pack) (LitE (StringL (Text.unpack contents))))+  path <- TH.makeRelativeToProject inputPath+  TH.addDependentFile path+  bytes <- TH.runIO (ByteString.readFile path)+  case Text.Encoding.decodeUtf8' bytes of+    Left decodeError -> fail ("invalid UTF-8 in " <> path <> ": " <> show decodeError)+    Right contents ->+      pure (AppE (VarE 'Text.pack) (LitE (StringL (Text.unpack contents))))

@@ -1,13 +1,12 @@ {-# LANGUAGE TemplateHaskell #-} -{- | Transitional Codd-only tools retained for expected-schema snapshots,-remediation drills, and historical ledger fixups.--Normal migration execution uses 'Keiro.Migrations' and does not build this-module unless the @legacy-codd-tools@ Cabal flag is enabled.--}-module Keiro.Migrations.LegacyCodd (-    LedgerSchema (..),+-- | Transitional Codd-only tools retained for expected-schema snapshots,+-- remediation drills, and historical ledger fixups.+--+-- Normal migration execution uses 'Keiro.Migrations' and does not build this+-- module unless the @legacy-codd-tools@ Cabal flag is enabled.+module Keiro.Migrations.LegacyCodd+  ( LedgerSchema (..),     MigrationStatus (..),     VerifyOutcome (..),     embeddedMigrationNames,@@ -19,7 +18,8 @@     runAllKeiroMigrationsNoCheck,     runKirokuMigrationsNoCheck,     verifySchema,-) where+  )+where  import Codd (ApplyResult, CoddSettings (..), VerifySchemas) import Codd.Extras.Ledger (LedgerSchema (..), MigrationStatus (..), VerifyOutcome (..))@@ -37,67 +37,67 @@  runAllKeiroMigrations :: CoddSettings -> DiffTime -> VerifySchemas -> IO ApplyResult runAllKeiroMigrations settings connectTimeout verifySchemas =-    MigrationSet.applyMigrationSets settings connectTimeout verifySchemas frameworkMigrationSets+  MigrationSet.applyMigrationSets settings connectTimeout verifySchemas frameworkMigrationSets  runAllKeiroMigrationsNoCheck :: CoddSettings -> DiffTime -> IO () runAllKeiroMigrationsNoCheck settings connectTimeout =-    void $ MigrationSet.applyMigrationSetsNoCheck settings connectTimeout frameworkMigrationSets+  void $ MigrationSet.applyMigrationSetsNoCheck settings connectTimeout frameworkMigrationSets  runKirokuMigrationsNoCheck :: CoddSettings -> DiffTime -> IO () runKirokuMigrationsNoCheck settings connectTimeout =-    void $ MigrationSet.applyMigrationSetNoCheck settings connectTimeout kirokuMigrationSet+  void $ MigrationSet.applyMigrationSetNoCheck settings connectTimeout kirokuMigrationSet  verifySchema :: CoddSettings -> DiffTime -> IO VerifyOutcome verifySchema =-    MigrationSet.verifyExpectedSchema-        expectedLedgerNames-        MigrationSet.ExpectedSchema-            { MigrationSet.label = "keiro-expected-schema"-            , MigrationSet.files = expectedSchemaFiles-            }+  MigrationSet.verifyExpectedSchema+    expectedLedgerNames+    MigrationSet.ExpectedSchema+      { MigrationSet.label = "keiro-expected-schema",+        MigrationSet.files = expectedSchemaFiles+      }  missingMigrations :: CoddSettings -> DiffTime -> IO [FilePath] missingMigrations settings connectTimeout =-    MigrationSet.missingMigrationsForNames expectedLedgerNames (migsConnString settings) connectTimeout+  MigrationSet.missingMigrationsForNames expectedLedgerNames (migsConnString settings) connectTimeout  migrationStatus :: CoddSettings -> DiffTime -> IO MigrationStatus migrationStatus settings connectTimeout =-    MigrationSet.migrationStatusForNames expectedLedgerNames (migsConnString settings) connectTimeout+  MigrationSet.migrationStatusForNames expectedLedgerNames (migsConnString settings) connectTimeout  frameworkMigrationSets :: [MigrationSet] frameworkMigrationSets =-    [ kirokuMigrationSet-    , keiroMigrationSet-    ]+  [ kirokuMigrationSet,+    keiroMigrationSet+  ]  kirokuMigrationSet :: MigrationSet kirokuMigrationSet =-    MigrationSet.MigrationSet-        { MigrationSet.label = "Kiroku legacy evidence"-        , MigrationSet.files = sourceFiles Kiroku.kirokuLegacyMigrationNames Kiroku.kirokuCoddSourcePayloads-        }+  MigrationSet.MigrationSet+    { MigrationSet.label = "Kiroku legacy evidence",+      MigrationSet.files = sourceFiles Kiroku.kirokuLegacyMigrationNames Kiroku.kirokuCoddSourcePayloads+    }  keiroMigrationSet :: MigrationSet keiroMigrationSet =-    MigrationSet.MigrationSet-        { MigrationSet.label = "Keiro legacy evidence"-        , MigrationSet.files = embeddedMigrationFiles-        }+  MigrationSet.MigrationSet+    { MigrationSet.label = "Keiro legacy evidence",+      MigrationSet.files = embeddedMigrationFiles+    }  sourceFiles ::-    (Foldable collection) =>-    collection FilePath ->-    Map.Map FilePath ByteString ->-    [(FilePath, ByteString)]+  (Foldable collection) =>+  collection FilePath ->+  Map.Map FilePath ByteString ->+  [(FilePath, ByteString)] sourceFiles names payloads =-    [ (name, requirePayload name)-    | name <- toList names-    ]+  [ (name, requirePayload name)+  | name <- toList names+  ]   where     requirePayload name =-        case Map.lookup name payloads of-            Just payload -> payload-            Nothing -> error ("missing checked-in legacy payload for " <> name)+      case Map.lookup name payloads of+        Just payload -> payload+        Nothing -> error ("missing checked-in legacy payload for " <> name)  embeddedMigrationFiles :: [(FilePath, ByteString)] embeddedMigrationFiles = $(embedDir "sql-migrations")@@ -107,12 +107,12 @@  embeddedMigrationNames :: [FilePath] embeddedMigrationNames =-    MigrationSet.migrationNames keiroMigrationSet+  MigrationSet.migrationNames keiroMigrationSet  kirokuEmbeddedMigrationNames :: [FilePath] kirokuEmbeddedMigrationNames =-    MigrationSet.migrationNames kirokuMigrationSet+  MigrationSet.migrationNames kirokuMigrationSet  expectedLedgerNames :: [FilePath] expectedLedgerNames =-    MigrationSet.migrationNamesForSets frameworkMigrationSets+  MigrationSet.migrationNamesForSets frameworkMigrationSets

@@ -1,18 +1,18 @@-{- | Generate a new timestamped Keiro migration skeleton.--The embedded migrations are ordered by their @YYYY-MM-DD-HH-MM-SS-slug.sql@-file names (lexicographic order == chronological order because every field is-fixed-width and zero-padded). 'newMigrationFile' stamps the /real/ current UTC-time, so two migrations authored at different moments can never collide and-always sort in authoring order -- no hand-assigned slots to coordinate.--}-module Keiro.Migrations.New (-    newMigrationFile,+-- | Generate a new timestamped Keiro migration skeleton.+--+-- The embedded migrations are ordered by their @YYYY-MM-DD-HH-MM-SS-slug.sql@+-- file names (lexicographic order == chronological order because every field is+-- fixed-width and zero-padded). 'newMigrationFile' stamps the /real/ current UTC+-- time, so two migrations authored at different moments can never collide and+-- always sort in authoring order -- no hand-assigned slots to coordinate.+module Keiro.Migrations.New+  ( newMigrationFile,     defaultMigrationsDir,     migrationFileName,     migrationSlug,     migrationTemplate,-) where+  )+where  import Codd.Extras.New qualified as New import Data.Time (UTCTime)@@ -31,21 +31,21 @@  migrationTemplate :: String -> String migrationTemplate description =-    unlines-        [ "-- " <> description-        , "--"-        , "-- Create objects fully qualified in the keiro schema (no session path pin)."-        , "-- Example:"-        , "--   CREATE TABLE IF NOT EXISTS keiro.keiro_example ("-        , "--     id UUID PRIMARY KEY"-        , "--   );"-        , ""-        , "-- TODO: write the migration body. Prefer idempotent DDL (IF NOT EXISTS)."-        ]+  unlines+    [ "-- " <> description,+      "--",+      "-- Create objects fully qualified in the keiro schema (no session path pin).",+      "-- Example:",+      "--   CREATE TABLE IF NOT EXISTS keiro.keiro_example (",+      "--     id UUID PRIMARY KEY",+      "--   );",+      "",+      "-- TODO: write the migration body. Prefer idempotent DDL (IF NOT EXISTS)."+    ]  migrationFileConfig :: New.MigrationFileConfig migrationFileConfig =-    New.MigrationFileConfig-        { New.migrationSlugPrefix = Just "keiro"-        , New.migrationTemplate = migrationTemplate-        }+  New.MigrationFileConfig+    { New.migrationSlugPrefix = Just "keiro",+      New.migrationTemplate = migrationTemplate+    }

@@ -1,13 +1,14 @@ {-# LANGUAGE TemplateHaskell #-} -module Keiro.Migrations.SchemaCheck (-    SchemaDrift (..),+module Keiro.Migrations.SchemaCheck+  ( SchemaDrift (..),     compareSchemaSnapshot,     expectedSchemaSnapshot,     renderSchemaDrift,     snapshotSchema,     verifyExpectedSchema,-) where+  )+where  import Control.Exception (finally) import Data.Int (Int32)@@ -30,196 +31,196 @@  -- | 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)+  = 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+  mapMaybe driftFor allKeys   where     expectedObjects = snapshotObjects expected     actualObjects = snapshotObjects actual     allKeys =-        Set.toAscList-            (Map.keysSet expectedObjects `Set.union` Map.keysSet actualObjects)+      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+      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-                    <> ")"+  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+  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")+  $(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])+  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)+  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))+      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+  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+      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)+  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)+  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)))+  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)))+  Statement.preparable+    "SELECT current_setting('server_version_num')::integer"+    Encoders.noParams+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int4)))

@@ -1,6 +1,6 @@-module Main (-    main,-)+module Main+  ( main,+  ) where  import Codd (ApplyResult (..), CoddSettings (..), VerifySchemas (LaxCheck, StrictCheck))@@ -26,8 +26,8 @@ import Hasql.Pool.Config qualified as Pool.Config import Hasql.Session qualified as Session import Hasql.Statement (Statement, preparable)-import Keiro.Migrations.LegacyCodd (-    MigrationStatus (..),+import Keiro.Migrations.LegacyCodd+  ( MigrationStatus (..),     VerifyOutcome (..),     embeddedMigrationNames,     embeddedMigrationSources,@@ -38,367 +38,363 @@     runAllKeiroMigrationsNoCheck,     runKirokuMigrationsNoCheck,     verifySchema,- )+  ) import Keiro.Migrations.New (migrationFileName, migrationSlug, newMigrationFile) import System.Directory (doesDirectoryExist, doesFileExist, listDirectory) import System.FilePath (takeFileName) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec -{- | Pin the ephemeral PostgreSQL superuser to the fixed name @keiro@ so the-captured snapshot identity (roles, database owner, per-object owners) is-deterministic across machines and CI rather than the local OS username. This is-the portability fix for the strict drift gate.--}+-- | Pin the ephemeral PostgreSQL superuser to the fixed name @keiro@ so the+-- captured snapshot identity (roles, database owner, per-object owners) is+-- deterministic across machines and CI rather than the local OS username. This is+-- the portability fix for the strict drift gate. keiroPgConfig :: Pg.Config-keiroPgConfig = Pg.defaultConfig{Pg.user = "keiro"}+keiroPgConfig = Pg.defaultConfig {Pg.user = "keiro"} -{- | Start a cached ephemeral server whose PostgreSQL superuser is the fixed-name @keiro@. Mirrors 'Pg.withCached' but pins the user; 'Pg.withCachedConfig'-is not exported, so we use 'Pg.startCached' + 'finally'.--}+-- | Start a cached ephemeral server whose PostgreSQL superuser is the fixed+-- name @keiro@. Mirrors 'Pg.withCached' but pins the user; 'Pg.withCachedConfig'+-- is not exported, so we use 'Pg.startCached' + 'finally'. withKeiroPg :: (Pg.Database -> IO a) -> IO (Either Pg.StartError a) withKeiroPg action = do-    started <- Pg.startCached keiroPgConfig Pg.defaultCacheConfig-    case started of-        Left err -> pure (Left err)-        Right db -> Right <$> (action db `finally` Pg.stop db)+  started <- Pg.startCached keiroPgConfig Pg.defaultCacheConfig+  case started of+    Left err -> pure (Left err)+    Right db -> Right <$> (action db `finally` Pg.stop db)  main :: IO () main =-    hspec $ do-        migrationFileNameSpec-        migrationIntegritySpec-        scaffolderSpec-        migrationUpgradeSpec-        describe "Keiro codd migrations" $ do-            it "applies Kiroku and Keiro migrations to a fresh database and is repeatable" $ do-                result <- withKeiroPg $ \db -> do-                    let connStr = Pg.connectionString db-                        coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"+  hspec $ do+    migrationFileNameSpec+    migrationIntegritySpec+    scaffolderSpec+    migrationUpgradeSpec+    describe "Keiro codd migrations" $ do+      it "applies Kiroku and Keiro migrations to a fresh database and is repeatable" $ do+        result <- withKeiroPg $ \db -> do+          let connStr = Pg.connectionString db+              coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema" -                    runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                    assertTablesExist connStr "kiroku" kirokuTables-                    assertTablesExist connStr "keiro" keiroTables-                    assertTablesAbsent connStr "kiroku" keiroTables-                    assertTablesAbsent connStr "public" keiroTables-                    assertTablesAbsent connStr "public" kirokuTables+          runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+          assertTablesExist connStr "kiroku" kirokuTables+          assertTablesExist connStr "keiro" keiroTables+          assertTablesAbsent connStr "kiroku" keiroTables+          assertTablesAbsent connStr "public" keiroTables+          assertTablesAbsent connStr "public" kirokuTables -                    runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                    assertTablesExist connStr "kiroku" kirokuTables-                    assertTablesExist connStr "keiro" keiroTables-                    assertTablesAbsent connStr "kiroku" keiroTables-                    assertTablesAbsent connStr "public" keiroTables-                    assertColumnExists connStr "keiro" "keiro_timers" "last_error"+          runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+          assertTablesExist connStr "kiroku" kirokuTables+          assertTablesExist connStr "keiro" keiroTables+          assertTablesAbsent connStr "kiroku" keiroTables+          assertTablesAbsent connStr "public" keiroTables+          assertColumnExists connStr "keiro" "keiro_timers" "last_error" -                case result of-                    Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                    Right () -> pure ()+        case result of+          Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+          Right () -> pure () -            it "matches the checked-in expected schema" $ do-                expectedSchemaDir <- findExpectedSchemaDir-                result <- withKeiroPg $ \db -> do-                    let coddSettings = testCoddSettings (Pg.connectionString db) expectedSchemaDir-                    runAllKeiroMigrations coddSettings (secondsToDiffTime 5) StrictCheck+      it "matches the checked-in expected schema" $ do+        expectedSchemaDir <- findExpectedSchemaDir+        result <- withKeiroPg $ \db -> do+          let coddSettings = testCoddSettings (Pg.connectionString db) expectedSchemaDir+          runAllKeiroMigrations coddSettings (secondsToDiffTime 5) StrictCheck -                case result of-                    Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                    Right (SchemasMatch _) -> pure ()-                    Right SchemasNotVerified -> expectationFailure "StrictCheck did not verify schemas"-                    Right (SchemasDiffer _) -> expectationFailure "StrictCheck returned a schema mismatch without throwing"+        case result of+          Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+          Right (SchemasMatch _) -> pure ()+          Right SchemasNotVerified -> expectationFailure "StrictCheck did not verify schemas"+          Right (SchemasDiffer _) -> expectationFailure "StrictCheck returned a schema mismatch without throwing" -            it "reports schema drift under LaxCheck" $ do-                expectedSchemaDir <- findExpectedSchemaDir-                result <- withKeiroPg $ \db -> do-                    let connStr = Pg.connectionString db-                        coddSettings = testCoddSettings connStr expectedSchemaDir-                    runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                    runDb-                        connStr-                        "drift drill"-                        (Session.script "ALTER TABLE keiro.keiro_timers ALTER COLUMN last_error SET NOT NULL;")-                    runAllKeiroMigrations coddSettings (secondsToDiffTime 5) LaxCheck+      it "reports schema drift under LaxCheck" $ do+        expectedSchemaDir <- findExpectedSchemaDir+        result <- withKeiroPg $ \db -> do+          let connStr = Pg.connectionString db+              coddSettings = testCoddSettings connStr expectedSchemaDir+          runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+          runDb+            connStr+            "drift drill"+            (Session.script "ALTER TABLE keiro.keiro_timers ALTER COLUMN last_error SET NOT NULL;")+          runAllKeiroMigrations coddSettings (secondsToDiffTime 5) LaxCheck -                case result of-                    Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                    Right (SchemasDiffer _) -> pure ()-                    Right SchemasNotVerified -> expectationFailure "LaxCheck did not verify schemas"-                    Right (SchemasMatch _) -> expectationFailure "LaxCheck did not report schema drift"+        case result of+          Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+          Right (SchemasDiffer _) -> pure ()+          Right SchemasNotVerified -> expectationFailure "LaxCheck did not verify schemas"+          Right (SchemasMatch _) -> expectationFailure "LaxCheck did not report schema drift" -{- | Guard against the recurring mistake of hand-assigning rounded, sentinel-migration timestamps (e.g. @2026-05-17-00-00-00-...@, @...-01-00-00-...@).-Migrations must be created with @keiro-migrate new@ ("Keiro.Migrations.New"),-which stamps the real current UTC time to the second, so filenames sort in true-authoring order and never collide in codd's timestamp-keyed ledger.--}+-- | Guard against the recurring mistake of hand-assigning rounded, sentinel+-- migration timestamps (e.g. @2026-05-17-00-00-00-...@, @...-01-00-00-...@).+-- Migrations must be created with @keiro-migrate new@ ("Keiro.Migrations.New"),+-- which stamps the real current UTC time to the second, so filenames sort in true+-- authoring order and never collide in codd's timestamp-keyed ledger. migrationFileNameSpec :: Spec migrationFileNameSpec =-    describe "migration file names" $ do-        it "carry real UTC authoring timestamps, not hand-assigned sentinels" $ do-            files <- migrationFiles-            files `shouldNotBe` []-            sentinelViolations files `shouldHaveNoViolations` "sentinel timestamp violations"+  describe "migration file names" $ do+    it "carry real UTC authoring timestamps, not hand-assigned sentinels" $ do+      files <- migrationFiles+      files `shouldNotBe` []+      sentinelViolations files `shouldHaveNoViolations` "sentinel timestamp violations" -        it "have unique, strictly increasing timestamps" $ do-            files <- migrationFiles-            duplicateTimestampViolations files `shouldHaveNoViolations` "duplicate timestamp violations"+    it "have unique, strictly increasing timestamps" $ do+      files <- migrationFiles+      duplicateTimestampViolations files `shouldHaveNoViolations` "duplicate timestamp violations"  migrationIntegritySpec :: Spec migrationIntegritySpec =-    describe "migration integrity guards" $ do-        it "embeds exactly the checked-in sql-migrations directory" $ do-            diskNames <- sort <$> migrationFiles-            embeddedMigrationNames `shouldBe` diskNames+  describe "migration integrity guards" $ do+    it "embeds exactly the checked-in sql-migrations directory" $ do+      diskNames <- sort <$> migrationFiles+      embeddedMigrationNames `shouldBe` diskNames -        it "matches the checked-in SHA-256 manifest" $ do-            manifestPath <- findLockfile-            parsed <- parseChecksumManifest <$> TIO.readFile manifestPath-            case parsed of-                Left err -> expectationFailure (T.unpack err)-                Right manifest ->-                    checksumViolations manifest embeddedMigrationSources-                        `shouldHaveNoViolations` "checksum manifest violations"+    it "matches the checked-in SHA-256 manifest" $ do+      manifestPath <- findLockfile+      parsed <- parseChecksumManifest <$> TIO.readFile manifestPath+      case parsed of+        Left err -> expectationFailure (T.unpack err)+        Right manifest ->+          checksumViolations manifest embeddedMigrationSources+            `shouldHaveNoViolations` "checksum manifest violations" -        it "keeps future migration bodies schema-qualified and codd-safe" $ do-            lintViolations-                LintConfig-                    { requiredQualifier = "keiro."-                    , exemptFiles = []-                    }-                embeddedMigrationSources-                `shouldHaveNoViolations` "migration body lint violations"+    it "keeps future migration bodies schema-qualified and codd-safe" $ do+      lintViolations+        LintConfig+          { requiredQualifier = "keiro.",+            exemptFiles = []+          }+        embeddedMigrationSources+        `shouldHaveNoViolations` "migration body lint violations" -        it "keeps timestamps unique across the combined Kiroku and Keiro ledger" $ do-            duplicateTimestampViolations expectedLedgerNames-                `shouldHaveNoViolations` "combined-ledger duplicate timestamp violations"+    it "keeps timestamps unique across the combined Kiroku and Keiro ledger" $ do+      duplicateTimestampViolations expectedLedgerNames+        `shouldHaveNoViolations` "combined-ledger duplicate timestamp violations" -        it "records every embedded Kiroku and Keiro migration in the codd v5 ledger" $ do-            result <- withKeiroPg $ \db -> do-                let connStr = Pg.connectionString db-                    coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                schema <- detectLedgerSchema connStr-                schema `shouldBe` "codd"-                names <- ledgerNames connStr schema-                names `shouldBe` map T.pack expectedLedgerNames-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "records every embedded Kiroku and Keiro migration in the codd v5 ledger" $ do+      result <- withKeiroPg $ \db -> do+        let connStr = Pg.connectionString db+            coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        schema <- detectLedgerSchema connStr+        schema `shouldBe` "codd"+        names <- ledgerNames connStr schema+        names `shouldBe` map T.pack expectedLedgerNames+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "serializes concurrent combined applies with the shared advisory lock" $ do-            result <- withKeiroPg $ \db -> do-                let connStr = Pg.connectionString db-                    coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"-                concurrently-                    (runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5))-                    (runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5))-                schema <- detectLedgerSchema connStr-                names <- ledgerNames connStr schema-                names `shouldBe` map T.pack expectedLedgerNames-                count <- ledgerRowCount connStr schema-                count `shouldBe` fromIntegral (length expectedLedgerNames)-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "serializes concurrent combined applies with the shared advisory lock" $ do+      result <- withKeiroPg $ \db -> do+        let connStr = Pg.connectionString db+            coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"+        concurrently+          (runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5))+          (runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5))+        schema <- detectLedgerSchema connStr+        names <- ledgerNames connStr schema+        names `shouldBe` map T.pack expectedLedgerNames+        count <- ledgerRowCount connStr schema+        count `shouldBe` fromIntegral (length expectedLedgerNames)+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "reports every embedded migration as pending on an empty database" $ do-            result <- withKeiroPg $ \db -> do-                let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"-                verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyPending expectedLedgerNames-                status <- migrationStatus coddSettings (secondsToDiffTime 5)-                statusApplied status `shouldBe` []-                statusPending status `shouldBe` expectedLedgerNames-                missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` expectedLedgerNames-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "reports every embedded migration as pending on an empty database" $ do+      result <- withKeiroPg $ \db -> do+        let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"+        verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyPending expectedLedgerNames+        status <- migrationStatus coddSettings (secondsToDiffTime 5)+        statusApplied status `shouldBe` []+        statusPending status `shouldBe` expectedLedgerNames+        missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` expectedLedgerNames+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "reports only Keiro migrations as pending after Kiroku-only apply" $ do-            result <- withKeiroPg $ \db -> do-                let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"-                runKirokuMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyPending embeddedMigrationNames-                status <- migrationStatus coddSettings (secondsToDiffTime 5)-                map fst (statusApplied status) `shouldBe` kirokuEmbeddedMigrationNames-                statusPending status `shouldBe` embeddedMigrationNames-                missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` embeddedMigrationNames-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "reports only Keiro migrations as pending after Kiroku-only apply" $ do+      result <- withKeiroPg $ \db -> do+        let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"+        runKirokuMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyPending embeddedMigrationNames+        status <- migrationStatus coddSettings (secondsToDiffTime 5)+        map fst (statusApplied status) `shouldBe` kirokuEmbeddedMigrationNames+        statusPending status `shouldBe` embeddedMigrationNames+        missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` embeddedMigrationNames+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "verifies the embedded Keiro expected schema after combined apply" $ do-            result <- withKeiroPg $ \db -> do-                let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifySucceeded-                status <- migrationStatus coddSettings (secondsToDiffTime 5)-                map fst (statusApplied status) `shouldBe` expectedLedgerNames-                statusPending status `shouldBe` []-                missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` []-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "verifies the embedded Keiro expected schema after combined apply" $ do+      result <- withKeiroPg $ \db -> do+        let coddSettings = testCoddSettings (Pg.connectionString db) "keiro-migrations/expected-schema"+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifySucceeded+        status <- migrationStatus coddSettings (secondsToDiffTime 5)+        map fst (statusApplied status) `shouldBe` expectedLedgerNames+        statusPending status `shouldBe` []+        missingMigrations coddSettings (secondsToDiffTime 5) `shouldReturn` []+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "reports Keiro schema drift without applying migrations" $ do-            result <- withKeiroPg $ \db -> do-                let connStr = Pg.connectionString db-                    coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                beforeCount <- ledgerRowCount connStr "codd"-                runDb connStr "verify drift mutation" (Session.script "CREATE TABLE keiro.verify_drift (id int);")-                verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyFailed-                afterCount <- ledgerRowCount connStr "codd"-                afterCount `shouldBe` beforeCount-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "reports Keiro schema drift without applying migrations" $ do+      result <- withKeiroPg $ \db -> do+        let connStr = Pg.connectionString db+            coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        beforeCount <- ledgerRowCount connStr "codd"+        runDb connStr "verify drift mutation" (Session.script "CREATE TABLE keiro.verify_drift (id int);")+        verifySchema coddSettings (secondsToDiffTime 5) `shouldReturn` VerifyFailed+        afterCount <- ledgerRowCount connStr "codd"+        afterCount `shouldBe` beforeCount+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -        it "realigns historical sentinel ledger rows before a repeat migrate" $ do-            fixupPath <- findLedgerFixup-            fixupScript <- TIO.readFile fixupPath-            result <- withKeiroPg $ \db -> do-                let connStr = Pg.connectionString db-                    coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                schema <- detectLedgerSchema connStr-                rewindKeiroLedgerToSentinelNames connStr schema-                sentinelNames <- ledgerNames connStr schema-                sentinelNames `shouldSatisfy` any (`elem` map oldLedgerName keiroLedgerRemaps)-                runDb connStr "keiro ledger fixup script" (Session.script fixupScript)-                fixedNames <- ledgerNames connStr schema-                fixedNames `shouldBe` map T.pack expectedLedgerNames-                beforeCount <- ledgerRowCount connStr schema-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                afterCount <- ledgerRowCount connStr schema-                afterCount `shouldBe` beforeCount-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+    it "realigns historical sentinel ledger rows before a repeat migrate" $ do+      fixupPath <- findLedgerFixup+      fixupScript <- TIO.readFile fixupPath+      result <- withKeiroPg $ \db -> do+        let connStr = Pg.connectionString db+            coddSettings = testCoddSettings connStr "keiro-migrations/expected-schema"+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        schema <- detectLedgerSchema connStr+        rewindKeiroLedgerToSentinelNames connStr schema+        sentinelNames <- ledgerNames connStr schema+        sentinelNames `shouldSatisfy` any (`elem` map oldLedgerName keiroLedgerRemaps)+        runDb connStr "keiro ledger fixup script" (Session.script fixupScript)+        fixedNames <- ledgerNames connStr schema+        fixedNames `shouldBe` map T.pack expectedLedgerNames+        beforeCount <- ledgerRowCount connStr schema+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        afterCount <- ledgerRowCount connStr schema+        afterCount `shouldBe` beforeCount+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure () -{- | Prove the scaffolder (`Keiro.Migrations.New`) is the producer that satisfies-the reactive filename guard. The deterministic check proves the slug convention;-the temp-dir check proves the live writer creates a schema-qualified template.--}+-- | Prove the scaffolder (`Keiro.Migrations.New`) is the producer that satisfies+-- the reactive filename guard. The deterministic check proves the slug convention;+-- the temp-dir check proves the live writer creates a schema-qualified template. scaffolderSpec :: Spec scaffolderSpec =-    describe "migration scaffolder" $ do-        it "stamps a real, non-sentinel UTC timestamp and a keiro-prefixed slug" $ do-            let sampled = UTCTime (fromGregorian 2026 7 5) (secondsToDiffTime (19 * 3600 + 9 * 60 + 18))-                name = migrationFileName sampled "Add widget index"-            takeFileName name `shouldBe` name-            isTimestampShaped (take timestampWidth name) `shouldBe` True-            handAssignedTimestamp name `shouldBe` False-            migrationSlug "Add widget index" `shouldBe` "keiro-add-widget-index"+  describe "migration scaffolder" $ do+    it "stamps a real, non-sentinel UTC timestamp and a keiro-prefixed slug" $ do+      let sampled = UTCTime (fromGregorian 2026 7 5) (secondsToDiffTime (19 * 3600 + 9 * 60 + 18))+          name = migrationFileName sampled "Add widget index"+      takeFileName name `shouldBe` name+      isTimestampShaped (take timestampWidth name) `shouldBe` True+      handAssignedTimestamp name `shouldBe` False+      migrationSlug "Add widget index" `shouldBe` "keiro-add-widget-index" -        it "writes a well-named file into a temp dir with a qualified template" $-            withSystemTempDirectory "keiro-scaffolder" $ \dir -> do-                path <- newMigrationFile dir "add widget index"-                let base = takeFileName path-                isTimestampShaped (take timestampWidth base) `shouldBe` True-                length base `shouldSatisfy` (> timestampWidth)-                body <- TIO.readFile path-                (".sql" `isSuffixOf` path) `shouldBe` True-                ("keiro.keiro_example" `T.isInfixOf` body) `shouldBe` True-                ("search_path" `T.isInfixOf` body) `shouldBe` False+    it "writes a well-named file into a temp dir with a qualified template" $+      withSystemTempDirectory "keiro-scaffolder" $ \dir -> do+        path <- newMigrationFile dir "add widget index"+        let base = takeFileName path+        isTimestampShaped (take timestampWidth base) `shouldBe` True+        length base `shouldSatisfy` (> timestampWidth)+        body <- TIO.readFile path+        (".sql" `isSuffixOf` path) `shouldBe` True+        ("keiro.keiro_example" `T.isInfixOf` body) `shouldBe` True+        ("search_path" `T.isInfixOf` body) `shouldBe` False  migrationUpgradeSpec :: Spec migrationUpgradeSpec =-    describe "keiro migration upgrade artifacts" $ do-        it "remediates a 0.1.0.0-style kiroku-schema layout without losing rows" $ do-            remediationPath <- findRemediationScript-            remediationScript <- TIO.readFile remediationPath-            expectedSchemaDir <- findExpectedSchemaDir-            result <- withKeiroPg $ \db -> do-                let connStr = Pg.connectionString db-                    coddSettings = testCoddSettings connStr expectedSchemaDir-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                schema <- detectLedgerSchema connStr-                moveKeiroTablesBackToKiroku connStr-                seedRemediationRows connStr-                runDb connStr "keiro schema remediation script" (Session.script remediationScript)+  describe "keiro migration upgrade artifacts" $ do+    it "remediates a 0.1.0.0-style kiroku-schema layout without losing rows" $ do+      remediationPath <- findRemediationScript+      remediationScript <- TIO.readFile remediationPath+      expectedSchemaDir <- findExpectedSchemaDir+      result <- withKeiroPg $ \db -> do+        let connStr = Pg.connectionString db+            coddSettings = testCoddSettings connStr expectedSchemaDir+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        schema <- detectLedgerSchema connStr+        moveKeiroTablesBackToKiroku connStr+        seedRemediationRows connStr+        runDb connStr "keiro schema remediation script" (Session.script remediationScript) -                assertTablesExist connStr "keiro" keiroTables-                assertTablesAbsent connStr "kiroku" keiroTables-                assertSnapshotRowSurvived connStr-                assertTimerRowSurvived connStr+        assertTablesExist connStr "keiro" keiroTables+        assertTablesAbsent connStr "kiroku" keiroTables+        assertSnapshotRowSurvived connStr+        assertTimerRowSurvived connStr -                beforeCount <- ledgerRowCount connStr schema-                runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)-                afterCount <- ledgerRowCount connStr schema-                afterCount `shouldBe` beforeCount+        beforeCount <- ledgerRowCount connStr schema+        runAllKeiroMigrationsNoCheck coddSettings (secondsToDiffTime 5)+        afterCount <- ledgerRowCount connStr schema+        afterCount `shouldBe` beforeCount -                strictResult <- runAllKeiroMigrations coddSettings (secondsToDiffTime 5) StrictCheck-                case strictResult of-                    SchemasMatch _ -> pure ()-                    SchemasNotVerified -> expectationFailure "StrictCheck did not verify remediated schemas"-                    SchemasDiffer _ -> expectationFailure "StrictCheck returned a schema mismatch after remediation"+        strictResult <- runAllKeiroMigrations coddSettings (secondsToDiffTime 5) StrictCheck+        case strictResult of+          SchemasMatch _ -> pure ()+          SchemasNotVerified -> expectationFailure "StrictCheck did not verify remediated schemas"+          SchemasDiffer _ -> expectationFailure "StrictCheck returned a schema mismatch after remediation" -                runDb connStr "idempotent keiro schema remediation script" (Session.script remediationScript)-                assertTablesExist connStr "keiro" keiroTables-                assertTablesAbsent connStr "kiroku" keiroTables-                assertSnapshotRowSurvived connStr-                assertTimerRowSurvived connStr-            case result of-                Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)-                Right () -> pure ()+        runDb connStr "idempotent keiro schema remediation script" (Session.script remediationScript)+        assertTablesExist connStr "keiro" keiroTables+        assertTablesAbsent connStr "kiroku" keiroTables+        assertSnapshotRowSurvived connStr+        assertTimerRowSurvived connStr+      case result of+        Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+        Right () -> pure ()  -- | The migration @.sql@ files, wherever the suite is run from. migrationFiles :: IO [FilePath] migrationFiles = do-    dir <- findMigrationsDir-    filter (".sql" `isSuffixOf`) <$> listDirectory dir+  dir <- findMigrationsDir+  filter (".sql" `isSuffixOf`) <$> listDirectory dir  findMigrationsDir :: IO FilePath findMigrationsDir = do-    let candidates = ["keiro-migrations/sql-migrations", "sql-migrations"]-    existing <- filterM doesDirectoryExist candidates-    case existing of-        dir : _ -> pure dir-        [] ->-            expectationFailure "Could not find keiro-migrations/sql-migrations"-                >> pure "keiro-migrations/sql-migrations"+  let candidates = ["keiro-migrations/sql-migrations", "sql-migrations"]+  existing <- filterM doesDirectoryExist candidates+  case existing of+    dir : _ -> pure dir+    [] ->+      expectationFailure "Could not find keiro-migrations/sql-migrations"+        >> pure "keiro-migrations/sql-migrations"  findExpectedSchemaDir :: IO FilePath findExpectedSchemaDir = do-    let candidates =-            [ "keiro-migrations/expected-schema"-            , "expected-schema"-            ]-    existing <- filterM doesDirectoryExist candidates-    case existing of-        dir : _ -> pure dir-        [] ->-            expectationFailure "Could not find keiro-migrations/expected-schema"-                >> pure "keiro-migrations/expected-schema"+  let candidates =+        [ "keiro-migrations/expected-schema",+          "expected-schema"+        ]+  existing <- filterM doesDirectoryExist candidates+  case existing of+    dir : _ -> pure dir+    [] ->+      expectationFailure "Could not find keiro-migrations/expected-schema"+        >> pure "keiro-migrations/expected-schema"  findLockfile :: IO FilePath findLockfile = findExistingFile ["keiro-migrations/migrations.lock", "migrations.lock"]  findLedgerFixup :: IO FilePath findLedgerFixup =-    findExistingFile-        [ "keiro-migrations/ledger-fixups/2026-07-05-realign-keiro-migration-timestamps.sql"-        , "ledger-fixups/2026-07-05-realign-keiro-migration-timestamps.sql"-        ]+  findExistingFile+    [ "keiro-migrations/ledger-fixups/2026-07-05-realign-keiro-migration-timestamps.sql",+      "ledger-fixups/2026-07-05-realign-keiro-migration-timestamps.sql"+    ]  findRemediationScript :: IO FilePath findRemediationScript =-    findExistingFile-        [ "keiro-migrations/remediation/2026-07-05-relocate-keiro-tables-to-keiro-schema.sql"-        , "remediation/2026-07-05-relocate-keiro-tables-to-keiro-schema.sql"-        ]+  findExistingFile+    [ "keiro-migrations/remediation/2026-07-05-relocate-keiro-tables-to-keiro-schema.sql",+      "remediation/2026-07-05-relocate-keiro-tables-to-keiro-schema.sql"+    ]  findExistingFile :: [FilePath] -> IO FilePath findExistingFile candidates = do-    existing <- filterM doesFileExist candidates-    case existing of-        path : _ -> pure path-        [] -> expectationFailure ("Could not find any of: " <> show candidates) >> pure fallback+  existing <- filterM doesFileExist candidates+  case existing of+    path : _ -> pure path+    [] -> expectationFailure ("Could not find any of: " <> show candidates) >> pure fallback   where     fallback =-        case candidates of-            path : _ -> path-            [] -> "."+      case candidates of+        path : _ -> path+        [] -> "."  expectedLedgerNames :: [FilePath] expectedLedgerNames = sort (kirokuEmbeddedMigrationNames <> embeddedMigrationNames)@@ -406,82 +402,82 @@ -- | Kiroku's own event-store tables, which remain in the kiroku schema. kirokuTables :: [Text] kirokuTables =-    [ "events"-    , "stream_events"-    , "streams"-    , "subscriptions"-    ]+  [ "events",+    "stream_events",+    "streams",+    "subscriptions"+  ]  -- | Keiro's framework tables, which live in the dedicated keiro schema. keiroTables :: [Text] keiroTables =-    [ "keiro_awakeables"-    , "keiro_inbox"-    , "keiro_outbox"-    , "keiro_projection_dedup"-    , "keiro_read_models"-    , "keiro_snapshots"-    , "keiro_subscription_shards"-    , "keiro_timers"-    , "keiro_workflow_children"-    , "keiro_workflow_steps"-    , "keiro_workflows"-    ]+  [ "keiro_awakeables",+    "keiro_inbox",+    "keiro_outbox",+    "keiro_projection_dedup",+    "keiro_read_models",+    "keiro_snapshots",+    "keiro_subscription_shards",+    "keiro_timers",+    "keiro_workflow_children",+    "keiro_workflow_steps",+    "keiro_workflows"+  ]  testCoddSettings :: Text -> FilePath -> CoddSettings testCoddSettings connStr expectedSchemaDir =-    CoddSettings-        { migsConnString = parseConnString connStr-        , sqlMigrations = []-        , onDiskReps = Left expectedSchemaDir-        , namespacesToCheck = IncludeSchemas [SqlSchema "keiro"]-        , extraRolesToCheck = []-        , retryPolicy = singleTryPolicy-        , txnIsolationLvl = DbDefault-        , schemaAlgoOpts = SchemaAlgo False False False-        }+  CoddSettings+    { migsConnString = parseConnString connStr,+      sqlMigrations = [],+      onDiskReps = Left expectedSchemaDir,+      namespacesToCheck = IncludeSchemas [SqlSchema "keiro"],+      extraRolesToCheck = [],+      retryPolicy = singleTryPolicy,+      txnIsolationLvl = DbDefault,+      schemaAlgoOpts = SchemaAlgo False False False+    }  parseConnString :: Text -> ConnectionString parseConnString connStr =-    case parseOnly (connStringParser <* endOfInput) connStr of-        Left err -> error ("Could not parse ephemeral PostgreSQL connection string for codd: " <> err)-        Right parsed -> parsed+  case parseOnly (connStringParser <* endOfInput) connStr of+    Left err -> error ("Could not parse ephemeral PostgreSQL connection string for codd: " <> err)+    Right parsed -> parsed  shouldHaveNoViolations :: [Text] -> String -> Expectation shouldHaveNoViolations [] _ = pure () shouldHaveNoViolations violations label =-    expectationFailure (label <> ":\n" <> T.unpack (T.unlines violations))+  expectationFailure (label <> ":\n" <> T.unpack (T.unlines violations))  runDb :: Text -> String -> Session.Session a -> IO a runDb connStr label session = do-    pool <- Pool.acquire poolConfig-    result <- Pool.use pool session-    Pool.release pool-    case result of-        Left err -> expectationFailure (label <> " failed: " <> show err) >> fail label-        Right value -> pure value+  pool <- Pool.acquire poolConfig+  result <- Pool.use pool session+  Pool.release pool+  case result of+    Left err -> expectationFailure (label <> " failed: " <> show err) >> fail label+    Right value -> pure value   where     poolConfig =-        Pool.Config.settings-            [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr)-            , Pool.Config.size 1-            ]+      Pool.Config.settings+        [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr),+          Pool.Config.size 1+        ]  detectLedgerSchema :: Text -> IO Text detectLedgerSchema connStr = do-    (hasCodd, hasCoddSchema) <- runDb connStr "ledger schema detection" (Session.statement () ledgerSchemaStmt)-    case (hasCodd, hasCoddSchema) of-        (True, False) -> pure "codd"-        (False, True) -> pure "codd_schema"-        (False, False) -> expectationFailure "codd ledger table was not found" >> pure "codd"-        (True, True) -> expectationFailure "both codd and codd_schema ledger tables exist" >> pure "codd"+  (hasCodd, hasCoddSchema) <- runDb connStr "ledger schema detection" (Session.statement () ledgerSchemaStmt)+  case (hasCodd, hasCoddSchema) of+    (True, False) -> pure "codd"+    (False, True) -> pure "codd_schema"+    (False, False) -> expectationFailure "codd ledger table was not found" >> pure "codd"+    (True, True) -> expectationFailure "both codd and codd_schema ledger tables exist" >> pure "codd"  ledgerSchemaStmt :: Statement () (Bool, Bool) ledgerSchemaStmt =-    preparable-        "SELECT to_regclass('codd.sql_migrations') IS NOT NULL, to_regclass('codd_schema.sql_migrations') IS NOT NULL"-        E.noParams-        (D.singleRow ((,) <$> D.column (D.nonNullable D.bool) <*> D.column (D.nonNullable D.bool)))+  preparable+    "SELECT to_regclass('codd.sql_migrations') IS NOT NULL, to_regclass('codd_schema.sql_migrations') IS NOT NULL"+    E.noParams+    (D.singleRow ((,) <$> D.column (D.nonNullable D.bool) <*> D.column (D.nonNullable D.bool)))  ledgerNames :: Text -> Text -> IO [Text] ledgerNames connStr "codd" = runDb connStr "codd ledger names" (Session.statement () ledgerNamesCoddStmt)@@ -490,17 +486,17 @@  ledgerNamesCoddStmt :: Statement () [Text] ledgerNamesCoddStmt =-    preparable-        "SELECT name::text FROM codd.sql_migrations ORDER BY name"-        E.noParams-        (D.rowList (D.column (D.nonNullable D.text)))+  preparable+    "SELECT name::text FROM codd.sql_migrations ORDER BY name"+    E.noParams+    (D.rowList (D.column (D.nonNullable D.text)))  ledgerNamesCoddSchemaStmt :: Statement () [Text] ledgerNamesCoddSchemaStmt =-    preparable-        "SELECT name::text FROM codd_schema.sql_migrations ORDER BY name"-        E.noParams-        (D.rowList (D.column (D.nonNullable D.text)))+  preparable+    "SELECT name::text FROM codd_schema.sql_migrations ORDER BY name"+    E.noParams+    (D.rowList (D.column (D.nonNullable D.text)))  ledgerRowCount :: Text -> Text -> IO Int32 ledgerRowCount connStr "codd" = runDb connStr "codd ledger row count" (Session.statement () ledgerCountCoddStmt)@@ -509,181 +505,181 @@  ledgerCountCoddStmt :: Statement () Int32 ledgerCountCoddStmt =-    preparable-        "SELECT count(*)::int FROM codd.sql_migrations"-        E.noParams-        (D.singleRow (D.column (D.nonNullable D.int4)))+  preparable+    "SELECT count(*)::int FROM codd.sql_migrations"+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.int4)))  ledgerCountCoddSchemaStmt :: Statement () Int32 ledgerCountCoddSchemaStmt =-    preparable-        "SELECT count(*)::int FROM codd_schema.sql_migrations"-        E.noParams-        (D.singleRow (D.column (D.nonNullable D.int4)))+  preparable+    "SELECT count(*)::int FROM codd_schema.sql_migrations"+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.int4)))  data KeiroLedgerRemap = KeiroLedgerRemap-    { newLedgerName :: Text-    , oldLedgerName :: Text-    , oldLedgerTimestamp :: Text-    }-    deriving stock (Eq, Show)+  { newLedgerName :: Text,+    oldLedgerName :: Text,+    oldLedgerTimestamp :: Text+  }+  deriving stock (Eq, Show)  keiroLedgerRemaps :: [KeiroLedgerRemap] keiroLedgerRemaps =-    [ KeiroLedgerRemap "2026-05-17-13-58-15-keiro-bootstrap.sql" "2026-05-17-00-00-00-keiro-bootstrap.sql" "2026-05-17 00:00:00+00"-    , KeiroLedgerRemap "2026-05-19-12-55-02-keiro-outbox.sql" "2026-05-17-01-00-00-keiro-outbox.sql" "2026-05-17 01:00:00+00"-    , KeiroLedgerRemap "2026-05-19-13-05-23-keiro-inbox.sql" "2026-05-17-02-00-00-keiro-inbox.sql" "2026-05-17 02:00:00+00"-    , KeiroLedgerRemap "2026-06-03-05-14-28-keiro-timer-recovery.sql" "2026-05-17-03-00-00-keiro-timer-recovery.sql" "2026-05-17 03:00:00+00"-    , KeiroLedgerRemap "2026-06-03-16-10-05-keiro-workflow-steps.sql" "2026-06-03-00-00-00-keiro-workflow-steps.sql" "2026-06-03 00:00:00+00"-    , KeiroLedgerRemap "2026-06-03-18-19-41-keiro-awakeables.sql" "2026-06-03-01-00-00-keiro-awakeables.sql" "2026-06-03 01:00:00+00"-    , KeiroLedgerRemap "2026-06-03-19-49-23-keiro-workflow-children.sql" "2026-06-03-02-00-00-keiro-workflow-children.sql" "2026-06-03 02:00:00+00"-    , KeiroLedgerRemap "2026-06-04-02-12-28-keiro-workflow-generation.sql" "2026-06-05-00-00-00-keiro-workflow-generation.sql" "2026-06-05 00:00:00+00"-    , KeiroLedgerRemap "2026-06-04-03-53-34-keiro-subscription-shards.sql" "2026-06-05-01-00-00-keiro-subscription-shards.sql" "2026-06-05 01:00:00+00"-    , KeiroLedgerRemap "2026-06-15-15-07-25-keiro-workflows-instances.sql" "2026-06-11-00-00-04-keiro-workflows-instances.sql" "2026-06-11 00:00:04+00"-    , KeiroLedgerRemap "2026-06-15-17-53-48-keiro-workflow-gc-index.sql" "2026-06-15-22-10-00-keiro-workflow-gc-index.sql" "2026-06-15 22:10:00+00"-    , KeiroLedgerRemap "2026-06-15-18-01-33-keiro-workflows-wake-after.sql" "2026-06-15-22-20-00-keiro-workflows-wake-after.sql" "2026-06-15 22:20:00+00"-    , KeiroLedgerRemap "2026-07-02-00-15-48-keiro-outbox-claim-order-index.sql" "2026-07-02-00-12-00-keiro-outbox-claim-order-index.sql" "2026-07-02 00:12:00+00"-    , KeiroLedgerRemap "2026-07-02-00-58-54-keiro-inbox-drop-received-idx.sql" "2026-07-02-00-55-00-keiro-inbox-drop-received-idx.sql" "2026-07-02 00:55:00+00"-    ]+  [ KeiroLedgerRemap "2026-05-17-13-58-15-keiro-bootstrap.sql" "2026-05-17-00-00-00-keiro-bootstrap.sql" "2026-05-17 00:00:00+00",+    KeiroLedgerRemap "2026-05-19-12-55-02-keiro-outbox.sql" "2026-05-17-01-00-00-keiro-outbox.sql" "2026-05-17 01:00:00+00",+    KeiroLedgerRemap "2026-05-19-13-05-23-keiro-inbox.sql" "2026-05-17-02-00-00-keiro-inbox.sql" "2026-05-17 02:00:00+00",+    KeiroLedgerRemap "2026-06-03-05-14-28-keiro-timer-recovery.sql" "2026-05-17-03-00-00-keiro-timer-recovery.sql" "2026-05-17 03:00:00+00",+    KeiroLedgerRemap "2026-06-03-16-10-05-keiro-workflow-steps.sql" "2026-06-03-00-00-00-keiro-workflow-steps.sql" "2026-06-03 00:00:00+00",+    KeiroLedgerRemap "2026-06-03-18-19-41-keiro-awakeables.sql" "2026-06-03-01-00-00-keiro-awakeables.sql" "2026-06-03 01:00:00+00",+    KeiroLedgerRemap "2026-06-03-19-49-23-keiro-workflow-children.sql" "2026-06-03-02-00-00-keiro-workflow-children.sql" "2026-06-03 02:00:00+00",+    KeiroLedgerRemap "2026-06-04-02-12-28-keiro-workflow-generation.sql" "2026-06-05-00-00-00-keiro-workflow-generation.sql" "2026-06-05 00:00:00+00",+    KeiroLedgerRemap "2026-06-04-03-53-34-keiro-subscription-shards.sql" "2026-06-05-01-00-00-keiro-subscription-shards.sql" "2026-06-05 01:00:00+00",+    KeiroLedgerRemap "2026-06-15-15-07-25-keiro-workflows-instances.sql" "2026-06-11-00-00-04-keiro-workflows-instances.sql" "2026-06-11 00:00:04+00",+    KeiroLedgerRemap "2026-06-15-17-53-48-keiro-workflow-gc-index.sql" "2026-06-15-22-10-00-keiro-workflow-gc-index.sql" "2026-06-15 22:10:00+00",+    KeiroLedgerRemap "2026-06-15-18-01-33-keiro-workflows-wake-after.sql" "2026-06-15-22-20-00-keiro-workflows-wake-after.sql" "2026-06-15 22:20:00+00",+    KeiroLedgerRemap "2026-07-02-00-15-48-keiro-outbox-claim-order-index.sql" "2026-07-02-00-12-00-keiro-outbox-claim-order-index.sql" "2026-07-02 00:12:00+00",+    KeiroLedgerRemap "2026-07-02-00-58-54-keiro-inbox-drop-received-idx.sql" "2026-07-02-00-55-00-keiro-inbox-drop-received-idx.sql" "2026-07-02 00:55:00+00"+  ]  rewindKeiroLedgerToSentinelNames :: Text -> Text -> IO () rewindKeiroLedgerToSentinelNames connStr schema =-    runDb connStr "keiro ledger rewind to sentinel names" (Session.script script)+  runDb connStr "keiro ledger rewind to sentinel names" (Session.script script)   where     qname = schema <> ".sql_migrations"     -- Kept in sync with ledger-fixups/2026-07-05-realign-keiro-migration-timestamps.sql.     script =-        T.unlines-            [ "UPDATE " <> qname <> " SET name = '" <> oldName <> "', migration_timestamp = '" <> oldTimestamp <> "' WHERE name = '" <> newName <> "';"-            | KeiroLedgerRemap newName oldName oldTimestamp <- keiroLedgerRemaps-            ]+      T.unlines+        [ "UPDATE " <> qname <> " SET name = '" <> oldName <> "', migration_timestamp = '" <> oldTimestamp <> "' WHERE name = '" <> newName <> "';"+        | KeiroLedgerRemap newName oldName oldTimestamp <- keiroLedgerRemaps+        ]  moveKeiroTablesBackToKiroku :: Text -> IO () moveKeiroTablesBackToKiroku connStr =-    runDb connStr "move keiro tables back to kiroku schema" (Session.script script)+  runDb connStr "move keiro tables back to kiroku schema" (Session.script script)   where     tableArray = T.intercalate ", " ["'" <> table <> "'" | table <- keiroTables]     script =-        T.unlines-            [ "DO $$"-            , "DECLARE"-            , "  t text;"-            , "  tables text[] := ARRAY[" <> tableArray <> "];"-            , "BEGIN"-            , "  FOREACH t IN ARRAY tables LOOP"-            , "    IF to_regclass('keiro.' || t) IS NOT NULL THEN"-            , "      EXECUTE format('ALTER TABLE keiro.%I SET SCHEMA kiroku', t);"-            , "    END IF;"-            , "  END LOOP;"-            , "END"-            , "$$;"-            , "DROP SCHEMA IF EXISTS keiro;"-            ]+      T.unlines+        [ "DO $$",+          "DECLARE",+          "  t text;",+          "  tables text[] := ARRAY[" <> tableArray <> "];",+          "BEGIN",+          "  FOREACH t IN ARRAY tables LOOP",+          "    IF to_regclass('keiro.' || t) IS NOT NULL THEN",+          "      EXECUTE format('ALTER TABLE keiro.%I SET SCHEMA kiroku', t);",+          "    END IF;",+          "  END LOOP;",+          "END",+          "$$;",+          "DROP SCHEMA IF EXISTS keiro;"+        ]  seedRemediationRows :: Text -> IO () seedRemediationRows connStr =-    runDb connStr "seed 0.1.0.0-layout keiro rows" (Session.script script)+  runDb connStr "seed 0.1.0.0-layout keiro rows" (Session.script script)   where     script =-        """-        INSERT INTO kiroku.keiro_snapshots-          (stream_id, stream_version, state, state_codec_version, regfile_shape_hash)-        VALUES-          (4242, 7, '{"ok": true}'::jsonb, 3, 'shape-abc');+      """+      INSERT INTO kiroku.keiro_snapshots+        (stream_id, stream_version, state, state_codec_version, regfile_shape_hash)+      VALUES+        (4242, 7, '{"ok": true}'::jsonb, 3, 'shape-abc'); -        INSERT INTO kiroku.keiro_timers-          (timer_id, process_manager_name, correlation_id, fire_at, payload, status)-        VALUES-          ('00000000-0000-4000-8000-000000000001', 'remediation-test', 'corr-1',-           '2026-07-06 00:00:00+00', '{"wake": true}'::jsonb, 'scheduled');-        """+      INSERT INTO kiroku.keiro_timers+        (timer_id, process_manager_name, correlation_id, fire_at, payload, status)+      VALUES+        ('00000000-0000-4000-8000-000000000001', 'remediation-test', 'corr-1',+         '2026-07-06 00:00:00+00', '{"wake": true}'::jsonb, 'scheduled');+      """  assertSnapshotRowSurvived :: Text -> IO () assertSnapshotRowSurvived connStr = do-    present <- runDb connStr "snapshot survival query" (Session.statement () snapshotSurvivedStmt)-    present `shouldBe` True+  present <- runDb connStr "snapshot survival query" (Session.statement () snapshotSurvivedStmt)+  present `shouldBe` True  snapshotSurvivedStmt :: Statement () Bool snapshotSurvivedStmt =-    preparable-        """-        SELECT EXISTS (-          SELECT 1-          FROM keiro.keiro_snapshots-          WHERE stream_id = 4242-            AND stream_version = 7-            AND state = '{"ok": true}'::jsonb-            AND state_codec_version = 3-            AND regfile_shape_hash = 'shape-abc'-        )-        """-        E.noParams-        (D.singleRow (D.column (D.nonNullable D.bool)))+  preparable+    """+    SELECT EXISTS (+      SELECT 1+      FROM keiro.keiro_snapshots+      WHERE stream_id = 4242+        AND stream_version = 7+        AND state = '{"ok": true}'::jsonb+        AND state_codec_version = 3+        AND regfile_shape_hash = 'shape-abc'+    )+    """+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.bool)))  assertTimerRowSurvived :: Text -> IO () assertTimerRowSurvived connStr = do-    present <- runDb connStr "timer survival query" (Session.statement () timerSurvivedStmt)-    present `shouldBe` True+  present <- runDb connStr "timer survival query" (Session.statement () timerSurvivedStmt)+  present `shouldBe` True  timerSurvivedStmt :: Statement () Bool timerSurvivedStmt =-    preparable-        """-        SELECT EXISTS (-          SELECT 1-          FROM keiro.keiro_timers-          WHERE timer_id = '00000000-0000-4000-8000-000000000001'-            AND process_manager_name = 'remediation-test'-            AND correlation_id = 'corr-1'-            AND payload = '{"wake": true}'::jsonb-            AND status = 'scheduled'-        )-        """-        E.noParams-        (D.singleRow (D.column (D.nonNullable D.bool)))+  preparable+    """+    SELECT EXISTS (+      SELECT 1+      FROM keiro.keiro_timers+      WHERE timer_id = '00000000-0000-4000-8000-000000000001'+        AND process_manager_name = 'remediation-test'+        AND correlation_id = 'corr-1'+        AND payload = '{"wake": true}'::jsonb+        AND status = 'scheduled'+    )+    """+    E.noParams+    (D.singleRow (D.column (D.nonNullable D.bool)))  assertTablesExist :: Text -> Text -> [Text] -> IO () assertTablesExist connStr schema tables = do-    actualTables <- runDb connStr "table verification query" (Session.statement schema schemaTablesStmt)-    let missing = filter (`notElem` actualTables) tables-    missing `shouldBe` []+  actualTables <- runDb connStr "table verification query" (Session.statement schema schemaTablesStmt)+  let missing = filter (`notElem` actualTables) tables+  missing `shouldBe` []  assertTablesAbsent :: Text -> Text -> [Text] -> IO () assertTablesAbsent connStr schema tables = do-    actualTables <- runDb connStr "table verification query" (Session.statement schema schemaTablesStmt)-    let present = filter (`elem` actualTables) tables-    present `shouldBe` []+  actualTables <- runDb connStr "table verification query" (Session.statement schema schemaTablesStmt)+  let present = filter (`elem` actualTables) tables+  present `shouldBe` []  assertColumnExists :: Text -> Text -> Text -> Text -> IO () assertColumnExists connStr schema table column = do-    present <- runDb connStr "column verification query" (Session.statement (schema, table, column) columnExistsStmt)-    present `shouldBe` True+  present <- runDb connStr "column verification query" (Session.statement (schema, table, column) columnExistsStmt)+  present `shouldBe` True  columnExistsStmt :: Statement (Text, Text, Text) Bool columnExistsStmt =-    preparable-        """-        SELECT EXISTS (-          SELECT 1 FROM information_schema.columns-          WHERE table_schema = $1 AND table_name = $2 AND column_name = $3-        )-        """-        ( contrazip3-            (E.param (E.nonNullable E.text))-            (E.param (E.nonNullable E.text))-            (E.param (E.nonNullable E.text))-        )-        (D.singleRow (D.column (D.nonNullable D.bool)))+  preparable+    """+    SELECT EXISTS (+      SELECT 1 FROM information_schema.columns+      WHERE table_schema = $1 AND table_name = $2 AND column_name = $3+    )+    """+    ( contrazip3+        (E.param (E.nonNullable E.text))+        (E.param (E.nonNullable E.text))+        (E.param (E.nonNullable E.text))+    )+    (D.singleRow (D.column (D.nonNullable D.bool)))  schemaTablesStmt :: Statement Text [Text] schemaTablesStmt =-    preparable-        """-        SELECT table_name::text-        FROM information_schema.tables-        WHERE table_schema = $1-          AND table_type = 'BASE TABLE'-        ORDER BY table_name-        """-        (E.param (E.nonNullable E.text))-        (D.rowList (D.column (D.nonNullable D.text)))+  preparable+    """+    SELECT table_name::text+    FROM information_schema.tables+    WHERE table_schema = $1+      AND table_type = 'BASE TABLE'+    ORDER BY table_name+    """+    (E.param (E.nonNullable E.text))+    (D.rowList (D.column (D.nonNullable D.text)))

@@ -1,7 +1,8 @@-module Lint (-    LintConfig (..),+module Lint+  ( LintConfig (..),     lintViolations,-) where+  )+where  import Data.ByteString (ByteString) import Data.List (sortOn)@@ -10,30 +11,29 @@ 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.--}+-- | 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)+  { 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)+  concatMap lintOne (sortOn fst sources)   where     lintOne (file, bytes)-        | file `elem` exemptFiles config = []-        | otherwise =-            searchPathViolation file body-                <> concatMap (statementViolations file) statements+      | 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@@ -41,44 +41,44 @@     requiredLower = Text.toCaseFold (requiredQualifier config)      searchPathViolation file body =-        [ "migration body mentions search_path: " <> Text.pack file-        | "search_path" `Text.isInfixOf` Text.toCaseFold (stripCommentLines 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)-                    ]+      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+  | 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@@ -86,32 +86,32 @@  startsWithWords :: Text -> [Text] -> Bool startsWithWords statement wordsExpected =-    wordsExpected == take (length wordsExpected) (Text.words statement)+  wordsExpected == take (length wordsExpected) (Text.words statement)  targetAfter :: [Text] -> [Text] -> Maybe Text targetAfter prefix wordsOriginal =-    skipIfNotExists (drop (length prefix) wordsOriginal)+  skipIfNotExists (drop (length prefix) wordsOriginal)  targetAfterToken :: Text -> [Text] -> Maybe Text targetAfterToken token wordsOriginal =-    skipIfNotExists . drop 1 $ dropWhile ((/= token) . Text.toCaseFold) 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+  | map Text.toCaseFold [first, second, third] == ["if", "not", "exists"] = Just target skipIfNotExists (first : second : target : _)-    | map Text.toCaseFold [first, second] == ["if", "exists"] = Just 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+  Text.unlines . filter (not . Text.isPrefixOf "--" . Text.strip) . Text.lines  cleanTarget :: Text -> Text cleanTarget =-    Text.dropAround (`elem` ("\"(),;" :: String))+  Text.dropAround (`elem` ("\"(),;" :: String))  oneLine :: Text -> Text oneLine =-    Text.unwords . Text.words+  Text.unwords . Text.words

@@ -20,804 +20,804 @@ import Data.Text.IO qualified as Text.IO import Database.PostgreSQL.Migrate import Database.PostgreSQL.Migrate.History.Codd-import Database.PostgreSQL.Migrate.Internal (-    ComponentDescription (..),-    PlanDescription (..),-    componentNameText,-    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-import Hasql.Connection.Settings qualified as Settings-import Hasql.Decoders qualified as Decoders-import Hasql.Encoders qualified as Encoders-import Hasql.Session qualified as Session-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, 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 twenty native files in manifest order" $ do-            directory <- findMigrationsDirectory-            manifest <- Text.lines <$> Text.IO.readFile (directory </> "manifest")-            manifest `shouldBe` Text.pack <$> nativeMigrationFiles--        it "preserves every legacy payload byte recorded by migrations.lock" $ do-            directory <- findMigrationsDirectory-            lockPath <- findLockfile-            lockEntries <- parseLockfile <$> Text.IO.readFile lockPath-            forM_ (zip (toList keiroLegacyMigrationNames) nativeMigrationFiles) $ \(legacyName, nativeName) -> do-                bytes <- ByteString.readFile (directory </> nativeName)-                lookup legacyName lockEntries `shouldBe` Just (checksumText bytes)--        it "builds component keiro with dependency kiroku and twenty migrations" $ do-            plan <- requirePlan-            let PlanDescription components = planDescription plan-            case toList components of-                [ ComponentDescription{name = kirokuName, dependencies = kirokuDependencies, migrations = kirokuEntries}-                    , ComponentDescription{name = keiroName, dependencies = keiroDependencies, migrations = keiroEntries}-                    ] -> do-                        componentNameText kirokuName `shouldBe` "kiroku"-                        kirokuDependencies `shouldBe` mempty-                        length kirokuEntries `shouldBe` 8-                        componentNameText keiroName `shouldBe` "keiro"-                        dependencyName <- requireRight (componentName "kiroku")-                        keiroDependencies `shouldBe` Set.singleton dependencyName-                        length keiroEntries `shouldBe` 20-                actual -> expectationFailure ("unexpected plan description: " <> show actual)-            validateHistoryMappingTargets plan frameworkCoddHistoryMappings `shouldBe` Right ()--        it "rejects missing and reversed Kiroku dependencies" $ do-            kiroku <- requireRight Kiroku.kirokuMigrations-            keiro <- requireRight keiroMigrations-            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-            result <- withMigratedDatabase plan $ \connection -> do-                assertSchema connection-                let provider = providerFor connection-                rerun <- runMigrationPlanWith defaultRunOptions provider plan >>= requireRight-                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` 28-                        pending `shouldBe` []-                        unknown `shouldBe` []-            either (expectationFailure . show) pure result--        it "serializes concurrent composed applies" $ do-            plan <- requirePlan-            withKeiroPg $ \database -> do-                let settings = Pg.connectionSettings database-                (first, second) <--                    concurrently-                        (runMigrationPlan defaultRunOptions settings plan >>= requireRight)-                        (runMigrationPlan defaultRunOptions settings plan >>= requireRight)-                sort [reportOutcomes first, reportOutcomes second]-                    `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"--        it "imports the legacy codd_schema ledger shape" $-            importFixture "codd_schema"--        it "rejects one partial source row before creating the target ledger" $ do-            plan <- requirePlan-            withKeiroPg $ \database -> do-                let settings = Pg.connectionSettings database-                    provider = connectionProviderFromSettings settings-                withConnection settings $ \connection -> do-                    applyLegacyPayloads connection-                    installCoddLedger connection "codd" True False-                config <--                    requireRight-                        (frameworkCoddSourceConfig provider True "partial fixture must fail" Confirmed)-                imported <--                    importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings-                imported `shouldSatisfy` \case-                    Left CoddPartialMigration{} -> True-                    _ -> False-                withConnection settings $ \connection -> do-                    targetExists <- useSession connection (Session.statement "pgmigrate" schemaExistsStatement)-                    targetExists `shouldBe` False--        it "rejects unselected shared-ledger rows in strict mode" $ do-            plan <- requirePlan-            withKeiroPg $ \database -> do-                let settings = Pg.connectionSettings database-                    provider = connectionProviderFromSettings settings-                withConnection settings $ \connection -> do-                    applyLegacyPayloads connection-                    installCoddLedger connection "codd" False True-                config <--                    requireRight-                        (frameworkCoddSourceConfig provider True "strict source fixture" Confirmed)-                imported <--                    importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings-                imported `shouldSatisfy` \case-                    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-    withKeiroPg $ \database -> do-        let settings = Pg.connectionSettings database-            provider = connectionProviderFromSettings settings-        withConnection settings $ \connection -> do-            applyLegacyPayloads connection-            installCoddLedger connection sourceSchema False False-        config <--            requireRight-                (frameworkCoddSourceConfig provider True "verified Keiro shared-ledger cutover" Confirmed)-        first <--            importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings-                >>= requireRight-        importOutcomes first `shouldBe` replicate 23 Imported-        expectedPending <- postCoddImportPendingIssues-        verifiedBeforeCanaries <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight-        case verifiedBeforeCanaries of-            VerificationReport verificationIssues _ _ _ ->-                verificationIssues `shouldBe` expectedPending-        up <- runMigrationPlan defaultRunOptions settings plan >>= requireRight-        reportOutcomes up-            `shouldBe` replicate 7 AlreadyApplied-                <> [AppliedNow]-                <> replicate 16 AlreadyApplied-                <> [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 28 AlreadyApplied-        second <--            importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings-                >>= requireRight-        importOutcomes second `shouldBe` replicate 23 AlreadyImported-        withConnection settings $ \connection -> do-            assertSchema connection-            sourceRows <- useSession connection (Session.statement () (sourceRowCountStatement sourceSchema))-            sourceRows `shouldBe` 23-            facts <- useSession connection (Session.statement () importFactsStatement)-            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"-    , "0002-keiro-outbox.sql"-    , "0003-keiro-inbox.sql"-    , "0004-keiro-timer-recovery.sql"-    , "0005-keiro-workflow-steps.sql"-    , "0006-keiro-awakeables.sql"-    , "0007-keiro-workflow-children.sql"-    , "0008-keiro-workflow-generation.sql"-    , "0009-keiro-subscription-shards.sql"-    , "0010-keiro-messaging-crash-recovery.sql"-    , "0011-keiro-workflows-instances.sql"-    , "0012-keiro-workflow-gc-index.sql"-    , "0013-keiro-workflows-wake-after.sql"-    , "0014-keiro-projection-dedup.sql"-    , "0015-keiro-outbox-claim-order-index.sql"-    , "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-findMigrationsDirectory =-    findDirectory ["keiro-migrations/migrations", "migrations"]--findLockfile :: IO FilePath-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-    case existing of-        directory : _ -> pure directory-        [] -> expectationFailure ("could not find directory: " <> show candidates) >> pure "."--findFile :: [FilePath] -> IO FilePath-findFile candidates = do-    existing <- filterM doesFileExist candidates-    case existing of-        path : _ -> pure path-        [] -> expectationFailure ("could not find file: " <> show candidates) >> pure "."--filterM :: (value -> IO Bool) -> [value] -> IO [value]-filterM predicate = foldr step (pure [])-  where-    step value remaining = do-        matches <- predicate value-        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)-    | line <- Text.lines contents-    , [checksum, filename] <- [Text.words line]-    ]--checksumText :: ByteString -> Text-checksumText =-    Text.pack-        . concatMap renderByte-        . ByteString.unpack-        . migrationChecksumBytes-        . migrationFingerprint-  where-    renderByte byte =-        case Numeric.showHex byte "" of-            [digit] -> ['0', digit]-            digits -> digits--requirePlan :: IO MigrationPlan-requirePlan = do-    kiroku <- requireRight Kiroku.kirokuMigrations-    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--failure :: (Show value) => value -> IO result-failure value = expectationFailure (show value) >> fail (show value)--providerFor :: Connection.Connection -> ConnectionProvider-providerFor connection = connectionProvider (\action -> Right <$> action connection)--reportOutcomes :: MigrationReport -> [MigrationOutcome]-reportOutcomes MigrationReport{results} = outcome <$> toList results--importOutcomes :: HistoryImportReport -> [HistoryImportOutcome]-importOutcomes HistoryImportReport{importResults} = importOutcome <$> toList importResults--keiroPgConfig :: Pg.Config-keiroPgConfig = Pg.defaultConfig{Pg.user = "keiro"}--withKeiroPg :: (Pg.Database -> IO ()) -> IO ()-withKeiroPg action = do-    started <- Pg.startCached keiroPgConfig Pg.defaultCacheConfig-    case started of-        Left startError -> expectationFailure (show startError)-        Right database -> action database `finally` Pg.stop database--withConnection :: Settings.Settings -> (Connection.Connection -> IO value) -> IO value-withConnection settings action = do-    acquired <- Connection.acquire settings-    connection <- requireRight acquired-    action connection `finally` Connection.release connection--useSession :: Connection.Connection -> Session.Session value -> IO value-useSession connection session =-    Connection.use connection session >>= requireRight--assertSchema :: Connection.Connection -> Expectation-assertSchema connection = do-    healthy <- useSession connection (Session.statement () schemaFactsStatement)-    healthy `shouldBe` True--schemaFactsStatement :: Statement () Bool-schemaFactsStatement =-    Statement.preparable-        """-        SELECT bool_and(ok)-        FROM (VALUES-          (to_regnamespace('kiroku') IS NOT NULL),-          (to_regclass('kiroku.events') IS NOT NULL),-          (to_regnamespace('keiro') IS NOT NULL),-          (to_regclass('keiro.keiro_inbox') IS NOT NULL),-          (to_regclass('keiro.keiro_outbox') IS NOT NULL),-          (to_regclass('keiro.keiro_timers') IS NOT NULL),-          (to_regclass('keiro.keiro_workflows') IS NOT NULL),-          (obj_description(to_regnamespace('kiroku'), 'pg_namespace') = 'Managed by pg-migrate component kiroku through 0008-schema-management-comment'),-          (obj_description(to_regnamespace('keiro'), 'pg_namespace') = 'Managed by pg-migrate component keiro through 0017-schema-management-comment')-        ) AS checks(ok)-        """-        Encoders.noParams-        (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))--applyLegacyPayloads :: Connection.Connection -> IO ()-applyLegacyPayloads connection = do-    apply Kiroku.Codd.kirokuLegacyMigrationNames Kiroku.Codd.kirokuCoddSourcePayloads-    apply keiroLegacyMigrationNames keiroCoddSourcePayloads-  where-    apply names payloads =-        forM_ names $ \name ->-            case Map.lookup name payloads of-                Nothing -> failure ("missing source payload " <> name)-                Just bytes -> useSession connection (Session.script (Text.Encoding.decodeUtf8 bytes))--installCoddLedger :: Connection.Connection -> Text -> Bool -> Bool -> IO ()-installCoddLedger connection sourceSchema partial includeExtra =-    useSession connection (Session.script (coddFixtureSql sourceSchema partial includeExtra))--coddFixtureSql :: Text -> Bool -> Bool -> Text-coddFixtureSql sourceSchema partial includeExtra =-    Text.unlines-        [ "CREATE SCHEMA " <> sourceSchema <> ";"-        , "CREATE TABLE " <> sourceSchema <> ".sql_migrations ("-        , "  id serial NOT NULL, migration_timestamp timestamptz NOT NULL,"-        , "  applied_at timestamptz, name text NOT NULL, application_duration interval,"-        , "  num_applied_statements int, no_txn_failed_at timestamptz, txnid bigint, connid int"-        , ");"-        , "INSERT INTO " <> sourceSchema <> ".sql_migrations"-        , "  (migration_timestamp, applied_at, name, application_duration, num_applied_statements, no_txn_failed_at, txnid, connid) VALUES"-        , Text.intercalate ",\n" (zipWith renderRow [1 :: Int ..] filenames) <> ";"-        ]-  where-    selected = toList Kiroku.Codd.kirokuLegacyMigrationNames <> toList keiroLegacyMigrationNames-    filenames = selected <> ["application-owned-extra.sql" | includeExtra]-    renderRow index filename =-        "('2026-01-01 00:00:00+00'::timestamptz + interval '"-            <> Text.pack (show index)-            <> " seconds', "-            <> appliedAt index-            <> ", '"-            <> Text.pack filename-            <> "', interval '1 second', 1, "-            <> failureAt index-            <> ", 1, 1)"-    appliedAt index-        | partial && index == 11 = "NULL"-        | otherwise = "'2026-01-01 00:01:00+00'::timestamptz + interval '" <> Text.pack (show index) <> " seconds'"-    failureAt index-        | partial && index == 11 = "'2026-01-01 00:02:00+00'::timestamptz"-        | otherwise = "NULL"--schemaExistsStatement :: Statement Text Bool-schemaExistsStatement =-    Statement.preparable-        "SELECT to_regnamespace($1) IS NOT NULL"-        (Encoders.param (Encoders.nonNullable Encoders.text))-        (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))--sourceRowCountStatement :: Text -> Statement () Int64-sourceRowCountStatement sourceSchema =-    Statement.unpreparable-        ("SELECT count(*) FROM " <> sourceSchema <> ".sql_migrations")-        Encoders.noParams-        (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))--importFactsStatement :: Statement () (Int64, Int64, Bool)-importFactsStatement =-    Statement.preparable-        """-        SELECT-          (SELECT count(*) FROM pgmigrate.migrations),-          (SELECT count(*) FROM pgmigrate.history_imports),-          (SELECT bool_and(source_evidence #>> '{satisfying_evidence,0,details,adapter}' = 'codd') FROM pgmigrate.history_imports)-        """-        Encoders.noParams-        ( Decoders.singleRow-            ( (,,)-                <$> 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-            )-        )+import Database.PostgreSQL.Migrate.Internal+  ( ComponentDescription (..),+    PlanDescription (..),+    componentNameText,+    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+import Hasql.Connection.Settings qualified as Settings+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+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, 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 twenty native files in manifest order" $ do+      directory <- findMigrationsDirectory+      manifest <- Text.lines <$> Text.IO.readFile (directory </> "manifest")+      manifest `shouldBe` Text.pack <$> nativeMigrationFiles++    it "preserves every legacy payload byte recorded by migrations.lock" $ do+      directory <- findMigrationsDirectory+      lockPath <- findLockfile+      lockEntries <- parseLockfile <$> Text.IO.readFile lockPath+      forM_ (zip (toList keiroLegacyMigrationNames) nativeMigrationFiles) $ \(legacyName, nativeName) -> do+        bytes <- ByteString.readFile (directory </> nativeName)+        lookup legacyName lockEntries `shouldBe` Just (checksumText bytes)++    it "builds component keiro with dependency kiroku and twenty migrations" $ do+      plan <- requirePlan+      let PlanDescription components = planDescription plan+      case toList components of+        [ ComponentDescription {name = kirokuName, dependencies = kirokuDependencies, migrations = kirokuEntries},+          ComponentDescription {name = keiroName, dependencies = keiroDependencies, migrations = keiroEntries}+          ] -> do+            componentNameText kirokuName `shouldBe` "kiroku"+            kirokuDependencies `shouldBe` mempty+            length kirokuEntries `shouldBe` 8+            componentNameText keiroName `shouldBe` "keiro"+            dependencyName <- requireRight (componentName "kiroku")+            keiroDependencies `shouldBe` Set.singleton dependencyName+            length keiroEntries `shouldBe` 20+        actual -> expectationFailure ("unexpected plan description: " <> show actual)+      validateHistoryMappingTargets plan frameworkCoddHistoryMappings `shouldBe` Right ()++    it "rejects missing and reversed Kiroku dependencies" $ do+      kiroku <- requireRight Kiroku.kirokuMigrations+      keiro <- requireRight keiroMigrations+      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+      result <- withMigratedDatabase plan $ \connection -> do+        assertSchema connection+        let provider = providerFor connection+        rerun <- runMigrationPlanWith defaultRunOptions provider plan >>= requireRight+        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` 28+            pending `shouldBe` []+            unknown `shouldBe` []+      either (expectationFailure . show) pure result++    it "serializes concurrent composed applies" $ do+      plan <- requirePlan+      withKeiroPg $ \database -> do+        let settings = Pg.connectionSettings database+        (first, second) <-+          concurrently+            (runMigrationPlan defaultRunOptions settings plan >>= requireRight)+            (runMigrationPlan defaultRunOptions settings plan >>= requireRight)+        sort [reportOutcomes first, reportOutcomes second]+          `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"++    it "imports the legacy codd_schema ledger shape" $+      importFixture "codd_schema"++    it "rejects one partial source row before creating the target ledger" $ do+      plan <- requirePlan+      withKeiroPg $ \database -> do+        let settings = Pg.connectionSettings database+            provider = connectionProviderFromSettings settings+        withConnection settings $ \connection -> do+          applyLegacyPayloads connection+          installCoddLedger connection "codd" True False+        config <-+          requireRight+            (frameworkCoddSourceConfig provider True "partial fixture must fail" Confirmed)+        imported <-+          importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings+        imported `shouldSatisfy` \case+          Left CoddPartialMigration {} -> True+          _ -> False+        withConnection settings $ \connection -> do+          targetExists <- useSession connection (Session.statement "pgmigrate" schemaExistsStatement)+          targetExists `shouldBe` False++    it "rejects unselected shared-ledger rows in strict mode" $ do+      plan <- requirePlan+      withKeiroPg $ \database -> do+        let settings = Pg.connectionSettings database+            provider = connectionProviderFromSettings settings+        withConnection settings $ \connection -> do+          applyLegacyPayloads connection+          installCoddLedger connection "codd" False True+        config <-+          requireRight+            (frameworkCoddSourceConfig provider True "strict source fixture" Confirmed)+        imported <-+          importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings+        imported `shouldSatisfy` \case+          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+  withKeiroPg $ \database -> do+    let settings = Pg.connectionSettings database+        provider = connectionProviderFromSettings settings+    withConnection settings $ \connection -> do+      applyLegacyPayloads connection+      installCoddLedger connection sourceSchema False False+    config <-+      requireRight+        (frameworkCoddSourceConfig provider True "verified Keiro shared-ledger cutover" Confirmed)+    first <-+      importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings+        >>= requireRight+    importOutcomes first `shouldBe` replicate 23 Imported+    expectedPending <- postCoddImportPendingIssues+    verifiedBeforeCanaries <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight+    case verifiedBeforeCanaries of+      VerificationReport verificationIssues _ _ _ ->+        verificationIssues `shouldBe` expectedPending+    up <- runMigrationPlan defaultRunOptions settings plan >>= requireRight+    reportOutcomes up+      `shouldBe` replicate 7 AlreadyApplied+        <> [AppliedNow]+        <> replicate 16 AlreadyApplied+        <> [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 28 AlreadyApplied+    second <-+      importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings+        >>= requireRight+    importOutcomes second `shouldBe` replicate 23 AlreadyImported+    withConnection settings $ \connection -> do+      assertSchema connection+      sourceRows <- useSession connection (Session.statement () (sourceRowCountStatement sourceSchema))+      sourceRows `shouldBe` 23+      facts <- useSession connection (Session.statement () importFactsStatement)+      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",+    "0002-keiro-outbox.sql",+    "0003-keiro-inbox.sql",+    "0004-keiro-timer-recovery.sql",+    "0005-keiro-workflow-steps.sql",+    "0006-keiro-awakeables.sql",+    "0007-keiro-workflow-children.sql",+    "0008-keiro-workflow-generation.sql",+    "0009-keiro-subscription-shards.sql",+    "0010-keiro-messaging-crash-recovery.sql",+    "0011-keiro-workflows-instances.sql",+    "0012-keiro-workflow-gc-index.sql",+    "0013-keiro-workflows-wake-after.sql",+    "0014-keiro-projection-dedup.sql",+    "0015-keiro-outbox-claim-order-index.sql",+    "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+findMigrationsDirectory =+  findDirectory ["keiro-migrations/migrations", "migrations"]++findLockfile :: IO FilePath+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+  case existing of+    directory : _ -> pure directory+    [] -> expectationFailure ("could not find directory: " <> show candidates) >> pure "."++findFile :: [FilePath] -> IO FilePath+findFile candidates = do+  existing <- filterM doesFileExist candidates+  case existing of+    path : _ -> pure path+    [] -> expectationFailure ("could not find file: " <> show candidates) >> pure "."++filterM :: (value -> IO Bool) -> [value] -> IO [value]+filterM predicate = foldr step (pure [])+  where+    step value remaining = do+      matches <- predicate value+      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)+  | line <- Text.lines contents,+    [checksum, filename] <- [Text.words line]+  ]++checksumText :: ByteString -> Text+checksumText =+  Text.pack+    . concatMap renderByte+    . ByteString.unpack+    . migrationChecksumBytes+    . migrationFingerprint+  where+    renderByte byte =+      case Numeric.showHex byte "" of+        [digit] -> ['0', digit]+        digits -> digits++requirePlan :: IO MigrationPlan+requirePlan = do+  kiroku <- requireRight Kiroku.kirokuMigrations+  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++failure :: (Show value) => value -> IO result+failure value = expectationFailure (show value) >> fail (show value)++providerFor :: Connection.Connection -> ConnectionProvider+providerFor connection = connectionProvider (\action -> Right <$> action connection)++reportOutcomes :: MigrationReport -> [MigrationOutcome]+reportOutcomes MigrationReport {results} = outcome <$> toList results++importOutcomes :: HistoryImportReport -> [HistoryImportOutcome]+importOutcomes HistoryImportReport {importResults} = importOutcome <$> toList importResults++keiroPgConfig :: Pg.Config+keiroPgConfig = Pg.defaultConfig {Pg.user = "keiro"}++withKeiroPg :: (Pg.Database -> IO ()) -> IO ()+withKeiroPg action = do+  started <- Pg.startCached keiroPgConfig Pg.defaultCacheConfig+  case started of+    Left startError -> expectationFailure (show startError)+    Right database -> action database `finally` Pg.stop database++withConnection :: Settings.Settings -> (Connection.Connection -> IO value) -> IO value+withConnection settings action = do+  acquired <- Connection.acquire settings+  connection <- requireRight acquired+  action connection `finally` Connection.release connection++useSession :: Connection.Connection -> Session.Session value -> IO value+useSession connection session =+  Connection.use connection session >>= requireRight++assertSchema :: Connection.Connection -> Expectation+assertSchema connection = do+  healthy <- useSession connection (Session.statement () schemaFactsStatement)+  healthy `shouldBe` True++schemaFactsStatement :: Statement () Bool+schemaFactsStatement =+  Statement.preparable+    """+    SELECT bool_and(ok)+    FROM (VALUES+      (to_regnamespace('kiroku') IS NOT NULL),+      (to_regclass('kiroku.events') IS NOT NULL),+      (to_regnamespace('keiro') IS NOT NULL),+      (to_regclass('keiro.keiro_inbox') IS NOT NULL),+      (to_regclass('keiro.keiro_outbox') IS NOT NULL),+      (to_regclass('keiro.keiro_timers') IS NOT NULL),+      (to_regclass('keiro.keiro_workflows') IS NOT NULL),+      (obj_description(to_regnamespace('kiroku'), 'pg_namespace') = 'Managed by pg-migrate component kiroku through 0008-schema-management-comment'),+      (obj_description(to_regnamespace('keiro'), 'pg_namespace') = 'Managed by pg-migrate component keiro through 0017-schema-management-comment')+    ) AS checks(ok)+    """+    Encoders.noParams+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++applyLegacyPayloads :: Connection.Connection -> IO ()+applyLegacyPayloads connection = do+  apply Kiroku.Codd.kirokuLegacyMigrationNames Kiroku.Codd.kirokuCoddSourcePayloads+  apply keiroLegacyMigrationNames keiroCoddSourcePayloads+  where+    apply names payloads =+      forM_ names $ \name ->+        case Map.lookup name payloads of+          Nothing -> failure ("missing source payload " <> name)+          Just bytes -> useSession connection (Session.script (Text.Encoding.decodeUtf8 bytes))++installCoddLedger :: Connection.Connection -> Text -> Bool -> Bool -> IO ()+installCoddLedger connection sourceSchema partial includeExtra =+  useSession connection (Session.script (coddFixtureSql sourceSchema partial includeExtra))++coddFixtureSql :: Text -> Bool -> Bool -> Text+coddFixtureSql sourceSchema partial includeExtra =+  Text.unlines+    [ "CREATE SCHEMA " <> sourceSchema <> ";",+      "CREATE TABLE " <> sourceSchema <> ".sql_migrations (",+      "  id serial NOT NULL, migration_timestamp timestamptz NOT NULL,",+      "  applied_at timestamptz, name text NOT NULL, application_duration interval,",+      "  num_applied_statements int, no_txn_failed_at timestamptz, txnid bigint, connid int",+      ");",+      "INSERT INTO " <> sourceSchema <> ".sql_migrations",+      "  (migration_timestamp, applied_at, name, application_duration, num_applied_statements, no_txn_failed_at, txnid, connid) VALUES",+      Text.intercalate ",\n" (zipWith renderRow [1 :: Int ..] filenames) <> ";"+    ]+  where+    selected = toList Kiroku.Codd.kirokuLegacyMigrationNames <> toList keiroLegacyMigrationNames+    filenames = selected <> ["application-owned-extra.sql" | includeExtra]+    renderRow index filename =+      "('2026-01-01 00:00:00+00'::timestamptz + interval '"+        <> Text.pack (show index)+        <> " seconds', "+        <> appliedAt index+        <> ", '"+        <> Text.pack filename+        <> "', interval '1 second', 1, "+        <> failureAt index+        <> ", 1, 1)"+    appliedAt index+      | partial && index == 11 = "NULL"+      | otherwise = "'2026-01-01 00:01:00+00'::timestamptz + interval '" <> Text.pack (show index) <> " seconds'"+    failureAt index+      | partial && index == 11 = "'2026-01-01 00:02:00+00'::timestamptz"+      | otherwise = "NULL"++schemaExistsStatement :: Statement Text Bool+schemaExistsStatement =+  Statement.preparable+    "SELECT to_regnamespace($1) IS NOT NULL"+    (Encoders.param (Encoders.nonNullable Encoders.text))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++sourceRowCountStatement :: Text -> Statement () Int64+sourceRowCountStatement sourceSchema =+  Statement.unpreparable+    ("SELECT count(*) FROM " <> sourceSchema <> ".sql_migrations")+    Encoders.noParams+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))++importFactsStatement :: Statement () (Int64, Int64, Bool)+importFactsStatement =+  Statement.preparable+    """+    SELECT+      (SELECT count(*) FROM pgmigrate.migrations),+      (SELECT count(*) FROM pgmigrate.history_imports),+      (SELECT bool_and(source_evidence #>> '{satisfying_evidence,0,details,adapter}' = 'codd') FROM pgmigrate.history_imports)+    """+    Encoders.noParams+    ( Decoders.singleRow+        ( (,,)+            <$> 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     column = Decoders.column . Decoders.nonNullable