diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/pg-migrate-import-hasql-migration.cabal b/pg-migrate-import-hasql-migration.cabal --- a/pg-migrate-import-hasql-migration.cabal +++ b/pg-migrate-import-hasql-migration.cabal @@ -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 diff --git a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Import.hs b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Import.hs --- a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Import.hs +++ b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Import.hs @@ -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 diff --git a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Internal.hs b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Internal.hs --- a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Internal.hs +++ b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Internal.hs @@ -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, diff --git a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Ledger.hs b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Ledger.hs --- a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Ledger.hs +++ b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Ledger.hs @@ -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 diff --git a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Parser.hs b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Parser.hs --- a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Parser.hs +++ b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Parser.hs @@ -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 diff --git a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Types.hs b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Types.hs --- a/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Types.hs +++ b/src/Database/PostgreSQL/Migrate/History/HasqlMigration/Types.hs @@ -63,7 +63,6 @@ data HasqlMigrationDefinitionError = InvalidQualifiedTable !Text | InvalidQualifiedTableIdentifier !Text !PostgresIdentifierError - | EmptyHasqlMigrationSelection | EmptyHasqlMigrationFilename | DuplicateHasqlMigrationFilename !FilePath | MissingHasqlMigrationPayload !FilePath diff --git a/test/integration/Main.hs b/test/integration/Main.hs --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -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 diff --git a/test/unit/Test/Evidence.hs b/test/unit/Test/Evidence.hs --- a/test/unit/Test/Evidence.hs +++ b/test/unit/Test/Evidence.hs @@ -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 =