monatone-0.3.0.0: test/Test/IntegrationSpec.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
module Test.IntegrationSpec (tests) where
import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad.Except (runExceptT)
import System.FilePath ((</>))
import System.Directory (doesFileExist, copyFile, removeFile, getTemporaryDirectory)
import System.Process (callProcess)
import Control.Exception (catch, SomeException)
import Control.Monad (unless)
import System.OsPath hiding ((</>))
import Data.Bits ((.&.), (.|.), shiftL)
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word8)
import Monatone.Common (parseMetadata)
import Monatone.Metadata
import Monatone.Writer
tests :: TestTree
tests = withResource ensureFixtures (const $ return ()) $ \_ ->
testGroup "Integration Tests"
[ testGroup "Reading Real Files"
[ testReadMinimalMP3
, testReadTaggedMP3
, testReadMinimalFLAC
, testReadMinimalM4A
]
, testGroup "Round-trip Tests"
[ testMP3RoundTrip
, testFLACRoundTrip
, testM4ARoundTrip
]
, testGroup "Write Safety"
[ testFailedWriteLeavesOriginalIntact
]
, testGroup "Tag Preservation"
[ testTagPreservation "MP3" "minimal.mp3"
[("TXXX:MyCustomTag", "custom-value"), ("TMOO", "Chill")]
, testTagPreservation "FLAC" "minimal.flac"
[("MYCUSTOMTAG", "custom-value")]
, testTagPreservation "M4A" "minimal.m4a"
[("----:com.example.test:CustomField", "custom-value"), ("\169wrt", "A Composer")]
, testFLACBlockPreservation
]
]
-- | Updating one field must not drop MusicBrainz/AcoustID tags, track and
-- disc totals, release status/type, or tags the writer does not map at all
testTagPreservation :: String -> FilePath -> [(Text, Text)] -> TestTree
testTagPreservation label fixtureName customTags =
testCase (label ++ " update preserves unrelated tags") $ do
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> fixtureName
tmpPath = tmpDir </> "monatone-test-preserve-" ++ fixtureName
origExists <- doesFileExist origPath
unless origExists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
copyFile origPath tmpPath
osTmpPath <- toOsPath tmpPath
-- Enrich the file with everything an update must not lose
parsed <- parseMetadata osTmpPath >>= either (assertFailure . show) return
let enriched = parsed
{ musicBrainzIds = MusicBrainzIds
{ mbTrackId = Just "mb-track"
, mbRecordingId = Just "mb-recording"
, mbReleaseId = Just "mb-release"
, mbReleaseGroupId = Just "mb-release-group"
, mbArtistId = Just "mb-artist"
, mbAlbumArtistId = Just "mb-album-artist"
, mbWorkId = Just "mb-work"
, mbDiscId = Just "mb-disc"
}
, acoustidFingerprint = Just "fp-12345"
, acoustidId = Just "acoustid-67890"
-- MP3/M4A can only carry totals alongside a number ("n/total"),
-- so the numbers must be present too
, trackNumber = Just 7
, totalTracks = Just 12
, discNumber = Just 1
, totalDiscs = Just 2
, releaseStatus = Just "official"
, releaseType = Just "album"
, rawTags = foldr (uncurry HM.insert) (rawTags parsed) customTags
}
runExceptT (writeMetadata enriched Nothing osTmpPath)
>>= either (assertFailure . show) return
-- The regression under test: an unrelated update must keep all of it
runExceptT (updateMetadata osTmpPath (setTitle "Preserved Title Test" emptyUpdate))
>>= either (assertFailure . show) return
final <- parseMetadata osTmpPath >>= either (assertFailure . show) return
assertEqual "title updated" (Just "Preserved Title Test") (title final)
let mbIds = musicBrainzIds final
assertEqual "mbTrackId" (Just "mb-track") (mbTrackId mbIds)
assertEqual "mbRecordingId" (Just "mb-recording") (mbRecordingId mbIds)
assertEqual "mbReleaseId" (Just "mb-release") (mbReleaseId mbIds)
assertEqual "mbReleaseGroupId" (Just "mb-release-group") (mbReleaseGroupId mbIds)
assertEqual "mbArtistId" (Just "mb-artist") (mbArtistId mbIds)
assertEqual "mbAlbumArtistId" (Just "mb-album-artist") (mbAlbumArtistId mbIds)
assertEqual "mbWorkId" (Just "mb-work") (mbWorkId mbIds)
assertEqual "mbDiscId" (Just "mb-disc") (mbDiscId mbIds)
assertEqual "acoustidFingerprint" (Just "fp-12345") (acoustidFingerprint final)
assertEqual "acoustidId" (Just "acoustid-67890") (acoustidId final)
assertEqual "totalTracks" (Just 12) (totalTracks final)
assertEqual "totalDiscs" (Just 2) (totalDiscs final)
assertEqual "releaseStatus" (Just "official") (releaseStatus final)
assertEqual "releaseType" (Just "album") (releaseType final)
mapM_ (\(key, value) ->
assertEqual ("custom tag " ++ T.unpack key) (Just value) (HM.lookup key (rawTags final)))
customTags
removeFile tmpPath
-- | FLAC updates must carry over metadata blocks they do not regenerate
-- (SEEKTABLE, APPLICATION, CUESHEET)
testFLACBlockPreservation :: TestTree
testFLACBlockPreservation = testCase "FLAC update preserves SEEKTABLE block" $ do
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> "minimal.flac"
tmpPath = tmpDir </> "monatone-test-seektable.flac"
origExists <- doesFileExist origPath
unless origExists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
-- Insert a synthetic SEEKTABLE (type 3, one placeholder seekpoint) after
-- STREAMINFO: 4-byte signature + 38-byte STREAMINFO block, then the rest
orig <- BS.readFile origPath
let (prefix, rest) = BS.splitAt 42 orig
seekPoint = BS.replicate 18 0xFF -- placeholder seekpoint per spec
seekTable = BS.pack [3, 0, 0, 18] <> seekPoint
BS.writeFile tmpPath (prefix <> seekTable <> rest)
osTmpPath <- toOsPath tmpPath
runExceptT (updateMetadata osTmpPath (setTitle "Block Preservation" emptyUpdate))
>>= either (assertFailure . show) return
final <- BS.readFile tmpPath
let blocks = flacBlocks final
assertBool "SEEKTABLE block survived the update" $
(3, seekTable) `elem` [(t, BS.pack [3, 0, 0, 18] <> c) | (t, c) <- blocks, t == 3]
removeFile tmpPath
where
-- Walk the metadata blocks of a FLAC file: (type, content) pairs
flacBlocks :: BS.ByteString -> [(Word8, BS.ByteString)]
flacBlocks bs = go 4
where
go pos
| pos + 4 > BS.length bs = []
| otherwise =
let hdr = BS.index bs pos
btype = hdr .&. 0x7F
len = (fromIntegral (BS.index bs (pos + 1)) `shiftL` 16) .|.
(fromIntegral (BS.index bs (pos + 2)) `shiftL` 8) .|.
fromIntegral (BS.index bs (pos + 3))
content = BS.take len (BS.drop (pos + 4) bs)
next = if hdr .&. 0x80 /= 0 then [] else go (pos + 4 + len)
in (btype, content) : next
-- | Writes go through a temp copy + atomic rename, so a failed write must
-- leave the original file byte-identical and clean up its temp file.
testFailedWriteLeavesOriginalIntact :: TestTree
testFailedWriteLeavesOriginalIntact = testCase "Failed write leaves original untouched" $ do
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> "minimal.flac"
tmpPath = tmpDir </> "monatone-test-atomic.flac"
origExists <- doesFileExist origPath
unless origExists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
copyFile origPath tmpPath
before <- BS.readFile tmpPath
-- Force a failure: metadata claims M4A, but the file is FLAC, so the
-- M4A writer errors out partway through
osTmpPath <- toOsPath tmpPath
result <- runExceptT $ writeMetadata (emptyMetadata M4A) Nothing osTmpPath
case result of
Left _ -> return ()
Right () -> assertFailure "Expected write to fail on mismatched format"
after <- BS.readFile tmpPath
assertEqual "original bytes unchanged after failed write" before after
leftover <- doesFileExist (tmpPath ++ ".monatone.tmp")
assertBool "no temp file left behind" (not leftover)
removeFile tmpPath
-- | Ensure test fixtures exist, generate them if missing
ensureFixtures :: IO ()
ensureFixtures = do
let files = [ fixturesDir </> "minimal.mp3"
, fixturesDir </> "tagged.mp3"
, fixturesDir </> "minimal.flac"
, fixturesDir </> "minimal.m4a"
]
allExist <- and <$> mapM doesFileExist files
unless allExist $ do
putStrLn "Test fixtures not found. Attempting to generate with ffmpeg..."
generateTestFiles `catch` handleError
where
handleError :: SomeException -> IO ()
handleError _ = putStrLn "Warning: Could not generate test fixtures (ffmpeg not available). Integration tests will be skipped."
-- | Generate test files using ffmpeg
generateTestFiles :: IO ()
generateTestFiles = do
-- Generate 1 second of silence as raw PCM
callProcess "ffmpeg" ["-f", "lavfi", "-i", "anullsrc=r=44100:cl=stereo",
"-t", "1", "-f", "s16le", "-y", "/tmp/silence.raw"]
-- Create MP3 with metadata
callProcess "ffmpeg" ["-f", "s16le", "-ar", "44100", "-ac", "2", "-i", "/tmp/silence.raw",
"-codec:a", "libmp3lame", "-b:a", "128k",
"-metadata", "title=Test Title",
"-metadata", "artist=Test Artist",
"-metadata", "album=Test Album",
"-metadata", "date=2024",
"-metadata", "track=1/10",
"-metadata", "genre=Rock",
"-metadata", "comment=Test comment",
"-y", fixturesDir </> "tagged.mp3"]
-- Create minimal MP3
callProcess "ffmpeg" ["-f", "s16le", "-ar", "44100", "-ac", "2", "-i", "/tmp/silence.raw",
"-codec:a", "libmp3lame", "-b:a", "128k",
"-metadata", "title=Minimal Title",
"-y", fixturesDir </> "minimal.mp3"]
-- Create FLAC with metadata
callProcess "ffmpeg" ["-f", "s16le", "-ar", "44100", "-ac", "2", "-i", "/tmp/silence.raw",
"-codec:a", "flac",
"-metadata", "title=FLAC Test Track",
"-metadata", "artist=Test Band",
"-metadata", "album=FLAC Album",
"-metadata", "date=2024",
"-metadata", "track=3",
"-metadata", "comment=FLAC test comment",
"-y", fixturesDir </> "minimal.flac"]
-- Create M4A with metadata (AAC)
callProcess "ffmpeg" ["-f", "s16le", "-ar", "44100", "-ac", "2", "-i", "/tmp/silence.raw",
"-codec:a", "aac", "-b:a", "128k",
"-metadata", "title=M4A Test Track",
"-metadata", "artist=M4A Artist",
"-metadata", "album=M4A Album",
"-metadata", "date=2024",
"-metadata", "track=2/10",
"-metadata", "genre=Electronic",
"-metadata", "comment=M4A test comment",
"-y", fixturesDir </> "minimal.m4a"]
-- Clean up
removeFile "/tmp/silence.raw" `catch` (\(_ :: SomeException) -> return ())
fixturesDir :: FilePath
fixturesDir = "test/fixtures"
-- Helper to convert FilePath to OsPath
toOsPath :: FilePath -> IO OsPath
toOsPath = encodeFS
testReadMinimalMP3 :: TestTree
testReadMinimalMP3 = testCase "Read minimal MP3" $ do
let path = fixturesDir </> "minimal.mp3"
exists <- doesFileExist path
unless exists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
osPath <- toOsPath path
result <- parseMetadata osPath
case result of
Left err -> assertFailure $ T.unpack $ "Failed to parse: " <> T.pack (show err)
Right metadata -> do
assertEqual "Format" MP3 (format metadata)
assertEqual "Title" (Just "Minimal Title") (title metadata)
testReadTaggedMP3 :: TestTree
testReadTaggedMP3 = testCase "Read MP3 with full metadata" $ do
let path = fixturesDir </> "tagged.mp3"
exists <- doesFileExist path
assertBool "Test file exists" exists
osPath <- toOsPath path
result <- parseMetadata osPath
case result of
Left err -> assertFailure $ T.unpack $ "Failed to parse: " <> T.pack (show err)
Right metadata -> do
assertEqual "Format" MP3 (format metadata)
assertEqual "Title" (Just "Test Title") (title metadata)
assertEqual "Artist" (Just "Test Artist") (artist metadata)
assertEqual "Album" (Just "Test Album") (album metadata)
assertEqual "Year" (Just 2024) (year metadata)
assertEqual "Track number" (Just 1) (trackNumber metadata)
assertEqual "Genre" (Just "Rock") (genre metadata)
assertEqual "Comment" (Just "Test comment") (comment metadata)
testReadMinimalFLAC :: TestTree
testReadMinimalFLAC = testCase "Read minimal FLAC" $ do
let path = fixturesDir </> "minimal.flac"
exists <- doesFileExist path
assertBool "Test file exists" exists
osPath <- toOsPath path
result <- parseMetadata osPath
case result of
Left err -> assertFailure $ T.unpack $ "Failed to parse: " <> T.pack (show err)
Right metadata -> do
assertEqual "Format" FLAC (format metadata)
assertEqual "Title" (Just "FLAC Test Track") (title metadata)
assertEqual "Artist" (Just "Test Band") (artist metadata)
-- Check audio properties from STREAMINFO
let props = audioProperties metadata
case sampleRate props of
Just sr -> assertEqual "Sample rate" 44100 sr
Nothing -> assertFailure "No sample rate found"
case channels props of
Just ch -> assertEqual "Channels" 2 ch
Nothing -> assertFailure "No channels found"
testMP3RoundTrip :: TestTree
testMP3RoundTrip = testCase "MP3 read-write-read round trip" $ do
-- Use system temp directory
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> "tagged.mp3"
let tmpPath = tmpDir </> "monatone-test-mp3.mp3"
-- Verify source file exists
origExists <- doesFileExist origPath
assertBool (T.unpack $ "Source file exists: " <> T.pack origPath) origExists
-- Copy file to temp location
copyFile origPath tmpPath
-- Verify copy succeeded
tmpExists <- doesFileExist tmpPath
assertBool (T.unpack $ "Temp file created: " <> T.pack tmpPath) tmpExists
-- Read original metadata
osTmpPath <- toOsPath tmpPath
origResult <- parseMetadata osTmpPath
origMetadata <- case origResult of
Left err -> assertFailure $ T.unpack $ "Failed to read original: " <> T.pack (show err)
Right m -> return m
-- Modify metadata
let update = setTitle "Modified Title" $
setArtist "Modified Artist" $
setYear 2025 $
emptyUpdate
writeResult <- runExceptT $ updateMetadata osTmpPath update
case writeResult of
Left err -> assertFailure $ "Failed to write: " ++ show err
Right () -> return ()
-- Read modified metadata
modResult <- parseMetadata osTmpPath
case modResult of
Left err -> assertFailure $ "Failed to read modified: " ++ show err
Right modMetadata -> do
assertEqual "Modified title" (Just "Modified Title") (title modMetadata)
assertEqual "Modified artist" (Just "Modified Artist") (artist modMetadata)
assertEqual "Modified year" (Just 2025) (year modMetadata)
-- Unchanged fields should be preserved
assertEqual "Album preserved" (album origMetadata) (album modMetadata)
assertEqual "Genre preserved" (genre origMetadata) (genre modMetadata)
-- Clean up
removeFile tmpPath
testFLACRoundTrip :: TestTree
testFLACRoundTrip = testCase "FLAC read-write-read round trip" $ do
-- Use system temp directory
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> "minimal.flac"
let tmpPath = tmpDir </> "monatone-test-flac.flac"
-- Verify source file exists
origExists <- doesFileExist origPath
assertBool (T.unpack $ "Source file exists: " <> T.pack origPath) origExists
-- Copy file to temp location
copyFile origPath tmpPath
-- Verify copy succeeded
tmpExists <- doesFileExist tmpPath
assertBool (T.unpack $ "Temp file created: " <> T.pack tmpPath) tmpExists
-- Read original metadata
osTmpPath <- toOsPath tmpPath
origResult <- parseMetadata osTmpPath
origMetadata <- case origResult of
Left err -> assertFailure $ T.unpack $ "Failed to read original: " <> T.pack (show err)
Right m -> return m
-- Modify metadata
let update = setTitle "New FLAC Title" $
setAlbum "New Album" $
setTrackNumber 5 $
setComment "Test comment" $
emptyUpdate
writeResult <- runExceptT $ updateMetadata osTmpPath update
case writeResult of
Left err -> assertFailure $ "Failed to write: " ++ show err
Right () -> return ()
-- Read modified metadata
modResult <- parseMetadata osTmpPath
case modResult of
Left err -> assertFailure $ "Failed to read modified: " ++ show err
Right modMetadata -> do
assertEqual "Modified title" (Just "New FLAC Title") (title modMetadata)
assertEqual "Modified album" (Just "New Album") (album modMetadata)
assertEqual "Modified track" (Just 5) (trackNumber modMetadata)
assertEqual "Modified comment" (Just "Test comment") (comment modMetadata)
-- Original artist should be preserved
assertEqual "Artist preserved" (artist origMetadata) (artist modMetadata)
-- Audio properties should remain unchanged
assertEqual "Audio props preserved"
(audioProperties origMetadata)
(audioProperties modMetadata)
-- Clean up
removeFile tmpPath
testReadMinimalM4A :: TestTree
testReadMinimalM4A = testCase "Read minimal M4A" $ do
let path = fixturesDir </> "minimal.m4a"
exists <- doesFileExist path
unless exists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
osPath <- toOsPath path
result <- parseMetadata osPath
case result of
Left err -> assertFailure $ T.unpack $ "Failed to parse: " <> T.pack (show err)
Right metadata -> do
assertEqual "Format" M4A (format metadata)
assertEqual "Title" (Just "M4A Test Track") (title metadata)
assertEqual "Artist" (Just "M4A Artist") (artist metadata)
assertEqual "Album" (Just "M4A Album") (album metadata)
assertEqual "Track number" (Just 2) (trackNumber metadata)
assertEqual "Total tracks" (Just 10) (totalTracks metadata)
assertEqual "Genre" (Just "Electronic") (genre metadata)
-- Check audio properties
let props = audioProperties metadata
case sampleRate props of
Just sr -> assertEqual "Sample rate" 44100 sr
Nothing -> assertFailure "No sample rate found"
case channels props of
Just ch -> assertEqual "Channels" 2 ch
Nothing -> assertFailure "No channels found"
testM4ARoundTrip :: TestTree
testM4ARoundTrip = testCase "M4A read-write-read round trip" $ do
-- Use system temp directory
tmpDir <- getTemporaryDirectory
let origPath = fixturesDir </> "minimal.m4a"
let tmpPath = tmpDir </> "monatone-test-m4a.m4a"
-- Verify source file exists
origExists <- doesFileExist origPath
unless origExists $ assertFailure "Test skipped: fixture not available (run with ffmpeg to generate)"
-- Copy file to temp location
copyFile origPath tmpPath
-- Verify copy succeeded
tmpExists <- doesFileExist tmpPath
assertBool (T.unpack $ "Temp file created: " <> T.pack tmpPath) tmpExists
-- Read original metadata
osTmpPath <- toOsPath tmpPath
origResult <- parseMetadata osTmpPath
origMetadata <- case origResult of
Left err -> assertFailure $ T.unpack $ "Failed to read original: " <> T.pack (show err)
Right m -> return m
-- Modify metadata including freeform fields
let update = setTitle "Modified M4A Title" $
setArtist "New Artist" $
setYear 2025 $
setTrackNumber 7 $
setGenre "Jazz" $
setLabel "Test Records" $
setCatalogNumber "TEST-001" $
setBarcode "1234567890123" $
setReleaseCountry "US" $
emptyUpdate
writeResult <- runExceptT $ updateMetadata osTmpPath update
case writeResult of
Left err -> assertFailure $ "Failed to write: " ++ show err
Right () -> return ()
-- Read modified metadata
modResult <- parseMetadata osTmpPath
case modResult of
Left err -> assertFailure $ "Failed to read modified: " ++ show err
Right modMetadata -> do
assertEqual "Modified title" (Just "Modified M4A Title") (title modMetadata)
assertEqual "Modified artist" (Just "New Artist") (artist modMetadata)
assertEqual "Modified year" (Just 2025) (year modMetadata)
assertEqual "Modified track" (Just 7) (trackNumber modMetadata)
assertEqual "Modified genre" (Just "Jazz") (genre modMetadata)
-- Freeform fields
assertEqual "Record label" (Just "Test Records") (recordLabel modMetadata)
assertEqual "Catalog number" (Just "TEST-001") (catalogNumber modMetadata)
assertEqual "Barcode" (Just "1234567890123") (barcode modMetadata)
assertEqual "Release country" (Just "US") (releaseCountry modMetadata)
-- Unchanged fields should be preserved
assertEqual "Album preserved" (album origMetadata) (album modMetadata)
assertEqual "Comment preserved" (comment origMetadata) (comment modMetadata)
-- Total tracks should be preserved
assertEqual "Total tracks preserved" (totalTracks origMetadata) (totalTracks modMetadata)
-- Audio properties should remain unchanged
assertEqual "Audio props preserved"
(audioProperties origMetadata)
(audioProperties modMetadata)
-- Clean up
removeFile tmpPath