pg-migrate-import-hasql-migration 1.0.0.0 → 1.1.0.0

raw patch · 9 files changed

+79/−20 lines, 9 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 +17/−0
• pg-migrate-import-hasql-migration.cabal +4/−3
• src/Database/PostgreSQL/Migrate/History/HasqlMigration/Import.hs +19/−4
• src/Database/PostgreSQL/Migrate/History/HasqlMigration/Internal.hs +5/−1
• src/Database/PostgreSQL/Migrate/History/HasqlMigration/Ledger.hs +10/−5
• src/Database/PostgreSQL/Migrate/History/HasqlMigration/Parser.hs +1/−1
• src/Database/PostgreSQL/Migrate/History/HasqlMigration/Types.hs +0/−1
• test/integration/Main.hs +5/−4
• test/unit/Test/Evidence.hs +18/−1

@@ -1,5 +1,22 @@ # Changelog +## 1.1.0.0 — 2026-07-13++Major release: this set removes a public error constructor.++### Breaking changes++- Removed the unreachable `EmptyHasqlMigrationSelection` constructor from+  `HasqlMigrationDefinitionError`.++### Fixes and behavior changes++- Record the quoted schema-qualified `source_table` in every row's audit evidence.+- Replace internal partial payload-map lookups with the structured+  `MissingHasqlMigrationPayload` definition error.+- Correct the reusable parser's API description to state that its plan parameter is+  reserved.+ ## 1.0.0.0 — 2026-07-10  - Initial stable release of the qualified-table `hasql-migration` adapter with base64-MD5

@@ -1,6 +1,6 @@ cabal-version:   3.8 name:            pg-migrate-import-hasql-migration-version:         1.0.0.0+version:         1.1.0.0 synopsis:        Import hasql-migration history into pg-migrate category:        Database maintainer:      nadeem@gmail.com@@ -45,8 +45,8 @@     , crypton               >=1.1  && <1.2     , 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     , ram                   >=0.20 && <0.23     , text                  >=2.1  && <2.2     , time                  >=1.12 && <1.15@@ -63,6 +63,7 @@     Test.Parser    build-depends:+    , aeson                              >=2.2  && <2.3     , base                               >=4.20 && <4.22     , bytestring                         >=0.12 && <0.13     , containers                         >=0.7  && <0.8

