pg-migrate-import-codd 1.0.0.0 → 1.1.0.0

raw patch · 11 files changed

+375/−77 lines, 11 filesdep ~pg-migratedep ~pg-migrate-cliPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: pg-migrate, pg-migrate-cli

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• pg-migrate-import-codd.cabal +4/−3
• src/Database/PostgreSQL/Migrate/History/Codd.hs +2/−1
• src/Database/PostgreSQL/Migrate/History/Codd/Import.hs +72/−34
• src/Database/PostgreSQL/Migrate/History/Codd/Ledger.hs +46/−23
• src/Database/PostgreSQL/Migrate/History/Codd/Manifest.hs +1/−1
• src/Database/PostgreSQL/Migrate/History/Codd/Parser.hs +13/−5
• src/Database/PostgreSQL/Migrate/History/Codd/Types.hs +7/−3
• test/integration/Main.hs +169/−1
• test/unit/Test/Evidence.hs +22/−2
• test/unit/Test/Parser.hs +16/−4

@@ -1,5 +1,28 @@ # Changelog +## 1.1.0.0 — 2026-07-13++Major release: this set adds a field to `CoddImportCommand` and removes a public error+constructor.++### Breaking changes++- Added `allowEquivalent :: Bool` to `CoddImportCommand`, backed by the reusable parser's+  new `--allow-equivalent` flag.+- Removed the unreachable `EmptyCoddSelection` constructor from `CoddDefinitionError`.++### Fixes and behavior changes++- Parse `--source-lock-key` through `Integer` and reject decimal or hexadecimal values+  outside signed `Int64` bounds instead of silently wrapping them.+- Make `--strict-source` reject selected rows missing from a provided manifest as well as+  manifest entries outside the selection.+- Stop attaching locally calculated, unverified checksums to `LedgerOnly` evidence.+- Preserve a committed `HistoryImportReport` when releasing the Codd source lock fails,+  appending the source observation to `cleanupIssues`.+- Document the two optional error slots of `CoddUnlockFailed` and correct manifest/parser+  API descriptions.+ ## 1.0.0.0 — 2026-07-10  - Initial stable release of the Hasql-only Codd V1–V5 history adapter with source-first

@@ -1,6 +1,6 @@ cabal-version:   3.8 name:            pg-migrate-import-codd-version:         1.0.0.0+version:         1.1.0.0 synopsis:        Import Codd migration history into pg-migrate category:        Database maintainer:      nadeem@gmail.com@@ -45,8 +45,8 @@     , containers            >=0.7  && <0.8     , hasql                 >=1.10 && <1.11     , optparse-applicative  >=0.19 && <0.20-    , pg-migrate            >=1.0  && <1.1-    , pg-migrate-cli        >=1.0  && <1.1+    , pg-migrate            >=1.1  && <1.2+    , pg-migrate-cli        >=1.1  && <1.2     , text                  >=2.1  && <2.2     , time                  >=1.12 && <1.15 @@ -80,6 +80,7 @@   hs-source-dirs: test/integration   main-is:        Main.hs   build-depends:+    , aeson                   >=2.2  && <2.3     , base                    >=4.20 && <4.22     , bytestring              >=0.12 && <0.13     , containers              >=0.7  && <0.8

@@ -16,11 +16,12 @@     parseCoddManifest,     readCoddHistory,     importCoddHistory,+    importCoddHistoryWithValidators,     coddImportCommandParser,   ) where -import Database.PostgreSQL.Migrate.History.Codd.Import (importCoddHistory)+import Database.PostgreSQL.Migrate.History.Codd.Import (importCoddHistory, importCoddHistoryWithValidators) import Database.PostgreSQL.Migrate.History.Codd.Ledger (readCoddHistory) import Database.PostgreSQL.Migrate.History.Codd.Manifest (parseCoddManifest) import Database.PostgreSQL.Migrate.History.Codd.Parser (coddImportCommandParser)

