uuid-1.2.3/0000755000000000000000000000000011620625147010655 5ustar0000000000000000uuid-1.2.3/CHANGES0000644000000000000000000000247611620625147011661 0ustar00000000000000001.2.3 - The Read instance now drops leading spaces in the string to be parsed. Thanks to Marc Ziegert for reporting this bug. - The tests have moved over to the new Cabal test running framework. 1.2.2 - Add functions fromWords/toWords The goal was to have a total function that can be used to construct a UUID, primarily for use by uuid-th. 1.2.1 - Fix concurrency bug in Data.UUID.V1 (thanks to Neil Mitchell for reporting and a test case) 1.2.0 (Contributors: Antoine Latter & Mark Lentczner) - added functions toByteString and fromByteString - added 'nil' UUID - added unit tests and benchmarks, built when configured -ftest - major speed up of to/from functions (as well as in general) - added version-3 generation (deterministic based on MD5) - major changes to internal representation - now uses four strict Word32 values - internal ByteSource classes for easy construction (see Builder.hs) - Storable instance now stores in memory as system libraries in C do: 16 bytes derived from the network order of the fields, no matter what the host native endianess is. - fixed bugs in V1 time and clock stepping, and V1 generated values - builds cleanly under GHC's -Wall - added CHANGES file 1.1.1 - no longer exporting 'null' from the prelude - add 'null' predicate on UUIDs - documentation fix (thanks Mark Lentczner) uuid-1.2.3/CONTRIBUTORS0000644000000000000000000000011711620625147012534 0ustar0000000000000000In order of appearance: Antoine Latter Jason Dusek Tim Newsham Mark Lentczner uuid-1.2.3/LICENSE0000644000000000000000000000266011620625147011666 0ustar0000000000000000Copyright (c) 2008, Antoine Latter All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of the authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. uuid-1.2.3/Setup.hs0000644000000000000000000000007511620625147012313 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain uuid-1.2.3/uuid.cabal0000644000000000000000000000340511620625147012611 0ustar0000000000000000Name: uuid Version: 1.2.3 Copyright: (c) 2008-2011 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com License: BSD3 License-file: LICENSE Category: Data Build-Type: Simple Cabal-Version: >= 1.8 Description: This library is useful for creating, comparing, parsing and printing Universally Unique Identifiers. See for the general idea. Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers Homepage: http://projects.haskell.org/uuid/ Bug-Reports: mailto:aslatter@gmail.com Extra-Source-Files: CHANGES CONTRIBUTORS Library Build-Depends: random, binary, bytestring, Crypto, maccatcher, time, base >=3, base < 5 Exposed-Modules: Data.UUID Data.UUID.V1 Data.UUID.V3 Data.UUID.V5 Other-Modules: Data.UUID.Builder Data.UUID.Internal Data.UUID.Named Extensions: DeriveDataTypeable Ghc-Prof-Options: -auto-all -caf-all Ghc-Shared-Options: Ghc-Options: -Wall -- not strictly a test, but we want it to error if -- it can't build Test-Suite benchmark Type: exitcode-stdio-1.0 Main-is: BenchUUID.hs Hs-source-dirs: tests Extensions: DeriveDataTypeable, CPP Build-depends: base == 4.*, uuid, random, criterion >= 0.4 && < 0.6, mersenne-random-pure64, bytestring == 0.9.*, containers == 0.4.*, deepseq == 1.1.* Test-Suite testuuid Type: exitcode-stdio-1.0 Main-is: TestUUID.hs Hs-source-dirs: tests Extensions: DeriveDataTypeable Ghc-Options: -Wall -fno-warn-orphans Build-Depends: random, bytestring, base >=3, base < 5, uuid, HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3 uuid-1.2.3/Data/0000755000000000000000000000000011620625147011526 5ustar0000000000000000uuid-1.2.3/Data/UUID.hs0000644000000000000000000000174111620625147012633 0ustar0000000000000000-- | -- Module : Data.UUID -- Copyright : (c) 2008 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 for the general idea. -- See for the specification. -- -- For generating UUIDs, check out 'Data.UUID.V1', 'Data.UUID.V5' and -- 'System.Random'. module Data.UUID(UUID ,toString ,fromString ,toByteString ,fromByteString ,toWords ,fromWords ,null ,nil ) where import Prelude () -- we need to hide Prelude.null import Data.UUID.Internal -- Everything is really implemented in Data.UUID.Internal, -- but I don't want to export the constructors out of the -- package. uuid-1.2.3/Data/UUID/0000755000000000000000000000000011620625147012274 5ustar0000000000000000uuid-1.2.3/Data/UUID/Builder.hs0000644000000000000000000000537011620625147014223 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} -- Module : Data.UUID.Builder -- Copyright : (c) 2009 Mark Lentczner -- -- License : BSD-style -- -- Maintainer : markl@glyphic.com -- Stability : experimental -- Portability : portable -- -- This module provides a system that can call a function that takes -- a sequence of some number of Word8 arguments. -- -- The twist is that the Word8 arguments can be supplied directly -- from Word8s, or from other sources that may provide more than -- one Word8 apiece. Examples are Word16 and Word32 that supply -- two and four Word8s respectively. Other ByteSource instances -- can be defined. -- -- This module is admittedly overkill. There are only three places -- in the uuid package that need to call buildFromBytes with 16 -- Word8 values, but each place uses Words of different lengths: -- version 1 uuids: 32-16-16-16-8-8-8-8-8-8 -- version 4 uuids: 24-24-32-24-24 -- version 5 uuids: 32-32-32-32 -- Originally, these three constructions were hand coded but the -- code was ungainly. Using this module makes the code very -- concise, and turns out to optimize to just as fast, or faster! module Data.UUID.Builder (ByteSource(..) ,ByteSink ,Takes1Byte ,Takes2Bytes ,Takes3Bytes ,Takes4Bytes ) where import Data.Bits import Data.Word type Takes1Byte g = Word8 -> g type Takes2Bytes g = Word8 -> Word8 -> g type Takes3Bytes g = Word8 -> Word8 -> Word8 -> g type Takes4Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> g -- | Type of function that a given ByteSource needs. -- This function must take as many Word8 arguments as the ByteSource provides type family ByteSink w g type instance ByteSink Word8 g = Takes1Byte g type instance ByteSink Word16 g = Takes2Bytes g type instance ByteSink Word32 g = Takes4Bytes g type instance ByteSink Int g = Takes4Bytes g -- | Class of types that can add Word8s to a Builder. -- Instances for Word8, Word16, Word32 and Int provide 1, 2, 4 and 4 bytes, -- respectively, into a ByteSink class ByteSource w where -- | Apply the source's bytes to the sink (/-/) :: ByteSink w g -> w -> g infixl 6 /-/ instance ByteSource Word8 where f /-/ w = f w instance ByteSource Word16 where f /-/ w = f b1 b2 where b1 = fromIntegral (w `shiftR` 8) b2 = fromIntegral w instance ByteSource Word32 where f /-/ w = f b1 b2 b3 b4 where b1 = fromIntegral (w `shiftR` 24) b2 = fromIntegral (w `shiftR` 16) b3 = fromIntegral (w `shiftR` 8) b4 = fromIntegral w instance ByteSource Int where f /-/ w = f b1 b2 b3 b4 where b1 = fromIntegral (w `shiftR` 24) b2 = fromIntegral (w `shiftR` 16) b3 = fromIntegral (w `shiftR` 8) b4 = fromIntegral w uuid-1.2.3/Data/UUID/Internal.hs0000644000000000000000000002342011620625147014405 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-} -- | -- Module : Data.UUID -- Copyright : (c) 2008-2009 Antoine Latter -- (c) 2009 Mark Lentczner -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable module Data.UUID.Internal (UUID(..) ,null ,nil ,fromByteString ,toByteString ,fromString ,toString ,fromWords ,toWords ,buildFromBytes ,buildFromWords ) where import Prelude hiding (null) import Control.Monad (liftM4) import Data.Char import Data.Maybe import Data.Bits import Data.List (elemIndices) #if MIN_VERSION_base(4,0,0) import Data.Data #else import Data.Generics.Basics #endif import Foreign.Storable import Data.Binary import Data.Binary.Put import Data.Binary.Get import qualified Data.ByteString.Lazy as Lazy import Data.UUID.Builder import System.Random -- |The UUID type. A 'Random' instance is provided which produces -- version 4 UUIDs as specified in RFC 4122. The 'Storable' and -- 'Binary' instances are compatible with RFC 4122, storing the fields -- in network order as 16 bytes. data UUID = UUID !Word32 !Word32 !Word32 !Word32 deriving (Eq, Ord, Typeable) {- Other representations that we tried are: Mimic V1 structure: !Word32 !Word16 !Word16 !Word16 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8 Sixteen bytes: !Word8 ... (x 16) Simple list of bytes: [Word8] ByteString (strict) ByteString Immutable array: UArray Int Word8 Vector: UArr Word8 None was as fast, overall, as the representation used here. -} -- | Covert a 'UUID' into a sequence of 'Word32' values. -- Usefull for when you need to serialize a UUID and -- neither 'Storable' nor 'Binary' are appropriate. toWords :: UUID -> (Word32, Word32, Word32, Word32) toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4) -- | Create a 'UUID' from a sequence of 'Word32'. The -- opposite of 'toWords'. fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID fromWords = UUID -- -- UTILITIES -- -- |Build a Word32 from four Word8 values, presented in big-endian order word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32 word a b c d = (fromIntegral a `shiftL` 24) .|. (fromIntegral b `shiftL` 16) .|. (fromIntegral c `shiftL` 8) .|. (fromIntegral d ) -- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0, byte :: Int -> Word32 -> Word8 byte i w = fromIntegral (w `shiftR` (i * 8)) -- |Make a UUID from sixteen Word8 values makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = UUID w0 w1 w2 w3 where w0 = word b0 b1 b2 b3 w1 = word b4 b5 b6 b7 w2 = word b8 b9 ba bb w3 = word bc bd be bf -- |Make a UUID from four Word32 values makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID makeFromWords = UUID -- |A Builder for constructing a UUID of a given version. buildFromBytes :: Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> UUID buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf = makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf where b6' = b6 .&. 0x0f .|. (v `shiftL` 4) b8' = b8 .&. 0x3f .|. 0x80 -- |Build a UUID of a given version from Word32 values. buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12) w2' = w2 .&. 0x3fffffff .|. 0x80000000 -- |Return the bytes that make up the UUID toList :: UUID -> [Word8] toList (UUID w0 w1 w2 w3) = [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0, byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1, byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2, byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3] -- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't -- exactly sixteen bytes long fromList :: [Word8] -> Maybe UUID fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] = Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf fromList _ = Nothing -- -- UUID API -- -- |Returns true if the passed-in UUID is the 'nil' UUID. null :: UUID -> Bool null = (== nil) -- Note: This actually faster than: -- null (UUID 0 0 0 0) = True -- null _ = False -- |The nil UUID, as defined in RFC 4122. -- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@. nil :: UUID nil = UUID 0 0 0 0 -- |Extract a UUID from a 'ByteString' in network byte order. -- The argument must be 16 bytes long, otherwise 'Nothing' is returned. fromByteString :: Lazy.ByteString -> Maybe UUID fromByteString = fromList . Lazy.unpack -- |Encode a UUID into a 'ByteString' in network order. toByteString :: UUID -> Lazy.ByteString toByteString = Lazy.pack . toList -- |If the passed in 'String' can be parsed as a 'UUID', it will be. -- The hyphens may not be omitted. -- Example: -- -- @ -- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\" -- @ -- -- Hex digits may be upper or lower-case. fromString :: String -> Maybe UUID fromString xs | validFmt = fromString' xs | otherwise = Nothing where validFmt = elemIndices '-' xs == [8,13,18,23] fromString' :: String -> Maybe UUID fromString' s0 = do (w0, s1) <- hexWord s0 (w1, s2) <- hexWord s1 (w2, s3) <- hexWord s2 (w3, s4) <- hexWord s3 if s4 /= "" then Nothing else Just $ UUID w0 w1 w2 w3 where hexWord :: String -> Maybe (Word32, String) hexWord s = Just (0, s) >>= hexByte >>= hexByte >>= hexByte >>= hexByte hexByte :: (Word32, String) -> Maybe (Word32, String) hexByte (w, '-':ds) = hexByte (w, ds) hexByte (w, hi:lo:ds) | bothHex = Just ((w `shiftL` 8) .|. octet, ds) | otherwise = Nothing where bothHex = isHexDigit hi && isHexDigit lo octet = fromIntegral (16 * digitToInt hi + digitToInt lo) hexByte _ = Nothing -- | Convert a UUID into a hypenated string using lower-case letters. -- Example: -- -- @ -- toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\" -- @ toString :: UUID -> String toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 "" where hexw :: Word32 -> String -> String hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s hexw' :: Word32 -> String -> String hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16 : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s hexn :: Word32 -> Int -> Char hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf) -- -- Class Instances -- instance Random UUID where random g = (fromGenNext w0 w1 w2 w3 w4, g4) where (w0, g0) = next g (w1, g1) = next g0 (w2, g2) = next g1 (w3, g3) = next g2 (w4, g4) = next g3 randomR _ = random -- range is ignored -- |Build a UUID from the results of five calls to next on a StdGen. -- While next on StdGet returns an Int, it doesn't provide 32 bits of -- randomness. This code relies on at last 28 bits of randomness in the -- and optimizes its use so as to make only five random values, not six. fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID fromGenNext w0 w1 w2 w3 w4 = buildFromBytes 4 /-/ (ThreeByte w0) /-/ (ThreeByte w1) /-/ w2 -- use all 4 bytes because we know the version -- field will "cover" the upper, non-random bits /-/ (ThreeByte w3) /-/ (ThreeByte w4) -- |A ByteSource to extract only three bytes from an Int, since next on StdGet -- only returns 31 bits of randomness. type instance ByteSink ThreeByte g = Takes3Bytes g newtype ThreeByte = ThreeByte Int instance ByteSource ThreeByte where f /-/ (ThreeByte w) = f b1 b2 b3 where b1 = fromIntegral (w `shiftR` 16) b2 = fromIntegral (w `shiftR` 8) b3 = fromIntegral w instance Show UUID where show = toString instance Read UUID where readsPrec _ str = let noSpaces = dropWhile isSpace str in case fromString (take 36 noSpaces) of Nothing -> [] Just u -> [(u,drop 36 noSpaces)] instance Storable UUID where sizeOf _ = 16 alignment _ = 1 -- UUIDs are stored as individual octets peekByteOff p off = mapM (peekByteOff p) [off..(off+15)] >>= return . fromJust . fromList pokeByteOff p off u = sequence_ $ zipWith (pokeByteOff p) [off..] (toList u) instance Binary UUID where put (UUID w0 w1 w2 w3) = putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3 get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be -- My goal with this instance was to make it work just enough to do what -- I want when used with the HStringTemplate library. instance Data UUID where toConstr uu = mkConstr uuidType (show uu) [] (error "fixity") gunfold _ _ = error "gunfold" dataTypeOf _ = uuidType uuidType :: DataType uuidType = mkNoRepType "Data.UUID.UUID" #if !(MIN_VERSION_base(4,2,0)) mkNoRepType :: String -> DataType mkNoRepType = mkNorepType #endif uuid-1.2.3/Data/UUID/Named.hs0000644000000000000000000000332311620625147013655 0ustar0000000000000000-- | -- 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.Internal import Data.Binary import Data.Maybe import qualified Data.ByteString.Lazy as BS -- |Generate a 'UUID' within the specified namespace out of the given -- object. generateNamed :: ([Word8] -> (Word32, Word32, Word32, Word32)) -- ^Hash -> Word8 -- ^Version -> UUID -- ^Namespace -> [Word8] -- ^Object -> UUID generateNamed hash version namespace object = let chunk = BS.unpack (toByteString namespace) ++ object (w1, w2, w3, w4) = hash chunk in buildFromWords version w1 w2 w3 w4 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" uuid-1.2.3/Data/UUID/V1.hs0000644000000000000000000000533211620625147013121 0ustar0000000000000000{-# OPTIONS_GHC -fno-cse #-} {-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.UUID.V1 -- Copyright : (c) 2008 Jason Dusek -- (c) 2009 Mark Lentczner -- (c) 2009-2010 Antoine Latter -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable -- -- RFC 4122 Version 1 UUID state machine. module Data.UUID.V1(nextUUID) where import Data.Time import Data.Bits import Data.Word import Control.Concurrent.MVar import System.IO.Unsafe import qualified System.Info.MAC as SysMAC import Data.MAC import Data.UUID.Builder import Data.UUID.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 the hardware MAC address could not -- be discovered. nextUUID :: IO (Maybe UUID) nextUUID = do res <- stepTime mac <- SysMAC.mac case (res, mac) of (Just (c, t), Just m) -> return $ Just $ makeUUID t c m _ -> 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 (Word16, Word64)) stepTime = do h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime modifyMVar state $ \s@(State c0 h0) -> if h1 > h0 then return (State c0 h1, Just (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 c1 h1, Just (c1, h1)) else return (s, Nothing) {-# NOINLINE state #-} state :: MVar State state = unsafePerformIO $ do h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime newMVar $ State 0 h0 -- the 0 should be a random number data State = State {-# 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 uuid-1.2.3/Data/UUID/V3.hs0000644000000000000000000000335511620625147013126 0ustar0000000000000000-- | -- Module : Data.UUID.V3 -- Copyright : (c) 2010 Antoine Latter -- -- License : BSD-style -- -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable -- -- -- 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.Bits import Data.UUID.Internal import qualified Data.UUID.Named as Shared import qualified Data.Digest.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 hash 3 hash :: [Word8] -> (Word32, Word32, Word32, Word32) hash bytes = case map f $ chunk 4 $ MD5.hash bytes of w1:w2:w3:w4:_ -> (w1, w2, w3, w4) _ -> error "Data.UUID.V3.hash: fatal error" where f [b1, b2, b3, b4] = sum [ fromIntegral b4 , fromIntegral b3 `shiftL` 8 , fromIntegral b2 `shiftL` 16 , fromIntegral b1 `shiftL` 24 ] f _ = error "Data.UUID.V3.hash: fatal error" chunk :: Int -> [a] -> [[a]] chunk n = go n [] where go _ [] [] = [] go _ ys [] = reverse ys:[] go 0 ys xs = reverse ys:go n [] xs go m ys (x:xs) = go (m-1) (x:ys) xs uuid-1.2.3/Data/UUID/V5.hs0000644000000000000000000000230111620625147013116 0ustar0000000000000000-- | -- 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.Internal import qualified Data.UUID.Named as Shared import qualified Data.Digest.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 hash 5 where hash bytes = case SHA1.hash bytes of SHA1.Word160 w1 w2 w3 w4 _w5 -> (w1, w2, w3, w4)