{-# 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
, testCase "numberToBits simple" $ do
numberToBits (BitsVal 6 (0b010110::Int)) @?= [False, True, False, True, True, False]
]
main :: IO ()
main = defaultMain tests