{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Data.BitProtocol
import qualified Data.ByteString.Base64.URL.Lazy as B64URL
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC

tests :: TestTree
tests =
  testGroup
    "Tests"
    [ testCase "Semigroup/Monoid 000001 + 000001 == 000001000001" $ do
        mconcat [BitsVal 6 (1 :: Int), BitsVal 6 1] @?=
          BitsVal 12 0b000001000001
    , testCase "numToWord8Array simple" $ do
        numToWord8Array (BitsVal 12 (0b000001000001 :: Int)) @?=
          [0b00000100, 0b0001]
    , testCase "word8sToIntegral simple" $ do
        word8sToIntegral [0b0001] @?= (1 :: Int)
    , testCase "bitsValBiggerToCharUnsafe simple" $ do
        bitsValBiggerToCharUnsafe (BitsVal 12 (0b000001000001 :: Int)) @?=
          ([0b00000100], BitsVal 4 0b0001)
    , testCase "Readme example" $ do
        let age = 29 :: Int
            fav = 12
            lucky = 13
            rand = 14
        B64URL.encode
          (encodeBS8
             [BitsVal 6 age, BitsVal 7 fav, BitsVal 5 lucky, BitsVal 6 rand]) @?=
          "dGNO"
    , testCase "encodeBS8 without encoding" $ do
        encodeBS8
          [ BitsVal 4 (0b0000 :: Int)
          , BitsVal 4 0b0100
          , BitsVal 4 0b1110
          , BitsVal 4 0b0001
          , BitsVal 4 0b0000
          , BitsVal 4 0b0101
          , BitsVal 4 0b0001
          , BitsVal 4 0b0000
          ] @?=
          "\x04\xE1\x05\x10"
    , testCase "mconcat simple test" $
      do mconcat
           [ BitsVal 6 0b000001
           , BitsVal 26 (0b00111000010000010100010000 :: Int)
           ]
     @?= BitsVal 32 0b00000100111000010000010100010000
    , testCase "division logic check" $ do
        (0b00000100111000010000010100010000 :: Int) `div`
          (2 ^ (32 - (8 :: Int))) @?= 0b00000100
        0b00000100111000010000010100010000 `mod`
          (2 ^ (32 - (8 :: Int))) @?= (0b111000010000010100010000 :: Int)
    , testCase "numToWord8Array simple test" $ do
        numToWord8Array (BitsVal 32 (0b00000100111000010000010100010000 :: Int)) @?=
          [0b00000100, 0b11100001, 0b00000101, 0b00010000]
    , testCase "bitsValBiggerToCharUnsafe simple test" $ do
        bitsValBiggerToCharUnsafe
          (BitsVal 32 (0b00000100111000010000010100010000 :: Int)) @?=
          ([0b00000100, 0b11100001, 0b00000101, 0b00010000], BitsVal 0 0)
    , testCase "encodeBS8 without encoding for the GDPR subcase" $ do
        encodeBS8
          [BitsVal 6 (0b000001 :: Int), BitsVal 26 0b00111000010000010100010000] @?=
          "\x04\xE1\x05\x10"
    , testCase "base64url reassurance" $
        -- 000001 001110000100000101000100000000110010 001110000100000101000100000000110010 ...
        -- 000001001110000100000101000100000000110010001110000100000101000100000000110010 ...
        -- 000001_001110_000100_000101_000100_000000_110010_001110_000100_000101_000100_000000_110010 ...
        -- 1 14 4 5 4 0 50 ...
        -- B O E F E A y ...
        -- 0000_0100_1110_0001_0000_0101_0001_0000_0000_1100_1000_1110_0001_0000_0101_0001_0000_0000_1100_10 ...
        -- 04E105100C ...
       do B64URL.encode "\x04\xE1\x05\x10\x0C" @?= "BOEFEAw="
    , testCase "roundTo8 simple" $ do
        roundTo8 (BitsVal 6 0b000001) @?= BitsVal 8 (0b00000100 :: Int)
    , testCase "roundTo8 zero" $ do
        roundTo8 (BitsVal 0 0) @?= BitsVal 0 (0 :: Int)
    , testCase "GDPR subcase" $ do
        B64URL.encode
          (encodeBS8
             [ BitsVal 6 (0b000001 :: Int)
             , BitsVal 36 0b001110000100000101000100000000110010
             ]) @?=
          "BOEFEAyA"
    , testCase
        "GDPR example (see \"Example Vendor Consent String\" at https://github.com/InteractiveAdvertisingBureau/GDPR-Transparency-and-Consent-Framework/blob/master/Consent%20string%20and%20vendor%20list%20formats%20v1.1%20Final.md#example-vendor-consent-string-)" $ do
        let version = BitsVal 6 (0b000001 :: Int)
            created = BitsVal 36 0b001110000100000101000100000000110010
            lastUpdated = BitsVal 36 0b001110000100000101000100000000110010
            cmpId = BitsVal 12 0b000000000111
            cmpVersion = BitsVal 12 0b000000000001
            consentScreen = BitsVal 6 0b000011
            consentLanguage = BitsVal 12 0b000100001101
            vendorListVersion = BitsVal 12 0b000000001000
            purposesAllowed = BitsVal 24 0b111000000000000000000000
            maxVendorId = BitsVal 16 0b0000011111011011
            encodingType = BitsVal 1 1
            defaultConsent = BitsVal 1 1
            numEntries = BitsVal 12 0b000000000001
            singleOrRange = BitsVal 1 0
            singleVendorId = BitsVal 16 0b0000000000001001
            expectedResult = "BOEFEAyOEFEAyAHABDENAI4AAAB9vABAASA="
        B64URL.encode
          (encodeBS8
             [ version
             , created
             , lastUpdated
             , cmpId
             , cmpVersion
             , consentScreen
             , consentLanguage
             , vendorListVersion
             , purposesAllowed
             , maxVendorId
             , encodingType
             , defaultConsent
             , numEntries
             , singleOrRange
             , singleVendorId
             ]) @?=
          expectedResult
    , testCase "byteStringToBitsVal simple" $ do
        byteStringToBitsVal "\x04\xE1\xe05\x10" @?=
          BitsVal 32 (0b00000100111000010000010100010000 :: Int)
    , testCase
        "readBitValue reading 6 bits from \"010 + 11111111\" gives \"010111\" and a leftover \"11111\"" $ do
        readBitValue 6 (BitsVal 3 (0b010 :: Int)) "\xFF" @?=
          (BitsVal 6 0b010111, BitsVal 5 0b11111)
    , testCase "parseBS8 simple parse" $ do
        parseBS8 [6, 26] "\x04\xE1\x05\x10" @?=
          ( [ BitsVal 6 (0b000001 :: Int)
            , BitsVal 26 0b00111000010000010100010000
            ]
          , BitsVal 0 0
          , "")
    , testCase "parseBS8 from readme" $ do
        let (Right bs) = B64URL.decode "dGNO"
        parseBS8 [6, 7, 5, 6] bs @?=
          ( [BitsVal 6 (29 :: Int), BitsVal 7 12, BitsVal 5 13, BitsVal 6 14]
          , BitsVal 0 0
          , "")
    , testCase "quickcheck failure simplified-02" $ do
        readBitValue 20 (BitsVal 7 (0 :: Int)) "\NUL\DLE\ENQ\NUL" @?=
          (BitsVal 20 2, BitsVal 19 1280)
    , testCase "quickcheck failure simplified-01" $
      do parseBS8
           @Int
           [17, 20, 11, 15, 19, 13, 12, 13, 10]
           "\NUL\EOT\128\NUL\DLE\ENQ\NUL\STX\NUL\NUL\128\STX\NUL\128\STX\SOH\128"
     @?= ( [ BitsVal {bvBitsNum = 17, bvVal = 9}
           , BitsVal {bvBitsNum = 20, bvVal = 2}
           , BitsVal {bvBitsNum = 11, bvVal = 5}
           , BitsVal {bvBitsNum = 15, bvVal = 1}
           , BitsVal {bvBitsNum = 19, bvVal = 2}
           , BitsVal {bvBitsNum = 13, bvVal = 1}
           , BitsVal {bvBitsNum = 12, bvVal = 4}
           , BitsVal {bvBitsNum = 13, bvVal = 2}
           , BitsVal {bvBitsNum = 10, bvVal = 6}
           ]
         , BitsVal {bvBitsNum = 6, bvVal = 0}
         , "")
    , testCase "encode . decode = id from QuickCheck failure" $ do
        let xs =
              [ BitsVal 17 (9 :: Int)
              , BitsVal 20 2
              , BitsVal 11 5
              , BitsVal 15 1
              , BitsVal 19 2
              , BitsVal 13 1
              , BitsVal 12 4
              , BitsVal 13 2
              , BitsVal 10 6
              ]
            bitNums = map bvBitsNum xs
            (res, _, _) = parseBS8 @Int bitNums (encodeBS8 xs)
        res @?= xs
    , testCase "encode . decode = id from QuickCheck failure-02" $ do
        let xs :: [BitsVal Int]
            xs = [BitsVal 12 4, BitsVal 16 2]
            bitNums = [12, 16]
            (res, _, _) = parseBS8 bitNums (encodeBS8 xs)
        res @?= xs
    , QC.testProperty "encode . decode = id" $ \(xs' :: [BitsVal (Positive Integer)]) ->
        let xs =
              map (\(BitsVal len (Positive val)) -> BitsVal (len + 10) val) xs'
            bitNums = map bvBitsNum xs
            (res, _, _) = parseBS8 bitNums (encodeBS8 xs)
         in res == xs
    ]

main :: IO ()
main = defaultMain tests