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
|
{-# LANGUAGE OverloadedStrings #-}
module Main
( main
) where
import Control.Monad (liftM)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (c2w, w2c)
import Data.ByteString.Char8 ()
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Base16.Lazy as LB16
import qualified Data.ByteString.Lazy as LBS
import Data.ByteString.Lazy.Char8 ()
import Data.Char (toUpper)
import Data.String
import Test.Framework (Test, defaultMain, testGroup)
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.Framework.Providers.HUnit (testCase)
import Test.HUnit hiding (Test)
import Test.QuickCheck (Arbitrary(..))
main :: IO ()
main = defaultMain tests
tests =
[ testGroup "property tests"
[ properties b16
, properties lb16
]
, testGroup "unit tests"
[ units b16
, units lb16
, lenientUnits b16
, lenientUnits lb16
]
]
properties
:: ( IsString bs
, Show bs
, Eq bs
, Arbitrary bs
)
=> Impl bs
-> Test
properties (Impl label e d l _ u) = testGroup label
[ testProperty "decode-encode-lower" $ \a -> Right a == d (e a)
, testProperty "decode-encode-upper" $ \a -> Right a == d (u . e $ a)
, testProperty "lenient-encode-lower" $ \a -> a == l (e a)
, testProperty "lenient-encode-upper" $ \a -> a == l (u . e $ a)
, testProperty "decode-encode-encode" $ \a -> Right (e a) == d (e (e a))
, testProperty "lenient-encode-encode" $ \a -> e a == l (e (e a))
]
units
:: ( IsString bs
, Show bs
, Eq bs
)
=> Impl bs
-> Test
units (Impl label e d l td u) = testGroup label $ encs ++ decs ++ lens
where
encs =
[ testCase ("encode: " ++ show raw) $ do enc @?= rawEnc
| (raw, rawEnc) <- td
, let enc = e raw
]
decs =
[ testCase ("decode: " ++ show rawEnc) $ do dec_enc @?= Right raw; dec_upp @?= Right raw
| (raw, rawEnc) <- td
, let dec_enc = d rawEnc
, let dec_upp = d (u rawEnc)
]
lens =
[ testCase ("lenient: " ++ show rawEnc) $ do len_enc @?= raw; len_upp @?= raw
| (raw, rawEnc) <- td
, let len_enc = l rawEnc
, let len_upp = l (u rawEnc)
]
lenientUnits :: (IsString bs, Show bs, Eq bs) => Impl bs -> Test
lenientUnits (Impl label e d l _ _) = testGroup (label ++ " lenient unit tests")
[ testCaseB16 "" ""
, testCaseB16 "f" "6+++++++____++++++======*%$@#%#^*$^6"
, testCaseB16 "fo" "6$6+6|f"
, testCaseB16 "foo" "==========6$$66()*f6f"
, testCaseB16 "foob" "66^%$&^6f6f62"
, testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61"
, testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"
]
where
testCaseB16 s t = testCase (show $ if s == "" then "empty" else s) $ do
let t0 = d (e s)
t1 = l t
(d (e s)) @=? Right (l t)
-- ------------------------------------------------------------------ --
-- Test data
rfcVectors :: IsString bs => [(bs,bs)]
rfcVectors =
[ ("","")
, ("fo", "666f")
, ("foo", "666f6f")
, ("foob", "666f6f62")
, ("fooba", "666f6f6261")
, ("foobar", "666f6f626172")
]
data Impl bs = Impl
{ _label :: String
, _encode :: bs -> bs
, _decode :: bs -> Either String bs
, _lenient :: bs -> bs
, _data :: [(bs, bs)]
, _upper :: bs -> bs
}
b16 :: Impl BS.ByteString
b16 = Impl "base16-strict" B16.encode B16.decode B16.decodeLenient rfcVectors (BS.map (c2w . toUpper . w2c))
lb16 :: Impl LBS.ByteString
lb16 = Impl "base16-lazy" LB16.encode LB16.decode LB16.decodeLenient rfcVectors (LBS.map (c2w . toUpper . w2c))
instance Arbitrary BS.ByteString where
arbitrary = liftM BS.pack arbitrary
instance Arbitrary LBS.ByteString where
arbitrary = liftM LBS.pack arbitrary
|
