@@ -1,135 +0,0 @@
1−{-# OPTIONS_GHC -fno-cse #-}
2−{-# LANGUAGE TypeFamilies #-}
6−Copyright : (c) 2008 Jason Dusek
7− (c) 2009 Mark Lentczner
8− (c) 2009-2010,2012 Antoine Latter
12−Maintainer : aslatter@gmail.com
13−Stability : experimental
14−Portability : portable
16−RFC 4122 Version 1 UUID state machine.
18−The generated UUID is based on the hardware MAC
19−address and the system clock.
21−If we cannot lookup the MAC address we seed the
22−generator with a pseudo-random number.
25−module Data.UUID.V1(nextUUID)
34−import Control.Applicative ((<$>),(<*>))
35−import Control.Concurrent.MVar
36−import System.IO.Unsafe
38−import qualified System.Random as R
42−import Data.UUID.Types.Internal.Builder
43−import Data.UUID.Types.Internal
45−-- | Returns a new UUID derived from the local hardware MAC
46−-- address and the current system time.
47−-- Is generated according to the Version 1 UUID specified in
50−-- Returns 'Nothing' if you request UUIDs too quickly.
51−nextUUID :: IO (Maybe UUID)
55− Just (mac', c, t) -> return $ Just $ makeUUID t c mac'
59−makeUUID :: Word64 -> Word16 -> MAC -> UUID
60−makeUUID time clock mac' =
61− buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')
62− where tLow = (fromIntegral time) :: Word32
63− tMid = (fromIntegral (time `shiftR` 32)) :: Word16
64− tHigh = (fromIntegral (time `shiftR` 48)) :: Word16
66−newtype MACSource = MACSource MAC
67−instance ByteSource MACSource where
68− z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f
69−type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)
72−-- |Approximates the clock algorithm in RFC 4122, section 4.2
73−-- Isn't system wide or thread safe, nor does it properly randomize
74−-- the clock value on initialization.
75−stepTime :: IO (Maybe (MAC, Word16, Word64))
77− h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
78− modifyMVar state $ \s@(State mac' c0 h0) ->
81− return (State mac' c0 h1, Just (mac', c0, h1))
85− in if c1 <= 0x3fff -- when clock is initially randomized,
86− -- then this test will need to change
88− return (State mac' c1 h1, Just (mac', c1, h1))
93−{-# NOINLINE state #-}
95−state = unsafePerformIO $ do
96− h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime
98− newMVar $ State mac' 0 h0 -- the 0 should be a random number
100−-- SysMAC.mac can fail on some machines.
101−-- In those cases we fake it with a random
105− getNetworkInterfaces >>=
106− return . listToMaybe . filter (minBound /=) . map mac >>=
107− \macM -> case macM of
109− Nothing -> randomMac
113− -- I'm too lazy to thread through
114− -- the random state ...
116− <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.
125− {-# UNPACK #-} !Word16
126− {-# UNPACK #-} !Word64
131−hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64
132−hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt
134− gregorianReform = UTCTime (fromGregorian 1582 10 15) 0
135− dt = t `diffUTCTime` gregorianReform