git.iko.soy/typeable/uuid
on master help sign in
rollback dropping maccathcer and version bump
c088659Antoine Latter
Data/UUID/V1.hs+11−13
compare with master
unifiedsplit
@@ -12,12 +12,8 @@
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.
19
15
20−module Data.UUID.V1(nextUUID, MAC(..))
16+module Data.UUID.V1(nextUUID)
21where
17where
22
18
23import Data.Time
19import Data.Time
@@ -29,6 +25,9 @@ import Data.IORef
29import System.IO
25import System.IO
30import System.IO.Unsafe
26import System.IO.Unsafe
31
27
28+import qualified System.Info.MAC as SysMAC
29+import Data.MAC
30+
32import Data.UUID.Builder
31import Data.UUID.Builder
33import Data.UUID.Internal
32import Data.UUID.Internal
34
33
@@ -37,12 +36,14 @@ import Data.UUID.Internal
37-- Is generated according to the Version 1 UUID sepcified in
36-- Is generated according to the Version 1 UUID sepcified in
38-- RFC 4122.
37-- RFC 4122.
39--
38--
40−-- Returns nothing if UUIDs are generated to quickly
39+-- Returns nothing if the hardware MAC address could not
40+-- be discovered.
41−nextUUID :: MAC -> IO (Maybe UUID)
41+nextUUID :: IO (Maybe UUID)
42−nextUUID m = do
42+nextUUID = do
43 res <- stepTime
43 res <- stepTime
44+ mac <- SysMAC.mac
44− case res of
45+ case (res, mac) of
45− Just (c, t) -> return $ Just $ makeUUID t c m
46+ (Just (c, t), Just m) -> return $ Just $ makeUUID t c m
46 _ -> return Nothing
47 _ -> return Nothing
47
48
48
49
@@ -58,9 +59,6 @@ instance ByteSource MACSource where
58 z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
59 z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
59type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
60type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
60
61
61−-- | Machine address of computer generating UUIDs.
62−data MAC = MAC !Word8 !Word8 !Word8
63− !Word8 !Word8 !Word8
64
62
65-- |Approximates the clock algorithm in RFC 4122, section 4.2
63-- |Approximates the clock algorithm in RFC 4122, section 4.2
66-- Isn't system wide or thread safe, nor does it properly randomize
64-- Isn't system wide or thread safe, nor does it properly randomize
tests/BenchUUID.hs+1−5
@@ -58,7 +58,7 @@ main = do
58 bench "fromByteString" $ nf U.fromByteString b1
58 bench "fromByteString" $ nf U.fromByteString b1
59 ],
59 ],
60 bgroup "generation" [
60 bgroup "generation" [
61− bench "V1" $ nfIO (U.nextUUID testMAC),
61+ bench "V1" $ nfIO U.nextUUID,
62 bench "V4" $ nfIO (randomUUID :: IO U.UUID),
62 bench "V4" $ nfIO (randomUUID :: IO U.UUID),
63 bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
63 bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,
64 bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
64 bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1
@@ -66,10 +66,6 @@ main = do
66 bench "set making" $ nf Set.fromList uuids
66 bench "set making" $ nf Set.fromList uuids
67 ]
67 ]
68
68
69−-- | MAC address to use in testing
70−testMAC :: U.MAC
71−testMAC = U.MAC 0 0 0 0 0 0
72−
73-- 50 uuids, so tests can be repeatable
69-- 50 uuids, so tests can be repeatable
74uuids :: [U.UUID]
70uuids :: [U.UUID]
75uuids
71uuids
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 $ U.MAC 0 0 0 0 0 0
141+ v1s <- replicateM 100 U.nextUUID
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+4−4
@@ -1,5 +1,5 @@
1Name: uuid
1Name: uuid
2−Version: 1.3.0
2+Version: 1.2.0
3Copyright: (c) 2008-2009 Antoine Latter
3Copyright: (c) 2008-2009 Antoine Latter
4Author: Antoine Latter
4Author: Antoine Latter
5Maintainer: aslatter@gmail.com
5Maintainer: aslatter@gmail.com
@@ -29,7 +29,7 @@ Flag test
29 Default: False
29 Default: False
30
30
31Library
31Library
32− Build-Depends: random, binary, bytestring, Crypto,
32+ Build-Depends: random, binary, bytestring, Crypto, maccatcher,
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,
57+ Build-Depends: random, binary, bytestring, Crypto, maccatcher,
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,
74+ Build-Depends: random, binary, bytestring, Crypto, maccatcher,
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