pg-migrate-embed 1.0.0.0 → 1.1.0.0
raw patch · 11 files changed
+345/−57 lines, 11 filesdep +ghcdep ~pg-migratePVP ok
version bump matches the API change (PVP)
Dependencies added: ghc
Dependency ranges changed: pg-migrate
API changes (from Hackage documentation)
+ Database.PostgreSQL.Migrate.Embed: AuthoringConcurrentModification :: !FilePath -> AuthoringError
+ Database.PostgreSQL.Migrate.Embed: ManifestByteOrderMark :: !FilePath -> ManifestError
+ Database.PostgreSQL.Migrate.Embed.RecompilePlugin: plugin :: Plugin
Files
- CHANGELOG.md +24/−0
- pg-migrate-embed.cabal +4/−2
- src/Database/PostgreSQL/Migrate/Embed/Authoring.hs +33/−4
- src/Database/PostgreSQL/Migrate/Embed/Internal.hs +9/−1
- src/Database/PostgreSQL/Migrate/Embed/Manifest.hs +46/−16
- src/Database/PostgreSQL/Migrate/Embed/RecompilePlugin.hs +24/−0
- test/recompilation/Main.hs +101/−32
- test/recompilation/fixture/app/Main.hs +2/−0
- test/recompilation/fixture/app/TrackedMain.hs +24/−0
- test/unit/Test/Authoring.hs +54/−1
- test/unit/Test/Manifest.hs +24/−1
CHANGELOG.md view
@@ -1,5 +1,29 @@ # Changelog +## 1.1.0.0 — 2026-07-13++Major release: this set adds constructors to the public `ManifestError` and+`AuthoringError` sums.++### Breaking changes++- Added `ManifestByteOrderMark` so a leading UTF-8 BOM has a dedicated diagnostic.+- Added `AuthoringConcurrentModification` so a detected post-rename manifest clobber does+ not silently report successful authoring.++### Fixes and behavior changes++- Stop automatic numbering before a successor would lose the sequence's leading zero and+ become unreadable by the next authoring operation.+- Emit embedded SQL as one static primitive byte literal instead of one Template Haskell+ expression per byte, making multi-megabyte payloads practical while preserving exact+ bytes.+- Add `Database.PostgreSQL.Migrate.Embed.RecompilePlugin` for GHC 9.12. A module-local+ `OPTIONS_GHC -fplugin=...` pragma makes the embedding module recompile on every build so+ newly added or removed sibling SQL files rerun strict manifest membership validation.+- Document that migration authoring requires POSIX while manifest validation and embedding+ remain portable, and describe the authoring helper's actual concurrency guarantees.+ ## 1.0.0.0 — 2026-07-10 - Initial stable release of manifest format v1, exact-byte Template Haskell embedding,
pg-migrate-embed.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.8 name: pg-migrate-embed-version: 1.0.0.0+version: 1.1.0.0 synopsis: Compile-time ordered SQL manifests for pg-migrate category: Database maintainer: nadeem@gmail.com@@ -51,6 +51,7 @@ exposed-modules: Database.PostgreSQL.Migrate.Embed Database.PostgreSQL.Migrate.Embed.Internal+ Database.PostgreSQL.Migrate.Embed.RecompilePlugin other-modules: Database.PostgreSQL.Migrate.Embed.Authoring@@ -61,7 +62,8 @@ , bytestring >=0.12 && <0.13 , directory >=1.3 && <1.4 , filepath >=1.5 && <1.6- , pg-migrate >=1.0 && <1.1+ , ghc >=9.10 && <9.13+ , pg-migrate >=1.1 && <1.2 , template-haskell >=2.22 && <2.24 , text >=2.1 && <2.2 , unix >=2.8 && <2.9
src/Database/PostgreSQL/Migrate/Embed/Authoring.hs view
@@ -4,6 +4,8 @@ newMigrationOptions, newMigration, newMigrationWithRename,+ renderNextMigrationName,+ numericPrefix, ) where @@ -44,6 +46,7 @@ | ExplicitMigrationNameRequired | MigrationSequenceExhausted !Int | MigrationFileAlreadyExists !FilePath+ | AuthoringConcurrentModification !FilePath | AuthoringIoError !FilePath !Text.Text | AuthoringCleanupError !FilePath !Text.Text deriving stock (Eq, Show)@@ -62,7 +65,8 @@ explicitName <- traverse normalizeExplicitName requestedName Right NewMigrationOptions {manifestPath, explicitName, initialSql} --- | Exclusively create a SQL file and atomically append its manifest entry.+-- | Exclusively create a SQL file and atomically replace the manifest with its new entry.+-- Concurrent authoring is not supported; detected post-replacement clobbers are reported. newMigration :: NewMigrationOptions -> IO (Either AuthoringError FilePath) newMigration = newMigrationWithRename Directory.renameFile @@ -109,7 +113,7 @@ renderNextMigrationName :: Int -> Integer -> Either AuthoringError FilePath renderNextMigrationName width next = let rendered = show next- in if length rendered > width+ in if length rendered >= width then Left (MigrationSequenceExhausted width) else firstLeft@@ -156,7 +160,15 @@ replacementResult <- replaceManifest renameFile manifestPath (appendEntry originalManifest entry) case replacementResult of- Right () -> pure (Right migrationPath)+ Right () -> do+ verificationResult <- manifestContainsEntry manifestPath entry+ case verificationResult of+ Left verificationError -> pure (Left verificationError)+ Right True -> pure (Right migrationPath)+ Right False ->+ cleanupCreatedFile+ migrationPath+ (AuthoringConcurrentModification manifestPath) Left replacementError -> do cleanupResult <- tryIOException (Directory.removeFile migrationPath) pure $ case cleanupResult of@@ -196,7 +208,7 @@ ignoreIOException (IO.hClose handle) cleanupCreatedFile path (authoringIoError path err) -cleanupCreatedFile :: FilePath -> AuthoringError -> IO (Either AuthoringError ())+cleanupCreatedFile :: FilePath -> AuthoringError -> IO (Either AuthoringError value) cleanupCreatedFile path originalError = do cleanupResult <- tryIOException (Directory.removeFile path) pure $ case cleanupResult of@@ -245,6 +257,23 @@ | ByteString.null original = ByteString.empty | ByteString.last original == 0x0A = ByteString.empty | otherwise = "\n"++manifestContainsEntry :: FilePath -> FilePath -> IO (Either AuthoringError Bool)+manifestContainsEntry manifestPath entry = do+ manifestResult <- tryIOException (ByteString.readFile manifestPath)+ pure $ case manifestResult of+ Left err -> Left (authoringIoError manifestPath err)+ Right contents ->+ Right+ ( Text.Encoding.encodeUtf8 (Text.pack entry)+ `elem` (dropCarriageReturn <$> ByteString.split 0x0A contents)+ )++dropCarriageReturn :: ByteString.ByteString -> ByteString.ByteString+dropCarriageReturn line =+ case ByteString.unsnoc line of+ Just (prefix, 0x0D) -> prefix+ _ -> line authoringIoError :: FilePath -> IOException -> AuthoringError authoringIoError path err = AuthoringIoError path (Text.pack (show err))
src/Database/PostgreSQL/Migrate/Embed/Internal.hs view
@@ -2,7 +2,15 @@ module Database.PostgreSQL.Migrate.Embed.Internal ( newMigrationWithRename,+ renderNextMigrationName,+ numericPrefix,+ byteStringExpression, ) where -import Database.PostgreSQL.Migrate.Embed.Authoring (newMigrationWithRename)+import Database.PostgreSQL.Migrate.Embed.Authoring+ ( newMigrationWithRename,+ numericPrefix,+ renderNextMigrationName,+ )+import Database.PostgreSQL.Migrate.Embed.Manifest (byteStringExpression)
src/Database/PostgreSQL/Migrate/Embed/Manifest.hs view
@@ -4,6 +4,7 @@ checkMigrationManifest, embedMigrationManifest, validateManifestEntry,+ byteStringExpression, ) where @@ -11,6 +12,7 @@ import Control.Exception qualified as Exception import Data.Bifunctor (first) import Data.ByteString qualified as ByteString+import Data.ByteString.Internal qualified as ByteString.Internal import Data.Foldable (toList, traverse_) import Data.List qualified as List import Data.List.NonEmpty (NonEmpty (..))@@ -21,6 +23,7 @@ Lit (..), Q, )+import Language.Haskell.TH.Lib qualified as TH.Lib import Language.Haskell.TH.Syntax qualified as TH.Syntax import System.Directory qualified as Directory import System.FilePath qualified as FilePath@@ -33,6 +36,7 @@ data ManifestError = ManifestIoError !FilePath !Text.Text | ManifestInvalidUtf8 !FilePath !Text.Text+ | ManifestByteOrderMark !FilePath | EmptyManifest | BlankManifestLine !Int | CommentManifestLine !Int@@ -61,6 +65,12 @@ Right entries -> checkManifestFiles manifestPath entries -- | Validate and embed an ordered migration manifest at compile time.+--+-- On GHC 9.12, modules using this splice should load+-- @Database.PostgreSQL.Migrate.Embed.RecompilePlugin@ with a module-local+-- @OPTIONS_GHC -fplugin=...@ pragma. The plugin makes additions and removals in the+-- manifest directory observable even though that compiler can register only existing+-- files as Template Haskell dependencies. embedMigrationManifest :: FilePath -> Q Exp embedMigrationManifest inputPath = do manifestPath <- TH.Syntax.makeRelativeToProject inputPath@@ -76,19 +86,25 @@ pure (nonEmptyExpression entries) parseManifest :: FilePath -> ByteString.ByteString -> Either ManifestError (NonEmpty FilePath)-parseManifest manifestPath manifestBytes = do- manifestText <-- first- (ManifestInvalidUtf8 manifestPath . Text.pack . show)- (Text.Encoding.decodeUtf8' manifestBytes)- let numberedLines = zip [1 ..] (normalizeLineEnding <$> Text.lines manifestText)- entries <- traverse validateManifestLine numberedLines- nonEmptyEntries <-- case entries of- firstEntry : remainingEntries -> Right (firstEntry :| remainingEntries)- [] -> Left EmptyManifest- validateDuplicates nonEmptyEntries+parseManifest manifestPath manifestBytes+ | utf8ByteOrderMark `ByteString.isPrefixOf` manifestBytes =+ Left (ManifestByteOrderMark manifestPath)+ | otherwise = do+ manifestText <-+ first+ (ManifestInvalidUtf8 manifestPath . Text.pack . show)+ (Text.Encoding.decodeUtf8' manifestBytes)+ let numberedLines = zip [1 ..] (normalizeLineEnding <$> Text.lines manifestText)+ entries <- traverse validateManifestLine numberedLines+ nonEmptyEntries <-+ case entries of+ firstEntry : remainingEntries -> Right (firstEntry :| remainingEntries)+ [] -> Left EmptyManifest+ validateDuplicates nonEmptyEntries +utf8ByteOrderMark :: ByteString.ByteString+utf8ByteOrderMark = ByteString.pack [0xEF, 0xBB, 0xBF]+ normalizeLineEnding :: Text.Text -> Text.Text normalizeLineEnding = Text.dropWhileEnd (== '\r') @@ -172,12 +188,26 @@ entryExpression (entry, bytes) = TupE [ Just (LitE (StringL entry)),- Just+ Just (byteStringExpression bytes)+ ]++byteStringExpression :: ByteString.ByteString -> Exp+byteStringExpression bytes =+ let (foreignPointer, offset, length_) = ByteString.Internal.toForeignPtr bytes+ in AppE ( AppE- (VarE 'ByteString.pack)- (ListE (LitE . IntegerL . fromIntegral <$> ByteString.unpack bytes))+ (VarE 'ByteString.Internal.unsafePackLenLiteral)+ (LitE (IntegerL (fromIntegral length_))) )- ]+ ( LitE+ ( TH.Lib.bytesPrimL+ ( TH.Lib.mkBytes+ foreignPointer+ (fromIntegral offset)+ (fromIntegral length_)+ )+ )+ ) tryIOException :: IO value -> IO (Either IOException value) tryIOException = Exception.try
+ src/Database/PostgreSQL/Migrate/Embed/RecompilePlugin.hs view
@@ -0,0 +1,24 @@+-- | GHC 9.12 recompilation support for strict manifest membership checks.+--+-- Put this pragma in each module that calls @embedMigrationManifest@:+--+-- > {-# OPTIONS_GHC -fplugin=Database.PostgreSQL.Migrate.Embed.RecompilePlugin #-}+--+-- GHC 9.12 can track existing files but has no Template Haskell directory-dependency+-- API. This no-op Core plugin forces that embedding module to be reconsidered on every+-- build, allowing a newly added or removed sibling SQL file to rerun manifest validation.+module Database.PostgreSQL.Migrate.Embed.RecompilePlugin (plugin) where++import GHC.Plugins+ ( Plugin (pluginRecompile),+ PluginRecompile (ForceRecompile),+ defaultPlugin,+ )++-- | The compiler plugin entry point. Applications load it with the module-local pragma+-- shown above; application code does not call it.+plugin :: Plugin+plugin =+ defaultPlugin+ { pluginRecompile = const (pure ForceRecompile)+ }
test/recompilation/Main.hs view
@@ -2,7 +2,7 @@ import Control.Exception qualified as Exception import Control.Monad (filterM, unless, when)-import Data.List (isPrefixOf)+import Data.List (isInfixOf, isPrefixOf) import Data.Time.Clock qualified as Time import Paths_pg_migrate_embed qualified as Paths import System.Directory qualified as Directory@@ -28,11 +28,25 @@ copyDirectory fixtureSource workspace writeProjectFile corePackageRoot packageRoot workspace prepareProbe workspace- moduleTimestamp <- Directory.getModificationTime (workspace FilePath.</> "app/Main.hs")+ directoryModuleTimestamp <-+ Directory.getModificationTime (workspace FilePath.</> "app/Main.hs")+ trackedModuleTimestamp <-+ Directory.getModificationTime (workspace FilePath.</> "app/TrackedMain.hs") - initialOutput <- runProbe workspace+ directoryOutput <- runDirectoryProbe workspace+ let unlistedPath = workspace FilePath.</> "migrations/0002-unlisted.sql"+ writeFile unlistedPath "SELECT 2;\n"+ runDirectoryProbeExpectingFailure+ workspace+ "UnlistedSqlFiles [\"0002-unlisted.sql\"]"+ Directory.removeFile unlistedPath+ directoryOutputAfterRemoval <- runDirectoryProbe workspace+ unless (directoryOutputAfterRemoval == directoryOutput) $+ fail "removing the unlisted SQL file changed the embedded checksums"++ initialOutput <- runTrackedProbe workspace writeTrackedFile (workspace FilePath.</> "migrations/0001-first.sql") "SELECT 2;\n"- sqlChangedOutput <- runProbe workspace+ sqlChangedOutput <- runTrackedProbe workspace when (sqlChangedOutput == initialOutput) $ fail "changing a tracked SQL file did not change the embedded checksums" @@ -40,47 +54,102 @@ writeTrackedFile (workspace FilePath.</> "migrations/manifest") "0001-first.sql\n0002-second.sql\n"- manifestChangedOutput <- runProbe workspace+ manifestChangedOutput <- runTrackedProbe workspace when (manifestChangedOutput == sqlChangedOutput) $ fail "changing the manifest did not change the embedded checksums" unless (length (lines manifestChangedOutput) == 2) $ fail "the rebuilt probe did not embed both manifest entries" - finalModuleTimestamp <- Directory.getModificationTime (workspace FilePath.</> "app/Main.hs")- unless (finalModuleTimestamp == moduleTimestamp) $- fail "the recompilation test unexpectedly touched the Haskell module"+ finalDirectoryModuleTimestamp <-+ Directory.getModificationTime (workspace FilePath.</> "app/Main.hs")+ finalTrackedModuleTimestamp <-+ Directory.getModificationTime (workspace FilePath.</> "app/TrackedMain.hs")+ unless+ ( finalDirectoryModuleTimestamp == directoryModuleTimestamp+ && finalTrackedModuleTimestamp == trackedModuleTimestamp+ )+ $ fail "the recompilation test unexpectedly touched a Haskell module" -runProbe :: FilePath -> IO String-runProbe workspace = do+runDirectoryProbe :: FilePath -> IO String+runDirectoryProbe workspace = do _ <- runChecked workspace "cabal"- [ "exec",- "--builddir=dist-recompilation",- "--",- "ghc",- "--make",- "app/Main.hs",- "-o",- "ghc-recompilation/probe",- "-odir",- "ghc-recompilation",- "-hidir",- "ghc-recompilation",- "-package",- "pg-migrate",- "-package",- "pg-migrate-embed",- "-XGHC2024",- "-XOverloadedStrings",- "-XTemplateHaskell"- ]- runChecked workspace (workspace FilePath.</> "ghc-recompilation/probe") []+ directoryProbeArguments+ runChecked workspace (workspace FilePath.</> "ghc-directory-recompilation/probe") [] +runDirectoryProbeExpectingFailure :: FilePath -> String -> IO ()+runDirectoryProbeExpectingFailure workspace expectedError = do+ let command =+ (Process.proc "cabal" directoryProbeArguments)+ { Process.cwd = Just workspace+ }+ (exitCode, standardOutput, standardError) <-+ Process.readCreateProcessWithExitCode command ""+ case exitCode of+ ExitFailure _ ->+ unless (expectedError `isInfixOf` (standardOutput <> standardError)) $+ fail+ ( "probe compilation failed without the expected diagnostic "+ <> show expectedError+ <> ":\n"+ <> standardError+ )+ ExitSuccess ->+ fail "adding an unlisted SQL file did not force manifest revalidation"++runTrackedProbe :: FilePath -> IO String+runTrackedProbe workspace = do+ _ <-+ runChecked+ workspace+ "cabal"+ trackedProbeArguments+ runChecked workspace (workspace FilePath.</> "ghc-tracked-recompilation/probe") []++directoryProbeArguments :: [String]+directoryProbeArguments =+ ghcArguments+ "app/Main.hs"+ Nothing+ "ghc-directory-recompilation"++trackedProbeArguments :: [String]+trackedProbeArguments =+ ghcArguments+ "app/TrackedMain.hs"+ (Just "TrackedMain")+ "ghc-tracked-recompilation"++ghcArguments :: FilePath -> Maybe String -> FilePath -> [String]+ghcArguments source mainModule outputDirectory =+ [ "exec",+ "--builddir=dist-recompilation",+ "--",+ "ghc",+ "--make",+ source,+ "-o",+ outputDirectory FilePath.</> "probe",+ "-odir",+ outputDirectory,+ "-hidir",+ outputDirectory,+ "-package",+ "pg-migrate",+ "-package",+ "pg-migrate-embed",+ "-XGHC2024",+ "-XOverloadedStrings",+ "-XTemplateHaskell"+ ]+ <> maybe [] (\moduleName -> ["-main-is", moduleName]) mainModule+ prepareProbe :: FilePath -> IO () prepareProbe workspace = do- Directory.createDirectory (workspace FilePath.</> "ghc-recompilation")+ Directory.createDirectory (workspace FilePath.</> "ghc-directory-recompilation")+ Directory.createDirectory (workspace FilePath.</> "ghc-tracked-recompilation") _ <- runChecked workspace
test/recompilation/fixture/app/Main.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fplugin=Database.PostgreSQL.Migrate.Embed.RecompilePlugin #-}+ module Main (main) where import Data.ByteString (ByteString)
+ test/recompilation/fixture/app/TrackedMain.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE TemplateHaskell #-}++module TrackedMain (main) where++import Data.ByteString (ByteString)+import Data.Foldable (traverse_)+import Data.List.NonEmpty (NonEmpty)+import Database.PostgreSQL.Migrate qualified as Migrate+import Database.PostgreSQL.Migrate.Embed (embedMigrationManifest)+import Database.PostgreSQL.Migrate.Internal qualified as Internal++main :: IO ()+main = traverse_ printChecksum embeddedMigrations+ where+ printChecksum =+ print+ . Internal.migrationChecksumBytes+ . Migrate.migrationFingerprint+ . snd++embeddedMigrations :: NonEmpty (FilePath, ByteString)+embeddedMigrations =+ $(embedMigrationManifest "migrations/manifest")
test/unit/Test/Authoring.hs view
@@ -1,12 +1,17 @@ module Test.Authoring (tests) where import Control.Exception qualified as Exception+import Control.Monad (forM_) import Data.ByteString qualified as ByteString import Data.ByteString.Char8 qualified as ByteString.Char8 import Data.Foldable (traverse_) import Data.List qualified as List import Database.PostgreSQL.Migrate.Embed-import Database.PostgreSQL.Migrate.Embed.Internal (newMigrationWithRename)+import Database.PostgreSQL.Migrate.Embed.Internal+ ( newMigrationWithRename,+ numericPrefix,+ renderNextMigrationName,+ ) import System.Directory qualified as Directory import System.FilePath qualified as FilePath import Test.Tasty (TestTree, testGroup)@@ -40,6 +45,26 @@ options <- assertRight (newMigrationOptions manifestPath Nothing "SELECT 2;\n") result <- newMigration options result @?= Left ExplicitMigrationNameRequired,+ testCase "next automatic name after 08 is 09" $+ withWorkspace "next-nine" (numberedFiles 2 [1 .. 8]) $ \manifestPath -> do+ options <- assertRight (newMigrationOptions manifestPath Nothing "SELECT 9;\n")+ result <- newMigration options+ result+ @?= Right (FilePath.takeDirectory manifestPath FilePath.</> "09.sql"),+ testCase "successor of 09 at width 2 is exhausted" $+ withWorkspace "width-two-exhausted" (numberedFiles 2 [1 .. 9]) $ \manifestPath -> do+ options <- assertRight (newMigrationOptions manifestPath Nothing "SELECT 10;\n")+ result <- newMigration options+ result @?= Left (MigrationSequenceExhausted 2),+ testCase "successor of 0999 at width 4 is exhausted" $+ withWorkspace "width-four-exhausted" [("0999.sql", "SELECT 999;\n")] $ \manifestPath -> do+ options <- assertRight (newMigrationOptions manifestPath Nothing "SELECT 1000;\n")+ result <- newMigration options+ result @?= Left (MigrationSequenceExhausted 4),+ testCase "automatic names round-trip through numeric-prefix inference" $+ forM_ roundTripCases $ \(width, next) -> do+ entry <- assertRight (renderNextMigrationName width next)+ numericPrefix entry @?= Just (width, next), testCase "exclusive creation refuses an existing migration" $ withWorkspace "collision" [("0001-first.sql", "SELECT 1;\n")] $ \manifestPath -> do originalManifest <- ByteString.readFile manifestPath@@ -75,6 +100,19 @@ createdFileExists @?= False directoryEntries <- List.sort <$> Directory.listDirectory (FilePath.takeDirectory manifestPath) directoryEntries @?= ["0001-first.sql", "manifest"],+ testCase "a post-rename clobber is detected and the new SQL file is removed" $+ withWorkspace "concurrent-modification" [("0001-first.sql", "SELECT 1;\n")] $ \manifestPath -> do+ originalManifest <- ByteString.readFile manifestPath+ options <- assertRight (newMigrationOptions manifestPath Nothing "SELECT 2;\n")+ let clobberingRename temporaryPath destinationPath = do+ Directory.renameFile temporaryPath destinationPath+ ByteString.writeFile destinationPath originalManifest+ result <- newMigrationWithRename clobberingRename options+ result @?= Left (AuthoringConcurrentModification manifestPath)+ ByteString.readFile manifestPath >>= (@?= originalManifest)+ Directory.doesFileExist+ (FilePath.takeDirectory manifestPath FilePath.</> "0002.sql")+ >>= (@?= False), testCase "option construction rejects nested explicit names" $ case newMigrationOptions "migrations/manifest" (Just "../outside") "SELECT 1" of Left (InvalidNewMigrationName (ParentTraversalManifestEntry 1 "../outside.sql")) -> pure ()@@ -88,6 +126,21 @@ numericFiles = [ ("0001-first.sql", "SELECT 1;\n"), ("0002-second.sql", "SELECT 2;\n")+ ]++numberedFiles :: Int -> [Integer] -> [(FilePath, ByteString.ByteString)]+numberedFiles width =+ fmap $ \number ->+ ( replicate (width - length (show number)) '0' <> show number <> ".sql",+ "SELECT " <> ByteString.Char8.pack (show number) <> ";\n"+ )++roundTripCases :: [(Int, Integer)]+roundTripCases =+ [ (width, next)+ | width <- [2 .. 6],+ next <- [1, 8, 9, 10, 99, 100, 999],+ length (show next) < width ] withWorkspace ::
test/unit/Test/Manifest.hs view
@@ -6,6 +6,7 @@ import Data.ByteString qualified as ByteString import Data.List.NonEmpty (NonEmpty (..)) import Database.PostgreSQL.Migrate.Embed+import Database.PostgreSQL.Migrate.Embed.Internal (byteStringExpression) import Paths_pg_migrate_embed qualified as Paths import System.Directory qualified as Directory import System.FilePath ((</>))@@ -21,6 +22,11 @@ testCase "valid entries and exact bytes follow manifest order" $ do result <- checkMigrationManifest =<< fixture "valid/migrations/manifest" result @?= Right validEmbedded,+ testCase "embedded primitive bytes preserve every byte value" $+ embeddedAllBytes @?= ByteString.pack [0 .. 255],+ testCase "a large embedded payload compiles without per-byte AST expansion" $ do+ ByteString.length largeEmbeddedBytes @?= largeFixtureSize+ ByteString.all (== 0xA5) largeEmbeddedBytes @?= True, testCase "blank lines are rejected" $ checkError "blank/manifest" (BlankManifestLine 2), testCase "comment lines are rejected" $@@ -67,12 +73,29 @@ case result of Left (ManifestInvalidUtf8 actualPath _) -> actualPath @?= manifestPath Left actual -> fail ("expected ManifestInvalidUtf8, received " <> show actual)- Right _ -> fail "expected invalid manifest UTF-8 to fail"+ Right _ -> fail "expected invalid manifest UTF-8 to fail",+ testCase "a manifest byte-order mark has a dedicated diagnostic"+ $ withTemporaryManifest+ "byte-order-mark"+ (ByteString.pack [0xEF, 0xBB, 0xBF] <> "0001-first.sql\n")+ $ \manifestPath ->+ checkTemporaryError manifestPath (ManifestByteOrderMark manifestPath) ] validEmbedded :: NonEmpty (FilePath, ByteString.ByteString) validEmbedded = $(embedMigrationManifest "test/fixtures/valid/migrations/manifest")++embeddedAllBytes :: ByteString.ByteString+embeddedAllBytes =+ $(pure (byteStringExpression (ByteString.pack [0 .. 255])))++largeFixtureSize :: Int+largeFixtureSize = 1024 * 1024 + 1++largeEmbeddedBytes :: ByteString.ByteString+largeEmbeddedBytes =+ $(pure (byteStringExpression (ByteString.replicate (1024 * 1024 + 1) 0xA5))) checkError :: FilePath -> ManifestError -> IO () checkError relativePath expected = do