EucJp.hs

{-|
Description:    

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

Stability:      experimental
Portability:    portable
-}
module Test.Willow.Property.Encoding.EucJp
    ( tests
    ) where


import qualified Hedgehog as H
import qualified Hedgehog.Gen as H.G
import qualified Hedgehog.Range as H.R

import Web.Willow.Common.Encoding

import Test.Willow.Property.Common


tests :: H.Group
tests = packGroup "Web.Willow.Common.Encoding.EucJp"
    -- Single byte tests handled in "unit" due to limited number
    [ decodeEndOfStream
    , decodeTwoByteInvalid
    , decodeThreeByteInvalid
    , decodeOneByteLookup
    , decodeTwoByteLookup
    , decodeThreeByteLookup
    ]


decodeEndOfStream :: Test
decodeEndOfStream = packTest "incomplete character" $ do
    char <- H.forAll $ H.G.choice
        [ (: []) <$> H.G.choice
            [ H.G.constant 0x8E
            , H.G.word8 $ H.R.linear 0xA1 0xFE
            ]
        , do
            b2 <- H.G.word8 $ H.R.linear 0xA1 0xFE
            return [0x8F, b2]
        ]
    checkEndOfStream EucJp char


decodeTwoByteInvalid :: Test
decodeTwoByteInvalid = packTest "invalid second byte" $ do
    (char, second) <- H.forAll $ H.G.choice
        [ do
            b1 <- H.G.word8 $ H.R.linear 0xA1 0xFE
            b2 <- H.G.choice
                [ H.G.word8 $ H.R.linear 0x00 0xA0
                , H.G.constant 0xFF
                ]
            lead <- H.G.element
                [ []
                , [0x8F]
                ]
            return (lead ++ [b1, b2], b2)
        , do
            b1 <- H.G.element [0x8E, 0x8F]
            let l2 = if b1 == 0x8E
                    then 0xE0
                    else 0xFF
            b2 <- H.G.choice $ map H.G.word8
                [ H.R.linear 0x00 0xA0
                , H.R.linear l2 0xFF
                ]
            return ([b1, b2], b2)
        ]
    let check = if second <= 0x7F
            then checkInvalid
            else checkInvalidAll
    check EucJp char

decodeThreeByteInvalid :: Test
decodeThreeByteInvalid = packTest "invalid third byte" $ do
    second <- H.forAll . H.G.word8 $ H.R.linear 0xA1 0xFE
    third <- H.forAll $ H.G.choice
        [ H.G.word8 $ H.R.linear 0x00 0xA0
        , H.G.constant 0xFF
        ]
    let check = if second <= 0x7F
            then checkInvalid
            else checkInvalidAll
    check EucJp [0x8F, second, third]

decodeOneByteLookup :: Test
decodeOneByteLookup = packTest "one-byte sequence" $ do
    first <- H.forAll $ H.G.choice
        [ H.G.word8 $ H.R.linear 0x00 0x8D
        , H.G.word8 $ H.R.linear 0x90 0xA0
        , H.G.constant 0xFF
        ]
    checkTrailing EucJp [first]

decodeTwoByteLookup :: Test
decodeTwoByteLookup = packTest "two-byte sequence" $ do
    (first, second) <- H.forAll $ H.G.choice
        [ do
            b2 <- H.G.word8 $ H.R.linear 0xA1 0xDF
            return (0x8E, b2)
        , do
            b1 <- H.G.word8 $ H.R.linear 0xA1 0xFE
            b2 <- H.G.word8 $ H.R.linear 0xA1 0xFE
            return (b1, b2)
        ]
    checkTrailingAll EucJp [first, second]

decodeThreeByteLookup :: Test
decodeThreeByteLookup = packTest "three-byte sequence" $ do
    second <- H.forAll . H.G.word8 $ H.R.linear 0xA1 0xFE
    third <- H.forAll . H.G.word8 $ H.R.linear 0xA1 0xFE
    checkTrailingAll EucJp [0x8F, second, third]