@@ -1,5 +1,6 @@ module Database.PostgreSQL.Migrate.History.Codd.Import   ( importCoddHistory,+    importCoddHistoryWithValidators,     buildCoddEvidence,   ) where@@ -12,7 +13,9 @@ import Data.Text qualified as Text import Database.PostgreSQL.Migrate import Database.PostgreSQL.Migrate.History.Codd.Ledger-  ( readCoddHistoryOnConnection,+  ( coddUnlockFailure,+    readCoddHistoryOnConnection,+    sourceUnlockCleanupIssue,     withLockedCoddHistory,   ) import Database.PostgreSQL.Migrate.History.Codd.Types@@ -29,26 +32,53 @@   NonEmpty HistoryMapping ->   IO (Either CoddImportError HistoryImportReport) importCoddHistory options config targetProvider plan mappings =-  case validateImportDefinition config plan mappings of+  importCoddHistoryWithValidators options [] config targetProvider plan mappings++-- | As 'importCoddHistory', with read-only state validators available to+-- 'EquivalentState' mappings. The source advisory lock remains held while the+-- target import validates state and writes its ledger rows.+importCoddHistoryWithValidators ::+  ImportOptions ->+  [StateValidator] ->+  CoddSourceConfig ->+  ConnectionProvider ->+  MigrationPlan ->+  NonEmpty HistoryMapping ->+  IO (Either CoddImportError HistoryImportReport)+importCoddHistoryWithValidators options validators config targetProvider plan mappings =+  case validateImportDefinition config validators plan mappings of     Left err -> pure (Left err)-    Right () ->-      withLockedCoddHistory config $ \sourceConnection -> do-        loaded <- readCoddHistoryOnConnection config sourceConnection-        case loaded of-          Left err -> pure (Left err)-          Right history ->-            case buildHistoryImport config history mappings of-              Left err -> pure (Left err)-              Right historyImportDefinition -> do-                imported <- importMigrationHistory options targetProvider plan historyImportDefinition-                pure (first CoddTargetImportFailed imported)+    Right () -> do+      (sourceResult, sourceUnlockIssues) <-+        withLockedCoddHistory config $ \sourceConnection -> do+          loaded <- readCoddHistoryOnConnection config sourceConnection+          case loaded of+            Left err -> pure (Left err)+            Right history ->+              case buildHistoryImport config history validators mappings of+                Left err -> pure (Left err)+                Right historyImportDefinition -> do+                  imported <- importMigrationHistory options targetProvider plan historyImportDefinition+                  pure (first CoddTargetImportFailed imported)+      pure $ case sourceResult of+        Left primary ->+          case sourceUnlockIssues of+            issue : _ -> Left (coddUnlockFailure (sourceLockKey config) (Just primary) issue)+            [] -> Left primary+        Right HistoryImportReport {importResults, cleanupIssues} ->+          Right+            HistoryImportReport+              { importResults,+                cleanupIssues = cleanupIssues <> (sourceUnlockCleanupIssue <$> sourceUnlockIssues)+              }  validateImportDefinition ::   CoddSourceConfig ->+  [StateValidator] ->   MigrationPlan ->   NonEmpty HistoryMapping ->   Either CoddImportError ()-validateImportDefinition config@CoddSourceConfig {selectedFilenames, confirmation, sourceManifest} plan mappings = do+validateImportDefinition config@CoddSourceConfig {selectedFilenames, confirmation, sourceManifest} validators plan mappings = do   if any isSamePayload mappings && confirmation /= Confirmed     then Left CoddConfirmationRequired     else pure ()@@ -56,7 +86,7 @@     then Left CoddSamePayloadRequiresManifest     else pure ()   placeholderEvidence <- buildPlaceholderEvidence selectedFilenames-  case historyImport "codd" placeholderEvidence [] mappings (importReason config) of+  case historyImport "codd" placeholderEvidence validators mappings (importReason config) of     Left err -> Left (CoddHistoryDefinitionFailed err)     Right _ -> Right ()   first@@ -85,13 +115,14 @@ buildHistoryImport ::   CoddSourceConfig ->   CoddHistory ->+  [StateValidator] ->   NonEmpty HistoryMapping ->   Either CoddImportError HistoryImport-buildHistoryImport config history mappings = do+buildHistoryImport config history validators mappings = do   evidence <- buildCoddEvidence config history   first     CoddHistoryDefinitionFailed-    (historyImport "codd" evidence [] mappings (importReason config))+    (historyImport "codd" evidence validators mappings (importReason config))  buildCoddEvidence ::   CoddSourceConfig ->@@ -102,8 +133,11 @@     Just (CoddManifest manifest)       | strictSource ->           let selected = Set.fromList (filename <$> toList selectedRows)+              missing = Set.toAscList (selected `Set.difference` Map.keysSet manifest)               extras = Set.toAscList (Map.keysSet manifest `Set.difference` selected)-           in if null extras then Right () else Left (CoddManifestHasUnexpected extras)+           in case missing of+                missingFilename : _ -> Left (CoddManifestEntryMissing missingFilename)+                [] -> if null extras then Right () else Left (CoddManifestHasUnexpected extras)     _ -> Right ()   Map.fromList . toList <$> traverse (rowEvidence config schemaVersion) selectedRows @@ -115,7 +149,6 @@ rowEvidence CoddSourceConfig {sourcePayloads, sourceManifest} version row@CoddHistoryRow {filename, appliedAt} = do   key <- first CoddDefinitionFailed (coddEvidenceKey filename)   let maybeBytes = Map.lookup filename sourcePayloads-      maybeChecksum = migrationFingerprint <$> maybeBytes       details = rowDetails version row       timestamp = AbsoluteTime <$> appliedAt   evidence <-@@ -123,23 +156,28 @@       Nothing ->         first           CoddHistoryDefinitionFailed-          (ledgerOnlyEvidence (Text.pack filename) timestamp maybeChecksum details)-      Just (CoddManifest manifest) -> do-        expected <- maybe (Left (CoddManifestEntryMissing filename)) Right (Map.lookup filename manifest)-        bytes <- maybe (Left (CoddSourcePayloadMissing filename)) Right maybeBytes-        let actualChecksum = migrationFingerprint bytes-            actual = checksumText actualChecksum-        if actual /= expected-          then Left (CoddManifestChecksumMismatch filename expected actual)-          else+          (ledgerOnlyEvidence (Text.pack filename) timestamp Nothing details)+      Just (CoddManifest manifest) ->+        case Map.lookup filename manifest of+          Nothing ->             first               CoddHistoryDefinitionFailed-              ( sourceManifestVerifiedEvidence-                  (Text.pack filename)-                  timestamp-                  (Just actualChecksum)-                  details-              )+              (ledgerOnlyEvidence (Text.pack filename) timestamp Nothing details)+          Just expected -> do+            bytes <- maybe (Left (CoddSourcePayloadMissing filename)) Right maybeBytes+            let actualChecksum = migrationFingerprint bytes+                actual = checksumText actualChecksum+            if actual /= expected+              then Left (CoddManifestChecksumMismatch filename expected actual)+              else+                first+                  CoddHistoryDefinitionFailed+                  ( sourceManifestVerifiedEvidence+                      (Text.pack filename)+                      timestamp+                      (Just actualChecksum)+                      details+                  )   Right (key, evidence)  rowDetails :: CoddSchemaVersion -> CoddHistoryRow -> Aeson.Value

@@ -1,6 +1,9 @@ module Database.PostgreSQL.Migrate.History.Codd.Ledger   ( readCoddHistory,     withLockedCoddHistory,+    SourceUnlockIssue,+    coddUnlockFailure,+    sourceUnlockCleanupIssue,     readCoddHistoryOnConnection,     classifyCoddSchema,     validateCoddRows,@@ -13,11 +16,13 @@ import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text+import Database.PostgreSQL.Migrate (CleanupIssue (..)) import Database.PostgreSQL.Migrate.History.Codd.Types import Database.PostgreSQL.Migrate.Internal (useConnectionProvider) import Hasql.Connection qualified as Connection import Hasql.Decoders qualified as Decoders import Hasql.Encoders qualified as Encoders+import Hasql.Errors qualified as Errors import Hasql.Session qualified as Session import Hasql.Statement (Statement) import Hasql.Statement qualified as Statement@@ -25,43 +30,61 @@  -- | Read and verify selected legacy rows without mutating source objects. readCoddHistory :: CoddSourceConfig -> IO (Either CoddImportError CoddHistory)-readCoddHistory config = withLockedCoddHistory config (readCoddHistoryOnConnection config)+readCoddHistory config@CoddSourceConfig {sourceLockKey} = do+  (result, unlockIssues) <-+    withLockedCoddHistory config (readCoddHistoryOnConnection config)+  pure $ case (result, unlockIssues) of+    (Left primary, issue : _) -> Left (coddUnlockFailure sourceLockKey (Just primary) issue)+    (Left primary, []) -> Left primary+    (Right _, issue : _) -> Left (coddUnlockFailure sourceLockKey Nothing issue)+    (Right history, []) -> Right history +data SourceUnlockIssue+  = SourceUnlockReturnedFalse+  | SourceUnlockSessionFailed !Errors.SessionError+ withLockedCoddHistory ::   CoddSourceConfig ->   (Connection.Connection -> IO (Either CoddImportError value)) ->-  IO (Either CoddImportError value)+  IO (Either CoddImportError value, [SourceUnlockIssue]) withLockedCoddHistory CoddSourceConfig {sourceProvider, sourceLockKey} action = do   acquired <-     useConnectionProvider sourceProvider $ \connection ->       Exception.mask $ \restore -> do         locked <- runSession connection (Session.statement sourceLockKey tryLockStatement)         case locked of-          Left err -> pure (Left err)-          Right False -> pure (Left (CoddLockUnavailable sourceLockKey))+          Left err -> pure (Left err, [])+          Right False -> pure (Left (CoddLockUnavailable sourceLockKey), [])           Right True -> do-            primary <--              restore (action connection)-                `Exception.onException` releaseIgnoringFailure connection sourceLockKey-            unlocked <- runSession connection (Session.statement sourceLockKey unlockStatement)-            pure $ case unlocked of-              Right True -> primary-              Right False -> Left (CoddUnlockFailed sourceLockKey (either Just (const Nothing) primary) Nothing)-              Left cleanupFailure ->-                Left-                  ( CoddUnlockFailed-                      sourceLockKey-                      (either Just (const Nothing) primary)-                      (Just cleanupFailure)-                  )+            captured <- Exception.try @Exception.SomeException (restore (action connection))+            unlockIssues <- unlockSource connection sourceLockKey+            case captured of+              Left exception -> Exception.throwIO exception+              Right primary -> pure (primary, unlockIssues)   pure $ case acquired of-    Left connectionError -> Left (CoddConnectionFailed connectionError)+    Left connectionError -> (Left (CoddConnectionFailed connectionError), [])     Right result -> result -releaseIgnoringFailure :: Connection.Connection -> Int64 -> IO ()-releaseIgnoringFailure connection lockKey = do-  _ <- Connection.use connection (Session.statement lockKey unlockStatement)-  pure ()+unlockSource :: Connection.Connection -> Int64 -> IO [SourceUnlockIssue]+unlockSource connection lockKey = do+  unlocked <- Connection.use connection (Session.statement lockKey unlockStatement)+  pure $ case unlocked of+    Left sessionError -> [SourceUnlockSessionFailed sessionError]+    Right False -> [SourceUnlockReturnedFalse]+    Right True -> []++coddUnlockFailure :: Int64 -> Maybe CoddImportError -> SourceUnlockIssue -> CoddImportError+coddUnlockFailure lockKey primary unlockIssue =+  case unlockIssue of+    SourceUnlockReturnedFalse -> CoddUnlockFailed lockKey primary Nothing+    SourceUnlockSessionFailed sessionError ->+      CoddUnlockFailed lockKey primary (Just (CoddSessionFailed sessionError))++sourceUnlockCleanupIssue :: SourceUnlockIssue -> CleanupIssue+sourceUnlockCleanupIssue unlockIssue =+  case unlockIssue of+    SourceUnlockReturnedFalse -> AdvisoryUnlockReturnedFalse+    SourceUnlockSessionFailed sessionError -> AdvisoryUnlockFailed sessionError  readCoddHistoryOnConnection ::   CoddSourceConfig ->

@@ -8,7 +8,7 @@ import Database.PostgreSQL.Migrate.History.Codd.Types import PgMigrate.History.Codd.Prelude --- | Parse the exact ordered Codd manifest selection.+-- | Parse expected SHA-256 checksums keyed by Codd source filename. parseCoddManifest :: Text -> Either CoddDefinitionError CoddManifest parseCoddManifest contents =   CoddManifest <$> foldl parseLine (Right Map.empty) (zip [1 ..] (Text.lines contents))

@@ -16,7 +16,7 @@ import PgMigrate.History.Codd.Prelude import Text.Read qualified as Read --- | Build the reusable, target-aware Codd import parser.+-- | Build the reusable Codd import parser; the plan parameter is reserved. coddImportCommandParser :: MigrationPlan -> Parser CoddImportCommand coddImportCommandParser _ =   CoddImportCommand@@ -41,16 +41,24 @@     <*> optional (strOption (long "source-directory" <> metavar "PATH" <> help "Directory containing exact selected Codd SQL payloads"))     <*> switch (long "strict-source" <> help "Reject every unselected source row and unexpected manifest entry")     <*> flag NotConfirmed Confirmed (long "confirm" <> help "Confirm Codd source evidence when SamePayload is mapped")+    <*> switch (long "allow-equivalent" <> help "Opt in to mappings proven by read-only state validators")     <*> flag TextOutput JsonOutput (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 of-        [(parsed, "")] | parsed <= fromIntegral (maxBound :: Int64) -> Right parsed+      case (Numeric.readHex hexadecimal :: [(Integer, String)]) of+        [(parsed, "")] -> checkedInt64 parsed         _ -> Left "expected an Int64 decimal or 0x hexadecimal advisory-lock key"     _ ->-      case Read.readMaybe input of-        Just parsed -> Right parsed+      case (Read.readMaybe input :: Maybe Integer) of+        Just parsed -> checkedInt64 parsed         Nothing -> Left "expected an Int64 decimal or 0x hexadecimal advisory-lock key"+  where+    checkedInt64 parsed+      | parsed < toInteger (minBound :: Int64) = Left rangeError+      | parsed > toInteger (maxBound :: Int64) = Left rangeError+      | otherwise = Right (fromInteger parsed)++    rangeError = "expected an Int64 decimal or 0x hexadecimal advisory-lock key"

@@ -41,7 +41,7 @@     confirmation :: !Confirmation   } --- | Ordered exact source filenames selected for import.+-- | Unordered expected SHA-256 checksums keyed by source filename. newtype CoddManifest = CoddManifest   { manifestChecksums :: Map FilePath Text   }@@ -76,8 +76,7 @@  -- | Invalid source identifiers, manifest, mappings, or adapter options. data CoddDefinitionError-  = EmptyCoddSelection-  | EmptyCoddFilename+  = EmptyCoddFilename   | DuplicateCoddFilename !FilePath   | EmptyCoddImportReason   | InvalidCoddManifestLine !Int@@ -87,6 +86,10 @@   deriving stock (Generic, Eq, Show)  -- | Structured source-read, validation, lock, or target-import failure.+--+-- In 'CoddUnlockFailed', the first optional error is the primary source-read or+-- import failure. The second is the unlock session failure; it is 'Nothing' when+-- @pg_advisory_unlock@ returned false rather than raising a session error. data CoddImportError   = CoddDefinitionFailed !CoddDefinitionError   | CoddConnectionFailed !Errors.ConnectionError@@ -119,6 +122,7 @@     sourceDirectory :: !(Maybe FilePath),     strict :: !Bool,     confirmation :: !Confirmation,+    allowEquivalent :: !Bool,     outputFormat :: !OutputFormat   }   deriving stock (Generic, Eq, Show)

@@ -1,6 +1,7 @@ module Main (main) where  import Control.Exception qualified as Exception+import Data.Aeson qualified as Aeson import Data.ByteString (ByteString) import Data.ByteString qualified as ByteString import Data.Foldable (toList)@@ -45,7 +46,10 @@       testCase "partial and duplicate rows are rejected" (testInvalidRows settings),       testCase "lenient selection reports extras and strict selection rejects them" (testSelection settings),       testCase "legacy lock contention prevents target acquisition" (testLockContention settings),-      testCase "import is audited, action-free, source-preserving, and idempotent" (testImportLifecycle settings)+      testCase "strict source rejects a selected row omitted from the manifest" (testStrictManifestSymmetry settings),+      testCase "import is audited, action-free, source-preserving, and idempotent" (testImportLifecycle settings),+      testCase "source unlock failure preserves the committed import report" (testUnlockFailurePreservesImportReport settings),+      testCase "a partial manifest supports mixed payload and state evidence" (testMixedEvidenceImport settings)     ]  testSupportedFixture :: Settings.Settings -> CoddSchemaVersion -> Assertion@@ -94,6 +98,19 @@       unlocked <- useSession holder (Session.statement defaultCoddLockKey unlockStatement)       unlocked @?= True +testStrictManifestSymmetry :: Settings.Settings -> Assertion+testStrictManifestSymmetry settings =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 selectedFilename)+    result <-+      importCoddHistory+        importOptions+        (strictMissingManifestConfig settings)+        (connectionProviderFromSettings settings)+        targetPlan+        (targetMapping :| [])+    assertCoddError (\case CoddManifestEntryMissing filename -> filename == selectedFilename; _ -> False) result+ testImportLifecycle :: Settings.Settings -> Assertion testImportLifecycle settings =   withCleanSchemas settings $ do@@ -110,6 +127,105 @@     afterSnapshot <- sourceSnapshot settings CoddV5     afterSnapshot @?= before +testUnlockFailurePreservesImportReport :: Settings.Settings -> Assertion+testUnlockFailurePreservesImportReport settings =+  withCleanSchemas settings $ do+    runScript settings unlockingFixtureSql+    report <- runImport settings >>= requireCoddRight+    importOutcomes report @?= [Imported]+    let HistoryImportReport {cleanupIssues = observedCleanupIssues} = report+    observedCleanupIssues @?= [AdvisoryUnlockReturnedFalse]+    facts <- query settings targetFactsStatement+    facts @?= (1, 1, False, True, True)++testMixedEvidenceImport :: Settings.Settings -> Assertion+testMixedEvidenceImport settings =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 mixedSameFilename <> appliedInsertSql CoddV5 mixedEquivalentFilename)+    first <- runMixedImport settings >>= requireCoddRight+    importOutcomes first @?= [Imported, Imported]+    facts <- query settings mixedTargetFactsStatement+    facts @?= (2, 2, False, False)+    second <- runMixedImport settings >>= requireCoddRight+    importOutcomes second @?= [AlreadyImported, AlreadyImported]++runMixedImport :: Settings.Settings -> IO (Either CoddImportError HistoryImportReport)+runMixedImport settings =+  importCoddHistoryWithValidators+    (withEquivalentHistory AllowEquivalentHistory importOptions)+    [mixedStateValidator]+    (mixedSourceConfig settings)+    (connectionProviderFromSettings settings)+    mixedTargetPlan+    mixedMappings++mixedSourceConfig :: Settings.Settings -> CoddSourceConfig+mixedSourceConfig settings =+  expectRight+    ( coddSourceConfig+        (connectionProviderFromSettings settings)+        (mixedSameFilename :| [mixedEquivalentFilename])+        False+        (Map.singleton mixedSameFilename mixedSamePayload)+        (Just mixedManifest)+        "verified mixed-evidence cutover"+        Confirmed+    )++mixedManifest :: CoddManifest+mixedManifest = expectRight (parseCoddManifest (checksumText mixedSamePayload <> " " <> Text.pack mixedSameFilename <> "\n"))++mixedMappings :: NonEmpty HistoryMapping+mixedMappings =+  historyMapping mixedSameTarget (Evidence mixedSameSourceKey) (SamePayload mixedSameSourceKey)+    :| [ historyMapping+           mixedEquivalentTarget+           (AllOf (Evidence mixedEquivalentSourceKey :| [Evidence mixedStateKey]))+           EquivalentState+       ]++mixedStateValidator :: StateValidator+mixedStateValidator = stateValidator mixedStateKey (pure (Right (Aeson.object ["state" Aeson..= ("verified" :: Text)])))++mixedStateKey :: EvidenceKey+mixedStateKey = expectRight (evidenceKey "codd:mixed-equivalent-state")++mixedSameSourceKey :: EvidenceKey+mixedSameSourceKey = expectRight (coddEvidenceKey mixedSameFilename)++mixedEquivalentSourceKey :: EvidenceKey+mixedEquivalentSourceKey = expectRight (coddEvidenceKey mixedEquivalentFilename)++mixedSameTarget :: MigrationId+mixedSameTarget = expectRight (migrationId "codd-target" "0001-mixed-same")++mixedEquivalentTarget :: MigrationId+mixedEquivalentTarget = expectRight (migrationId "codd-target" "0002-mixed-equivalent")++mixedTargetPlan :: MigrationPlan+mixedTargetPlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "codd-target"+                Set.empty+                ( expectRight (sqlMigration "0001-mixed-same" mixedSamePayload)+                    :| [expectRight (sqlMigration "0002-mixed-equivalent" mixedEquivalentPayload)]+                )+            )+            :| []+        )+    )++mixedSameFilename, mixedEquivalentFilename :: FilePath+mixedSameFilename = "20240101000000-mixed-same.sql"+mixedEquivalentFilename = "20240101000001-mixed-equivalent.sql"++mixedSamePayload, mixedEquivalentPayload :: ByteString+mixedSamePayload = "CREATE TABLE pgmigrate_codd_target.mixed_same_should_not_exist (id bigint)"+mixedEquivalentPayload = "CREATE TABLE pgmigrate_codd_target.mixed_equivalent_should_not_exist (id bigint)"+ runImport :: Settings.Settings -> IO (Either CoddImportError HistoryImportReport) runImport settings =   importCoddHistory@@ -145,6 +261,19 @@         Confirmed     ) +strictMissingManifestConfig :: Settings.Settings -> CoddSourceConfig+strictMissingManifestConfig settings =+  expectRight+    ( coddSourceConfig+        (connectionProviderFromSettings settings)+        (selectedFilename :| [])+        True+        Map.empty+        (Just (expectRight (parseCoddManifest "")))+        "strict Codd cutover"+        Confirmed+    )+ targetManifest :: CoddManifest targetManifest = expectRight (parseCoddManifest (checksumText targetPayload <> " " <> Text.pack selectedFilename <> "\n")) @@ -219,6 +348,28 @@   where     required = Decoders.column . Decoders.nonNullable +mixedTargetFactsStatement :: Statement () (Int64, Int64, Bool, Bool)+mixedTargetFactsStatement =+  Statement.unpreparable+    ( Text.unwords+        [ "SELECT (SELECT count(*) FROM " <> targetSchema <> ".migrations),",+          "(SELECT count(*) FROM " <> targetSchema <> ".history_imports),",+          "to_regclass('" <> targetSchema <> ".mixed_same_should_not_exist') IS NOT NULL,",+          "to_regclass('" <> targetSchema <> ".mixed_equivalent_should_not_exist') IS NOT NULL"+        ]+    )+    Encoders.noParams+    ( Decoders.singleRow+        ( (,,,)+            <$> required Decoders.int8+            <*> required Decoders.int8+            <*> required Decoders.bool+            <*> required Decoders.bool+        )+    )+  where+    required = Decoders.column . Decoders.nonNullable+ targetSchemaExistsStatement :: Statement Text Bool targetSchemaExistsStatement =   Statement.preparable@@ -252,6 +403,23 @@         CoddV3 -> ", application_duration interval, num_applied_statements int, no_txn_failed_at timestamptz);"         CoddV4 -> ", application_duration interval, num_applied_statements int, no_txn_failed_at timestamptz, txnid bigint, connid int);"         CoddV5 -> ", application_duration interval, num_applied_statements int, no_txn_failed_at timestamptz, txnid bigint, connid int);"+    ]++unlockingFixtureSql :: Text+unlockingFixtureSql =+  Text.unwords+    [ "CREATE SCHEMA codd;",+      "CREATE VIEW codd.sql_migrations AS SELECT",+      "1::integer AS id,",+      "'2024-01-01 00:00:00+00'::timestamptz AS migration_timestamp,",+      "CASE WHEN pg_advisory_unlock(" <> Text.pack (show defaultCoddLockKey) <> ")",+      "THEN '2024-01-01 00:00:01+00'::timestamptz ELSE NULL::timestamptz END AS applied_at,",+      "'" <> Text.pack selectedFilename <> "'::text AS name,",+      "NULL::interval AS application_duration,",+      "1::integer AS num_applied_statements,",+      "NULL::timestamptz AS no_txn_failed_at,",+      "NULL::bigint AS txnid,",+      "NULL::integer AS connid;"     ]  fixtureSchema :: CoddSchemaVersion -> Text

