git.iko.soy/typeable/uuid
on a94db99 help sign in
typeable/uuid/tests/TestUUID.hs
164 lines 5.5 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 Test.HUnit
13import Test.QuickCheck hiding ((.&.))
14import System.IO
17isValidVersion :: Int -> U.UUID -> Bool
18isValidVersion v u = lenOK && variantOK && versionOK
19 where bs = U.toByteString u
20 lenOK = B.length bs == 16
21 variantOK = (B.index bs 8) .&. 0xc0 == 0x80
22 versionOK = (B.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4)
25instance Arbitrary U.UUID where
26 -- the UUID random instance ignores bounds
27 arbitrary = choose (U.nil, U.nil)
30test_null :: Test
31test_null = TestList [
32 "nil is null" ~: assertBool "" (U.null U.nil),
33 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)
34 ]
36test_nil :: Test
37test_nil = TestList [
38 "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
39 "nil bytes" ~: U.toByteString U.nil @?= B.pack (replicate 16 0)
40 ]
42test_conv :: Test
43test_conv = TestList [
44 "conv bytes to string" ~:
45 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
46 "conv string to bytes" ~:
47 maybe B.empty (U.toByteString) (U.fromString s16) @?= b16
48 ]
49 where b16 = B.pack [1..16]
50 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
52test_v1 :: [Maybe U.UUID] -> Test
53test_v1 v1s = TestList [
54 "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],
55 "V1 not null" ~: TestList $ map (testUUID (not . U.null)) v1s,
56 "V1 valid" ~: TestList $ map (testUUID (isValidVersion 1)) v1s
57 ]
58 where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test
59 testUUID p u = maybe False p u ~? show u
61test_v3 :: Test
62test_v3 = TestList [
63 "V3 computation" ~:
64 U3.generateNamed U3.namespaceDNS name @?= uV3
65 ]
66 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
67 uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
69test_v5 :: Test
70test_v5 = TestList [
71 "V5 computation" ~:
72 U5.generateNamed U5.namespaceDNS name @?= uV5
73 ]
74 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
75 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
77prop_stringRoundTrip :: Property
78prop_stringRoundTrip = label "String round trip" stringRoundTrip
79 where stringRoundTrip :: U.UUID -> Bool
80 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
82prop_byteStringRoundTrip :: Property
83prop_byteStringRoundTrip = label "ByteString round trip" byteStringRoundTrip
84 where byteStringRoundTrip :: U.UUID -> Bool
85 byteStringRoundTrip u = maybe False (== u)
86 $ U.fromByteString (U.toByteString u)
88prop_stringLength :: Property
89prop_stringLength = label "String length" stringLength
90 where stringLength :: U.UUID -> Bool
91 stringLength u = length (U.toString u) == 36
93prop_byteStringLength :: Property
94prop_byteStringLength = label "ByteString length" byteStringLength
95 where byteStringLength :: U.UUID -> Bool
96 byteStringLength u = B.length (U.toByteString u) == 16
98prop_randomsDiffer :: Property
99prop_randomsDiffer = label "Randoms differ" randomsDiffer
100 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
101 randomsDiffer (u1, u2) = u1 /= u2
103prop_randomNotNull :: Property
104prop_randomNotNull = label "Random not null" randomNotNull
105 where randomNotNull :: U.UUID -> Bool
106 randomNotNull = not. U.null
108prop_randomsValid :: Property
109prop_randomsValid = label "Random valid" randomsValid
110 where randomsValid :: U.UUID -> Bool
111 randomsValid = isValidVersion 4
113prop_v3NotNull :: Property
114prop_v3NotNull = label "V3 not null" v3NotNull
115 where v3NotNull :: [Word8] -> Bool
116 v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS
118prop_v3Valid :: Property
119prop_v3Valid = label "V3 valid" v3Valid
120 where v3Valid :: [Word8] -> Bool
121 v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS
123prop_v5NotNull :: Property
124prop_v5NotNull = label "V5 not null" v5NotNull
125 where v5NotNull :: [Word8] -> Bool
126 v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS
128prop_v5Valid :: Property
129prop_v5Valid = label "V5 valid" v5Valid
130 where v5Valid :: [Word8] -> Bool
131 v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS
133prop_readShowRoundTrip :: Property
134prop_readShowRoundTrip = label "Read/Show round-trip" prop
135 where -- we're using 'Maybe UUID' to add a bit of
136 -- real-world complexity.
137 prop :: U.UUID -> Bool
138 prop uuid = read (show (Just uuid)) == Just uuid
140main :: IO ()
141main = do
142 v1s <- replicateM 100 U.nextUUID
143 _ <- runTestText (putTextToHandle stderr False) (TestList [
144 test_null,
145 test_nil,
146 test_conv,
147 test_v1 v1s,
148 test_v3,
149 test_v5
150 ])
151 mapM_ quickCheck $ [
152 prop_stringRoundTrip,
153 prop_readShowRoundTrip,
154 prop_byteStringRoundTrip,
155 prop_stringLength,
156 prop_byteStringLength,
157 prop_randomsDiffer,
158 prop_randomNotNull,
159 prop_randomsValid,
160 prop_v3NotNull,
161 prop_v3Valid,
162 prop_v5NotNull,
163 prop_v5Valid
164 ]