uuid 1.3.13 → 1.3.16.1
raw patch · 20 files changed
Files
- CHANGES.md +15/−1
- Data/UUID.hs +0/−49
- Data/UUID/Named.hs +0/−72
- Data/UUID/Util.hs +0/−53
- Data/UUID/V1.hs +0/−135
- Data/UUID/V3.hs +0/−49
- Data/UUID/V4.hs +0/−34
- Data/UUID/V5.hs +0/−44
- Data/Word/Util.hs +0/−20
- src/Data/UUID.hs +52/−0
- src/Data/UUID/Named.hs +72/−0
- src/Data/UUID/Util.hs +53/−0
- src/Data/UUID/V1.hs +135/−0
- src/Data/UUID/V3.hs +49/−0
- src/Data/UUID/V4.hs +33/−0
- src/Data/UUID/V5.hs +44/−0
- src/Data/Word/Util.hs +20/−0
- tests/BenchUUID.hs +0/−34
- tests/TestUUID.hs +2/−2
- uuid.cabal +85/−80
CHANGES.md view
@@ -1,9 +1,23 @@+1.3.16++- Support GHC-8.6.5...9.10.1++1.3.15++- Add (Template Haskell) `Lift UUID` instance++1.3.14++- Use more compact heap object representation which saves 16 bytes on 64bit platforms.+- Add `toWords64`/`fromWords64` functions+ 1.3.13 - Optimize `V4.nextRandom` (~3x speed increase) - Optimize UUID V3 & V5 generation (~2x speed increase) - Use `cryptohash-md5`/`cryptohash-sha1`/`entropy` instead- of `memory`/`cryptonite` for better performance and stability.+ of `memory`/`cryptonite` for better performance and stability,+ but GHCJS is now no longer supported. - Update cabal-spec to version 1.10 1.3.12
− Data/UUID.hs
@@ -1,49 +0,0 @@-{- |-Module : Data.UUID-Copyright : (c) 2008,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable---This library is useful for comparing, parsing and-printing Universally Unique Identifiers.-See <http://en.wikipedia.org/wiki/UUID> for the general idea.-See <http://tools.ietf.org/html/rfc4122> for the specification.--* Random UUIDs may be generated using 'Data.UUID.V4.nextRandom' or-your favorite instance of 'System.Random.Random'.--* We have an implementation of generating a UUID from the hardware-MAC address and current system time in "Data.UUID.V1".--* For name-based generation of UUIDs using SHA-1 hashing see-"Data.UUID.V5".--}-module Data.UUID(UUID- ,toString- ,fromString- ,toText- ,fromText- ,toASCIIBytes- ,fromASCIIBytes- ,toLazyASCIIBytes- ,fromLazyASCIIBytes- ,toByteString- ,fromByteString- ,toWords- ,fromWords- ,null- ,nil- ) where--import Prelude () -- we need to hide Prelude.null-import Data.UUID.Types---- We use explicit re-exports of everything from Data.UUID.Types in--- preference to just re-exporting the whole module. This is to avoid--- unforeseen transitive API breakage if the Data.UUID.Types module--- should change.
− Data/UUID/Named.hs
@@ -1,72 +0,0 @@--- |--- Module : Data.UUID.Named--- Copyright : (c) 2008 Antoine Latter------ License : BSD-style------ Maintainer : aslatter@gmail.com--- Stability : experimental--- Portability : portable--------- This module implements Version 3/5 UUIDs as specified--- in RFC 4122.------ These UUIDs identify an object within a namespace,--- and are deterministic.------ The namespace is identified by a UUID. Several sample--- namespaces are enclosed.--module Data.UUID.Named- (generateNamed- ,namespaceDNS- ,namespaceURL- ,namespaceOID- ,namespaceX500- ) where--import Data.UUID.Types.Internal--import Control.Applicative ((<*>),(<$>))-import Data.Binary.Get (runGet, getWord32be)-import Data.Maybe-import Data.Word (Word8)--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL---- |Generate a 'UUID' within the specified namespace out of the given--- object.-generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash- -> Word8 -- ^Version- -> UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed hash version namespace object =- let chunk = B.pack $ toList namespace ++ object- bytes = BL.fromChunks . (:[]) $ hash chunk- w = getWord32be- unpackBytes = runGet $- buildFromWords version <$> w <*> w <*> w <*> w- in unpackBytes bytes---unsafeFromString :: String -> UUID-unsafeFromString = fromJust . fromString---- |The namespace for DNS addresses-namespaceDNS :: UUID-namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for URLs-namespaceURL :: UUID-namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for ISO OIDs-namespaceOID :: UUID-namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for X.500 DNs-namespaceX500 :: UUID-namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"
− Data/UUID/Util.hs
@@ -1,53 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module Data.UUID.Util (- UnpackedUUID(..)- , unpack, pack- , version- , extractMac- , extractTime- , setTime- ) where--import Prelude hiding (null)-import Data.Word-import Data.Word.Util-import Data.Bits-import Data.UUID.Types.Internal-import Network.Info-import Data.Int (Int64)--version :: UUID -> Int-version uuid =- fromEnum ((time_hi_and_version unpacked `shiftR` 12) .&. 0xF)- where- unpacked = unpack uuid---- Note UUID time is in 10^-7 seconds.-setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID-setTime uuid t =- if version uuid == 1- then Just $ pack $ (unpack uuid){time_low = new_low_bits, time_mid = new_mid_bits, time_hi_and_version = new_hi_and_version_bits}- else Nothing- where new_low_bits = fromIntegral $ t .&. 0xFFFFFFFF- new_mid_bits = fromIntegral $ (t `shiftR` 32) .&. 0xFFFF- new_hi_and_version_bits = fromIntegral $ 0x1000 .|. ((t `shiftR` 48) .&. 0x0FFF)--extractTime :: UUID -> Maybe Int64-extractTime uuid =- if version uuid == 1- then Just $ fromIntegral $ w32to64 (w16to32 (timeAndVersionToTime $ time_hi_and_version unpacked) $ time_mid unpacked) (time_low unpacked)- else Nothing- where- unpacked = unpack uuid--timeAndVersionToTime :: Word16 -> Word16-timeAndVersionToTime tv = tv .&. 0x0FFF--extractMac :: UUID -> Maybe MAC-extractMac uuid =- if version uuid == 1- then Just $- MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)- else Nothing- where- unpacked = unpack uuid
− Data/UUID/V1.hs
@@ -1,135 +0,0 @@-{-# OPTIONS_GHC -fno-cse #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module : Data.UUID.V1-Copyright : (c) 2008 Jason Dusek- (c) 2009 Mark Lentczner- (c) 2009-2010,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable--RFC 4122 Version 1 UUID state machine.--The generated UUID is based on the hardware MAC-address and the system clock.--If we cannot lookup the MAC address we seed the-generator with a psuedo-random number.--}--module Data.UUID.V1(nextUUID)-where---import Data.Bits-import Data.Maybe-import Data.Time-import Data.Word--import Control.Applicative ((<$>),(<*>))-import Control.Concurrent.MVar-import System.IO.Unsafe--import qualified System.Random as R--import Network.Info--import Data.UUID.Types.Internal.Builder-import Data.UUID.Types.Internal---- | Returns a new UUID derived from the local hardware MAC--- address and the current system time.--- Is generated according to the Version 1 UUID sepcified in--- RFC 4122.------ Returns 'Nothing' if you request UUIDs too quickly.-nextUUID :: IO (Maybe UUID)-nextUUID = do- res <- stepTime- case res of- Just (mac', c, t) -> return $ Just $ makeUUID t c mac'- _ -> return Nothing---makeUUID :: Word64 -> Word16 -> MAC -> UUID-makeUUID time clock mac' =- buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')- where tLow = (fromIntegral time) :: Word32- tMid = (fromIntegral (time `shiftR` 32)) :: Word16- tHigh = (fromIntegral (time `shiftR` 48)) :: Word16--newtype MACSource = MACSource MAC-instance ByteSource MACSource where- z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f-type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)----- |Approximates the clock algorithm in RFC 4122, section 4.2--- Isn't system wide or thread safe, nor does it properly randomize--- the clock value on initialization.-stepTime :: IO (Maybe (MAC, Word16, Word64))-stepTime = do- h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime- modifyMVar state $ \s@(State mac' c0 h0) ->- if h1 > h0- then- return (State mac' c0 h1, Just (mac', c0, h1))- else- let- c1 = succ c0- in if c1 <= 0x3fff -- when clock is initially randomized,- -- then this test will need to change- then- return (State mac' c1 h1, Just (mac', c1, h1))- else- return (s, Nothing)---{-# NOINLINE state #-}-state :: MVar State-state = unsafePerformIO $ do- h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime- mac' <- getMac- newMVar $ State mac' 0 h0 -- the 0 should be a random number---- SysMAC.mac can fail on some machines.--- In those cases we fake it with a random--- 6 bytes seed.-getMac :: IO MAC-getMac =- getNetworkInterfaces >>=- return . listToMaybe . filter (minBound /=) . map mac >>=- \macM -> case macM of- Just m -> return m- Nothing -> randomMac--randomMac :: IO MAC-randomMac =- -- I'm too lazy to thread through- -- the random state ...- MAC- <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO--data State = State- {-# UNPACK #-} !MAC- {-# UNPACK #-} !Word16- {-# UNPACK #-} !Word64- deriving (Show)----hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64-hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt- where- gregorianReform = UTCTime (fromGregorian 1582 10 15) 0- dt = t `diffUTCTime` gregorianReform
− Data/UUID/V3.hs
@@ -1,49 +0,0 @@-{- |-Module : Data.UUID.V3-Copyright : (c) 2010,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable--NOTE: This module uses MD5 hashing. Unless you know-you need to use this module, you should probably be-using "Data.UUID.V5", which offers the same sort of-functionality as this module except implemented with-SHA-1 hashing.--This module implements Version 3 UUIDs as specified-in RFC 4122.--These UUIDs identify an object within a namespace,-and are deterministic.--The namespace is identified by a UUID. Several sample-namespaces are enclosed.--}-module Data.UUID.V3- (generateNamed- ,Shared.namespaceDNS- ,Shared.namespaceURL- ,Shared.namespaceOID- ,Shared.namespaceX500- ) where--import Data.Word--import Data.UUID.Types.Internal-import qualified Data.UUID.Named as Shared-import qualified Crypto.Hash.MD5 as MD5----- |Generate a 'UUID' within the specified namespace out of the given--- object.------ Uses an MD5 hash. The UUID is built from first 128 bits of the hash of--- the namespace UUID and the name (as a series of Word8).-generateNamed :: UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed = Shared.generateNamed MD5.hash 3
− Data/UUID/V4.hs
@@ -1,34 +0,0 @@-{- |- Module : Data.UUID.V4- Copyright : (c) 2012-2016 Antoine Latter-- License : BSD-style-- Maintainer : aslatter@gmail.com- Stability : experimental- Portability : portable-- This module implements Version 4 UUIDs as specified- in RFC 4122.-- These UUIDs are generated from a psuedo-random generator.- We use the System.Random 'R.StdGen' as our random source.-- All of the logic is encapsulated in the 'R.Random' instance- for the UUID type, so you are also free to use the random generator- of your choice.--}-module Data.UUID.V4 (nextRandom) where--import Data.UUID-import Data.UUID.Types.Internal ( buildFromBytes )--import System.Entropy ( getEntropy )-import Data.ByteString ( unpack )---- | Generate a random UUID. Introduced in version 1.2.6.-nextRandom :: IO UUID-nextRandom = do- [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]- <- unpack `fmap` getEntropy 16- return $ buildFromBytes 4 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
− Data/UUID/V5.hs
@@ -1,44 +0,0 @@--- |--- Module : Data.UUID.V5--- Copyright : (c) 2008-2009 Antoine Latter------ License : BSD-style------ Maintainer : aslatter@gmail.com--- Stability : experimental--- Portability : portable--------- This module implements Version 5 UUIDs as specified--- in RFC 4122.------ These UUIDs identify an object within a namespace,--- and are deterministic.------ The namespace is identified by a UUID. Several sample--- namespaces are enclosed.--module Data.UUID.V5- (generateNamed- ,Shared.namespaceDNS- ,Shared.namespaceURL- ,Shared.namespaceOID- ,Shared.namespaceX500- ) where--import Data.Word--import Data.UUID.Types.Internal-import qualified Data.UUID.Named as Shared-import qualified Crypto.Hash.SHA1 as SHA1----- |Generate a 'UUID' within the specified namespace out of the given--- object.------ Uses a SHA1 hash. The UUID is built from first 128 bits of the hash of--- the namespace UUID and the name (as a series of Word8).-generateNamed :: UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed = Shared.generateNamed SHA1.hash 5
− Data/Word/Util.hs
@@ -1,20 +0,0 @@---- | Internal utilites-module Data.Word.Util where--import Data.Bits-import Data.Word--w16to32 :: Word16 -> Word16 -> Word32-w16to32 w0s w1s =- (w0 `shiftL` 16) .|. w1- where- w0 = fromIntegral w0s- w1 = fromIntegral w1s--w32to64 :: Word32 -> Word32 -> Word64-w32to64 w0s w1s =- (w0 `shiftL` 32) .|. w1- where- w0 = fromIntegral w0s- w1 = fromIntegral w1s
+ src/Data/UUID.hs view
@@ -0,0 +1,52 @@+{- |+Module : Data.UUID+Copyright : (c) 2008,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable+++This library is useful for comparing, parsing and+printing Universally Unique Identifiers.+See <http://en.wikipedia.org/wiki/UUID> for the general idea.+See <http://tools.ietf.org/html/rfc4122> for the specification.++* Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your+favorite instance of 'System.Random.Random' for faster but insecure+generation of UUIDs.++* We have an implementation of generating a UUID from the hardware+MAC address and current system time in "Data.UUID.V1".++* For name-based generation of UUIDs using SHA-1 hashing see+"Data.UUID.V5".+-}+module Data.UUID(UUID+ ,toString+ ,fromString+ ,toText+ ,fromText+ ,toASCIIBytes+ ,fromASCIIBytes+ ,toLazyASCIIBytes+ ,fromLazyASCIIBytes+ ,toByteString+ ,fromByteString+ ,toWords+ ,fromWords+ ,toWords64+ ,fromWords64+ ,null+ ,nil+ ) where++import Prelude () -- we need to hide Prelude.null+import Data.UUID.Types++-- We use explicit re-exports of everything from Data.UUID.Types in+-- preference to just re-exporting the whole module. This is to avoid+-- unforeseen transitive API breakage if the Data.UUID.Types module+-- should change.
+ src/Data/UUID/Named.hs view
@@ -0,0 +1,72 @@+-- |+-- Module : Data.UUID.Named+-- Copyright : (c) 2008 Antoine Latter+--+-- License : BSD-style+--+-- Maintainer : aslatter@gmail.com+-- Stability : experimental+-- Portability : portable+--+--+-- This module implements Version 3/5 UUIDs as specified+-- in RFC 4122.+--+-- These UUIDs identify an object within a namespace,+-- and are deterministic.+--+-- The namespace is identified by a UUID. Several sample+-- namespaces are enclosed.++module Data.UUID.Named+ (generateNamed+ ,namespaceDNS+ ,namespaceURL+ ,namespaceOID+ ,namespaceX500+ ) where++import Data.UUID.Types.Internal++import Control.Applicative ((<*>),(<$>))+import Data.Binary.Get (runGet, getWord32be)+import Data.Maybe+import Data.Word (Word8)++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash+ -> Word8 -- ^Version+ -> UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed hash version namespace object =+ let chunk = B.pack $ toList namespace ++ object+ bytes = BL.fromChunks . (:[]) $ hash chunk+ w = getWord32be+ unpackBytes = runGet $+ buildFromWords version <$> w <*> w <*> w <*> w+ in unpackBytes bytes+++unsafeFromString :: String -> UUID+unsafeFromString = fromJust . fromString++-- |The namespace for DNS addresses+namespaceDNS :: UUID+namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for URLs+namespaceURL :: UUID+namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for ISO OIDs+namespaceOID :: UUID+namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for X.500 DNs+namespaceX500 :: UUID+namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"
+ src/Data/UUID/Util.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TypeFamilies #-}+module Data.UUID.Util (+ UnpackedUUID(..)+ , unpack, pack+ , version+ , extractMac+ , extractTime+ , setTime+ ) where++import Prelude hiding (null)+import Data.Word+import Data.Word.Util+import Data.Bits+import Data.UUID.Types.Internal+import Network.Info+import Data.Int (Int64)++version :: UUID -> Int+version uuid =+ fromEnum ((time_hi_and_version unpacked `shiftR` 12) .&. 0xF)+ where+ unpacked = unpack uuid++-- Note UUID time is in 10^-7 seconds.+setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID+setTime uuid t =+ if version uuid == 1+ then Just $ pack $ (unpack uuid){time_low = new_low_bits, time_mid = new_mid_bits, time_hi_and_version = new_hi_and_version_bits}+ else Nothing+ where new_low_bits = fromIntegral $ t .&. 0xFFFFFFFF+ new_mid_bits = fromIntegral $ (t `shiftR` 32) .&. 0xFFFF+ new_hi_and_version_bits = fromIntegral $ 0x1000 .|. ((t `shiftR` 48) .&. 0x0FFF)++extractTime :: UUID -> Maybe Int64+extractTime uuid =+ if version uuid == 1+ then Just $ fromIntegral $ w32to64 (w16to32 (timeAndVersionToTime $ time_hi_and_version unpacked) $ time_mid unpacked) (time_low unpacked)+ else Nothing+ where+ unpacked = unpack uuid++timeAndVersionToTime :: Word16 -> Word16+timeAndVersionToTime tv = tv .&. 0x0FFF++extractMac :: UUID -> Maybe MAC+extractMac uuid =+ if version uuid == 1+ then Just $+ MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)+ else Nothing+ where+ unpacked = unpack uuid
+ src/Data/UUID/V1.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -fno-cse #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module : Data.UUID.V1+Copyright : (c) 2008 Jason Dusek+ (c) 2009 Mark Lentczner+ (c) 2009-2010,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable++RFC 4122 Version 1 UUID state machine.++The generated UUID is based on the hardware MAC+address and the system clock.++If we cannot lookup the MAC address we seed the+generator with a pseudo-random number.+-}++module Data.UUID.V1(nextUUID)+where+++import Data.Bits+import Data.Maybe+import Data.Time+import Data.Word++import Control.Applicative ((<$>),(<*>))+import Control.Concurrent.MVar+import System.IO.Unsafe++import qualified System.Random as R++import Network.Info++import Data.UUID.Types.Internal.Builder+import Data.UUID.Types.Internal++-- | Returns a new UUID derived from the local hardware MAC+-- address and the current system time.+-- Is generated according to the Version 1 UUID specified in+-- RFC 4122.+--+-- Returns 'Nothing' if you request UUIDs too quickly.+nextUUID :: IO (Maybe UUID)+nextUUID = do+ res <- stepTime+ case res of+ Just (mac', c, t) -> return $ Just $ makeUUID t c mac'+ _ -> return Nothing+++makeUUID :: Word64 -> Word16 -> MAC -> UUID+makeUUID time clock mac' =+ buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')+ where tLow = (fromIntegral time) :: Word32+ tMid = (fromIntegral (time `shiftR` 32)) :: Word16+ tHigh = (fromIntegral (time `shiftR` 48)) :: Word16++newtype MACSource = MACSource MAC+instance ByteSource MACSource where+ z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f+type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)+++-- |Approximates the clock algorithm in RFC 4122, section 4.2+-- Isn't system wide or thread safe, nor does it properly randomize+-- the clock value on initialization.+stepTime :: IO (Maybe (MAC, Word16, Word64))+stepTime = do+ h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+ modifyMVar state $ \s@(State mac' c0 h0) ->+ if h1 > h0+ then+ return (State mac' c0 h1, Just (mac', c0, h1))+ else+ let+ c1 = succ c0+ in if c1 <= 0x3fff -- when clock is initially randomized,+ -- then this test will need to change+ then+ return (State mac' c1 h1, Just (mac', c1, h1))+ else+ return (s, Nothing)+++{-# NOINLINE state #-}+state :: MVar State+state = unsafePerformIO $ do+ h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+ mac' <- getMac+ newMVar $ State mac' 0 h0 -- the 0 should be a random number++-- SysMAC.mac can fail on some machines.+-- In those cases we fake it with a random+-- 6 bytes seed.+getMac :: IO MAC+getMac =+ getNetworkInterfaces >>=+ return . listToMaybe . filter (minBound /=) . map mac >>=+ \macM -> case macM of+ Just m -> return m+ Nothing -> randomMac++randomMac :: IO MAC+randomMac =+ -- I'm too lazy to thread through+ -- the random state ...+ MAC+ <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO++data State = State+ {-# UNPACK #-} !MAC+ {-# UNPACK #-} !Word16+ {-# UNPACK #-} !Word64+ deriving (Show)++++hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64+hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt+ where+ gregorianReform = UTCTime (fromGregorian 1582 10 15) 0+ dt = t `diffUTCTime` gregorianReform
+ src/Data/UUID/V3.hs view
@@ -0,0 +1,49 @@+{- |+Module : Data.UUID.V3+Copyright : (c) 2010,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable++NOTE\: This module uses MD5 hashing. Unless you know+you need to use this module, you should probably be+using "Data.UUID.V5", which offers the same sort of+functionality as this module except implemented with+SHA-1 hashing.++This module implements Version 3 UUIDs as specified+in RFC 4122.++These UUIDs identify an object within a namespace,+and are deterministic.++The namespace is identified by a UUID. Several sample+namespaces are enclosed.+-}+module Data.UUID.V3+ (generateNamed+ ,Shared.namespaceDNS+ ,Shared.namespaceURL+ ,Shared.namespaceOID+ ,Shared.namespaceX500+ ) where++import Data.Word++import Data.UUID.Types.Internal+import qualified Data.UUID.Named as Shared+import qualified Crypto.Hash.MD5 as MD5+++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+--+-- Uses an MD5 hash. The UUID is built from first 128 bits of the hash of+-- the namespace UUID and the name (as a series of Word8).+generateNamed :: UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed = Shared.generateNamed MD5.hash 3
+ src/Data/UUID/V4.hs view
@@ -0,0 +1,33 @@+{- |+ Module : Data.UUID.V4+ Copyright : (c) 2012-2016 Antoine Latter++ License : BSD-style++ Maintainer : aslatter@gmail.com+ Stability : experimental+ Portability : portable++ This module implements Version 4 UUIDs as specified+ in RFC 4122.++ These UUIDs are generated from a pseudo-random generator.+ We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,+ which should provide cryptographically secure random data.+-}+module Data.UUID.V4 (nextRandom) where++import Data.UUID+import Data.UUID.Types.Internal ( buildFromBytes )++import System.Entropy ( getEntropy )+import Data.ByteString ( unpack )++-- | Generate a crytographically secure, random UUID.+--+-- @since 1.2.6+nextRandom :: IO UUID+nextRandom = do+ [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]+ <- unpack `fmap` getEntropy 16+ return $ buildFromBytes 4 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
+ src/Data/UUID/V5.hs view
@@ -0,0 +1,44 @@+-- |+-- Module : Data.UUID.V5+-- Copyright : (c) 2008-2009 Antoine Latter+--+-- License : BSD-style+--+-- Maintainer : aslatter@gmail.com+-- Stability : experimental+-- Portability : portable+--+--+-- This module implements Version 5 UUIDs as specified+-- in RFC 4122.+--+-- These UUIDs identify an object within a namespace,+-- and are deterministic.+--+-- The namespace is identified by a UUID. Several sample+-- namespaces are enclosed.++module Data.UUID.V5+ (generateNamed+ ,Shared.namespaceDNS+ ,Shared.namespaceURL+ ,Shared.namespaceOID+ ,Shared.namespaceX500+ ) where++import Data.Word++import Data.UUID.Types.Internal+import qualified Data.UUID.Named as Shared+import qualified Crypto.Hash.SHA1 as SHA1+++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+--+-- Uses a SHA1 hash. The UUID is built from first 128 bits of the hash of+-- the namespace UUID and the name (as a series of Word8).+generateNamed :: UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed = Shared.generateNamed SHA1.hash 5
+ src/Data/Word/Util.hs view
@@ -0,0 +1,20 @@++-- | Internal utilites+module Data.Word.Util where++import Data.Bits+import Data.Word++w16to32 :: Word16 -> Word16 -> Word32+w16to32 w0s w1s =+ (w0 `shiftL` 16) .|. w1+ where+ w0 = fromIntegral w0s+ w1 = fromIntegral w1s++w32to64 :: Word32 -> Word32 -> Word64+w32to64 w0s w1s =+ (w0 `shiftL` 32) .|. w1+ where+ w0 = fromIntegral w0s+ w1 = fromIntegral w1s
− tests/BenchUUID.hs
@@ -1,34 +0,0 @@-import Criterion.Main-import Data.Char (ord)-import Data.IORef-import Data.Word-import qualified Data.UUID as U-import qualified Data.UUID.V1 as U-import qualified Data.UUID.V4 as U-import qualified Data.UUID.V3 as U3-import qualified Data.UUID.V5 as U5-import System.Random-import System.Random.Mersenne.Pure64--main :: IO ()-main = do- let n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8]-- -- setup for random generation- randomState <- newPureMT >>= newIORef- let randomUUID = do- state <- readIORef randomState- let (uuid, state') = random state- writeIORef randomState state'- return uuid-- -- benchmark UUID generation- defaultMain [- bgroup "generation" [- bench "V1" $ nfIO U.nextUUID,- bench "V4-stock" $ nfIO (U.nextRandom :: IO U.UUID),- bench "V4-mersenne" $ nfIO (randomUUID :: IO U.UUID),- bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1,- bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1- ]- ]
tests/TestUUID.hs view
@@ -15,7 +15,7 @@ import Test.QuickCheck ( Arbitrary(arbitrary), choose ) import Test.Tasty ( TestTree, testGroup, defaultMain ) import Test.Tasty.HUnit- ( Assertable(assert), assertBool, (@?=), testCase )+ ( assertBool, (@?=), testCase ) import Test.Tasty.QuickCheck ( testProperty ) type Test = TestTree@@ -47,7 +47,7 @@ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test testUUID p u = testCase (show u) $- assert $ maybe False p u+ assertBool "" $ maybe False p u test_v3 :: Test test_v3 =
uuid.cabal view
@@ -1,90 +1,95 @@-Name: uuid-Version: 1.3.13-Copyright: (c) 2008-2014 Antoine Latter-Author: Antoine Latter-Maintainer: hvr@gnu.org-License: BSD3-License-file: LICENSE-Category: Data-Build-Type: Simple-Cabal-Version: >= 1.10-Tested-With: GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2+cabal-version: 1.12+name: uuid+version: 1.3.16.1+copyright: (c) 2008-2014 Antoine Latter+author: Antoine Latter+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+category: Data+build-type: Simple+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.6+ || ==9.8.4+ || ==9.10.1+ || ==9.12.4+ || ==9.14.1 -Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers-Description:- This library is useful for creating, comparing, parsing and- printing Universally Unique Identifiers.- .- See <http://en.wikipedia.org/wiki/UUID> for the general idea.+synopsis:+ For creating, comparing, parsing and printing Universally Unique Identifiers -Homepage: https://github.com/hvr/uuid-Bug-Reports: https://github.com/hvr/uuid/issues+description:+ This library is useful for creating, comparing, parsing and+ printing Universally Unique Identifiers.+ .+ See <http://en.wikipedia.org/wiki/UUID> for the general idea. -Extra-Source-Files:- CHANGES.md+homepage: https://github.com/haskell-hvr/uuid+bug-reports: https://github.com/haskell-hvr/uuid/issues+extra-source-files: CHANGES.md -Source-Repository head- Type: git- Location: https://github.com/hvr/uuid.git- Subdir: uuid+source-repository head+ type: git+ location: https://github.com/haskell-hvr/uuid.git+ subdir: uuid -Library- Build-Depends: base >= 4.3 && < 5,- binary >= 0.4 && < 0.9,- bytestring >= 0.10 && < 0.11,- cryptohash-sha1 >= 0.11.100 && < 0.12,- cryptohash-md5 >= 0.11.100 && < 0.12,- entropy >= 0.3.7 && < 0.4,- network-info == 0.2.*,- random >= 1.0.1 && < 1.2,- time >= 1.1 && < 1.8,- text >= 1 && < 1.3,- uuid-types >= 1.0.2 && < 2+library+ build-depends:+ base >=4.12 && <5+ , binary >=0.8.6.0 && <0.9+ , bytestring >=0.10.8.2 && <0.13+ , cryptohash-md5 >=0.11.100 && <0.12+ , cryptohash-sha1 >=0.11.100 && <0.12+ , entropy >=0.3.7 && <0.5+ , network-info >=0.2 && <0.3+ , random >=1.2.1.2 && <1.4+ , time >=1.4 && <1.16 - Exposed-Modules:- Data.UUID- Data.UUID.Util- Data.UUID.V1- Data.UUID.V3- Data.UUID.V4- Data.UUID.V5+ -- strict dependency on uuid-types,+ -- as we re-rexport datatype, thus leak instances etc.+ build-depends: uuid-types >=1.0.6 && <1.0.7+ exposed-modules:+ Data.UUID+ Data.UUID.Util+ Data.UUID.V1+ Data.UUID.V3+ Data.UUID.V4+ Data.UUID.V5 - Other-Modules:- Data.UUID.Named- Data.Word.Util+ other-modules:+ Data.UUID.Named+ Data.Word.Util - Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable- Other-Extensions: TypeFamilies- Ghc-Options: -Wall+ default-language: Haskell2010+ default-extensions: DeriveDataTypeable+ other-extensions: TypeFamilies+ ghc-options: -Wall+ hs-source-dirs: src -Test-Suite testuuid- Type: exitcode-stdio-1.0- Main-is: TestUUID.hs- Hs-source-dirs: tests- Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable- Other-Extensions: ViewPatterns- Ghc-Options: -Wall -fno-warn-orphans- Build-Depends: uuid- Build-Depends: base >= 4.3 && < 5,- bytestring >= 0.9 && < 0.11,- HUnit >= 1.2 && < 1.4,- QuickCheck >= 2.4 && < 2.10,- random >= 1.0.1 && < 1.2,- tasty >= 0.10 && < 0.12,- tasty-hunit == 0.9.*,- tasty-quickcheck == 0.8.*+test-suite test-uuid+ type: exitcode-stdio-1.0+ main-is: TestUUID.hs+ hs-source-dirs: tests+ default-language: Haskell2010+ default-extensions: DeriveDataTypeable+ other-extensions: ViewPatterns+ ghc-options: -Wall -fno-warn-orphans -benchmark benchmark- Type: exitcode-stdio-1.0- Main-is: BenchUUID.hs- Hs-source-dirs: tests- Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable, CPP- Ghc-Options: -Wall -fno-warn-orphans- Build-Depends: uuid- Build-Depends: base >= 4.3 && < 5,- criterion >= 0.4 && < 1.2,- mersenne-random-pure64 >= 0.2 && < 0.3,- random >= 1.0.1 && < 1.2+ -- inherited constraints+ build-depends:+ base+ , bytestring+ , uuid++ -- deps w/o inherited constraints+ build-depends:+ QuickCheck >=2.14.2 && <2.16+ , tasty >=1.4.0.1 && <1.6+ , tasty-hunit >=0.10 && <0.11+ , tasty-quickcheck >=0.10 && <0.12