diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,13 @@ +# Changelog + +## 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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. diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -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 () diff --git a/kiroku-store-migrations.cabal b/kiroku-store-migrations.cabal new file mode 100644 --- /dev/null +++ b/kiroku-store-migrations.cabal @@ -0,0 +1,77 @@ +cabal-version: 3.0 +name: kiroku-store-migrations +version: 0.1.0.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.1 + , kiroku-store-migrations + , text >=2.0 && <2.2 + , time >=1.12 && <1.15 + , vector >=0.13 && <0.14 diff --git a/sql-migrations/2026-05-16-00-00-00-kiroku-bootstrap.sql b/sql-migrations/2026-05-16-00-00-00-kiroku-bootstrap.sql new file mode 100644 --- /dev/null +++ b/sql-migrations/2026-05-16-00-00-00-kiroku-bootstrap.sql @@ -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(); diff --git a/src/Kiroku/Store/Migrations.hs b/src/Kiroku/Store/Migrations.hs new file mode 100644 --- /dev/null +++ b/src/Kiroku/Store/Migrations.hs @@ -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") diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,201 @@ +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 + 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))) + +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)))