@@ -1,6 +1,7 @@ module Database.PostgreSQL.Migrate.History.HasqlMigration.Import   ( importHasqlMigrationHistory,     buildHasqlMigrationEvidence,+    rowDetails,   ) where @@ -9,7 +10,10 @@ import Data.Map.Strict qualified as Map import Data.Text qualified as Text import Database.PostgreSQL.Migrate-import Database.PostgreSQL.Migrate.History.HasqlMigration.Ledger (readHasqlMigrationHistory)+import Database.PostgreSQL.Migrate.History.HasqlMigration.Ledger+  ( readHasqlMigrationHistory,+    renderQualifiedTable,+  ) import Database.PostgreSQL.Migrate.History.HasqlMigration.Types import PgMigrate.History.HasqlMigration.Prelude @@ -58,13 +62,18 @@   where     placeholder migrationFilename = do       key <- first HasqlMigrationDefinitionFailed (hasqlMigrationEvidenceKey migrationFilename)+      payloadBytes <-+        maybe+          (Left (HasqlMigrationDefinitionFailed (MissingHasqlMigrationPayload migrationFilename)))+          Right+          (Map.lookup migrationFilename sourcePayloads)       evidence <-         first           HasqlMigrationHistoryDefinitionFailed           ( sourceLedgerChecksumVerifiedEvidence               (Text.pack migrationFilename)               Nothing-              (Just (migrationFingerprint (sourcePayloads Map.! migrationFilename)))+              (Just (migrationFingerprint payloadBytes))               Aeson.Null           )       Right (key, evidence)@@ -89,21 +98,27 @@   where     rowEvidence row@HasqlMigrationRow {filename, executedAt} = do       key <- first HasqlMigrationDefinitionFailed (hasqlMigrationEvidenceKey filename)+      payloadBytes <-+        maybe+          (Left (HasqlMigrationDefinitionFailed (MissingHasqlMigrationPayload filename)))+          Right+          (Map.lookup filename sourcePayloads)       evidence <-         first           HasqlMigrationHistoryDefinitionFailed           ( sourceLedgerChecksumVerifiedEvidence               (Text.pack filename)               (Just (LocalTimeWithoutZone executedAt))-              (Just (migrationFingerprint (sourcePayloads Map.! filename)))+              (Just (migrationFingerprint payloadBytes))               (rowDetails sourceTable row)           )       Right (key, evidence)  rowDetails :: QualifiedTable -> HasqlMigrationRow -> Aeson.Value-rowDetails _ HasqlMigrationRow {filename, storedMd5, executedAt} =+rowDetails sourceTable HasqlMigrationRow {filename, storedMd5, executedAt} =   Aeson.object     [ "adapter" Aeson..= ("hasql-migration" :: Text),+      "source_table" Aeson..= renderQualifiedTable sourceTable,       "filename" Aeson..= filename,       "storedMd5" Aeson..= storedMd5,       "executedAt" Aeson..= executedAt

@@ -2,12 +2,16 @@  module Database.PostgreSQL.Migrate.History.HasqlMigration.Internal   ( buildHasqlMigrationEvidence,+    rowDetails,     renderQualifiedTable,     validateHasqlMigrationRows,   ) where -import Database.PostgreSQL.Migrate.History.HasqlMigration.Import (buildHasqlMigrationEvidence)+import Database.PostgreSQL.Migrate.History.HasqlMigration.Import+  ( buildHasqlMigrationEvidence,+    rowDetails,+  ) import Database.PostgreSQL.Migrate.History.HasqlMigration.Ledger   ( renderQualifiedTable,     validateHasqlMigrationRows,

@@ -68,11 +68,16 @@     byFilename = Map.fromList [(filename row, row) | row <- rows]     selectRow selected =       maybe (Left (HasqlMigrationSelectedFilenameMissing selected)) Right (Map.lookup selected byFilename)-    verifyChecksum row =-      let actual = legacyMd5 (sourcePayloads Map.! filename row)-       in if storedMd5 row == actual-            then Right ()-            else Left (HasqlMigrationChecksumMismatch (filename row) (storedMd5 row) actual)+    verifyChecksum row = do+      payloadBytes <-+        maybe+          (Left (HasqlMigrationDefinitionFailed (MissingHasqlMigrationPayload (filename row))))+          Right+          (Map.lookup (filename row) sourcePayloads)+      let actual = legacyMd5 payloadBytes+      if storedMd5 row == actual+        then Right ()+        else Left (HasqlMigrationChecksumMismatch (filename row) (storedMd5 row) actual)  legacyMd5 :: ByteString -> Text legacyMd5 = Text.Encoding.decodeUtf8 . convertToBase Base64 . hashWith MD5

@@ -10,7 +10,7 @@ import Hasql.Connection.Settings qualified as Settings import Options.Applicative --- | Build the reusable, target-aware hasql-migration import parser.+-- | Build the reusable hasql-migration import parser; the plan parameter is reserved. hasqlMigrationImportCommandParser :: MigrationPlan -> Parser HasqlMigrationImportCommand hasqlMigrationImportCommandParser _ =   HasqlMigrationImportCommand

@@ -63,7 +63,6 @@ data HasqlMigrationDefinitionError   = InvalidQualifiedTable !Text   | InvalidQualifiedTableIdentifier !Text !PostgresIdentifierError-  | EmptyHasqlMigrationSelection   | EmptyHasqlMigrationFilename   | DuplicateHasqlMigrationFilename !FilePath   | MissingHasqlMigrationPayload !FilePath

@@ -87,7 +87,7 @@     first <- runDirectImport settings >>= requireAdapterRight     outcomes first @?= [Imported]     facts <- query settings directTargetFactsStatement-    facts @?= (1, 1, False, True, True)+    facts @?= (1, 1, False, True, True, True)     second <- runDirectImport settings >>= requireAdapterRight     outcomes second @?= [AlreadyImported]     repeatedFacts <- query settings directTargetFactsStatement@@ -268,7 +268,7 @@   where     required = Decoders.column . Decoders.nonNullable -directTargetFactsStatement :: Statement () (Int64, Int64, Bool, Bool, Bool)+directTargetFactsStatement :: Statement () (Int64, Int64, Bool, Bool, Bool, Bool) directTargetFactsStatement =   Statement.unpreparable     ( Text.unwords@@ -276,12 +276,13 @@           "to_regclass('" <> targetSchema <> ".should_not_exist') IS NOT NULL,",           "bool_and(source_evidence #>> '{satisfying_evidence,0,strength}' = 'source-ledger-checksum-verified'),",           "bool_and(source_evidence #>> '{satisfying_evidence,0,applied_at,kind}' = 'local-without-zone'",-          "AND source_evidence #>> '{satisfying_evidence,0,applied_at,value}' = '2024-01-02 03:04:05')",+          "AND source_evidence #>> '{satisfying_evidence,0,applied_at,value}' = '2024-01-02 03:04:05'),",+          "bool_and(source_evidence #>> '{satisfying_evidence,0,details,source_table}' = '\"hasql_migration_source\".\"schema_migrations\"')",           "FROM " <> targetSchema <> ".history_imports"         ]     )     Encoders.noParams-    (Decoders.singleRow ((,,,,) <$> required Decoders.int8 <*> required Decoders.int8 <*> required Decoders.bool <*> required Decoders.bool <*> required Decoders.bool))+    (Decoders.singleRow ((,,,,,) <$> required Decoders.int8 <*> required Decoders.int8 <*> required Decoders.bool <*> required Decoders.bool <*> required Decoders.bool <*> required Decoders.bool))   where     required = Decoders.column . Decoders.nonNullable 

@@ -1,8 +1,10 @@ module Test.Evidence (tests) where +import Data.Aeson qualified as Aeson import Data.List.NonEmpty (NonEmpty (..)) import Data.Map.Strict qualified as Map import Data.Set qualified as Set+import Data.Time (LocalTime) import Database.PostgreSQL.Migrate import Database.PostgreSQL.Migrate.History.HasqlMigration import Database.PostgreSQL.Migrate.History.HasqlMigration.Internal@@ -14,6 +16,7 @@   testGroup     "evidence"     [ testCase "verified ledger evidence carries exact source SHA-256" testEvidence,+      testCase "audit details identify the qualified source table" testSourceTableDetails,       testCase "unknown targets fail before connection acquisition" testTargetPreflight     ] @@ -23,6 +26,17 @@     Left err -> assertFailure (show err)     Right evidence -> Map.size evidence @?= 1 +testSourceTableDetails :: Assertion+testSourceTableDetails =+  rowDetails defaultHasqlMigrationTable sourceRow+    @?= Aeson.object+      [ "adapter" Aeson..= ("hasql-migration" :: String),+        "source_table" Aeson..= ("\"public\".\"schema_migrations\"" :: String),+        "filename" Aeson..= ("one.sql" :: String),+        "storedMd5" Aeson..= ("sWmOUqDxYgNIlFQZagxjBw==" :: String),+        "executedAt" Aeson..= (read "2024-01-02 03:04:05" :: LocalTime)+      ]+ testTargetPreflight :: Assertion testTargetPreflight = do   let key = expectRight (hasqlMigrationEvidenceKey "one.sql")@@ -46,8 +60,11 @@         "fixture import"     ) +sourceRow :: HasqlMigrationRow+sourceRow = HasqlMigrationRow "one.sql" "sWmOUqDxYgNIlFQZagxjBw==" (read "2024-01-02 03:04:05")+ history :: HasqlMigrationHistory-history = HasqlMigrationHistory (HasqlMigrationRow "one.sql" "sWmOUqDxYgNIlFQZagxjBw==" (read "2024-01-02 03:04:05") :| []) []+history = HasqlMigrationHistory (sourceRow :| []) []  targetPlan :: MigrationPlan targetPlan =