git.iko.soy/typeable/uuid
on 525b424 help sign in
typeable/uuid/tests/TestUUID.hs
248 lines 8.5 kB history raw
1{-# LANGUAGE ViewPatterns #-}
2import Control.Monad (replicateM)
3import Data.Bits
4import qualified Data.ByteString.Lazy as BL
5import qualified Data.ByteString.Lazy.Char8 as BL8
6import qualified Data.ByteString.Char8 as BC8
7import Data.Char (ord)
8import Data.Functor ((<$>))
9import Data.List (nub, (\\))
10import Data.Maybe
11import Data.Word
12import qualified Data.UUID as U
13import qualified Data.UUID.V1 as U
14import qualified Data.UUID.V3 as U3
15import qualified Data.UUID.V5 as U5
16import Foreign (alloca, peek, poke)
17import System.IO.Unsafe (unsafePerformIO)
18import qualified Test.HUnit as H
19import Test.HUnit hiding (Test)
20import Test.QuickCheck hiding ((.&.))
21import Test.Framework (defaultMain, Test)
22import Test.Framework.Providers.HUnit (hUnitTestToTests)
23import Test.Framework.Providers.QuickCheck2 (testProperty)
26isValidVersion :: Int -> U.UUID -> Bool
27isValidVersion v u = lenOK && variantOK && versionOK
28 where bs = U.toByteString u
29 lenOK = BL.length bs == 16
30 variantOK = (BL.index bs 8) .&. 0xc0 == 0x80
31 versionOK = (BL.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
34instance Arbitrary U.UUID where
35 -- the UUID random instance ignores bounds
36 arbitrary = choose (U.nil, U.nil)
39test_null :: H.Test
40test_null = H.TestList [
41 "nil is null" ~: assertBool "" (U.null U.nil),
42 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
43 ]
45test_nil :: H.Test
46test_nil = H.TestList [
47 "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
48 "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0)
49 ]
51test_conv :: H.Test
52test_conv = H.TestList [
53 "conv bytes to string" ~:
54 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
55 "conv string to bytes" ~:
56 maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16
57 ]
58 where b16 = BL.pack [1..16]
59 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
61test_v1 :: [Maybe U.UUID] -> H.Test
62test_v1 v1s = H.TestList [
63 "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
64 "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,
65 "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s
66 ]
67 where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> H.Test
68 testUUID p u = maybe False p u ~? show u
70test_v3 :: H.Test
71test_v3 = H.TestList [
72 "V3 computation" ~:
73 U3.generateNamed U3.namespaceDNS name @?= uV3
74 ]
75 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
76 uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
78test_v5 :: H.Test
79test_v5 = H.TestList [
80 "V5 computation" ~:
81 U5.generateNamed U5.namespaceDNS name @?= uV5
82 ]
83 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
84 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
87-- | Test fromByteString with a fixed-input.
88test_fromByteString :: H.Test
89test_fromByteString =
90 "UUID fromByteString" ~:
91 Just inputUUID @=?
92 U.fromByteString (BL8.pack "\165\202\133f\217\197H5\153\200\225\241>s\181\226")
94-- | Test fromWords with a fixed-input
95test_fromWords :: H.Test
96test_fromWords =
97 "UUID fromWords" ~:
98 inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594
100inputUUID :: U.UUID
101inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"
103prop_stringRoundTrip :: Test
104prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip
105 where stringRoundTrip :: U.UUID -> Bool
106 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
108prop_byteStringRoundTrip :: Test
109prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip
110 where byteStringRoundTrip :: U.UUID -> Bool
111 byteStringRoundTrip u = maybe False (== u)
112 $ U.fromByteString (U.toByteString u)
114prop_stringLength :: Test
115prop_stringLength = testProperty "String length" stringLength
116 where stringLength :: U.UUID -> Bool
117 stringLength u = length (U.toString u) == 36
119prop_byteStringLength :: Test
120prop_byteStringLength = testProperty "ByteString length" byteStringLength
121 where byteStringLength :: U.UUID -> Bool
122 byteStringLength u = BL.length (U.toByteString u) == 16
124prop_randomsDiffer :: Test
125prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer
126 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
127 randomsDiffer (u1, u2) = u1 /= u2
129prop_randomNotNull :: Test
130prop_randomNotNull = testProperty "Random not null" randomNotNull
131 where randomNotNull :: U.UUID -> Bool
132 randomNotNull = not. U.null
134prop_randomsValid :: Test
135prop_randomsValid = testProperty "Random valid" randomsValid
136 where randomsValid :: U.UUID -> Bool
137 randomsValid = isValidVersion 4
139prop_v3NotNull :: Test
140prop_v3NotNull = testProperty "V3 not null" v3NotNull
141 where v3NotNull :: [Word8] -> Bool
142 v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
144prop_v3Valid :: Test
145prop_v3Valid = testProperty "V3 valid" v3Valid
146 where v3Valid :: [Word8] -> Bool
147 v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
149prop_v5NotNull :: Test
150prop_v5NotNull = testProperty "V5 not null" v5NotNull
151 where v5NotNull :: [Word8] -> Bool
152 v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
154prop_v5Valid :: Test
155prop_v5Valid = testProperty "V5 valid" v5Valid
156 where v5Valid :: [Word8] -> Bool
157 v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
159prop_readShowRoundTrip :: Test
160prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop
161 where -- we're using 'Maybe UUID' to add a bit of
162 -- real-world complexity.
163 prop :: U.UUID -> Bool
164 prop uuid = read (show (Just uuid)) == Just uuid
166-- Mostly going to test for wrong UUIDs
167fromASCIIBytes_fromString1 :: String -> Bool
168fromASCIIBytes_fromString1 s =
169 if all (\c -> ord c < 256) s
170 then U.fromString s == U.fromASCIIBytes (BC8.pack s)
171 else True
173fromASCIIBytes_fromString2 :: U.UUID -> Bool
174fromASCIIBytes_fromString2 (U.toString -> s) =
175 U.fromString s == U.fromASCIIBytes (BC8.pack s)
177toASCIIBytes_toString :: U.UUID -> Bool
178toASCIIBytes_toString uuid =
179 U.toString uuid == BC8.unpack (U.toASCIIBytes uuid)
181fromASCIIBytes_toASCIIBytes :: U.UUID -> Bool
182fromASCIIBytes_toASCIIBytes (BC8.pack . U.toString -> bs) =
183 Just bs == (U.toASCIIBytes <$> U.fromASCIIBytes bs)
185toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool
186toASCIIBytes_fromASCIIBytes uuid =
187 Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)
189toWords_fromWords :: U.UUID -> Bool
190toWords_fromWords uuid =
191 uuid == myUncurry4 U.fromWords (U.toWords uuid)
193fromWords_toWords :: (Word32, Word32, Word32, Word32) -> Bool
194fromWords_toWords wds =
195 wds == U.toWords (myUncurry4 U.fromWords wds)
197myUncurry4 :: (x1 -> x2 -> x3 -> x4 -> y) -> (x1, x2, x3, x4) -> y
198myUncurry4 f (a,b,c,d) = f a b c d
200prop_storableRoundTrip :: Test
201prop_storableRoundTrip =
202 testProperty "Storeable round-trip" $ unsafePerformIO . prop
203 where
204 prop :: U.UUID -> IO Bool
205 prop uuid =
206 alloca $ \ptr -> do
207 poke ptr uuid
208 uuid2 <- peek ptr
209 return $ uuid == uuid2
211main :: IO ()
212main = do
213 v1s <- replicateM 100 U.nextUUID
214 defaultMain $
215 concat $
216 [ hUnitTestToTests $ H.TestList [
217 test_null,
218 test_nil,
219 test_conv,
220 test_v1 v1s,
221 test_v3,
222 test_v5,
223 test_fromByteString,
224 test_fromWords
225 ]
226 , [ prop_stringRoundTrip,
227 prop_readShowRoundTrip,
228 prop_byteStringRoundTrip,
229 prop_storableRoundTrip,
230 prop_stringLength,
231 prop_byteStringLength,
232 prop_randomsDiffer,
233 prop_randomNotNull,
234 prop_randomsValid,
235 prop_v3NotNull,
236 prop_v3Valid,
237 prop_v5NotNull,
238 prop_v5Valid
239 ]
240 , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1
241 , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2
242 , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString
243 , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes
244 , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes
245 , testProperty "toWords_fromWords" toWords_fromWords
246 , testProperty "fromWords_toWords" fromWords_toWords
247 ]
248 ]