packages feed

pg-migrate-import-codd (empty) → 1.0.0.0

raw patch · 16 files changed

+1512/−0 lines, 16 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, hasql, optparse-applicative, pg-migrate, pg-migrate-cli, pg-migrate-import-codd, tasty, tasty-hunit, text, time

Files

+ CHANGELOG.md view
@@ -0,0 +1,6 @@+# Changelog++## 1.0.0.0 — 2026-07-10++- Initial stable release of the Hasql-only Codd V1–V5 history adapter with source-first+  locking, manifest evidence, and action-free generic import.
+ pg-migrate-import-codd.cabal view
@@ -0,0 +1,91 @@+cabal-version:   3.8+name:            pg-migrate-import-codd+version:         1.0.0.0+synopsis:        Import Codd migration history into pg-migrate+category:        Database+maintainer:      nadeem@gmail.com+description:+  Reads supported Codd ledger shapes with Hasql, validates selected source+  evidence, and delegates target writes to pg-migrate's generic importer.++license:         BSD-3-Clause+build-type:      Simple+extra-doc-files: CHANGELOG.md++common common+  default-language:   GHC2024+  default-extensions:+    DeriveAnyClass+    DuplicateRecordFields+    MultilineStrings+    OverloadedLabels+    OverloadedStrings++  ghc-options:        -Wall -Wcompat++library+  import:          common+  hs-source-dirs:  src+  exposed-modules:+    Database.PostgreSQL.Migrate.History.Codd+    Database.PostgreSQL.Migrate.History.Codd.Internal+    PgMigrate.History.Codd.Prelude++  other-modules:+    Database.PostgreSQL.Migrate.History.Codd.Import+    Database.PostgreSQL.Migrate.History.Codd.Ledger+    Database.PostgreSQL.Migrate.History.Codd.Manifest+    Database.PostgreSQL.Migrate.History.Codd.Parser+    Database.PostgreSQL.Migrate.History.Codd.Types++  build-depends:+    , aeson                 >=2.2  && <2.3+    , base                  >=4.20 && <4.22+    , bytestring            >=0.12 && <0.13+    , 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+    , text                  >=2.1  && <2.2+    , time                  >=1.12 && <1.15++test-suite pg-migrate-import-codd-test+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: test/unit+  main-is:        Main.hs+  other-modules:+    Test.Evidence+    Test.Ledger+    Test.Manifest+    Test.Parser++  build-depends:+    , base                    >=4.20 && <4.22+    , bytestring              >=0.12 && <0.13+    , containers              >=0.7  && <0.8+    , optparse-applicative    >=0.19 && <0.20+    , pg-migrate+    , pg-migrate-cli+    , pg-migrate-import-codd+    , tasty                   >=1.5  && <1.6+    , tasty-hunit             >=0.10 && <0.11+    , text                    >=2.1  && <2.2+    , time                    >=1.12 && <1.15++test-suite pg-migrate-import-codd-integration+  import:         common+  type:           exitcode-stdio-1.0+  hs-source-dirs: test/integration+  main-is:        Main.hs+  build-depends:+    , base                    >=4.20 && <4.22+    , bytestring              >=0.12 && <0.13+    , containers              >=0.7  && <0.8+    , hasql                   >=1.10 && <1.11+    , pg-migrate+    , pg-migrate-import-codd+    , tasty                   >=1.5  && <1.6+    , tasty-hunit             >=0.10 && <0.11+    , text                    >=2.1  && <2.2
+ src/Database/PostgreSQL/Migrate/History/Codd.hs view
@@ -0,0 +1,27 @@+-- | Hasql-only reader and importer for exact Codd V1–V5 ledger shapes. Source objects are+-- read under the configured cooperating legacy lock and are never modified.+module Database.PostgreSQL.Migrate.History.Codd+  ( CoddSourceConfig,+    CoddManifest,+    CoddSchemaVersion (..),+    CoddHistoryRow (..),+    CoddHistory (..),+    CoddDefinitionError (..),+    CoddImportError (..),+    CoddImportCommand (..),+    defaultCoddLockKey,+    coddSourceConfig,+    withCoddLockKey,+    coddEvidenceKey,+    parseCoddManifest,+    readCoddHistory,+    importCoddHistory,+    coddImportCommandParser,+  )+where++import Database.PostgreSQL.Migrate.History.Codd.Import (importCoddHistory)+import Database.PostgreSQL.Migrate.History.Codd.Ledger (readCoddHistory)+import Database.PostgreSQL.Migrate.History.Codd.Manifest (parseCoddManifest)+import Database.PostgreSQL.Migrate.History.Codd.Parser (coddImportCommandParser)+import Database.PostgreSQL.Migrate.History.Codd.Types
+ src/Database/PostgreSQL/Migrate/History/Codd/Import.hs view
@@ -0,0 +1,173 @@+module Database.PostgreSQL.Migrate.History.Codd.Import+  ( importCoddHistory,+    buildCoddEvidence,+  )+where++import Data.Aeson qualified as Aeson+import Data.Bifunctor (first)+import Data.ByteString qualified as ByteString+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.History.Codd.Ledger+  ( readCoddHistoryOnConnection,+    withLockedCoddHistory,+  )+import Database.PostgreSQL.Migrate.History.Codd.Types+import Database.PostgreSQL.Migrate.Internal (migrationChecksumBytes)+import Numeric qualified+import PgMigrate.History.Codd.Prelude++-- | Read Codd under its source lock, then atomically import target metadata.+importCoddHistory ::+  ImportOptions ->+  CoddSourceConfig ->+  ConnectionProvider ->+  MigrationPlan ->+  NonEmpty HistoryMapping ->+  IO (Either CoddImportError HistoryImportReport)+importCoddHistory options config targetProvider plan mappings =+  case validateImportDefinition config 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)++validateImportDefinition ::+  CoddSourceConfig ->+  MigrationPlan ->+  NonEmpty HistoryMapping ->+  Either CoddImportError ()+validateImportDefinition config@CoddSourceConfig {selectedFilenames, confirmation, sourceManifest} plan mappings = do+  if any isSamePayload mappings && confirmation /= Confirmed+    then Left CoddConfirmationRequired+    else pure ()+  if any isSamePayload mappings && sourceManifest == Nothing+    then Left CoddSamePayloadRequiresManifest+    else pure ()+  placeholderEvidence <- buildPlaceholderEvidence selectedFilenames+  case historyImport "codd" placeholderEvidence [] mappings (importReason config) of+    Left err -> Left (CoddHistoryDefinitionFailed err)+    Right _ -> Right ()+  first+    (CoddTargetImportFailed . HistoryImportValidationFailed)+    (validateHistoryMappingTargets plan mappings)+  where+    isSamePayload mapping =+      case historyMappingPayloadRelation mapping of+        SamePayload _ -> True+        EquivalentState -> False++buildPlaceholderEvidence ::+  NonEmpty FilePath ->+  Either CoddImportError (Map EvidenceKey ImportEvidence)+buildPlaceholderEvidence filenames =+  Map.fromList . toList <$> traverse placeholder filenames+  where+    placeholder filename = do+      key <- first CoddDefinitionFailed (coddEvidenceKey filename)+      evidence <-+        first+          CoddHistoryDefinitionFailed+          (ledgerOnlyEvidence (Text.pack filename) Nothing Nothing Aeson.Null)+      Right (key, evidence)++buildHistoryImport ::+  CoddSourceConfig ->+  CoddHistory ->+  NonEmpty HistoryMapping ->+  Either CoddImportError HistoryImport+buildHistoryImport config history mappings = do+  evidence <- buildCoddEvidence config history+  first+    CoddHistoryDefinitionFailed+    (historyImport "codd" evidence [] mappings (importReason config))++buildCoddEvidence ::+  CoddSourceConfig ->+  CoddHistory ->+  Either CoddImportError (Map EvidenceKey ImportEvidence)+buildCoddEvidence config@CoddSourceConfig {strictSource, sourceManifest} CoddHistory {schemaVersion, selectedRows} = do+  case sourceManifest of+    Just (CoddManifest manifest)+      | strictSource ->+          let selected = Set.fromList (filename <$> toList selectedRows)+              extras = Set.toAscList (Map.keysSet manifest `Set.difference` selected)+           in if null extras then Right () else Left (CoddManifestHasUnexpected extras)+    _ -> Right ()+  Map.fromList . toList <$> traverse (rowEvidence config schemaVersion) selectedRows++rowEvidence ::+  CoddSourceConfig ->+  CoddSchemaVersion ->+  CoddHistoryRow ->+  Either CoddImportError (EvidenceKey, ImportEvidence)+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 <-+    case sourceManifest of+      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+            first+              CoddHistoryDefinitionFailed+              ( sourceManifestVerifiedEvidence+                  (Text.pack filename)+                  timestamp+                  (Just actualChecksum)+                  details+              )+  Right (key, evidence)++rowDetails :: CoddSchemaVersion -> CoddHistoryRow -> Aeson.Value+rowDetails version CoddHistoryRow {filename, migrationTimestamp, appliedAt, numAppliedStatements, noTransactionFailedAt} =+  Aeson.object+    [ "adapter" Aeson..= ("codd" :: Text),+      "schemaVersion" Aeson..= schemaVersionText version,+      "filename" Aeson..= filename,+      "migrationTimestamp" Aeson..= migrationTimestamp,+      "appliedAt" Aeson..= appliedAt,+      "numAppliedStatements" Aeson..= numAppliedStatements,+      "noTransactionFailedAt" Aeson..= noTransactionFailedAt+    ]++schemaVersionText :: CoddSchemaVersion -> Text+schemaVersionText version =+  case version of+    CoddV1 -> "v1"+    CoddV2 -> "v2"+    CoddV3 -> "v3"+    CoddV4 -> "v4"+    CoddV5 -> "v5"++checksumText :: MigrationChecksum -> Text+checksumText =+  Text.pack . concatMap renderByte . ByteString.unpack . migrationChecksumBytes+  where+    renderByte byte =+      case Numeric.showHex byte "" of+        [digit] -> ['0', digit]+        digits -> digits
+ src/Database/PostgreSQL/Migrate/History/Codd/Internal.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_HADDOCK hide #-}++module Database.PostgreSQL.Migrate.History.Codd.Internal+  ( classifyCoddSchema,+    buildCoddEvidence,+    validateCoddRows,+  )+where++import Database.PostgreSQL.Migrate.History.Codd.Import (buildCoddEvidence)+import Database.PostgreSQL.Migrate.History.Codd.Ledger+  ( classifyCoddSchema,+    validateCoddRows,+  )
+ src/Database/PostgreSQL/Migrate/History/Codd/Ledger.hs view
@@ -0,0 +1,187 @@+module Database.PostgreSQL.Migrate.History.Codd.Ledger+  ( readCoddHistory,+    withLockedCoddHistory,+    readCoddHistoryOnConnection,+    classifyCoddSchema,+    validateCoddRows,+  )+where++import Control.Exception qualified as Exception+import Data.Bifunctor (first)+import Data.List qualified as List+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text qualified as Text+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.Session qualified as Session+import Hasql.Statement (Statement)+import Hasql.Statement qualified as Statement+import PgMigrate.History.Codd.Prelude++-- | Read and verify selected legacy rows without mutating source objects.+readCoddHistory :: CoddSourceConfig -> IO (Either CoddImportError CoddHistory)+readCoddHistory config = withLockedCoddHistory config (readCoddHistoryOnConnection config)++withLockedCoddHistory ::+  CoddSourceConfig ->+  (Connection.Connection -> IO (Either CoddImportError value)) ->+  IO (Either CoddImportError value)+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))+          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)+                  )+  pure $ case acquired of+    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 ()++readCoddHistoryOnConnection ::+  CoddSourceConfig ->+  Connection.Connection ->+  IO (Either CoddImportError CoddHistory)+readCoddHistoryOnConnection config connection = do+  detected <- runSession connection (Session.statement () detectColumnsStatement)+  case detected >>= classifyCoddSchema of+    Left err -> pure (Left err)+    Right (version, schemaName) -> do+      loaded <- runSession connection (Session.statement () (loadRowsStatement version schemaName))+      pure (loaded >>= validateCoddRows config version)++classifyCoddSchema :: [(Text, Text)] -> Either CoddImportError (CoddSchemaVersion, Text)+classifyCoddSchema qualifiedColumns =+  case (Map.lookup "codd_schema" grouped, Map.lookup "codd" grouped) of+    (Nothing, Nothing) -> Left CoddLedgerMissing+    (Just _, Just _) -> Left CoddBothSchemasPresent+    (Just columns, Nothing) -> classifyLegacy columns+    (Nothing, Just columns)+      | columns == v4Columns -> Right (CoddV5, "codd")+      | otherwise -> Left (CoddUnsupportedShape "codd" columns)+  where+    grouped = Map.fromListWith (flip (<>)) [(schema, [column]) | (schema, column) <- qualifiedColumns]+    classifyLegacy columns+      | columns == v1Columns = Right (CoddV1, "codd_schema")+      | columns == v2Columns = Right (CoddV2, "codd_schema")+      | columns == v3Columns = Right (CoddV3, "codd_schema")+      | columns == v4Columns = Right (CoddV4, "codd_schema")+      | otherwise = Left (CoddUnsupportedShape "codd_schema" columns)++validateCoddRows ::+  CoddSourceConfig ->+  CoddSchemaVersion ->+  [CoddHistoryRow] ->+  Either CoddImportError CoddHistory+validateCoddRows CoddSourceConfig {selectedFilenames, strictSource} version rows = do+  case firstDuplicate (filename <$> rows) of+    Just duplicate -> Left (CoddDuplicateLedgerFilename duplicate)+    Nothing -> pure ()+  case List.find (\row -> isJust (noTransactionFailedAt row) || appliedAt row == Nothing) rows of+    Just partial -> Left (CoddPartialMigration (filename partial))+    Nothing -> pure ()+  selected <- traverse selectRow selectedFilenames+  let selectedSet = Set.fromList (toList selectedFilenames)+      unselectedRows = filter ((`Set.notMember` selectedSet) . filename) rows+  if strictSource && not (null unselectedRows)+    then Left (CoddStrictSourceHasUnselected (filename <$> unselectedRows))+    else Right CoddHistory {schemaVersion = version, selectedRows = selected, unselectedRows}+  where+    rowsByFilename = Map.fromList [(filename row, row) | row <- rows]+    selectRow selected =+      maybe (Left (CoddSelectedFilenameMissing selected)) Right (Map.lookup selected rowsByFilename)++firstDuplicate :: (Ord value) => [value] -> Maybe value+firstDuplicate = go Set.empty+  where+    go _ [] = Nothing+    go seen (value : rest)+      | Set.member value seen = Just value+      | otherwise = go (Set.insert value seen) rest++detectColumnsStatement :: Statement () [(Text, Text)]+detectColumnsStatement =+  Statement.preparable+    "SELECT n.nspname::text, a.attname::text FROM pg_catalog.pg_attribute a JOIN pg_catalog.pg_class c ON a.attrelid = c.oid JOIN pg_catalog.pg_namespace n ON c.relnamespace = n.oid WHERE c.relname = 'sql_migrations' AND n.nspname IN ('codd_schema', 'codd') AND a.attnum >= 1 AND NOT a.attisdropped ORDER BY n.nspname, a.attnum"+    Encoders.noParams+    (Decoders.rowList ((,) <$> required Decoders.text <*> required Decoders.text))+  where+    required = Decoders.column . Decoders.nonNullable++loadRowsStatement :: CoddSchemaVersion -> Text -> Statement () [CoddHistoryRow]+loadRowsStatement version schemaName =+  Statement.unpreparable+    ( Text.unwords+        [ "SELECT name, migration_timestamp, applied_at,",+          if version >= CoddV3 then "COALESCE(num_applied_statements, 0)::int4," else "0::int4,",+          if version >= CoddV3 then "no_txn_failed_at" else "NULL::timestamptz",+          "FROM " <> schemaName <> ".sql_migrations ORDER BY id"+        ]+    )+    Encoders.noParams+    (Decoders.rowList rowDecoder)+  where+    rowDecoder =+      CoddHistoryRow+        <$> (Text.unpack <$> required Decoders.text)+        <*> required Decoders.timestamptz+        <*> nullableColumn Decoders.timestamptz+        <*> required Decoders.int4+        <*> nullableColumn Decoders.timestamptz+    required = Decoders.column . Decoders.nonNullable+    nullableColumn = Decoders.column . Decoders.nullable++tryLockStatement :: Statement Int64 Bool+tryLockStatement =+  Statement.preparable+    "SELECT pg_try_advisory_lock($1)"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++unlockStatement :: Statement Int64 Bool+unlockStatement =+  Statement.preparable+    "SELECT pg_advisory_unlock($1)"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++runSession :: Connection.Connection -> Session.Session value -> IO (Either CoddImportError value)+runSession connection session =+  first CoddSessionFailed <$> Connection.use connection session++v1Columns :: [Text]+v1Columns = ["id", "migration_timestamp", "applied_at", "name"]++v2Columns :: [Text]+v2Columns = v1Columns <> ["application_duration"]++v3Columns :: [Text]+v3Columns = v2Columns <> ["num_applied_statements", "no_txn_failed_at"]++v4Columns :: [Text]+v4Columns = v3Columns <> ["txnid", "connid"]
+ src/Database/PostgreSQL/Migrate/History/Codd/Manifest.hs view
@@ -0,0 +1,34 @@+module Database.PostgreSQL.Migrate.History.Codd.Manifest+  ( parseCoddManifest,+  )+where++import Data.Map.Strict qualified as Map+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate.History.Codd.Types+import PgMigrate.History.Codd.Prelude++-- | Parse the exact ordered Codd manifest selection.+parseCoddManifest :: Text -> Either CoddDefinitionError CoddManifest+parseCoddManifest contents =+  CoddManifest <$> foldl parseLine (Right Map.empty) (zip [1 ..] (Text.lines contents))+  where+    parseLine accumulated (lineNumber, line) = do+      entries <- accumulated+      case Text.words line of+        [checksum, filenameText]+          | validChecksum checksum ->+              let filename = Text.unpack filenameText+               in if null filename+                    then Left (InvalidCoddManifestLine lineNumber)+                    else+                      if Map.member filename entries+                        then Left (DuplicateCoddManifestFilename filename)+                        else Right (Map.insert filename checksum entries)+          | otherwise -> Left (InvalidCoddManifestChecksum lineNumber checksum)+        _ -> Left (InvalidCoddManifestLine lineNumber)++validChecksum :: Text -> Bool+validChecksum checksum =+  Text.length checksum == 64+    && Text.all (\character -> (character >= '0' && character <= '9') || character `elem` ['a' .. 'f']) checksum
+ src/Database/PostgreSQL/Migrate/History/Codd/Parser.hs view
@@ -0,0 +1,56 @@+module Database.PostgreSQL.Migrate.History.Codd.Parser+  ( coddImportCommandParser,+  )+where++import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+  ( Confirmation (..),+    MigrationPlan,+  )+import Database.PostgreSQL.Migrate.CLI (OutputFormat (..))+import Database.PostgreSQL.Migrate.History.Codd.Types+import Hasql.Connection.Settings qualified as Settings+import Numeric qualified+import Options.Applicative+import PgMigrate.History.Codd.Prelude+import Text.Read qualified as Read++-- | Build the reusable, target-aware Codd import parser.+coddImportCommandParser :: MigrationPlan -> Parser CoddImportCommand+coddImportCommandParser _ =+  CoddImportCommand+    <$> parserOptionGroup+      "Connection"+      ( optional+          ( option+              (Settings.connectionString . Text.pack <$> str)+              (long "source-database-url" <> metavar "URL" <> help "Codd source connection string; no environment variable is read")+          )+      )+    <*> option+      lockKeyReader+      ( long "source-lock-key"+          <> metavar "INT64"+          <> value defaultCoddLockKey+          <> showDefault+          <> help "Cooperating legacy wrapper advisory-lock key (decimal or 0x hexadecimal)"+      )+    <*> strOption (long "mapping" <> metavar "PATH" <> help "Checked-in source-to-target mapping artifact")+    <*> optional (strOption (long "manifest" <> metavar "PATH" <> help "Optional lowercase SHA-256 migrations.lock evidence"))+    <*> 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")+    <*> 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+        _ -> Left "expected an Int64 decimal or 0x hexadecimal advisory-lock key"+    _ ->+      case Read.readMaybe input of+        Just parsed -> Right parsed+        Nothing -> Left "expected an Int64 decimal or 0x hexadecimal advisory-lock key"
+ src/Database/PostgreSQL/Migrate/History/Codd/Types.hs view
@@ -0,0 +1,178 @@+module Database.PostgreSQL.Migrate.History.Codd.Types+  ( CoddSourceConfig (..),+    CoddManifest (..),+    CoddSchemaVersion (..),+    CoddHistoryRow (..),+    CoddHistory (..),+    CoddDefinitionError (..),+    CoddImportError (..),+    CoddImportCommand (..),+    defaultCoddLockKey,+    coddSourceConfig,+    withCoddLockKey,+    coddEvidenceKey,+  )+where++import Data.Set qualified as Set+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+  ( Confirmation,+    ConnectionProvider,+    EvidenceKey,+    HistoryDefinitionError,+    HistoryImportError,+    evidenceKey,+  )+import Database.PostgreSQL.Migrate.CLI (OutputFormat)+import Hasql.Connection.Settings qualified as Settings+import Hasql.Errors qualified as Errors+import PgMigrate.History.Codd.Prelude++-- | Validated source connection, ledger names, manifest, and cooperating lock.+data CoddSourceConfig = CoddSourceConfig+  { sourceProvider :: !ConnectionProvider,+    sourceLockKey :: !Int64,+    selectedFilenames :: !(NonEmpty FilePath),+    strictSource :: !Bool,+    sourcePayloads :: !(Map FilePath ByteString),+    sourceManifest :: !(Maybe CoddManifest),+    importReason :: !Text,+    confirmation :: !Confirmation+  }++-- | Ordered exact source filenames selected for import.+newtype CoddManifest = CoddManifest+  { manifestChecksums :: Map FilePath Text+  }+  deriving stock (Generic, Eq, Show)++-- | Recognized Codd ledger shape from V1 through V5.+data CoddSchemaVersion+  = CoddV1+  | CoddV2+  | CoddV3+  | CoddV4+  | CoddV5+  deriving stock (Generic, Eq, Ord, Show)++-- | Normalized immutable row read from a supported Codd ledger.+data CoddHistoryRow = CoddHistoryRow+  { filename :: !FilePath,+    migrationTimestamp :: !UTCTime,+    appliedAt :: !(Maybe UTCTime),+    numAppliedStatements :: !Int32,+    noTransactionFailedAt :: !(Maybe UTCTime)+  }+  deriving stock (Generic, Eq, Show)++-- | Selected rows, schema shape, evidence, and unselected extras.+data CoddHistory = CoddHistory+  { schemaVersion :: !CoddSchemaVersion,+    selectedRows :: !(NonEmpty CoddHistoryRow),+    unselectedRows :: ![CoddHistoryRow]+  }+  deriving stock (Generic, Eq, Show)++-- | Invalid source identifiers, manifest, mappings, or adapter options.+data CoddDefinitionError+  = EmptyCoddSelection+  | EmptyCoddFilename+  | DuplicateCoddFilename !FilePath+  | EmptyCoddImportReason+  | InvalidCoddManifestLine !Int+  | InvalidCoddManifestChecksum !Int !Text+  | DuplicateCoddManifestFilename !FilePath+  | CoddEvidenceDefinitionError !HistoryDefinitionError+  deriving stock (Generic, Eq, Show)++-- | Structured source-read, validation, lock, or target-import failure.+data CoddImportError+  = CoddDefinitionFailed !CoddDefinitionError+  | CoddConnectionFailed !Errors.ConnectionError+  | CoddSessionFailed !Errors.SessionError+  | CoddLockUnavailable !Int64+  | CoddUnlockFailed !Int64 !(Maybe CoddImportError) !(Maybe CoddImportError)+  | CoddLedgerMissing+  | CoddBothSchemasPresent+  | CoddUnsupportedShape !Text ![Text]+  | CoddDuplicateLedgerFilename !FilePath+  | CoddSelectedFilenameMissing !FilePath+  | CoddPartialMigration !FilePath+  | CoddStrictSourceHasUnselected ![FilePath]+  | CoddManifestEntryMissing !FilePath+  | CoddManifestHasUnexpected ![FilePath]+  | CoddSourcePayloadMissing !FilePath+  | CoddManifestChecksumMismatch !FilePath !Text !Text+  | CoddConfirmationRequired+  | CoddSamePayloadRequiresManifest+  | CoddHistoryDefinitionFailed !HistoryDefinitionError+  | CoddTargetImportFailed !HistoryImportError+  deriving stock (Generic, Show)++-- | Parsed, application-dispatchable Codd import command.+data CoddImportCommand = CoddImportCommand+  { sourceSettings :: !(Maybe Settings.Settings),+    lockKey :: !Int64,+    mappingPath :: !FilePath,+    manifestPath :: !(Maybe FilePath),+    sourceDirectory :: !(Maybe FilePath),+    strict :: !Bool,+    confirmation :: !Confirmation,+    outputFormat :: !OutputFormat+  }+  deriving stock (Generic, Eq, Show)++-- | Default advisory lock used to cooperate with Codd writers.+defaultCoddLockKey :: Int64+defaultCoddLockKey = 0x6B69726F6B754D67++-- | Validate a complete Codd source configuration.+coddSourceConfig ::+  ConnectionProvider ->+  NonEmpty FilePath ->+  Bool ->+  Map FilePath ByteString ->+  Maybe CoddManifest ->+  Text ->+  Confirmation ->+  Either CoddDefinitionError CoddSourceConfig+coddSourceConfig sourceProvider selectedFilenames strictSource sourcePayloads sourceManifest importReason confirmation = do+  let filenames = toList selectedFilenames+  case findDuplicate filenames of+    Just duplicate -> Left (DuplicateCoddFilename duplicate)+    Nothing -> pure ()+  if any null filenames then Left EmptyCoddFilename else pure ()+  if Text.null (Text.strip importReason) then Left EmptyCoddImportReason else pure ()+  pure+    CoddSourceConfig+      { sourceProvider,+        sourceLockKey = defaultCoddLockKey,+        selectedFilenames,+        strictSource,+        sourcePayloads,+        sourceManifest,+        importReason,+        confirmation+      }++-- | Override the cooperating source advisory lock key.+withCoddLockKey :: Int64 -> CoddSourceConfig -> CoddSourceConfig+withCoddLockKey sourceLockKey config = config {sourceLockKey}++-- | Derive the canonical evidence key for one manifest filename.+coddEvidenceKey :: FilePath -> Either CoddDefinitionError EvidenceKey+coddEvidenceKey filename+  | null filename = Left EmptyCoddFilename+  | otherwise =+      case evidenceKey ("codd:" <> Text.pack filename) of+        Left err -> Left (CoddEvidenceDefinitionError err)+        Right key -> Right key++findDuplicate :: (Ord value) => [value] -> Maybe value+findDuplicate = go Set.empty+  where+    go _ [] = Nothing+    go seen (value : remaining)+      | Set.member value seen = Just value+      | otherwise = go (Set.insert value seen) remaining
+ src/PgMigrate/History/Codd/Prelude.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_HADDOCK hide #-}++module PgMigrate.History.Codd.Prelude+  ( module X,+  )+where++import "base" Control.Applicative as X (Alternative (..), optional)+import "base" Data.Foldable as X (toList, traverse_)+import "base" Data.Int as X (Int32, Int64)+import "base" Data.List.NonEmpty as X (NonEmpty (..))+import "base" Data.Maybe as X (isJust)+import "base" GHC.Generics as X (Generic)+import "bytestring" Data.ByteString as X (ByteString)+import "containers" Data.Map.Strict as X (Map)+import "containers" Data.Set as X (Set)+import "text" Data.Text as X (Text)+import "time" Data.Time as X (UTCTime)+import "base" Prelude as X
+ test/integration/Main.hs view
@@ -0,0 +1,333 @@+module Main (main) where++import Control.Exception qualified as Exception+import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.Foldable (toList)+import Data.Int (Int64)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.History.Codd+import Database.PostgreSQL.Migrate.Internal (migrationChecksumBytes)+import Hasql.Connection qualified as Connection+import Hasql.Connection.Settings qualified as Settings+import Hasql.Decoders qualified as Decoders+import Hasql.Encoders qualified as Encoders+import Hasql.Session qualified as Session+import Hasql.Statement (Statement)+import Hasql.Statement qualified as Statement+import Numeric qualified+import System.Environment (lookupEnv)+import Test.Tasty+import Test.Tasty.HUnit++main :: IO ()+main = do+  maybeConnectionString <- lookupEnv "PG_CONNECTION_STRING"+  case maybeConnectionString of+    Nothing -> putStrLn "pg-migrate-import-codd integration tests skipped: PG_CONNECTION_STRING is not set"+    Just connectionString ->+      defaultMain (tests (Settings.connectionString (Text.pack connectionString)))++tests :: Settings.Settings -> TestTree+tests settings =+  testGroup+    "Codd adapter PostgreSQL"+    [ testGroup+        "supported fixtures"+        [ testCase (show version <> " reads without source mutation") (testSupportedFixture settings version)+        | version <- [CoddV1, CoddV2, CoddV3, CoddV4, CoddV5]+        ],+      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)+    ]++testSupportedFixture :: Settings.Settings -> CoddSchemaVersion -> Assertion+testSupportedFixture settings version =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql version <> appliedInsertSql version selectedFilename)+    before <- sourceSnapshot settings version+    history <- readCoddHistory (sourceConfig settings False (selectedFilename :| [])) >>= requireCoddRight+    schemaVersion history @?= version+    (filename <$> toList (selectedRows history)) @?= [selectedFilename]+    unselectedRows history @?= []+    afterSnapshot <- sourceSnapshot settings version+    afterSnapshot @?= before++testInvalidRows :: Settings.Settings -> Assertion+testInvalidRows settings = do+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV3 <> partialInsertSql "partial.sql")+    readCoddHistory (sourceConfig settings False ("partial.sql" :| []))+      >>= assertCoddError (\case CoddPartialMigration "partial.sql" -> True; _ -> False)+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 "duplicate.sql" <> appliedInsertSql CoddV5 "duplicate.sql")+    readCoddHistory (sourceConfig settings False ("duplicate.sql" :| []))+      >>= assertCoddError (\case CoddDuplicateLedgerFilename "duplicate.sql" -> True; _ -> False)++testSelection :: Settings.Settings -> Assertion+testSelection settings =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 selectedFilename <> appliedInsertSql CoddV5 "unselected.sql")+    history <- readCoddHistory (sourceConfig settings False (selectedFilename :| [])) >>= requireCoddRight+    (filename <$> unselectedRows history) @?= ["unselected.sql"]+    readCoddHistory (sourceConfig settings True (selectedFilename :| []))+      >>= assertCoddError (\case CoddStrictSourceHasUnselected ["unselected.sql"] -> True; _ -> False)++testLockContention :: Settings.Settings -> Assertion+testLockContention settings =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 selectedFilename)+    withConnection settings $ \holder -> do+      locked <- useSession holder (Session.statement defaultCoddLockKey tryLockStatement)+      locked @?= True+      result <- runImport settings+      assertCoddError (\case CoddLockUnavailable key -> key == defaultCoddLockKey; _ -> False) result+      targetExists <- useSession holder (Session.statement targetSchema targetSchemaExistsStatement)+      targetExists @?= False+      unlocked <- useSession holder (Session.statement defaultCoddLockKey unlockStatement)+      unlocked @?= True++testImportLifecycle :: Settings.Settings -> Assertion+testImportLifecycle settings =+  withCleanSchemas settings $ do+    runScript settings (fixtureSql CoddV5 <> appliedInsertSql CoddV5 selectedFilename)+    before <- sourceSnapshot settings CoddV5+    first <- runImport settings >>= requireCoddRight+    importOutcomes first @?= [Imported]+    facts <- query settings targetFactsStatement+    facts @?= (1, 1, False, True, True)+    second <- runImport settings >>= requireCoddRight+    importOutcomes second @?= [AlreadyImported]+    repeatedFacts <- query settings targetFactsStatement+    repeatedFacts @?= facts+    afterSnapshot <- sourceSnapshot settings CoddV5+    afterSnapshot @?= before++runImport :: Settings.Settings -> IO (Either CoddImportError HistoryImportReport)+runImport settings =+  importCoddHistory+    importOptions+    (sourceConfigWithEvidence settings)+    (connectionProviderFromSettings settings)+    targetPlan+    (targetMapping :| [])++sourceConfig :: Settings.Settings -> Bool -> NonEmpty FilePath -> CoddSourceConfig+sourceConfig settings strict filenames =+  expectRight+    ( coddSourceConfig+        (connectionProviderFromSettings settings)+        filenames+        strict+        Map.empty+        Nothing+        "Codd fixture import"+        NotConfirmed+    )++sourceConfigWithEvidence :: Settings.Settings -> CoddSourceConfig+sourceConfigWithEvidence settings =+  expectRight+    ( coddSourceConfig+        (connectionProviderFromSettings settings)+        (selectedFilename :| [])+        False+        (Map.singleton selectedFilename targetPayload)+        (Just targetManifest)+        "verified Codd cutover"+        Confirmed+    )++targetManifest :: CoddManifest+targetManifest = expectRight (parseCoddManifest (checksumText targetPayload <> " " <> Text.pack selectedFilename <> "\n"))++targetMapping :: HistoryMapping+targetMapping =+  historyMapping targetId (Evidence sourceKey) (SamePayload sourceKey)++sourceKey :: EvidenceKey+sourceKey = expectRight (coddEvidenceKey selectedFilename)++targetId :: MigrationId+targetId = expectRight (migrationId "codd-target" "0001-imported")++targetPlan :: MigrationPlan+targetPlan =+  expectRight+    ( migrationPlan+        (expectRight (migrationComponent "codd-target" Set.empty (expectRight (sqlMigration "0001-imported" targetPayload) :| [])) :| [])+    )++importOptions :: ImportOptions+importOptions =+  withImportRunOptions+    (withLedger (expectRight (ledgerConfig targetSchema 0x636F646454617267)) defaultRunOptions)+    defaultImportOptions++importOutcomes :: HistoryImportReport -> [HistoryImportOutcome]+importOutcomes HistoryImportReport {importResults} = importOutcome <$> toList importResults++sourceSnapshot :: Settings.Settings -> CoddSchemaVersion -> IO (Int64, [Text])+sourceSnapshot settings version = query settings (sourceSnapshotStatement (fixtureSchema version))++sourceSnapshotStatement :: Text -> Statement () (Int64, [Text])+sourceSnapshotStatement schemaName =+  Statement.unpreparable+    ( Text.unwords+        [ "SELECT (SELECT count(*) FROM " <> schemaName <> ".sql_migrations),",+          "ARRAY(SELECT a.attname::text FROM pg_catalog.pg_attribute a",+          "JOIN pg_catalog.pg_class c ON a.attrelid = c.oid",+          "JOIN pg_catalog.pg_namespace n ON c.relnamespace = n.oid",+          "WHERE c.relname = 'sql_migrations' AND n.nspname = '" <> schemaName <> "'",+          "AND a.attnum >= 1 AND NOT a.attisdropped ORDER BY a.attnum)"+        ]+    )+    Encoders.noParams+    (Decoders.singleRow ((,) <$> required Decoders.int8 <*> required (Decoders.listArray (Decoders.nonNullable Decoders.text))))+  where+    required = Decoders.column . Decoders.nonNullable++targetFactsStatement :: Statement () (Int64, Int64, Bool, Bool, Bool)+targetFactsStatement =+  Statement.unpreparable+    ( Text.unwords+        [ "SELECT (SELECT count(*) FROM " <> targetSchema <> ".migrations),",+          "count(*),",+          "to_regclass('" <> targetSchema <> ".should_not_exist') IS NOT NULL,",+          "bool_and(source_evidence #>> '{satisfying_evidence,0,details,adapter}' = 'codd'),",+          "bool_and(source_evidence #>> '{satisfying_evidence,0,details,schemaVersion}' = 'v5')",+          "FROM " <> targetSchema <> ".history_imports"+        ]+    )+    Encoders.noParams+    ( Decoders.singleRow+        ( (,,,,)+            <$> required Decoders.int8+            <*> required Decoders.int8+            <*> required Decoders.bool+            <*> required Decoders.bool+            <*> required Decoders.bool+        )+    )+  where+    required = Decoders.column . Decoders.nonNullable++targetSchemaExistsStatement :: Statement Text Bool+targetSchemaExistsStatement =+  Statement.preparable+    "SELECT to_regnamespace($1) IS NOT NULL"+    (Encoders.param (Encoders.nonNullable Encoders.text))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++tryLockStatement :: Statement Int64 Bool+tryLockStatement =+  Statement.preparable+    "SELECT pg_try_advisory_lock($1)"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++unlockStatement :: Statement Int64 Bool+unlockStatement =+  Statement.preparable+    "SELECT pg_advisory_unlock($1)"+    (Encoders.param (Encoders.nonNullable Encoders.int8))+    (Decoders.singleRow (Decoders.column (Decoders.nonNullable Decoders.bool)))++fixtureSql :: CoddSchemaVersion -> Text+fixtureSql version =+  Text.unwords+    [ "CREATE SCHEMA " <> fixtureSchema version <> ";",+      "CREATE TABLE " <> fixtureSchema version <> ".sql_migrations (",+      "id serial NOT NULL, migration_timestamp timestamptz NOT NULL, applied_at timestamptz, name text NOT NULL",+      case version of+        CoddV1 -> ");"+        CoddV2 -> ", application_duration interval);"+        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);"+    ]++fixtureSchema :: CoddSchemaVersion -> Text+fixtureSchema CoddV5 = "codd"+fixtureSchema _ = "codd_schema"++appliedInsertSql :: CoddSchemaVersion -> FilePath -> Text+appliedInsertSql version migrationFilename =+  Text.unwords+    [ "INSERT INTO " <> fixtureSchema version <> ".sql_migrations",+      "(migration_timestamp, applied_at, name) VALUES",+      "('2024-01-01 00:00:00+00', '2024-01-01 00:00:01+00', '" <> Text.pack migrationFilename <> "');"+    ]++partialInsertSql :: FilePath -> Text+partialInsertSql migrationFilename =+  Text.unwords+    [ "INSERT INTO codd_schema.sql_migrations",+      "(migration_timestamp, applied_at, name, num_applied_statements, no_txn_failed_at) VALUES",+      "('2024-01-01 00:00:00+00', NULL, '" <> Text.pack migrationFilename <> "', 1, '2024-01-01 00:00:01+00');"+    ]++withCleanSchemas :: Settings.Settings -> IO value -> IO value+withCleanSchemas settings = Exception.bracket_ cleanup cleanup+  where+    cleanup = runScript settings cleanupSql++cleanupSql :: Text+cleanupSql =+  Text.unwords+    [ "DROP SCHEMA IF EXISTS codd CASCADE;",+      "DROP SCHEMA IF EXISTS codd_schema CASCADE;",+      "DROP SCHEMA IF EXISTS " <> targetSchema <> " CASCADE;"+    ]++runScript :: Settings.Settings -> Text -> IO ()+runScript settings sql = withConnection settings (\connection -> useSession connection (Session.script sql))++query :: Settings.Settings -> Statement () value -> IO value+query settings statement = withConnection settings (\connection -> useSession connection (Session.statement () statement))++withConnection :: Settings.Settings -> (Connection.Connection -> IO value) -> IO value+withConnection settings action =+  Exception.bracket acquire Connection.release action+  where+    acquire = Connection.acquire settings >>= either (assertFailure . ("could not acquire integration connection: " <>) . show) pure++useSession :: Connection.Connection -> Session.Session value -> IO value+useSession connection session =+  Connection.use connection session >>= either (assertFailure . ("integration session failed: " <>) . show) pure++requireCoddRight :: (Show error) => Either error value -> IO value+requireCoddRight = either (assertFailure . show) pure++assertCoddError :: (CoddImportError -> Bool) -> Either CoddImportError value -> Assertion+assertCoddError matches result =+  case result of+    Left err | matches err -> pure ()+    _ -> assertFailure ("unexpected Codd adapter result: " <> showResult result)+  where+    showResult = either show (const "Right <value>")++checksumText :: ByteString -> Text+checksumText =+  Text.pack . concatMap renderByte . ByteString.unpack . migrationChecksumBytes . migrationFingerprint+  where+    renderByte byte = case Numeric.showHex byte "" of [digit] -> ['0', digit]; digits -> digits++selectedFilename :: FilePath+selectedFilename = "20240101000000-create.sql"++targetPayload :: ByteString+targetPayload = "CREATE TABLE pgmigrate_codd_target.should_not_exist (id bigint)"++targetSchema :: Text+targetSchema = "pgmigrate_codd_target"++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/unit/Main.hs view
@@ -0,0 +1,10 @@+module Main (main) where++import Test.Evidence qualified as Evidence+import Test.Ledger qualified as Ledger+import Test.Manifest qualified as Manifest+import Test.Parser qualified as Parser+import Test.Tasty++main :: IO ()+main = defaultMain (testGroup "pg-migrate-import-codd" [Evidence.tests, Ledger.tests, Manifest.tests, Parser.tests])
+ test/unit/Test/Evidence.hs view
@@ -0,0 +1,133 @@+module Test.Evidence (tests) where++import Data.ByteString (ByteString)+import Data.ByteString qualified as ByteString+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict qualified as Map+import Data.Set qualified as Set+import Data.Text (Text)+import Data.Text qualified as Text+import Data.Time (UTCTime)+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.History.Codd+import Database.PostgreSQL.Migrate.History.Codd.Internal+import Database.PostgreSQL.Migrate.Internal (migrationChecksumBytes)+import Numeric qualified+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "evidence"+    [ testCase "manifest-verified payload evidence is constructed" testVerifiedEvidence,+      testCase "manifest checksum mismatches are distinct" testManifestMismatch,+      testCase "SamePayload confirmation fails before connection acquisition" testConfirmationPreflight,+      testCase "unknown targets fail before connection acquisition" testTargetPreflight+    ]++testVerifiedEvidence :: Assertion+testVerifiedEvidence = do+  let config = sourceConfig Confirmed (Just matchingManifest)+  case buildCoddEvidence config history of+    Left err -> assertFailure (show err)+    Right evidence -> Map.size evidence @?= 1++testManifestMismatch :: Assertion+testManifestMismatch = do+  let wrongManifest = expectRight (parseCoddManifest (replicateText 64 "0" <> " migration.sql\n"))+  case buildCoddEvidence (sourceConfig Confirmed (Just wrongManifest)) history of+    Left (CoddManifestChecksumMismatch "migration.sql" _ actual) -> actual @?= payloadChecksum+    result -> assertFailure ("expected manifest mismatch, received: " <> show result)++testConfirmationPreflight :: Assertion+testConfirmationPreflight = do+  let key = expectRight (coddEvidenceKey "migration.sql")+      target = expectRight (migrationId "target" "0001")+      mapping = historyMapping target (Evidence key) (SamePayload key)+      config = sourceConfig NotConfirmed Nothing+  result <-+    importCoddHistory+      defaultImportOptions+      config+      unusedProvider+      targetPlan+      (mapping :| [])+  case result of+    Left CoddConfirmationRequired -> pure ()+    other -> assertFailure ("expected confirmation preflight failure, received: " <> show other)++testTargetPreflight :: Assertion+testTargetPreflight = do+  let key = expectRight (coddEvidenceKey "migration.sql")+      unknownTarget = expectRight (migrationId "target" "missing")+      mapping = historyMapping unknownTarget (Evidence key) (SamePayload key)+  result <-+    importCoddHistory+      defaultImportOptions+      (sourceConfig Confirmed (Just matchingManifest))+      unusedProvider+      targetPlan+      (mapping :| [])+  case result of+    Left (CoddTargetImportFailed (HistoryImportValidationFailed (HistoryTargetUnknown actual))) ->+      actual @?= unknownTarget+    other -> assertFailure ("expected target preflight failure, received: " <> show other)++sourceConfig :: Confirmation -> Maybe CoddManifest -> CoddSourceConfig+sourceConfig confirmation manifest =+  expectRight+    ( coddSourceConfig+        unusedProvider+        ("migration.sql" :| [])+        False+        (Map.singleton "migration.sql" payload)+        manifest+        "fixture import"+        confirmation+    )++matchingManifest :: CoddManifest+matchingManifest = expectRight (parseCoddManifest (payloadChecksum <> " migration.sql\n"))++history :: CoddHistory+history =+  CoddHistory+    CoddV5+    (CoddHistoryRow "migration.sql" timestamp (Just timestamp) 1 Nothing :| [])+    []++targetPlan :: MigrationPlan+targetPlan =+  expectRight+    ( migrationPlan+        ( expectRight+            (migrationComponent "target" Set.empty (expectRight (sqlMigration "0001" payload) :| []))+            :| []+        )+    )++unusedProvider :: ConnectionProvider+unusedProvider = connectionProvider (\_ -> error "connection provider must not be used")++payload :: ByteString+payload = "SELECT 1"++payloadChecksum :: Text+payloadChecksum =+  Text.pack+    ( concatMap+        renderByte+        (ByteString.unpack (migrationChecksumBytes (migrationFingerprint payload)))+    )+  where+    renderByte byte = case Numeric.showHex byte "" of [digit] -> ['0', digit]; digits -> digits++timestamp :: UTCTime+timestamp = read "2026-07-10 12:00:00 UTC"++replicateText :: Int -> Text -> Text+replicateText count value = mconcat (replicate count value)++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id
+ test/unit/Test/Ledger.hs view
@@ -0,0 +1,122 @@+module Test.Ledger (tests) where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict qualified as Map+import Data.Text (Text)+import Data.Time (UTCTime)+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.History.Codd+import Database.PostgreSQL.Migrate.History.Codd.Internal+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "ledger model"+    [ testCase "V1 through V5 require exact documented columns" testShapes,+      testCase "both schema generations are rejected" testBothSchemas,+      testCase "unknown columns are rejected" testUnknownShape,+      testCase "selection preserves requested order and reports unselected rows" testSelection,+      testCase "strict selection rejects unselected rows" testStrictSelection,+      testCase "duplicate filenames are rejected" testDuplicate,+      testCase "partial nontransactional rows are rejected" testPartial,+      testCase "missing selected filenames are distinct" testMissing+    ]++testShapes :: Assertion+testShapes = do+  assertRight (CoddV1, "codd_schema") (classifyCoddSchema (qualified "codd_schema" v1Columns))+  assertRight (CoddV2, "codd_schema") (classifyCoddSchema (qualified "codd_schema" v2Columns))+  assertRight (CoddV3, "codd_schema") (classifyCoddSchema (qualified "codd_schema" v3Columns))+  assertRight (CoddV4, "codd_schema") (classifyCoddSchema (qualified "codd_schema" v4Columns))+  assertRight (CoddV5, "codd") (classifyCoddSchema (qualified "codd" v4Columns))++testBothSchemas :: Assertion+testBothSchemas =+  assertLeft CoddBothSchemasPresent (classifyCoddSchema (qualified "codd_schema" v1Columns <> qualified "codd" v4Columns))++testUnknownShape :: Assertion+testUnknownShape =+  assertLeft+    (CoddUnsupportedShape "codd" (v4Columns <> ["unexpected"]))+    (classifyCoddSchema (qualified "codd" (v4Columns <> ["unexpected"])))++testSelection :: Assertion+testSelection = do+  let config = sourceConfig ("second.sql" :| ["first.sql"]) False+  case validateCoddRows config CoddV5 [row "first.sql", row "extra.sql", row "second.sql"] of+    Left err -> assertFailure (show err)+    Right CoddHistory {selectedRows, unselectedRows} -> do+      fmap filename selectedRows @?= ("second.sql" :| ["first.sql"])+      fmap filename unselectedRows @?= ["extra.sql"]++testStrictSelection :: Assertion+testStrictSelection =+  assertLeft+    (CoddStrictSourceHasUnselected ["extra.sql"])+    (validateCoddRows (sourceConfig ("first.sql" :| []) True) CoddV1 [row "first.sql", row "extra.sql"])++testDuplicate :: Assertion+testDuplicate =+  assertLeft+    (CoddDuplicateLedgerFilename "first.sql")+    (validateCoddRows (sourceConfig ("first.sql" :| []) False) CoddV1 [row "first.sql", row "first.sql"])++testPartial :: Assertion+testPartial =+  assertLeft+    (CoddPartialMigration "first.sql")+    (validateCoddRows (sourceConfig ("first.sql" :| []) False) CoddV3 [partialRow "first.sql"])++testMissing :: Assertion+testMissing =+  assertLeft+    (CoddSelectedFilenameMissing "missing.sql")+    (validateCoddRows (sourceConfig ("missing.sql" :| []) False) CoddV2 [row "first.sql"])++sourceConfig :: NonEmpty FilePath -> Bool -> CoddSourceConfig+sourceConfig selected strictSource =+  expectRight+    ( coddSourceConfig+        (connectionProvider (\_ -> error "unused source provider"))+        selected+        strictSource+        Map.empty+        Nothing+        "fixture import"+        NotConfirmed+    )++row :: FilePath -> CoddHistoryRow+row filename = CoddHistoryRow filename timestamp (Just timestamp) 1 Nothing++partialRow :: FilePath -> CoddHistoryRow+partialRow filename = CoddHistoryRow filename timestamp Nothing 2 (Just timestamp)++timestamp :: UTCTime+timestamp = read "2026-07-10 12:00:00 UTC"++qualified :: Text -> [Text] -> [(Text, Text)]+qualified schemaName = fmap (\column -> (schemaName, column))++v1Columns, v2Columns, v3Columns, v4Columns :: [Text]+v1Columns = ["id", "migration_timestamp", "applied_at", "name"]+v2Columns = v1Columns <> ["application_duration"]+v3Columns = v2Columns <> ["num_applied_statements", "no_txn_failed_at"]+v4Columns = v3Columns <> ["txnid", "connid"]++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id++assertRight :: (Eq value, Show value, Show error) => value -> Either error value -> Assertion+assertRight expected actual =+  case actual of+    Left err -> assertFailure ("expected success, received: " <> show err)+    Right value -> value @?= expected++assertLeft :: (Show error, Show value) => error -> Either error value -> Assertion+assertLeft expected actual =+  case actual of+    Left err -> show err @?= show expected+    Right value -> assertFailure ("expected error, received: " <> show value)
+ test/unit/Test/Manifest.hs view
@@ -0,0 +1,44 @@+module Test.Manifest (tests) where++import Data.Text qualified+import Database.PostgreSQL.Migrate.History.Codd+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "manifest"+    [ testCase "lowercase SHA-256 entries parse" testValid,+      testCase "uppercase checksums are rejected" testUppercase,+      testCase "duplicate filenames are rejected" testDuplicate,+      testCase "evidence keys are explicit and stable" testEvidenceKey+    ]++testValid :: Assertion+testValid =+  case parseCoddManifest (checksum <> "  2024-01-01-create.sql\n") of+    Left err -> assertFailure (show err)+    Right _ -> pure ()++testUppercase :: Assertion+testUppercase =+  parseCoddManifest (replicateText 64 "A" <> " migration.sql\n")+    @?= Left (InvalidCoddManifestChecksum 1 (replicateText 64 "A"))++testDuplicate :: Assertion+testDuplicate =+  parseCoddManifest (checksum <> " migration.sql\n" <> checksum <> " migration.sql\n")+    @?= Left (DuplicateCoddManifestFilename "migration.sql")++testEvidenceKey :: Assertion+testEvidenceKey = do+  first <- either (assertFailure . show) pure (coddEvidenceKey "migration.sql")+  second <- either (assertFailure . show) pure (coddEvidenceKey "migration.sql")+  first @?= second++checksum :: Data.Text.Text+checksum = replicateText 64 "a"++replicateText :: Int -> Data.Text.Text -> Data.Text.Text+replicateText count value = mconcat (replicate count value)
+ test/unit/Test/Parser.hs view
@@ -0,0 +1,84 @@+module Test.Parser (tests) where++import Data.ByteString.Char8 qualified as ByteString+import Data.List.NonEmpty (NonEmpty (..))+import Data.Set qualified as Set+import Database.PostgreSQL.Migrate+import Database.PostgreSQL.Migrate.CLI (OutputFormat (JsonOutput))+import Database.PostgreSQL.Migrate.History.Codd+import Options.Applicative+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+  testGroup+    "parser"+    [ testCase "parser records explicit artifacts without reading them" testCommand,+      testCase "invalid lock keys fail in the parser" testInvalidLock+    ]++testCommand :: Assertion+testCommand =+  case parseSuccess+    [ "--source-lock-key",+      "0x6B69726F6B754D67",+      "--mapping",+      "codd-mapping.json",+      "--manifest",+      "migrations.lock",+      "--source-directory",+      "migrations",+      "--strict-source",+      "--confirm",+      "--json"+    ] of+    CoddImportCommand+      { lockKey,+        mappingPath,+        manifestPath,+        sourceDirectory,+        strict,+        confirmation,+        outputFormat+      } -> do+        lockKey @?= defaultCoddLockKey+        mappingPath @?= "codd-mapping.json"+        manifestPath @?= Just "migrations.lock"+        sourceDirectory @?= Just "migrations"+        strict @?= True+        confirmation @?= Confirmed+        outputFormat @?= JsonOutput++testInvalidLock :: Assertion+testInvalidLock =+  case execParserPure defaultPrefs commandInfo ["--source-lock-key", "nope", "--mapping", "map.json"] of+    Failure _ -> pure ()+    result -> assertFailure ("expected parser failure, received: " <> show result)++parseSuccess :: [String] -> CoddImportCommand+parseSuccess arguments =+  case execParserPure defaultPrefs commandInfo arguments of+    Success parsedCommand -> parsedCommand+    Failure failure -> error (fst (renderFailure failure "codd-import"))+    CompletionInvoked _ -> error "unexpected completion"++commandInfo :: ParserInfo CoddImportCommand+commandInfo = info (coddImportCommandParser fixturePlan <**> helper) fullDesc++fixturePlan :: MigrationPlan+fixturePlan =+  expectRight+    ( migrationPlan+        ( expectRight+            ( migrationComponent+                "accounts"+                Set.empty+                (expectRight (sqlMigration "0001" (ByteString.pack "SELECT 1")) :| [])+            )+            :| []+        )+    )++expectRight :: (Show error) => Either error value -> value+expectRight = either (error . show) id