git.iko.soy/typeable/uuid
on 8da772e help sign in
typeable/uuid/tests/TestUUID.hs
215 lines 7.4 kB history raw
1{-# LANGUAGE ViewPatterns #-}
2import Control.Monad (replicateM)
3import Data.Bits
4import qualified Data.ByteString.Lazy as BL
5import qualified Data.ByteString.Char8 as BC8
6import Data.Char (ord)
7import Data.Functor ((<$>))
8import Data.List (nub, (\\))
9import Data.Maybe
10import Data.Word
11import qualified Data.UUID as U
12import qualified Data.UUID.V1 as U
13import qualified Data.UUID.V3 as U3
14import qualified Data.UUID.V5 as U5
15import Foreign (alloca, peek, poke)
16import System.IO.Unsafe (unsafePerformIO)
17import qualified Test.HUnit as H
18import Test.HUnit hiding (Test)
19import Test.QuickCheck hiding ((.&.))
20import Test.Framework (defaultMain, Test)
21import Test.Framework.Providers.HUnit (hUnitTestToTests)
22import Test.Framework.Providers.QuickCheck2 (testProperty)
25isValidVersion :: Int -> U.UUID -> Bool
26isValidVersion v u = lenOK && variantOK && versionOK
27 where bs = U.toByteString u
28 lenOK = BL.length bs == 16
29 variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
30 versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
33instance Arbitrary U.UUID where
34 -- the UUID random instance ignores bounds
35 arbitrary = choose (U.nil, U.nil)
38test_null :: H.Test
39test_null = H.TestList [
40 "nil is null" ~: assertBool "" (U.null U.nil),
41 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
42 ]
44test_nil :: H.Test
45test_nil = H.TestList [
46 "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
47 "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0)
48 ]
50test_conv :: H.Test
51test_conv = H.TestList [
52 "conv bytes to string" ~:
53 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
54 "conv string to bytes" ~:
55 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16
56 ]
57 where b16 = BL.pack [1..16]
58 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
60test_v1 :: [Maybe U.UUID] -> H.Test
61test_v1 v1s = H.TestList [
62 "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
63 "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,
64 "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s
65 ]
66 where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test
67 testUUID p u = maybe False p u ~? show u
69test_v3 :: H.Test
70test_v3 = H.TestList [
71 "V3 computation" ~:
72 U3.generateNamed U3.namespaceDNS name @?= uV3
73 ]
74 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
75 uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
77test_v5 :: H.Test
78test_v5 = H.TestList [
79 "V5 computation" ~:
80 U5.generateNamed U5.namespaceDNS name @?= uV5
81 ]
82 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
83 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
85prop_stringRoundTrip :: Test
86prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
87 where stringRoundTrip :: U.UUID -> Bool
88 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
90prop_byteStringRoundTrip :: Test
91prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip
92 where byteStringRoundTrip :: U.UUID -> Bool
93 byteStringRoundTrip u = maybe False (== u)
94 $ U.fromByteString (U.toByteString u)
96prop_stringLength :: Test
97prop_stringLength = testProperty "String length" stringLength
98 where stringLength :: U.UUID -> Bool
99 stringLength u = length (U.toString u) == 36
101prop_byteStringLength :: Test
102prop_byteStringLength = testProperty "ByteString length" byteStringLength
103 where byteStringLength :: U.UUID -> Bool
104 byteStringLength u = BL.length (U.toByteString u) == 16
106prop_randomsDiffer :: Test
107prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer
108 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
109 randomsDiffer (u1, u2) = u1 /= u2
111prop_randomNotNull :: Test
112prop_randomNotNull = testProperty "Random not null" randomNotNull
113 where randomNotNull :: U.UUID -> Bool
114 randomNotNull = not. U.null
116prop_randomsValid :: Test
117prop_randomsValid = testProperty "Random valid" randomsValid
118 where randomsValid :: U.UUID -> Bool
119 randomsValid = isValidVersion 4
121prop_v3NotNull :: Test
122prop_v3NotNull = testProperty "V3 not null" v3NotNull
123 where v3NotNull :: [Word8] -> Bool
124 v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
126prop_v3Valid :: Test
127prop_v3Valid = testProperty "V3 valid" v3Valid
128 where v3Valid :: [Word8] -> Bool
129 v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
131prop_v5NotNull :: Test
132prop_v5NotNull = testProperty "V5 not null" v5NotNull
133 where v5NotNull :: [Word8] -> Bool
134 v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
136prop_v5Valid :: Test
137prop_v5Valid = testProperty "V5 valid" v5Valid
138 where v5Valid :: [Word8] -> Bool
139 v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
141prop_readShowRoundTrip :: Test
142prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
143 where -- we're using 'Maybe UUID' to add a bit of
144 -- real-world complexity.
145 prop :: U.UUID -> Bool
146 prop uuid = read (show (Just uuid)) == Just uuid
148-- Mostly going to test for wrong UUIDs
149fromASCIIBytes_fromString1 :: String -> Bool
150fromASCIIBytes_fromString1 s =
151 if all (\c -> ord c < 256) s
152 then U.fromString s == U.fromASCIIBytes (BC8.pack s)
153 else True
155fromASCIIBytes_fromString2 :: U.UUID -> Bool
156fromASCIIBytes_fromString2 (U.toString -> s) =
157 U.fromString s == U.fromASCIIBytes (BC8.pack s)
159toASCIIBytes_toString :: U.UUID -> Bool
160toASCIIBytes_toString uuid =
161 U.toString uuid == BC8.unpack (U.toASCIIBytes uuid)
163fromASCIIBytes_toASCIIBytes :: U.UUID -> Bool
164fromASCIIBytes_toASCIIBytes (BC8.pack . U.toString -> bs) =
165 Just bs == (U.toASCIIBytes <$> U.fromASCIIBytes bs)
167toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool
168toASCIIBytes_fromASCIIBytes uuid =
169 Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)
171prop_storableRoundTrip :: Test
172prop_storableRoundTrip =
173 testProperty "Storeable round-trip" $ unsafePerformIO . prop
174 where
175 prop :: U.UUID -> IO Bool
176 prop uuid =
177 alloca $ \ptr -> do
178 poke ptr uuid
179 uuid2 <- peek ptr
180 return $ uuid == uuid2
182main :: IO ()
183main = do
184 v1s <- replicateM 100 U.nextUUID
185 defaultMain $
186 concat $
187 [ hUnitTestToTests $ H.TestList [
188 test_null,
189 test_nil,
190 test_conv,
191 test_v1 v1s,
192 test_v3,
193 test_v5
194 ]
195 , [ prop_stringRoundTrip,
196 prop_readShowRoundTrip,
197 prop_byteStringRoundTrip,
198 prop_storableRoundTrip,
199 prop_stringLength,
200 prop_byteStringLength,
201 prop_randomsDiffer,
202 prop_randomNotNull,
203 prop_randomsValid,
204 prop_v3NotNull,
205 prop_v3Valid,
206 prop_v5NotNull,
207 prop_v5Valid
208 ]
209 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
210 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2
211 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString
212 , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes
213 , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes
214 ]
215 ]