git.iko.soy/typeable/uuid
on master help sign in
drop maccatcher dependency
49c1238Antoine Latter
Data/UUID/V1.hs+13−11
compare with master
unifiedsplit
@@ -12,8 +12,12 @@
12-- Portability : portable
12-- Portability : portable
13--
13--
14-- RFC 4122 Version 1 UUID state machine.
14-- RFC 4122 Version 1 UUID state machine.
15+--
16+-- Currently this is more useful as a reference. For
17+-- true machine-unique UUID generation see the
18+-- system-uuid package.
15
19
16−module Data.UUID.V1(nextUUID)
20+module Data.UUID.V1(nextUUID, MAC(..))
17where
21where
18
22
19import Data.Time
23import Data.Time
@@ -25,9 +29,6 @@ import Data.IORef
25import System.IO
29import System.IO
26import System.IO.Unsafe
30import System.IO.Unsafe
27
31
28−import qualified System.Info.MAC as SysMAC
29−import Data.MAC
30−
31import Data.UUID.Builder
32import Data.UUID.Builder
32import Data.UUID.Internal
33import Data.UUID.Internal
33
34
@@ -36,14 +37,12 @@ import Data.UUID.Internal
36-- Is generated according to the Version 1 UUID sepcified in
37-- Is generated according to the Version 1 UUID sepcified in
37-- RFC 4122.
38-- RFC 4122.
38--
39--
39−-- Returns nothing if the hardware MAC address could not
40+-- Returns nothing if UUIDs are generated to quickly
40−-- be discovered.
41−nextUUID :: IO (Maybe UUID)
41+nextUUID :: MAC -> IO (Maybe UUID)
42−nextUUID = do
42+nextUUID m = do
43 res <- stepTime
43 res <- stepTime
44− mac <- SysMAC.mac
45− case (res, mac) of
44+ case res of
46− (Just (c, t), Just m) -> return $ Just $ makeUUID t c m
45+ Just (c, t) -> return $ Just $ makeUUID t c m
47 _ -> return Nothing
46 _ -> return Nothing
48
47
49
48
@@ -59,6 +58,9 @@ instance ByteSource MACSource where
59 z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
58 z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
60type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
59type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
61
60
61+-- | Machine address of computer generating UUIDs.
62+data MAC = MAC !Word8 !Word8 !Word8
63+ !Word8 !Word8 !Word8
62
64
63-- |Approximates the clock algorithm in RFC 4122, section 4.2
65-- |Approximates the clock algorithm in RFC 4122, section 4.2
64-- Isn't system wide or thread safe, nor does it properly randomize
66-- Isn't system wide or thread safe, nor does it properly randomize
tests/BenchUUID.hs+5−1
@@ -61,7 +61,7 @@ main = do
61 bench "fromByteString" $ nf U.fromByteString b1
61 bench "fromByteString" $ nf U.fromByteString b1
62 ],
62 ],
63 bgroup "generation" [
63 bgroup "generation" [
64− bench "V1" $ nfIO U.nextUUID,
64+ bench "V1" $ nfIO (U.nextUUID testMAC),
65 bench "V4" $ nfIO (randomUUID :: IO U.UUID),
65 bench "V4" $ nfIO (randomUUID :: IO U.UUID),
66 bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
66 bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
67 bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
67 bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
@@ -69,6 +69,10 @@ main = do
69 bench "set making" $ nf Set.fromList uuids
69 bench "set making" $ nf Set.fromList uuids
70 ]
70 ]
71
71
72+-- | MAC address to use in testing
73+testMAC :: U.MAC
74+testMAC = U.MAC 0 0 0 0 0 0
75+
72-- 50 uuids, so tests can be repeatable
76-- 50 uuids, so tests can be repeatable
73uuids :: [U.UUID]
77uuids :: [U.UUID]
74uuids
78uuids
tests/TestUUID.hs+1−1
@@ -138,7 +138,7 @@ prop_v5Valid = label "V5 valid" v5Valid
138
138
139main :: IO ()
139main :: IO ()
140main = do
140main = do
141− v1s <- replicateM 100 U.nextUUID
141+ v1s <- replicateM 100 $ U.nextUUID $ U.MAC 0 0 0 0 0 0
142 runTestText (putTextToHandle stderr False) (TestList [
142 runTestText (putTextToHandle stderr False) (TestList [
143 test_null,
143 test_null,
144 test_nil,
144 test_nil,
uuid.cabal+3−3
@@ -29,7 +29,7 @@ Flag test
29 Default: False
29 Default: False
30
30
31Library
31Library
32− Build-Depends: random, binary, bytestring, Crypto, maccatcher,
32+ Build-Depends: random, binary, bytestring, Crypto,
33 time, base >=3, base < 5
33 time, base >=3, base < 5
34
34
35 Exposed-Modules:
35 Exposed-Modules:
@@ -54,7 +54,7 @@ Executable benchuuid
54 Extensions: DeriveDataTypeable, CPP
54 Extensions: DeriveDataTypeable, CPP
55 If flag(test)
55 If flag(test)
56 Buildable: True
56 Buildable: True
57− Build-Depends: random, binary, bytestring, Crypto, maccatcher,
57+ Build-Depends: random, binary, bytestring, Crypto,
58 time, base >=3, base < 5, containers,
58 time, base >=3, base < 5, containers,
59 criterion >= 0.3 && < 0.5, parallel >= 2.1 && < 2.3,
59 criterion >= 0.3 && < 0.5, parallel >= 2.1 && < 2.3,
60 mersenne-random-pure64 >= 0.2 && < 0.3
60 mersenne-random-pure64 >= 0.2 && < 0.3
@@ -71,7 +71,7 @@ Executable testuuid
71
71
72 If flag(test)
72 If flag(test)
73 Buildable: True
73 Buildable: True
74− Build-Depends: random, binary, bytestring, Crypto, maccatcher,
74+ Build-Depends: random, binary, bytestring, Crypto,
75 time, base >=3, base < 5,
75 time, base >=3, base < 5,
76 HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3
76 HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3
77 Else
77 Else