packages feed

kiroku-store-migrations (empty) → 0.1.1.0

raw patch · 8 files changed

Files

+ CHANGELOG.md view
@@ -0,0 +1,24 @@+# Changelog++## Unreleased++## 0.1.1.0 — 2026-05-31++### New Features++* Forward migration `2026-05-26-00-00-00-add-subscription-dead-letters.sql`:+  creates the `kiroku.dead_letters` table (per consumer-group member, with a+  foreign key to `kiroku.events`) and its recency index, supporting per-event+  dead-letter recording for subscriptions (MasterPlan 6 / plan 40).++## 0.1.0.0 — 2026-05-23++### New Features++* Initial release of the migration package.+* Embeds Kiroku's codd SQL migrations and exposes+  `Kiroku.Store.Migrations`.+* Provides the `kiroku-store-migrate` executable for applying the event store+  schema before application startup.+* Bootstraps the dedicated `kiroku` PostgreSQL schema and installs Kiroku+  tables, indexes, functions, and triggers there.
+ README.md view
@@ -0,0 +1,40 @@+# kiroku-store-migrations++`kiroku-store-migrations` owns schema evolution for `kiroku-store`.+It embeds Kiroku's timestamped SQL migrations and runs them through+`codd`, so a service can migrate its database before opening+`Kiroku.Store.withStore`.++Run the executable with codd's standard environment variables:++```bash+CODD_CONNECTION='host=/tmp port=5432 dbname=kiroku user=kiroku_admin' \+CODD_MIGRATION_DIRS=unused-for-embedded-migrations \+CODD_EXPECTED_SCHEMA_DIR=unused-for-unverified-embedded-migrations \+CODD_SCHEMAS=kiroku \+kiroku-store-migrate+```++The bootstrap migration creates a dedicated `kiroku` schema and installs+every Kiroku table, index, function, and trigger inside it, leaving+`public` free for application objects. `CODD_SCHEMAS=kiroku` tells codd to+track that schema. The runtime role therefore needs privileges on the+`kiroku` schema (for example `USAGE` plus the table privileges it uses),+not on `public`.++After migrations run, start the application normally:++```haskell+withStore (defaultConnectionSettings connString) app+```++`codd` is forward-only. Once a migration has run in production,+reverting the Haskell package does not undo the database change. Repair+state by restoring from backup or by shipping another forward migration.++This first implementation runs without codd expected-schema verification+because Kiroku does not yet ship a checked-in codd expected-schema+snapshot. `CODD_EXPECTED_SCHEMA_DIR` is still required by codd's settings+parser, but this executable does not read from it. Operators should treat+the migration table as the source of applied-version truth until strict+snapshots are added.
+ app/Main.hs view
@@ -0,0 +1,11 @@+module Main where++import Codd.Environment (getCoddSettings)+import Data.Time (secondsToDiffTime)+import Kiroku.Store.Migrations (runKirokuMigrationsNoCheck)++main :: IO ()+main = do+    settings <- getCoddSettings+    _ <- runKirokuMigrationsNoCheck settings (secondsToDiffTime 5)+    pure ()
+ kiroku-store-migrations.cabal view
@@ -0,0 +1,77 @@+cabal-version:      3.0+name:               kiroku-store-migrations+version:            0.1.1.0+synopsis:           Schema migrations for kiroku-store+description:+  Embedded codd migrations and a migration executable for installing and+  upgrading the PostgreSQL schema used by @kiroku-store@.++homepage:           https://github.com/shinzui/kiroku+bug-reports:        https://github.com/shinzui/kiroku/issues+author:             Nadeem Bitar+maintainer:         nadeem@gmail.com+license:            BSD-3-Clause+build-type:         Simple+category:           Database, Eventing+extra-doc-files:    CHANGELOG.md+extra-source-files:+  README.md+  sql-migrations/*.sql++source-repository head+  type:     git+  location: https://github.com/shinzui/kiroku.git++common common+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    OverloadedLabels+    OverloadedStrings++library+  import:          common+  exposed-modules: Kiroku.Store.Migrations+  hs-source-dirs:  src+  build-depends:+    , base        >=4.18   && <5+    , bytestring  >=0.11   && <0.13+    , codd        >=0.1.8  && <0.2+    , file-embed  >=0.0.15 && <0.0.17+    , streaming   >=0.2    && <0.3+    , text        >=2.0    && <2.2+    , time        >=1.12   && <1.15++executable kiroku-store-migrate+  import:         common+  main-is:        Main.hs+  hs-source-dirs: app+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , base+    , codd+    , kiroku-store-migrations+    , time                     >=1.12 && <1.15++test-suite kiroku-store-migrations-test+  import:         common+  type:           exitcode-stdio-1.0+  main-is:        Main.hs+  hs-source-dirs: test+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+    , aeson                    >=2.1  && <2.3+    , attoparsec+    , base                     >=4.18 && <5+    , codd+    , containers               >=0.6  && <0.8+    , ephemeral-pg             >=0.2  && <0.3+    , hasql                    >=1.10 && <1.11+    , hasql-pool               >=1.2  && <1.5+    , hspec                    >=2.10 && <2.12+    , kiroku-store             ^>=0.2+    , kiroku-store-migrations+    , text                     >=2.0  && <2.2+    , time                     >=1.12 && <1.15+    , vector                   >=0.13 && <0.14
+ sql-migrations/2026-05-16-00-00-00-kiroku-bootstrap.sql view
@@ -0,0 +1,229 @@+-- Kiroku Store bootstrap migration (codd)+-- Supports PostgreSQL 17+.+--+-- kiroku-store-migrations is the schema owner. codd applies this file+-- verbatim, records that the timestamped migration ran, and skips it on later+-- runs. Future schema changes add new timestamped SQL files in this directory+-- instead of changing kiroku-store.+--+-- All Kiroku-owned objects live in the dedicated `kiroku` schema, leaving+-- `public` free for application objects. Creating the schema and setting+-- search_path first means every unqualified object name in the rest of this+-- file resolves into the Kiroku schema.+CREATE SCHEMA IF NOT EXISTS kiroku;+SET search_path TO kiroku, pg_catalog;++-- PostgreSQL 18 provides pg_catalog.uuidv7(); PostgreSQL 17 needs this+-- Kiroku-schema fallback before events.event_id DEFAULT uuidv7() is parsed.+-- With search_path set above, the unqualified CREATE FUNCTION lands in the+-- Kiroku schema, and to_regprocedure('uuidv7()') resolves through search_path+-- (pg_catalog first for the built-in, then the Kiroku schema for the fallback).+DO $$+BEGIN+    IF to_regprocedure('pg_catalog.uuidv7()') IS NULL+       AND to_regprocedure('uuidv7()') IS NULL THEN+        EXECUTE $fn$+            CREATE FUNCTION uuidv7()+            RETURNS uuid+            AS $body$+            DECLARE+                unix_ts_ms bytea;+                uuid_bytes bytea;+            BEGIN+                unix_ts_ms = substring(int8send(floor(extract(epoch from clock_timestamp()) * 1000)::bigint) from 3);+                uuid_bytes = uuid_send(gen_random_uuid());+                uuid_bytes = overlay(uuid_bytes placing unix_ts_ms from 1 for 6);+                uuid_bytes = set_byte(uuid_bytes, 6, (b'0111' || get_byte(uuid_bytes, 6)::bit(4))::bit(8)::int);+                RETURN encode(uuid_bytes, 'hex')::uuid;+            END+            $body$+            LANGUAGE plpgsql+            VOLATILE+        $fn$;+    END IF;+END+$$;++-- Streams (including $all as stream_id = 0)+CREATE TABLE IF NOT EXISTS streams (+    stream_id    BIGSERIAL    PRIMARY KEY,+    stream_name  TEXT         NOT NULL,+    category     TEXT         GENERATED ALWAYS AS (split_part(stream_name, '-', 1)) STORED,+    stream_version BIGINT     NOT NULL DEFAULT 0,+    created_at   TIMESTAMPTZ  NOT NULL DEFAULT now(),+    deleted_at   TIMESTAMPTZ,+    CONSTRAINT ix_streams_stream_name UNIQUE (stream_name)+);++-- Seed the $all stream+INSERT INTO streams (stream_id, stream_name, stream_version)+VALUES (0, '$all', 0)+ON CONFLICT DO NOTHING;++-- Reset sequence past the reserved stream_id=0+SELECT setval('streams_stream_id_seq', GREATEST((SELECT MAX(stream_id) FROM streams), 1));++-- Events (flat table — stream membership tracked in stream_events)+CREATE TABLE IF NOT EXISTS events (+    event_id       UUID         PRIMARY KEY DEFAULT uuidv7(),+    event_type     TEXT         NOT NULL,+    causation_id   UUID,+    correlation_id UUID,+    data           JSONB        NOT NULL,+    metadata       JSONB,+    created_at     TIMESTAMPTZ  NOT NULL DEFAULT now()+);++-- Stream-event junction (each event gets 2+ rows: source stream + $all + any links)+CREATE TABLE IF NOT EXISTS stream_events (+    event_id                UUID   NOT NULL REFERENCES events(event_id),+    stream_id               BIGINT NOT NULL REFERENCES streams(stream_id),+    stream_version          BIGINT NOT NULL,+    original_stream_id      BIGINT NOT NULL,+    original_stream_version BIGINT NOT NULL,+    PRIMARY KEY (event_id, stream_id)+);++-- Indexes++-- Primary read path: fetch events from a stream in order+CREATE INDEX IF NOT EXISTS ix_stream_events_stream_version+    ON stream_events (stream_id, stream_version);++-- Event type filtering (for server-side subscription filtering)+CREATE INDEX IF NOT EXISTS ix_events_event_type+    ON events (event_type);++-- Correlation tracing+CREATE INDEX IF NOT EXISTS ix_events_correlation_id+    ON events (correlation_id) WHERE correlation_id IS NOT NULL;++-- Causation tracing+CREATE INDEX IF NOT EXISTS ix_events_causation_id+    ON events (causation_id) WHERE causation_id IS NOT NULL;++-- Category filtering (for readCategory — uses generated column, not LIKE)+CREATE INDEX IF NOT EXISTS ix_streams_category+    ON streams (category);++-- Category read path: find $all entries by originating stream, ordered by global position+-- Enables efficient category reads by allowing the planner to: look up category stream_ids →+-- index scan $all for each → merge ordered by stream_version+CREATE INDEX IF NOT EXISTS ix_stream_events_all_by_origin+    ON stream_events (original_stream_id, stream_version)+    WHERE stream_id = 0;++-- Subscriptions (checkpoint persistence for subscription positions).+-- consumer_group_member / consumer_group_size carry static consumer-group+-- topology (ExecPlan 28 / EP-1). Non-group subscriptions are member 0, size 1.+-- The unique key is composite (subscription_name, consumer_group_member) so each+-- group member persists its own checkpoint under one shared subscription name.+CREATE TABLE IF NOT EXISTS subscriptions (+    subscription_id       BIGSERIAL    PRIMARY KEY,+    subscription_name     TEXT         NOT NULL,+    stream_name           TEXT         NOT NULL DEFAULT '$all',+    last_seen             BIGINT       NOT NULL DEFAULT 0,+    consumer_group_member INT          NOT NULL DEFAULT 0,+    consumer_group_size   INT          NOT NULL DEFAULT 1,+    created_at            TIMESTAMPTZ  NOT NULL DEFAULT now(),+    updated_at            TIMESTAMPTZ  NOT NULL DEFAULT now()+);++-- Idempotent convergence for databases created before EP-1: add the columns if+-- missing, drop the old auto-named single-column unique constraint if present,+-- and install the composite unique index. All guarded so the bootstrap body is+-- still safe in disposable local databases; codd records the timestamped+-- migration and does not reapply it after a successful run.+ALTER TABLE subscriptions ADD COLUMN IF NOT EXISTS consumer_group_member INT NOT NULL DEFAULT 0;+ALTER TABLE subscriptions ADD COLUMN IF NOT EXISTS consumer_group_size   INT NOT NULL DEFAULT 1;+ALTER TABLE subscriptions DROP CONSTRAINT IF EXISTS subscriptions_subscription_name_key;+CREATE UNIQUE INDEX IF NOT EXISTS ix_subscriptions_name_member+    ON subscriptions (subscription_name, consumer_group_member);++-- Triggers++-- NOTIFY on stream changes (fires once per append, not per event)+CREATE OR REPLACE FUNCTION notify_events() RETURNS TRIGGER AS $$+BEGIN+    PERFORM pg_notify(+        TG_TABLE_SCHEMA || '.events',+        NEW.stream_name || ',' || NEW.stream_id || ',' || NEW.stream_version+    );+    RETURN NEW;+END;+$$ LANGUAGE plpgsql;++DROP TRIGGER IF EXISTS stream_events_notify ON streams;+CREATE TRIGGER stream_events_notify+    AFTER INSERT OR UPDATE ON streams+    FOR EACH ROW EXECUTE FUNCTION notify_events();++-- Immutability: prevent event mutation+CREATE OR REPLACE FUNCTION prevent_mutation() RETURNS TRIGGER AS $$+BEGIN+    RAISE EXCEPTION 'Immutable table: % cannot be updated', TG_TABLE_NAME;+END;+$$ LANGUAGE plpgsql;++DROP TRIGGER IF EXISTS no_update_events ON events;+CREATE TRIGGER no_update_events+    BEFORE UPDATE ON events+    FOR EACH ROW EXECUTE FUNCTION prevent_mutation();++DROP TRIGGER IF EXISTS no_update_stream_events ON stream_events;+CREATE TRIGGER no_update_stream_events+    BEFORE UPDATE ON stream_events+    FOR EACH ROW EXECUTE FUNCTION prevent_mutation();++-- Gated hard deletes (for maintenance/GDPR only)+CREATE OR REPLACE FUNCTION protect_deletion() RETURNS TRIGGER AS $$+BEGIN+    IF current_setting('kiroku.enable_hard_deletes', true) = 'on' THEN+        RETURN OLD;+    END IF;+    RAISE EXCEPTION 'Hard deletes require: SET LOCAL kiroku.enable_hard_deletes = ''on''';+END;+$$ LANGUAGE plpgsql;++DROP TRIGGER IF EXISTS no_delete_events ON events;+CREATE TRIGGER no_delete_events+    BEFORE DELETE ON events+    FOR EACH ROW EXECUTE FUNCTION protect_deletion();++DROP TRIGGER IF EXISTS no_delete_stream_events ON stream_events;+CREATE TRIGGER no_delete_stream_events+    BEFORE DELETE ON stream_events+    FOR EACH ROW EXECUTE FUNCTION protect_deletion();++DROP TRIGGER IF EXISTS no_delete_streams ON streams;+CREATE TRIGGER no_delete_streams+    BEFORE DELETE ON streams+    FOR EACH ROW EXECUTE FUNCTION protect_deletion();++-- TRUNCATE bypasses row-level triggers, so the BEFORE DELETE triggers above+-- do not protect against an operator running TRUNCATE on these tables. Add+-- statement-level BEFORE TRUNCATE triggers gated by the same GUC so the+-- protection is symmetric. See EP-1 F6.+CREATE OR REPLACE FUNCTION protect_truncation() RETURNS TRIGGER AS $$+BEGIN+    IF current_setting('kiroku.enable_hard_deletes', true) = 'on' THEN+        RETURN NULL;+    END IF;+    RAISE EXCEPTION 'TRUNCATE requires: SET LOCAL kiroku.enable_hard_deletes = ''on''';+END;+$$ LANGUAGE plpgsql;++DROP TRIGGER IF EXISTS no_truncate_events ON events;+CREATE TRIGGER no_truncate_events+    BEFORE TRUNCATE ON events+    FOR EACH STATEMENT EXECUTE FUNCTION protect_truncation();++DROP TRIGGER IF EXISTS no_truncate_stream_events ON stream_events;+CREATE TRIGGER no_truncate_stream_events+    BEFORE TRUNCATE ON stream_events+    FOR EACH STATEMENT EXECUTE FUNCTION protect_truncation();++DROP TRIGGER IF EXISTS no_truncate_streams ON streams;+CREATE TRIGGER no_truncate_streams+    BEFORE TRUNCATE ON streams+    FOR EACH STATEMENT EXECUTE FUNCTION protect_truncation();
+ sql-migrations/2026-05-26-00-00-00-add-subscription-dead-letters.sql view
@@ -0,0 +1,31 @@+-- Add the kiroku.dead_letters table (MasterPlan 6 / EP-2, docs/plans/40-...).+--+-- Forward, additive migration: codd applies this file once, records it, and+-- skips it on later runs. It does not edit the bootstrap migration and does not+-- mutate existing event data.+--+-- A dead-letter row records one event that a subscription handler asked to+-- "dead-letter" (return DeadLetter, or exhaust its bounded retry budget). The+-- event itself stays immutable in kiroku.events; this table references it by+-- event_id and global_position rather than copying the payload. The+-- consumer_group_member column (default 0, matching kiroku.subscriptions)+-- attributes the row to the member that produced it, so a consumer group's dead+-- letters are per-member. The worker writes a row and advances the member's+-- checkpoint in one atomic statement (see SQL.insertDeadLetterAndCheckpointStmt).++CREATE TABLE IF NOT EXISTS kiroku.dead_letters (+    dead_letter_id        BIGSERIAL    PRIMARY KEY,+    subscription_name     TEXT         NOT NULL,+    consumer_group_member INT          NOT NULL DEFAULT 0,+    global_position       BIGINT       NOT NULL,+    event_id              UUID         NOT NULL REFERENCES kiroku.events(event_id),+    reason                JSONB        NOT NULL,+    reason_summary        TEXT         NOT NULL,+    attempt_count         INT          NOT NULL,+    created_at            TIMESTAMPTZ  NOT NULL DEFAULT now(),+    UNIQUE (subscription_name, consumer_group_member, global_position, event_id)+);++-- Operator read path: list a subscription member's dead letters by recency.+CREATE INDEX IF NOT EXISTS ix_dead_letters_subscription_created_at+    ON kiroku.dead_letters (subscription_name, consumer_group_member, created_at);
+ src/Kiroku/Store/Migrations.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}++module Kiroku.Store.Migrations (+    kirokuMigrations,+    runKirokuMigrations,+    runKirokuMigrationsNoCheck,+) where++import Codd (ApplyResult (SchemasNotVerified), CoddSettings, VerifySchemas, applyMigrations, applyMigrationsNoCheck)+import Codd.Logging (runCoddLogger)+import Codd.Parsing (AddedSqlMigration, EnvVars, PureStream (..), parseAddedSqlMigration)+import Data.ByteString (ByteString)+import Data.FileEmbed (embedDir)+import Data.Text.Encoding qualified as TE+import Data.Time (DiffTime)+import Streaming.Prelude qualified as Streaming++-- | Kiroku's embedded SQL migrations, ordered by timestamped filename.+kirokuMigrations :: (MonadFail m, EnvVars m) => m [AddedSqlMigration m]+kirokuMigrations =+    traverse parseEmbeddedMigration embeddedMigrationFiles+  where+    parseEmbeddedMigration :: forall m. (MonadFail m, EnvVars m) => (FilePath, ByteString) -> m (AddedSqlMigration m)+    parseEmbeddedMigration (name, bytes) = do+        let stream :: PureStream m+            stream = PureStream $ Streaming.yield (TE.decodeUtf8 bytes)+        result <-+            parseAddedSqlMigration+                name+                stream+        case result of+            Left err -> fail ("Invalid Kiroku migration " <> name <> ": " <> err)+            Right migration -> pure migration++-- | Run Kiroku's embedded migrations through codd.+runKirokuMigrations :: CoddSettings -> DiffTime -> VerifySchemas -> IO ApplyResult+runKirokuMigrations settings connectTimeout verifySchemas =+    runCoddLogger $ do+        migrations <- kirokuMigrations+        applyMigrations settings (Just migrations) connectTimeout verifySchemas++{- | Run Kiroku's embedded migrations through codd without expected-schema+verification.++This is the right entry point until the caller owns a codd expected-schema+snapshot. Use 'runKirokuMigrations' when schema verification is configured.+-}+runKirokuMigrationsNoCheck :: CoddSettings -> DiffTime -> IO ApplyResult+runKirokuMigrationsNoCheck settings connectTimeout =+    runCoddLogger $ do+        migrations <- kirokuMigrations+        applyMigrationsNoCheck settings (Just migrations) connectTimeout (const (pure SchemasNotVerified))++embeddedMigrationFiles :: [(FilePath, ByteString)]+embeddedMigrationFiles = $(embedDir "sql-migrations")
+ test/Main.hs view
@@ -0,0 +1,229 @@+module Main where++import Codd (ApplyResult (SchemasNotVerified), CoddSettings (..))+import Codd.Parsing (connStringParser)+import Codd.Representations.Types (DbRep (..))+import Codd.Types (ConnectionString, SchemaAlgo (..), SchemaSelection (..), SqlSchema (..), TxnIsolationLvl (..), singleTryPolicy)+import Data.Aeson (Value (Null))+import Data.Aeson qualified as Aeson+import Data.Attoparsec.Text (endOfInput, parseOnly)+import Data.Map qualified as Map+import Data.Text (Text)+import Data.Text qualified as T+import Data.Time (secondsToDiffTime)+import Data.Vector qualified as Vector+import EphemeralPg qualified as Pg+import Hasql.Connection.Settings qualified as Conn+import Hasql.Decoders qualified as D+import Hasql.Encoders qualified as E+import Hasql.Pool qualified as Pool+import Hasql.Pool.Config qualified as Pool.Config+import Hasql.Session qualified as Session+import Hasql.Statement (Statement, preparable)+import Kiroku.Store+import Kiroku.Store.Migrations (runKirokuMigrationsNoCheck)+import Test.Hspec++main :: IO ()+main =+    hspec $+        describe "codd migration spike" $+            it "applies Kiroku migrations, opens the store without startup DDL, and is repeatable" $ do+                result <- Pg.withCached $ \db -> do+                    let connStr = Pg.connectionString db+                        coddSettings = testCoddSettings connStr++                    firstMigration <- runKirokuMigrationsNoCheck coddSettings (secondsToDiffTime 5)+                    firstMigration `shouldBeSchemasNotVerified` "first migration run"+                    assertBootstrapApplied connStr+                    assertSchemaPlacement connStr+                    assertDeadLettersTable connStr+                    assertDefaultUuidV7 connStr++                    withStore+                        (defaultConnectionSettings connStr)+                        $ \store -> do+                            let stream = StreamName "migration-consumer"+                                event = makeEvent "MigrationConsumerChecked" (Aeson.object [("ok", Aeson.Bool True)])+                            appendResult <- runStoreIO store $ appendToStream stream NoStream [event]+                            case appendResult of+                                Left err -> expectationFailure ("appendToStream failed: " <> show err)+                                Right _ -> pure ()++                            readResult <- runStoreIO store $ readStreamForward stream (StreamVersion 0) 10+                            case readResult of+                                Left err -> expectationFailure ("readStreamForward failed: " <> show err)+                                Right events -> Vector.length events `shouldBe` 1++                    secondMigration <- runKirokuMigrationsNoCheck coddSettings (secondsToDiffTime 5)+                    secondMigration `shouldBeSchemasNotVerified` "second migration run"+                    assertBootstrapApplied connStr+                    assertDefaultUuidV7 connStr+                case result of+                    Left err -> expectationFailure ("Failed to start ephemeral PostgreSQL: " <> show err)+                    Right () -> pure ()++testCoddSettings :: Text -> CoddSettings+testCoddSettings connStr =+    CoddSettings+        { migsConnString = parseConnString connStr+        , sqlMigrations = []+        , onDiskReps = Right (DbRep Null Map.empty Map.empty)+        , namespacesToCheck = IncludeSchemas [SqlSchema "kiroku"]+        , 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++makeEvent :: Text -> Value -> EventData+makeEvent typ payload =+    EventData+        { eventId = Nothing+        , eventType = EventType typ+        , payload = payload+        , metadata = Nothing+        , causationId = Nothing+        , correlationId = Nothing+        }++shouldBeSchemasNotVerified :: ApplyResult -> String -> Expectation+shouldBeSchemasNotVerified SchemasNotVerified _ = pure ()+shouldBeSchemasNotVerified _ label = expectationFailure (label <> " unexpectedly verified schemas")++assertBootstrapApplied :: Text -> IO ()+assertBootstrapApplied connStr = do+    pool <- Pool.acquire poolConfig+    result <- Pool.use pool (Session.statement () bootstrapStmt)+    Pool.release pool+    case result of+        Left err -> expectationFailure ("bootstrap verification query failed: " <> show err)+        Right True -> pure ()+        Right False -> expectationFailure "Kiroku bootstrap migration did not create the $all stream"+  where+    poolConfig =+        Pool.Config.settings+            [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr)+            , Pool.Config.size 1+            ]++bootstrapStmt :: Statement () Bool+bootstrapStmt =+    preparable+        "SELECT EXISTS (SELECT 1 FROM kiroku.streams WHERE stream_id = 0 AND stream_name = '$all')"+        E.noParams+        (D.singleRow (D.column (D.nonNullable D.bool)))++{- | Assert that the migration installed every Kiroku table under the @kiroku@+schema and left @public@ free of Kiroku tables. The connection uses no special+@search_path@, so the schema-qualified @to_regclass@ checks prove placement+directly rather than relying on name resolution.+-}+assertSchemaPlacement :: Text -> IO ()+assertSchemaPlacement connStr = do+    pool <- Pool.acquire poolConfig+    result <- Pool.use pool (Session.statement () placementStmt)+    Pool.release pool+    case result of+        Left err -> expectationFailure ("schema placement query failed: " <> show err)+        Right (True, True) -> pure ()+        Right (kirokuPresent, publicAbsent) ->+            expectationFailure+                ( "expected all Kiroku tables in 'kiroku' and none in 'public'; got kirokuPresent="+                    <> show kirokuPresent+                    <> ", publicAbsent="+                    <> show publicAbsent+                )+  where+    poolConfig =+        Pool.Config.settings+            [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr)+            , Pool.Config.size 1+            ]++placementStmt :: Statement () (Bool, Bool)+placementStmt =+    preparable+        "SELECT \+        \  (to_regclass('kiroku.streams') IS NOT NULL \+        \   AND to_regclass('kiroku.events') IS NOT NULL \+        \   AND to_regclass('kiroku.stream_events') IS NOT NULL \+        \   AND to_regclass('kiroku.subscriptions') IS NOT NULL), \+        \  (to_regclass('public.streams') IS NULL \+        \   AND to_regclass('public.events') IS NULL \+        \   AND to_regclass('public.stream_events') IS NULL \+        \   AND to_regclass('public.subscriptions') IS NULL)"+        E.noParams+        (D.singleRow ((,) <$> D.column (D.nonNullable D.bool) <*> D.column (D.nonNullable D.bool)))++{- | Assert that the forward migration installed the @kiroku.dead_letters@ table+(MasterPlan 6 / EP-40) — proving codd applied the timestamped migration after the+bootstrap, not only the bootstrap itself.+-}+assertDeadLettersTable :: Text -> IO ()+assertDeadLettersTable connStr = do+    pool <- Pool.acquire poolConfig+    result <- Pool.use pool (Session.statement () deadLettersStmt)+    Pool.release pool+    case result of+        Left err -> expectationFailure ("dead_letters verification query failed: " <> show err)+        Right True -> pure ()+        Right False -> expectationFailure "Kiroku migration did not create the kiroku.dead_letters table"+  where+    poolConfig =+        Pool.Config.settings+            [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr)+            , Pool.Config.size 1+            ]++deadLettersStmt :: Statement () Bool+deadLettersStmt =+    preparable+        "SELECT to_regclass('kiroku.dead_letters') IS NOT NULL"+        E.noParams+        (D.singleRow (D.column (D.nonNullable D.bool)))++assertDefaultUuidV7 :: Text -> IO ()+assertDefaultUuidV7 connStr = do+    pool <- Pool.acquire poolConfig+    result <- Pool.use pool (Session.statement () defaultUuidStmt)+    versionResult <- Pool.use pool (Session.statement () serverVersionStmt)+    Pool.release pool+    case (result, versionResult) of+        (Right eventIdText, Right version)+            | T.length eventIdText > 14 && T.index eventIdText 14 == '7' -> pure ()+            | otherwise ->+                expectationFailure+                    ( "expected migration-created database default to generate UUIDv7 on PostgreSQL "+                        <> T.unpack version+                        <> ", got "+                        <> T.unpack eventIdText+                    )+        (Left err, _) -> expectationFailure ("default UUID insert failed: " <> show err)+        (_, Left err) -> expectationFailure ("server version query failed: " <> show err)+  where+    poolConfig =+        Pool.Config.settings+            [ Pool.Config.staticConnectionSettings (Conn.connectionString connStr)+            , Pool.Config.size 1+            ]++defaultUuidStmt :: Statement () Text+defaultUuidStmt =+    preparable+        "INSERT INTO kiroku.events (event_type, data) VALUES ('DefaultUuidGenerated', '{}'::jsonb) RETURNING event_id::text"+        E.noParams+        (D.singleRow (D.column (D.nonNullable D.text)))++serverVersionStmt :: Statement () Text+serverVersionStmt =+    preparable+        "SELECT current_setting('server_version_num')"+        E.noParams+        (D.singleRow (D.column (D.nonNullable D.text)))