git.iko.soy/typeable/uuid
on 4637838 help sign in
typeable/uuid/tests/TestUUID.hs
170 lines 5.7 kB history raw
1import Control.Monad (replicateM)
2import Data.Bits
3import qualified Data.ByteString.Lazy as B
4import Data.Char (ord)
5import Data.List (nub, (\\))
6import Data.Maybe
7import Data.Word
8import qualified Data.UUID as U
9import qualified Data.UUID.V1 as U
10import qualified Data.UUID.V3 as U3
11import qualified Data.UUID.V5 as U5
12import qualified Test.HUnit as H
13import Test.HUnit hiding (Test)
14import Test.QuickCheck hiding ((.&.))
15import Test.Framework (defaultMain, Test(..))
16import Test.Framework.Providers.HUnit (hUnitTestToTests)
17import Test.Framework.Providers.QuickCheck2 (testProperty)
18import System.IO
21isValidVersion :: Int -> U.UUID -> Bool
22isValidVersion v u = lenOK && variantOK && versionOK
23 where bs = U.toByteString u
24 lenOK = B.length bs == 16
25 variantOK = (B.index bs 8) .&. 0xc0 == 0x80
26 versionOK = (B.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
29instance Arbitrary U.UUID where
30 -- the UUID random instance ignores bounds
31 arbitrary = choose (U.nil, U.nil)
34test_null :: H.Test
35test_null = H.TestList [
36 "nil is null" ~: assertBool "" (U.null U.nil),
37 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
38 ]
40test_nil :: H.Test
41test_nil = H.TestList [
42 "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
43 "nil bytes" ~: U.toByteString U.nil @?= B.pack (replicate 16 0)
44 ]
46test_conv :: H.Test
47test_conv = H.TestList [
48 "conv bytes to string" ~:
49 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
50 "conv string to bytes" ~:
51 maybe B.empty (U.toByteString) (U.fromString s16) @?= b16
52 ]
53 where b16 = B.pack [1..16]
54 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
56test_v1 :: [Maybe U.UUID] -> H.Test
57test_v1 v1s = H.TestList [
58 "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
59 "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,
60 "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s
61 ]
62 where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test
63 testUUID p u = maybe False p u ~? show u
65test_v3 :: H.Test
66test_v3 = H.TestList [
67 "V3 computation" ~:
68 U3.generateNamed U3.namespaceDNS name @?= uV3
69 ]
70 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
71 uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
73test_v5 :: H.Test
74test_v5 = H.TestList [
75 "V5 computation" ~:
76 U5.generateNamed U5.namespaceDNS name @?= uV5
77 ]
78 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
79 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
81prop_stringRoundTrip :: Test
82prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
83 where stringRoundTrip :: U.UUID -> Bool
84 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
86prop_byteStringRoundTrip :: Test
87prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip
88 where byteStringRoundTrip :: U.UUID -> Bool
89 byteStringRoundTrip u = maybe False (== u)
90 $ U.fromByteString (U.toByteString u)
92prop_stringLength :: Test
93prop_stringLength = testProperty "String length" stringLength
94 where stringLength :: U.UUID -> Bool
95 stringLength u = length (U.toString u) == 36
97prop_byteStringLength :: Test
98prop_byteStringLength = testProperty "ByteString length" byteStringLength
99 where byteStringLength :: U.UUID -> Bool
100 byteStringLength u = B.length (U.toByteString u) == 16
102prop_randomsDiffer :: Test
103prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer
104 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
105 randomsDiffer (u1, u2) = u1 /= u2
107prop_randomNotNull :: Test
108prop_randomNotNull = testProperty "Random not null" randomNotNull
109 where randomNotNull :: U.UUID -> Bool
110 randomNotNull = not. U.null
112prop_randomsValid :: Test
113prop_randomsValid = testProperty "Random valid" randomsValid
114 where randomsValid :: U.UUID -> Bool
115 randomsValid = isValidVersion 4
117prop_v3NotNull :: Test
118prop_v3NotNull = testProperty "V3 not null" v3NotNull
119 where v3NotNull :: [Word8] -> Bool
120 v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
122prop_v3Valid :: Test
123prop_v3Valid = testProperty "V3 valid" v3Valid
124 where v3Valid :: [Word8] -> Bool
125 v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
127prop_v5NotNull :: Test
128prop_v5NotNull = testProperty "V5 not null" v5NotNull
129 where v5NotNull :: [Word8] -> Bool
130 v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
132prop_v5Valid :: Test
133prop_v5Valid = testProperty "V5 valid" v5Valid
134 where v5Valid :: [Word8] -> Bool
135 v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
137prop_readShowRoundTrip :: Test
138prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
139 where -- we're using 'Maybe UUID' to add a bit of
140 -- real-world complexity.
141 prop :: U.UUID -> Bool
142 prop uuid = read (show (Just uuid)) == Just uuid
144main :: IO ()
145main = do
146 v1s <- replicateM 100 U.nextUUID
147 defaultMain $
148 concat $
149 [ hUnitTestToTests $ H.TestList [
150 test_null,
151 test_nil,
152 test_conv,
153 test_v1 v1s,
154 test_v3,
155 test_v5
156 ]
157 , [ prop_stringRoundTrip,
158 prop_readShowRoundTrip,
159 prop_byteStringRoundTrip,
160 prop_stringLength,
161 prop_byteStringLength,
162 prop_randomsDiffer,
163 prop_randomNotNull,
164 prop_randomsValid,
165 prop_v3NotNull,
166 prop_v3Valid,
167 prop_v5NotNull,
168 prop_v5Valid
169 ]
170 ]