ByteOrderMarks.hs

{-|
Description:    Emulating tests from @encoding/textdecoder-byte-order-marks.any.js@

Copyright:      (c) 2020 Samuel May
License:        MPL-2.0
Maintainer:     ag.eitilt@gmail.com

Stability:      experimental
Portability:    portable
-}
module Test.Willow.WebPlatformTests.Manual.Encoding.ByteOrderMarks
    ( tests
    ) where


import qualified Data.ByteString as BS
import qualified Data.Maybe as Y
import qualified Data.Text as T

import qualified Test.HUnit as U

import Test.HUnit ( (~:), (~?=), (@?) )

import Web.Willow.Common.Encoding
import Web.Willow.Common.Encoding.Labels

import Test.Willow.WebPlatformTests.Manual.Common


tests :: U.Test
tests = "textdecoder-byte-order-marks.any.js" ~: U.TestList $
    map test testData


test :: TestData -> U.Test
test d = encoding d ~: U.TestList
    [ "Sequence without BOM should decode successfully" ~:
        let result = do
                enc <- lookupEncoding (T.pack $ encoding d)
                return . decodeEnc' enc $ bytes d
        in  result ~?= Just reference
    , "Sequence with BOM should decode successfully (with no BOM present in output)" ~:
        let result = do
                enc <- lookupEncoding (T.pack $ encoding d)
                return . decodeEnc' enc $ bom d <> bytes d
        in  result ~?= Just reference
    , "Mismatching BOM should not be ignored - treated as garbage bytes" ~: U.TestList $
        Y.mapMaybe (testMismatch d) testData
    ]

testMismatch :: TestData -> TestData -> Maybe U.Test
testMismatch d d'
    | encoding d == encoding d' = Nothing
    | otherwise = Just $ encoding d' ~: do
        let s' = do
            enc <- lookupEncoding . T.pack $ encoding d
            return . decodeEnc' enc $ bom d' <> bytes d
        s' /= Just reference @? "BOM ignored"


data TestData = TestData
    { encoding :: String
    , bom :: BS.ByteString
    , bytes :: BS.ByteString
    }

testData :: [TestData]
testData =
    [ TestData
        { encoding = "utf-8"
        , bom = BS.pack [0xEF, 0xBB, 0xBF]
        , bytes = BS.pack
            [ 0x7A, 0xC2, 0xA2, 0xE6, 0xB0, 0xB4, 0xF0, 0x9D
            , 0x84, 0x9E, 0xF4, 0x8F, 0xBF, 0xBD
            ]
        }
    , TestData
        { encoding = "utf-16le"
        , bom = BS.pack [0xff, 0xfe]
        , bytes = BS.pack
            [ 0x7A, 0x00, 0xA2, 0x00, 0x34, 0x6C, 0x34, 0xD8
            , 0x1E, 0xDD, 0xFF, 0xDB, 0xFD, 0xDF
            ]
        }
    , TestData
        { encoding = "utf-16be"
        , bom = BS.pack [0xfe, 0xff]
        , bytes = BS.pack
            [ 0x00, 0x7A, 0x00, 0xA2, 0x6C, 0x34, 0xD8, 0x34
            , 0xDD, 0x1E, 0xDB, 0xFF, 0xDF, 0xFD
            ]
        }
    ]

reference :: T.Text
reference = T.pack "z\x00A2\x6C34\xD834\xDD1E\xDBFF\xDFFD"