@@ -22,6 +22,8 @@     "evidence"     [ testCase "manifest-verified payload evidence is constructed" testVerifiedEvidence,       testCase "manifest checksum mismatches are distinct" testManifestMismatch,+      testCase "strict source rejects selected rows missing from the manifest" testStrictManifestMissing,+      testCase "lenient source permits selected rows missing from the manifest" testLenientManifestMissing,       testCase "SamePayload confirmation fails before connection acquisition" testConfirmationPreflight,       testCase "unknown targets fail before connection acquisition" testTargetPreflight     ]@@ -40,6 +42,18 @@     Left (CoddManifestChecksumMismatch "migration.sql" _ actual) -> actual @?= payloadChecksum     result -> assertFailure ("expected manifest mismatch, received: " <> show result) +testStrictManifestMissing :: Assertion+testStrictManifestMissing =+  case buildCoddEvidence (sourceConfigWithStrict True Confirmed (Just emptyManifest)) history of+    Left (CoddManifestEntryMissing "migration.sql") -> pure ()+    result -> assertFailure ("expected missing manifest entry, received: " <> show result)++testLenientManifestMissing :: Assertion+testLenientManifestMissing =+  case buildCoddEvidence (sourceConfigWithStrict False Confirmed (Just emptyManifest)) history of+    Left err -> assertFailure (show err)+    Right evidence -> Map.size evidence @?= 1+ testConfirmationPreflight :: Assertion testConfirmationPreflight = do   let key = expectRight (coddEvidenceKey "migration.sql")@@ -75,12 +89,15 @@     other -> assertFailure ("expected target preflight failure, received: " <> show other)  sourceConfig :: Confirmation -> Maybe CoddManifest -> CoddSourceConfig-sourceConfig confirmation manifest =+sourceConfig = sourceConfigWithStrict False++sourceConfigWithStrict :: Bool -> Confirmation -> Maybe CoddManifest -> CoddSourceConfig+sourceConfigWithStrict strict confirmation manifest =   expectRight     ( coddSourceConfig         unusedProvider         ("migration.sql" :| [])-        False+        strict         (Map.singleton "migration.sql" payload)         manifest         "fixture import"@@ -89,6 +106,9 @@  matchingManifest :: CoddManifest matchingManifest = expectRight (parseCoddManifest (payloadChecksum <> " migration.sql\n"))++emptyManifest :: CoddManifest+emptyManifest = expectRight (parseCoddManifest "")  history :: CoddHistory history =

@@ -1,6 +1,7 @@ module Test.Parser (tests) where  import Data.ByteString.Char8 qualified as ByteString+import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..)) import Data.Set qualified as Set import Database.PostgreSQL.Migrate@@ -15,7 +16,12 @@   testGroup     "parser"     [ testCase "parser records explicit artifacts without reading them" testCommand,-      testCase "invalid lock keys fail in the parser" testInvalidLock+      testCase "invalid lock keys fail in the parser" (assertLockFailure "nope"),+      testCase "accepts 0x7FFFFFFFFFFFFFFF" (lockKeyFor "0x7FFFFFFFFFFFFFFF" @?= maxBound),+      testCase "accepts negative decimal advisory-lock keys" (lockKeyFor "-1" @?= -1),+      testCase "rejects 0x8000000000000000" (assertLockFailure "0x8000000000000000"),+      testCase "rejects 0xFFFFFFFFFFFFFFFF (wrap guard)" (assertLockFailure "0xFFFFFFFFFFFFFFFF"),+      testCase "rejects out-of-range decimal" (assertLockFailure "18446744073709551615")     ]  testCommand :: Assertion@@ -31,6 +37,7 @@       "migrations",       "--strict-source",       "--confirm",+      "--allow-equivalent",       "--json"     ] of     CoddImportCommand@@ -40,6 +47,7 @@         sourceDirectory,         strict,         confirmation,+        allowEquivalent,         outputFormat       } -> do         lockKey @?= defaultCoddLockKey@@ -48,11 +56,15 @@         sourceDirectory @?= Just "migrations"         strict @?= True         confirmation @?= Confirmed+        allowEquivalent @?= True         outputFormat @?= JsonOutput -testInvalidLock :: Assertion-testInvalidLock =-  case execParserPure defaultPrefs commandInfo ["--source-lock-key", "nope", "--mapping", "map.json"] of+lockKeyFor :: String -> Int64+lockKeyFor input = lockKey (parseSuccess ["--source-lock-key", input, "--mapping", "map.json"])++assertLockFailure :: String -> Assertion+assertLockFailure input =+  case execParserPure defaultPrefs commandInfo ["--source-lock-key", input, "--mapping", "map.json"] of     Failure _ -> pure ()     result -> assertFailure ("expected parser failure, received: " <> show result)