M4ASpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}

module Test.M4ASpec (tests) where

import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad.Except (runExceptT)
import Control.Exception (try, IOException)
import Data.Bits (shiftR)
import qualified Data.ByteString as BS
import System.Directory (getTemporaryDirectory, removeFile)
import System.FilePath ((</>))
import System.OsPath hiding ((</>))
import Data.Text (Text)

import Monatone.M4A (parseM4A, loadAlbumArtM4A)
import Monatone.M4A.Writer (writeM4AMetadata)
import Monatone.Metadata

tests :: TestTree
tests = testGroup "M4A Parser"
  [ testGroup "File parsing"
      [ testParseM4AErrors
      , testParseM4AMetadata
      ]
  , testGroup "Album art"
      [ testLoadAlbumArt
      ]
  , testGroup "Writer chunk offsets"
      [ testChunkOffsetAdjustment
      ]
  ]

testParseM4AErrors :: TestTree
testParseM4AErrors = testGroup "parseM4A error handling"
  [ testCase "handles non-existent file" $ do
      result <- try $ runExceptT $ parseM4A [osp|/nonexistent/file.m4a|]
      case result of
        Left (_ :: IOException) -> return ()  -- Expected IO exception
        Right (Left _) -> return ()  -- Also acceptable - parser error
        Right (Right _) -> assertFailure "Expected error for non-existent file"
  ]

testParseM4AMetadata :: TestTree
testParseM4AMetadata = testGroup "parseM4A metadata extraction"
  [ testCase "parses basic M4A metadata" $ do
      -- This test would run if we had test fixtures
      -- For now, just verify the test structure works
      return ()

  , testCase "handles AAC files" $ do
      -- AAC-specific test
      return ()

  , testCase "handles ALAC files" $ do
      -- Apple Lossless specific test
      return ()
  ]

testLoadAlbumArt :: TestTree
testLoadAlbumArt = testGroup "loadAlbumArtM4A"
  [ testCase "handles non-existent file" $ do
      result <- try $ runExceptT $ loadAlbumArtM4A [osp|/nonexistent/file.m4a|]
      case result of
        Left (_ :: IOException) -> return ()
        Right (Left _) -> return ()
        Right (Right _) -> assertFailure "Expected error for non-existent file"

  , testCase "returns Nothing for file without album art" $ do
      -- Would test with actual fixture
      return ()
  ]

-- | Rewriting metadata resizes moov; in moov-first files the absolute chunk
-- offsets in stco/co64 must shift with the mdat data or the audio is lost.
testChunkOffsetAdjustment :: TestTree
testChunkOffsetAdjustment = testGroup "stco/co64 adjustment on moov resize"
  [ testCase "stco offsets still point at chunk data after write" $
      checkChunkOffsets "stco" "stco" w32
  , testCase "co64 offsets still point at chunk data after write" $
      checkChunkOffsets "co64" "co64" w64
  ]
  where
    chunk1 = "CHUNKONEDATA" :: BS.ByteString
    chunk2 = "CHUNKTWODATA" :: BS.ByteString

    checkChunkOffsets label tableName putOffset = do
      tmpDir <- getTemporaryDirectory
      let tmpPath = tmpDir </> "monatone-test-" ++ label ++ ".m4a"
      BS.writeFile tmpPath (buildMoovFirstFile tableName putOffset)

      osTmpPath <- encodeFS tmpPath
      let meta = (emptyMetadata M4A) { title = Just "A considerably longer replacement title" }
      result <- runExceptT $ writeM4AMetadata meta KeepExistingArt osTmpPath
      case result of
        Left err -> assertFailure $ "Write failed: " ++ show err
        Right () -> return ()

      output <- BS.readFile tmpPath
      removeFile tmpPath

      let atTable = snd $ BS.breakSubstring tableName output
      assertBool "output contains offset table" (not (BS.null atTable))
      assertBool "offset table is unique" $
        BS.null $ snd $ BS.breakSubstring tableName (BS.drop 4 atTable)
      let entryWidth = if tableName == ("co64" :: BS.ByteString) then 8 else 4
          tableBody = BS.drop 12 atTable  -- name (4) + version/flags (4) + count (4)
          readOffset i = readBE $ BS.take entryWidth $ BS.drop (i * entryWidth) tableBody
          off1 = readOffset 0
          off2 = readOffset 1
      assertEqual "chunk 1 readable at patched offset"
        chunk1 (BS.take (BS.length chunk1) (BS.drop off1 output))
      assertEqual "chunk 2 readable at patched offset"
        chunk2 (BS.take (BS.length chunk2) (BS.drop off2 output))

    -- Layout: ftyp | moov(trak(mdia(minf(stbl(stco|co64))))) | mdat(chunk1 chunk2)
    buildMoovFirstFile tableName putOffset =
      let moovFor off1 off2 =
            atomBS "moov" $ atomBS "trak" $ atomBS "mdia" $ atomBS "minf" $
              atomBS "stbl" $ atomBS tableName $
                BS.concat [w32 0, w32 2, putOffset off1, putOffset off2]
          ftyp = atomBS "ftyp" ("M4A " <> w32 0)
          moovLen = BS.length (moovFor 0 0)  -- offsets are fixed-width
          mdatStart = BS.length ftyp + moovLen
          off1 = mdatStart + 8
          off2 = off1 + BS.length chunk1
      in ftyp <> moovFor off1 off2 <> atomBS "mdat" (chunk1 <> chunk2)

    atomBS name content =
      w32 (8 + BS.length content) <> name <> content

    w32, w64 :: Int -> BS.ByteString
    w32 n = BS.pack [fromIntegral (n `shiftR` s) | s <- [24, 16, 8, 0]]
    w64 n = BS.pack [fromIntegral (n `shiftR` s) | s <- [56, 48, 40, 32, 24, 16, 8, 0]]

    readBE = BS.foldl' (\acc b -> acc * 256 + fromIntegral b) 0