git.iko.soy/typeable/uuid
on 9d78650 help sign in
typeable/uuid/tests/TestUUID.hs
132 lines 4.4 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.V5 as U
11import Test.HUnit
12import Test.QuickCheck
13import System.IO
14import System.Random
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 arbitrary = (fst . random) `fmap` rand
27 coarbitrary = undefined
29instance Arbitrary Word8 where
30 arbitrary = (fromIntegral . fst . randomR (0,255::Int)) `fmap` rand
31 coarbitrary = undefined
34test_null = TestList [
35 "nil is null" ~: assertBool "" (U.null U.nil),
36 "namespaceDNS is not null" ~: assertBool "" (not $ U.null U.namespaceDNS)
37 ]
39test_nil = TestList [
40 "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000",
41 "nil bytes" ~: U.toByteString U.nil @?= B.pack (replicate 16 0)
42 ]
44test_conv = TestList [
45 "conv bytes to string" ~:
46 maybe "" (U.toString) (U.fromByteString b16) @?= s16,
47 "conv string to bytes" ~:
48 maybe B.empty (U.toByteString) (U.fromString s16) @?= b16
49 ]
50 where b16 = B.pack [1..16]
51 s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"
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_v5 = TestList [
62 "V5 computation" ~:
63 U.generateNamed U.namespaceDNS name @?= uV5
64 ]
65 where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]
66 -- uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"
67 uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a"
69prop_stringRoundTrip = label "String round trip" stringRoundTrip
70 where stringRoundTrip :: U.UUID -> Bool
71 stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u)
73prop_byteStringRoundTrip = label "ByteString round trip" byteStringRoundTrip
74 where byteStringRoundTrip :: U.UUID -> Bool
75 byteStringRoundTrip u = maybe False (== u)
76 $ U.fromByteString (U.toByteString u)
78prop_stringLength = label "String length" stringLength
79 where stringLength :: U.UUID -> Bool
80 stringLength u = length (U.toString u) == 36
82prop_byteStringLength = label "ByteString length" byteStringLength
83 where byteStringLength :: U.UUID -> Bool
84 byteStringLength u = B.length (U.toByteString u) == 16
86prop_randomsDiffer :: Property
87prop_randomsDiffer = label "Randoms differ" randomsDiffer
88 where randomsDiffer :: (U.UUID, U.UUID) -> Bool
89 randomsDiffer (u1, u2) = u1 /= u2
91prop_randomNotNull :: Property
92prop_randomNotNull = label "Random not null" randomNotNull
93 where randomNotNull :: U.UUID -> Bool
94 randomNotNull = not. U.null
96prop_randomsValid :: Property
97prop_randomsValid = label "Random valid" randomsValid
98 where randomsValid :: U.UUID -> Bool
99 randomsValid = isValidVersion 4
101prop_v5NotNull :: Property
102prop_v5NotNull = label "V5 not null" v5NotNull
103 where v5NotNull :: [Word8] -> Bool
104 v5NotNull = not . U.null . U.generateNamed U.namespaceDNS
106prop_v5Valid :: Property
107prop_v5Valid = label "V5 valid" v5Valid
108 where v5Valid :: [Word8] -> Bool
109 v5Valid = isValidVersion 5 . U.generateNamed U.namespaceDNS
112main :: IO ()
113main = do
114 v1s <- replicateM 100 U.nextUUID
115 runTestText (putTextToHandle stderr False) (TestList [
116 test_null,
117 test_nil,
118 test_conv,
119 test_v1 v1s,
120 test_v5
121 ])
122 mapM_ quickCheck $ [
123 prop_stringRoundTrip,
124 prop_byteStringRoundTrip,
125 prop_stringLength,
126 prop_byteStringLength,
127 prop_randomsDiffer,
128 prop_randomNotNull,
129 prop_randomsValid,
130 prop_v5NotNull,
131 prop_v5Valid
132 ]