1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Tests.Util
( splits2
, splits3
, arbitraryWithBounds
, Length(..)
, mkLengthPrefix
) where
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL
import Data.Word
import Test.Tasty.QuickCheck
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
-- | Generate all 2-splits of a serialised CBOR value.
splits2 :: BSL.ByteString -> [BSL.ByteString]
splits2 bs = zipWith (\a b -> BSL.fromChunks [a,b]) (BS.inits sbs) (BS.tails sbs)
where
sbs = BSL.toStrict bs
-- | Generate all 3-splits of a serialised CBOR value.
splits3 :: BSL.ByteString -> [BSL.ByteString]
splits3 bs =
[ BSL.fromChunks [a,b,c]
| (a,x) <- zip (BS.inits sbs) (BS.tails sbs)
, (b,c) <- zip (BS.inits x) (BS.tails x) ]
where
sbs = BSL.toStrict bs
----------------------------------------
-- | Generate values of type 'a' embedded within (usually larger) type 'r' with
-- upped probabilities of getting neighbourhood of bounds of 'a'.
arbitraryWithBounds
:: forall a r. (Bounded a, Integral a, Num r, Arbitrary r)
=> a -> Gen r
arbitraryWithBounds _ = frequency
[ (70, arbitrary)
-- Boundaries
, (5, pure $ fromIntegral (minBound :: a))
, (5, pure $ fromIntegral (maxBound :: a))
-- Near boundaries, in range
, (5, pure $ fromIntegral (minBound + 1 :: a))
, (5, pure $ fromIntegral (maxBound - 1 :: a))
-- Near boundaries, out of range (assuming there is no overflow). It overflows
-- if a ~ r, but it's fine as then we just get a value within range.
, (5, pure $ fromIntegral (minBound :: a) - 1)
, (5, pure $ fromIntegral (maxBound :: a) + 1)
]
----------------------------------------
-- | Wrapper for list/map length.
newtype Length = Length { unLength :: Word }
instance Show Length where
showsPrec p = showsPrec p . unLength
instance Arbitrary Length where
arbitrary = Length <$> arbitraryWithBounds (undefined::Int)
-- | Generate CBOR prefix of non-empty string/bytes containing its length.
mkLengthPrefix :: Bool -> Length -> BSL.ByteString
mkLengthPrefix string (Length w)
| w <= 23 = BSL.pack $ [64 + stringBit + fromIntegral w]
| w <= 0xff = BSL.pack $ [88 + stringBit] ++ f 1 w []
| w <= 0xffff = BSL.pack $ [89 + stringBit] ++ f 2 w []
| w <= 0xffffffff = BSL.pack $ [90 + stringBit] ++ f 4 w []
| otherwise = BSL.pack $ [91 + stringBit] ++ f 8 w []
where
stringBit :: Word8
stringBit = if string then 32 else 0
f :: Int -> Word -> [Word8] -> [Word8]
f 0 _ acc = acc
f k n acc = f (k - 1) (n `shiftR` 8) (fromIntegral n : acc)
|
