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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE ExistentialQuantification #-}
module Utils where
import Control.Applicative
import Data.Char
import Data.Word
import Data.List
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Crypto.Random
import Crypto.Number.Serialize (os2ip)
import Prelude
import Test.Tasty.QuickCheck
import Test.Tasty.HUnit ((@=?))
newtype TestDRG = TestDRG (Word64, Word64, Word64, Word64, Word64)
deriving (Show,Eq)
instance Arbitrary TestDRG where
arbitrary = TestDRG `fmap` arbitrary -- distribution not uniform
withTestDRG (TestDRG l) f = fst $ withDRG (drgNewTest l) f
newtype ChunkingLen = ChunkingLen [Int]
deriving (Show,Eq)
instance Arbitrary ChunkingLen where
arbitrary = ChunkingLen `fmap` vectorOf 16 (choose (0,14))
newtype ChunkingLen0_127 = ChunkingLen0_127 [Int]
deriving (Show,Eq)
instance Arbitrary ChunkingLen0_127 where
arbitrary = ChunkingLen0_127 `fmap` vectorOf 16 (choose (0,127))
newtype ArbitraryBS0_2901 = ArbitraryBS0_2901 ByteString
deriving (Show,Eq,Ord)
instance Arbitrary ArbitraryBS0_2901 where
arbitrary = ArbitraryBS0_2901 `fmap` arbitraryBSof 0 2901
newtype Int0_2901 = Int0_2901 Int
deriving (Show,Eq,Ord)
newtype Int1_2901 = Int1_2901 Int
deriving (Show,Eq,Ord)
instance Arbitrary Int0_2901 where
arbitrary = Int0_2901 `fmap` choose (0,2901)
instance Arbitrary Int1_2901 where
arbitrary = Int1_2901 `fmap` choose (1,2901)
-- | a integer wrapper with a better range property
newtype QAInteger = QAInteger { getQAInteger :: Integer }
deriving (Show,Eq)
instance Arbitrary QAInteger where
arbitrary = oneof
[ QAInteger . fromIntegral <$> (choose (0, 65536) :: Gen Int) -- small integer
, larger <$> choose (0,4096) <*> choose (0, 65536) -- medium integer
, QAInteger . os2ip <$> arbitraryBSof 0 32 -- [ 0 .. 2^32 ] sized integer
]
where
larger :: Int -> Int -> QAInteger
larger p b = QAInteger (fromIntegral p * somePrime + fromIntegral b)
somePrime :: Integer
somePrime = 18446744073709551557
arbitraryBS :: Int -> Gen ByteString
arbitraryBS = fmap B.pack . vector
arbitraryBSof :: Int -> Int -> Gen ByteString
arbitraryBSof minSize maxSize = choose (minSize, maxSize) >>= arbitraryBS
chunkS :: ChunkingLen -> ByteString -> [ByteString]
chunkS (ChunkingLen originalChunks) = loop originalChunks
where loop l bs
| B.null bs = []
| otherwise =
case l of
(x:xs) -> let (b1, b2) = B.splitAt x bs in b1 : loop xs b2
[] -> loop originalChunks bs
chunksL :: ChunkingLen -> L.ByteString -> L.ByteString
chunksL (ChunkingLen originalChunks) = L.fromChunks . loop originalChunks . L.toChunks
where loop _ [] = []
loop l (b:bs)
| B.null b = loop l bs
| otherwise =
case l of
(x:xs) -> let (b1, b2) = B.splitAt x b in b1 : loop xs (b2:bs)
[] -> loop originalChunks (b:bs)
katZero :: Int
katZero = 0
--hexalise :: String -> [Word8]
hexalise s = concatMap (\c -> [ hex $ c `div` 16, hex $ c `mod` 16 ]) s
where hex i
| i >= 0 && i <= 9 = fromIntegral (ord '0') + i
| i >= 10 && i <= 15 = fromIntegral (ord 'a') + i - 10
| otherwise = 0
splitB :: Int -> ByteString -> [ByteString]
splitB l b =
if B.length b > l
then
let (b1, b2) = B.splitAt l b in
b1 : splitB l b2
else
[ b ]
assertBytesEq :: ByteString -> ByteString -> Bool
assertBytesEq b1 b2 | b1 /= b2 = error ("expected: " ++ show b1 ++ " got: " ++ show b2)
| otherwise = True
assertEq :: (Show a, Eq a) => a -> a -> Bool
assertEq b1 b2 | b1 /= b2 = error ("expected: " ++ show b1 ++ " got: " ++ show b2)
| otherwise = True
propertyEq :: (Show a, Eq a) => a -> a -> Bool
propertyEq = assertEq
data PropertyTest =
forall a . (Show a, Eq a) => EqTest String a a
type PropertyName = String
eqTest :: (Show a, Eq a)
=> PropertyName
-> a -- ^ expected value
-> a -- ^ got
-> PropertyTest
eqTest name a b = EqTest name a b
propertyHold :: [PropertyTest] -> Bool
propertyHold l =
case foldl runProperty [] l of
[] -> True
failed -> error (intercalate "\n" failed)
where
runProperty acc (EqTest name a b)
| a == b = acc
| otherwise =
(name ++ ": expected " ++ show a ++ " but got: " ++ show b) : acc
propertyHoldCase :: [PropertyTest] -> IO ()
propertyHoldCase l = True @=? propertyHold l
|
