keiro-migrations 0.15.0.0 → 0.16.0.0
raw patch · 7 files changed
+94/−22 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +16/−1
- expected-schema/native/keiro-v18.txt +3/−0
- keiro-migrations.cabal +1/−1
- migrations.native.lock +1/−0
- migrations/0032.sql +8/−0
- migrations/manifest +1/−0
- test/Main.hs +64/−20
CHANGELOG.md view
@@ -4,7 +4,22 @@ [Keep a Changelog](https://keepachangelog.com/), and the package follows the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## Unreleased+## [Unreleased]++## 0.16.0.0 — 2026-09-07++### Breaking Changes++- Stop/drain old timer writers before applying and enable foreground resume only+ after all writers are upgraded. Before rollback, disable resume and drain or+ recover guarded claims; old writers lack ownership exclusion predicates.++### New Features++- Migration `0032.sql` adds nullable foreground timer ownership tokens and lease+ deadlines, with a constraint requiring paired fields only on Firing rows.+ Existing timers retain all metadata and retry history. The native schema+ snapshot, manifest, and checksum lock include the new migration. ## 0.15.0.0 — 2026-08-30
expected-schema/native/keiro-v18.txt view
@@ -261,6 +261,8 @@ column keiro_timers.last_error text column keiro_timers.payload jsonb not null column keiro_timers.process_manager_name text not null+column keiro_timers.resume_claim_token uuid+column keiro_timers.resume_lease_until timestamp with time zone column keiro_timers.status text not null default 'scheduled'::text column keiro_timers.timer_id uuid not null column keiro_timers.updated_at timestamp with time zone not null default now()@@ -560,6 +562,7 @@ constraint keiro_timers.keiro_timers_payload_not_null NOT NULL payload constraint keiro_timers.keiro_timers_pkey PRIMARY KEY (timer_id) constraint keiro_timers.keiro_timers_process_manager_name_not_null NOT NULL process_manager_name+constraint keiro_timers.keiro_timers_resume_ownership CHECK ((((resume_claim_token IS NULL) AND (resume_lease_until IS NULL)) OR ((resume_claim_token IS NOT NULL) AND (resume_lease_until IS NOT NULL) AND (status = 'firing'::text)))) constraint keiro_timers.keiro_timers_status_not_null NOT NULL status constraint keiro_timers.keiro_timers_timer_id_not_null NOT NULL timer_id constraint keiro_timers.keiro_timers_updated_at_not_null NOT NULL updated_at
keiro-migrations.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: keiro-migrations-version: 0.15.0.0+version: 0.16.0.0 synopsis: Schema migrations for keiro description: Embedded PostgreSQL schema migrations and a migration runner for the Keiro
migrations.native.lock view
@@ -29,3 +29,4 @@ 40f62a18adf0457fc6d35e880eca8be1922f22a2fd8c893c13d59537fe941719 0029.sql 0e0b847088d178290e77913224df82435b86c00062feb47c79351ed014a605a1 0030.sql d78b8400638b3a9005f4e964f2cb10d3863d60d1038735ed6fa09507a912a26e 0031.sql+b0fd734dde0a23d13f844a5e137fe92859f726ded171e14ca531c3e10f3dcf47 0032.sql
+ migrations/0032.sql view
@@ -0,0 +1,8 @@+-- add guarded timer resume leases+ALTER TABLE keiro.keiro_timers+ ADD COLUMN resume_claim_token UUID,+ ADD COLUMN resume_lease_until TIMESTAMPTZ,+ ADD CONSTRAINT keiro_timers_resume_ownership CHECK (+ (resume_claim_token IS NULL AND resume_lease_until IS NULL)+ OR (resume_claim_token IS NOT NULL AND resume_lease_until IS NOT NULL AND status = 'firing')+ );
migrations/manifest view
@@ -29,3 +29,4 @@ 0029.sql 0030.sql 0031.sql+0032.sql
test/Main.hs view
@@ -54,7 +54,7 @@ main :: IO () main = hspec $ do describe "native Keiro migration definition" $ do- it "tracks thirty-one native files in manifest order" $ do+ it "tracks thirty-two native files in manifest order" $ do directory <- findMigrationsDirectory manifest <- Text.lines <$> Text.IO.readFile (directory </> "manifest") manifest `shouldBe` Text.pack <$> nativeMigrationFiles@@ -67,7 +67,7 @@ bytes <- ByteString.readFile (directory </> nativeName) lookup legacyName lockEntries `shouldBe` Just (checksumText bytes) - it "builds component keiro with dependency kiroku and thirty-one migrations" $ do+ it "builds component keiro with dependency kiroku and thirty-two migrations" $ do plan <- requirePlan let PlanDescription components = planDescription plan case toList components of@@ -80,7 +80,7 @@ componentNameText keiroName `shouldBe` "keiro" dependencyName <- requireRight (componentName "kiroku") keiroDependencies `shouldBe` Set.singleton dependencyName- length keiroEntries `shouldBe` 31+ length keiroEntries `shouldBe` 32 actual -> expectationFailure ("unexpected plan description: " <> show actual) validateHistoryMappingTargets plan frameworkCoddHistoryMappings `shouldBe` Right () @@ -169,7 +169,7 @@ [("9999-fixture.sql", "-- Never set search_path in a migration.\nSELECT 1;")] `shouldBe` [] - it "passes all 31 embedded native bodies" $ do+ it "passes all 32 embedded native bodies" $ do lintViolations config (toList embeddedMigrationEntries) `shouldBe` [] describe "startup handshake" $ do@@ -183,7 +183,7 @@ plan >>= requireRight Keiro.pendingMigrations handshake `shouldBe` planMigrationIds plan- length (Keiro.pendingMigrations handshake) `shouldBe` 42+ length (Keiro.pendingMigrations handshake) `shouldBe` 43 Keiro.ledgerIssues handshake `shouldBe` [] handshakePassed handshake `shouldBe` False @@ -209,7 +209,7 @@ handshake <- missingMigrations defaultRunOptions provider plan >>= requireRight Keiro.pendingMigrations handshake `shouldBe` drop 11 (planMigrationIds plan)- length (Keiro.pendingMigrations handshake) `shouldBe` 31+ length (Keiro.pendingMigrations handshake) `shouldBe` 32 Keiro.ledgerIssues handshake `shouldBe` [] handshakePassed handshake `shouldBe` False @@ -292,12 +292,12 @@ assertSchema connection let provider = providerFor connection rerun <- runMigrationPlanWith defaultRunOptions provider plan >>= requireRight- reportOutcomes rerun `shouldBe` replicate 42 AlreadyApplied+ reportOutcomes rerun `shouldBe` replicate 43 AlreadyApplied verified <- verifyMigrationPlanWith defaultRunOptions provider plan >>= requireRight case verified of VerificationReport verificationIssues applied pending unknown -> do verificationIssues `shouldBe` []- length applied `shouldBe` 42+ length applied `shouldBe` 43 pending `shouldBe` [] unknown `shouldBe` [] either (expectationFailure . show) pure result@@ -346,7 +346,7 @@ (runMigrationPlan defaultRunOptions settings plan >>= requireRight) (runMigrationPlan defaultRunOptions settings plan >>= requireRight) sort [reportOutcomes first, reportOutcomes second]- `shouldBe` sort [replicate 42 AppliedNow, replicate 42 AlreadyApplied]+ `shouldBe` sort [replicate 43 AppliedNow, replicate 43 AlreadyApplied] it "upgrades singleton read-model rows into deterministic rebuild groups" $ do fullPlan <- requirePlan@@ -365,7 +365,7 @@ withConnection settings $ \connection -> useSession connection (Session.script legacyReadModelFixtureSql) report <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight- Prelude.drop 32 (reportOutcomes report) `shouldBe` replicate 10 AppliedNow+ Prelude.drop 32 (reportOutcomes report) `shouldBe` replicate 11 AppliedNow withConnection settings $ \connection -> do rows <- useSession connection (Session.statement () legacyGroupUpgradeStatement) rows@@ -391,7 +391,7 @@ withConnection settings $ \connection -> useSession connection (Session.script preCanonicalRebuildFixtureSql) report <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight- Prelude.drop 34 (reportOutcomes report) `shouldBe` replicate 8 AppliedNow+ Prelude.drop 34 (reportOutcomes report) `shouldBe` replicate 9 AppliedNow withConnection settings $ \connection -> do rows <- useSession connection (Session.statement () preCanonicalRebuildShapeStatement) rows@@ -416,7 +416,7 @@ withConnection settings $ \connection -> useSession connection (Session.script preStatusContractFixtureSql) report <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight- Prelude.drop 36 (reportOutcomes report) `shouldBe` replicate 6 AppliedNow+ Prelude.drop 36 (reportOutcomes report) `shouldBe` replicate 7 AppliedNow withConnection settings $ \connection -> do facts <- useSession connection (Session.statement () preStatusContractFactsStatement) facts `shouldBe` ("unmanaged", 0, "unmanaged", True, True)@@ -439,7 +439,7 @@ withConnection settings $ \connection -> useSession connection (Session.statement () guardFunctionOidStatement) report <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight- Prelude.drop 40 (reportOutcomes report) `shouldBe` replicate 2 AppliedNow+ Prelude.drop 40 (reportOutcomes report) `shouldBe` replicate 3 AppliedNow withConnection settings $ \connection -> do (afterOid, epochFenced, publicRevoked) <- useSession connection (Session.statement () upgradedGuardFactsStatement)@@ -464,7 +464,7 @@ withConnection settings $ \connection -> useSession connection (Session.script preRejectionOutboxFixtureSql) report <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight- Prelude.drop 41 (reportOutcomes report) `shouldBe` [AppliedNow]+ Prelude.drop 41 (reportOutcomes report) `shouldBe` replicate 2 AppliedNow withConnection settings $ \connection -> do useSession connection (Session.script validRejectionAuditSql) missingAudit <- Connection.use connection (Session.script missingRejectionAuditSql)@@ -476,6 +476,46 @@ auditOnSent <- Connection.use connection (Session.script rejectionAuditOnSentSql) auditOnSent `shouldSatisfy` isLeft + it "0032 preserves old timer rows and enforces paired firing ownership" $ do+ fullPlan <- requirePlan+ kiroku <- requireRight Kiroku.kirokuMigrations+ priorKeiro <-+ requireRight+ ( migrationComponentFromEmbeddedSql+ "keiro"+ (Set.singleton "kiroku")+ (NonEmpty.fromList (take 31 (toList embeddedMigrationEntries)))+ )+ priorPlan <- requireRight (frameworkMigrationPlan kiroku priorKeiro)+ withKeiroPg $ \database -> do+ let settings = Pg.connectionSettings database+ _ <- runMigrationPlan defaultRunOptions settings priorPlan >>= requireRight+ withConnection settings $ \connection ->+ useSession+ connection+ ( Session.script+ "INSERT INTO keiro.keiro_timers (timer_id, process_manager_name, correlation_id, fire_at, payload, status, attempts, last_error) SELECT ('00000000-0000-0000-0000-00000000000' || n)::uuid, 'owner', 'original', now(), '{\"work\":1}', s, 7, 'deferred' FROM (VALUES (1, 'scheduled'), (2, 'firing'), (3, 'dead')) AS states(n,s)"+ )+ _ <- runMigrationPlan defaultRunOptions settings fullPlan >>= requireRight+ withConnection settings $ \connection -> do+ count <-+ useSession+ connection+ ( Session.statement+ ()+ ( Statement.preparable+ "SELECT count(*) FROM keiro.keiro_timers WHERE resume_claim_token IS NULL AND resume_lease_until IS NULL AND attempts = 7 AND last_error = 'deferred' AND payload = '{\"work\":1}'::jsonb AND correlation_id = 'original'"+ Encoders.noParams+ (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.int8)))+ )+ )+ count `shouldBe` 3+ missingLease <- Connection.use connection (Session.script "UPDATE keiro.keiro_timers SET resume_claim_token = '00000000-0000-0000-0000-000000000001'")+ missingLease `shouldSatisfy` isLeft+ wrongState <- Connection.use connection (Session.script "UPDATE keiro.keiro_timers SET resume_claim_token = '00000000-0000-0000-0000-000000000001', resume_lease_until = now() WHERE status = 'dead'")+ wrongState `shouldSatisfy` isLeft+ useSession connection (Session.script "UPDATE keiro.keiro_timers SET resume_claim_token = '00000000-0000-0000-0000-000000000001', resume_lease_until = now() WHERE status = 'firing'")+ it "enforces replay source, adapter, and verification membership constraints" $ do plan <- requirePlan result <- withMigratedDatabase plan $ \connection -> do@@ -637,7 +677,7 @@ `shouldBe` replicate 7 AlreadyApplied <> replicate 4 AppliedNow <> replicate 16 AlreadyApplied- <> replicate 15 AppliedNow+ <> replicate 16 AppliedNow verifiedAfterUp <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight@@ -1074,12 +1114,12 @@ `shouldBe` replicate 7 AlreadyApplied <> replicate 4 AppliedNow <> replicate 16 AlreadyApplied- <> replicate 15 AppliedNow+ <> replicate 16 AppliedNow verifiedAfterCanaries <- verifyMigrationPlan defaultRunOptions settings plan >>= requireRight case verifiedAfterCanaries of VerificationReport verificationIssues _ _ _ -> verificationIssues `shouldBe` [] rerun <- runMigrationPlan defaultRunOptions settings plan >>= requireRight- reportOutcomes rerun `shouldBe` replicate 42 AlreadyApplied+ reportOutcomes rerun `shouldBe` replicate 43 AlreadyApplied second <- importCoddHistory defaultImportOptions config provider plan frameworkCoddHistoryMappings >>= requireRight@@ -1089,7 +1129,7 @@ sourceRows <- useSession connection (Session.statement () (sourceRowCountStatement sourceSchema)) sourceRows `shouldBe` 23 facts <- useSession connection (Session.statement () importFactsStatement)- facts `shouldBe` (42, 23, True)+ facts `shouldBe` (43, 23, True) postCoddImportPendingIssues :: IO [VerificationIssue] postCoddImportPendingIssues =@@ -1117,7 +1157,8 @@ ("keiro", "0028"), ("keiro", "0029"), ("keiro", "0030"),- ("keiro", "0031")+ ("keiro", "0031"),+ ("keiro", "0032") ] assertPoisonedLedger :: Settings.Settings -> Expectation@@ -1161,7 +1202,8 @@ "0028.sql", "0029.sql", "0030.sql",- "0031.sql"+ "0031.sql",+ "0032.sql" ] findMigrationsDirectory :: IO FilePath@@ -1291,6 +1333,8 @@ requireRight :: (Show error) => Either error value -> IO value requireRight = either failure pure +-- Keep the cold assertion path out of each specialized migration example.+{-# NOINLINE failure #-} failure :: (Show value) => value -> IO result failure value = expectationFailure (show value) >> fail (show value)