diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -0,0 +1,23 @@ +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) diff --git a/CONTRIBUTORS b/CONTRIBUTORS new file mode 100644 --- /dev/null +++ b/CONTRIBUTORS @@ -0,0 +1,6 @@ +In order of appearance: + +Antoine Latter +Jason Dusek +Tim Newsham +Mark Lentczner diff --git a/Data/UUID.hs b/Data/UUID.hs --- a/Data/UUID.hs +++ b/Data/UUID.hs @@ -12,6 +12,7 @@ -- 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'. @@ -19,7 +20,10 @@ module Data.UUID(UUID ,toString ,fromString + ,toByteString + ,fromByteString ,null + ,nil ) where import Prelude hiding (null) diff --git a/Data/UUID/Builder.hs b/Data/UUID/Builder.hs new file mode 100644 --- /dev/null +++ b/Data/UUID/Builder.hs @@ -0,0 +1,88 @@ +{-# 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 diff --git a/Data/UUID/Internal.hs b/Data/UUID/Internal.hs --- a/Data/UUID/Internal.hs +++ b/Data/UUID/Internal.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE DeriveDataTypeable, CPP #-} +{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-} -- | -- Module : Data.UUID --- Copyright : (c) 2008 Antoine Latter +-- Copyright : (c) 2008-2009 Antoine Latter -- -- License : BSD-style -- @@ -13,27 +13,23 @@ module Data.UUID.Internal (UUID(..) ,null - ,Node(..) - ,nullNode - ,nodeToList - ,listToNode + ,nil + ,fromByteString + ,toByteString ,fromString ,toString - ,versionMask - ,reservedMask - ,reserved + ,buildFromBytes + ,buildFromWords ) where import Prelude hiding (null) import qualified Prelude -import Data.Word +import Control.Monad (liftM4) import Data.Char import Data.Maybe import Data.Bits -import Data.List (splitAt, foldl', unfoldr) - -import Data.Typeable +import Data.List (elemIndices) #if MIN_VERSION_base(4,0,0) import Data.Data @@ -41,196 +37,129 @@ import Data.Generics.Basics #endif -import Foreign.Ptr 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 -import Text.Printf -#ifndef STRICT -#define SLOT(x) x -#else -#define SLOT(x) {-# UNPACK #-} !x -#endif - -- |The UUID type. A 'Random' instance is provided which produces --- version 4 UUIDs as specified in RFC 4122. The 'Storable' and --- 'Binary' instances are compatable with RFC 4122. The 'Binary' --- instance serializes to network byte order. -data UUID = UUID - {uuid_timeLow :: SLOT(Word32) - ,uuid_timeMid :: SLOT(Word16) - ,uuid_timeHigh :: SLOT(Word16) -- includes version number - ,uuid_clockSeqHi :: SLOT(Word8) -- includes reserved field - ,uuid_clokcSeqLow :: SLOT(Word8) - ,uuid_node :: SLOT(Node) - } deriving (Eq, Ord, Typeable) +-- 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. +-} --- |Returns true if the passed-in UUID is the null UUID. -null :: UUID -> Bool -null (UUID 0 0 0 0 0 node) | nullNode node = True -null _ = False -instance Random UUID where - random g = let (timeLow, g1) = randomBoundedIntegral g - (timeMid, g2) = randomBoundedIntegral g1 - (timeHigh, g3) = randomBoundedIntegral g2 - (seqHigh, g4) = randomBoundedIntegral g3 - (seqLow, g5) = randomBoundedIntegral g4 - (node, g6) = random g5 - seqHighReserved = (seqHigh .&. reservedMask) .|. reserved - timeHighVersion = (timeHigh .&. versionMask) .|. versionRandom - in (UUID timeLow timeMid timeHighVersion seqHighReserved seqLow node, g6) +-- +-- UTILITIES +-- - randomR _ = random -- range is ignored +-- |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 ) -versionMask :: Word16 -- 0000 1111 1111 1111 -versionMask = 0x0FFF +-- |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)) -versionRandom :: Word16 -versionRandom = 4 `shiftL` 12 -reservedMask :: Word8 -- 0011 1111 -reservedMask = 0x3F - -reserved :: Word8 -reserved = bit 7 - -data Node = Node - SLOT(Word8) - SLOT(Word8) - SLOT(Word8) - SLOT(Word8) - SLOT(Word8) - SLOT(Word8) - deriving (Eq, Ord, Typeable) - -instance Random Node where - random g = let (w1, g1) = randomBoundedIntegral g - (w2, g2) = randomBoundedIntegral g1 - (w3, g3) = randomBoundedIntegral g2 - (w4, g4) = randomBoundedIntegral g3 - (w5, g5) = randomBoundedIntegral g4 - (w6, g6) = randomBoundedIntegral g5 - in (Node w1 w2 w3 w4 w5 w6, g6) - randomR _ = random -- neglect range - -nullNode :: Node -> Bool -nullNode (Node 0 0 0 0 0 0) = True -nullNode _ = False - -nodeToList :: Node -> [Word8] -nodeToList (Node w1 w2 w3 w4 w5 w6) = [w1, w2, w3, w4, w5, w6] +-- |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 -listToNode :: [Word8] -> Maybe Node -listToNode [w1, w2, w3, w4, w5, w6] = return $ Node w1 w2 w3 w4 w5 w6 -listToNode _ = Nothing +-- |Make a UUID from four Word32 values +makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID +makeFromWords = UUID -instance Show UUID where - show = toString +-- |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 -instance Read UUID where - readsPrec _ str = case fromString (take 36 str) of - Nothing -> [] - Just u -> [(u,drop 36 str)] +-- |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 -instance Storable UUID where - sizeOf _ = 16 - alignment _ = 4 -- not sure what to put here - - peek p = do - tl <- peek $ castPtr p - tm <- peekByteOff p 4 - th <- peekByteOff p 6 - ch <- peekByteOff p 8 - cl <- peekByteOff p 9 - node <- peekByteOff p 10 - return $ UUID tl tm th ch cl node - - poke p (UUID tl tm th ch cl node) = do - poke (castPtr p) tl - pokeByteOff p 4 tm - pokeByteOff p 6 th - pokeByteOff p 8 ch - pokeByteOff p 9 cl - pokeByteOff p 10 node - -instance Storable Node where - sizeOf _ = 6 - alignment _ = 1 -- ??? - - peek p = do - w1 <- peek $ castPtr p - w2 <- peekByteOff p 1 - w3 <- peekByteOff p 2 - w4 <- peekByteOff p 3 - w5 <- peekByteOff p 4 - w6 <- peekByteOff p 5 - return $ Node w1 w2 w3 w4 w5 w6 - - poke p (Node w1 w2 w3 w4 w5 w6) = do - poke (castPtr p) w1 - pokeByteOff p 1 w2 - pokeByteOff p 2 w3 - pokeByteOff p 3 w4 - pokeByteOff p 4 w5 - pokeByteOff p 5 w6 - --- Binary instance in network byte-order -instance Binary UUID where - put (UUID tl tm th ch cl n) = do - putWord32be tl - putWord16be tm - putWord16be th - putWord8 ch - putWord8 cl - put n - - get = do - tl <- getWord32be - tm <- getWord16be - th <- getWord16be - ch <- getWord8 - cl <- getWord8 - node <- get - return $ UUID tl tm th ch cl node - -instance Binary Node where - put (Node w1 w2 w3 w4 w5 w6) = do - putWord8 w1 - putWord8 w2 - putWord8 w3 - putWord8 w4 - putWord8 w5 - putWord8 w6 +-- |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] - get = do - w1 <- getWord8 - w2 <- getWord8 - w3 <- getWord8 - w4 <- getWord8 - w5 <- getWord8 - w6 <- getWord8 - return $ Node w1 w2 w3 w4 w5 w6 +-- |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 --- 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 +-- +-- UUID API +-- -uuidType = mkNorepType "Data.UUID.UUID" +-- |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. @@ -242,25 +171,30 @@ -- -- Hex digits may be upper or lower-case. fromString :: String -> Maybe UUID -fromString xs | validFmt = Just uuid +fromString xs | validFmt = fromString' xs | otherwise = Nothing - where validFmt = length ws == 5 && - map length ws == [8,4,4,4,12] && - all isHexDigit (concat ws) && - isJust node - ws = splitList '-' xs - [tl, tm, th, c, n] = ws - ns = unfoldUntil Prelude.null (splitAt 2) n :: [String] - node = listToNode $ map hexVal ns :: Maybe Node - uuid = UUID (hexVal tl) (hexVal tm) (hexVal th) (hexVal $ take 2 c) (hexVal $ drop 2 c) (fromJust $ node) - --- | Convert a string to a hex value, assuming the string is already validated. -hexVal :: Num a => String -> a -hexVal = fromInteger . foldl' (\n c -> 16*n + digitToInteger c) 0 + where validFmt = elemIndices '-' xs == [8,13,18,23] -digitToInteger :: Char -> Integer -digitToInteger = fromIntegral . digitToInt +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: @@ -269,35 +203,94 @@ -- toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\" -- @ toString :: UUID -> String -toString (UUID tl tm th ch cl n) = printf "%08x-%04x-%04x-%02x%02x-%s" tl tm th ch cl ns - where ns = concatMap hexb $ nodeToList n - hexb x = printf "%02x" x :: 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 --- remove all occurances of the input element in the inpt list. --- none of the sub-lists are empty. -splitList :: Eq a => a -> [a] -> [[a]] -splitList c xs = let ys = dropWhile (== c) xs - in case span (/= c) ys of - ([],_) -> [] - (sub,rest) -> sub : splitList c rest + hexn :: Word32 -> Int -> Char + hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf) --- the passed-in predicate signals when to stop unfolding -unfoldUntil :: (b -> Bool) -> (b -> (a, b)) -> b -> [a] -unfoldUntil p f n = unfoldr g n - where g m | p m = Nothing - | otherwise = Just $ f m +-- +-- Class Instances +-- --- no random intance for Data.Word types :-( --- this will work, though +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 -randomBoundedIntegral :: (RandomGen g, Bounded a, Integral a) => g -> (a, g) -randomBoundedIntegral g = - let (n, g1) = randomR (fromIntegral l, fromIntegral u) g - _ = n :: Integer - retVal = fromIntegral n `asTypeOf` (l `asTypeOf` u) - u = maxBound - l = minBound - in (retVal, g1) +-- |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 = case fromString (take 36 str) of + Nothing -> [] + Just u -> [(u,drop 36 str)] + + +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 diff --git a/Data/UUID/Named.hs b/Data/UUID/Named.hs new file mode 100644 --- /dev/null +++ b/Data/UUID/Named.hs @@ -0,0 +1,67 @@ +-- | +-- 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" diff --git a/Data/UUID/V1.hs b/Data/UUID/V1.hs --- a/Data/UUID/V1.hs +++ b/Data/UUID/V1.hs @@ -1,4 +1,5 @@ {-# OPTIONS_GHC -fno-cse #-} +{-# LANGUAGE TypeFamilies #-} -- | -- Module : Data.UUID.V1 @@ -19,15 +20,15 @@ import Data.Bits import Data.Word -import Data.Binary import Data.IORef import System.IO import System.IO.Unsafe -import System.Info.MAC +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 @@ -40,48 +41,53 @@ nextUUID :: IO (Maybe UUID) nextUUID = do res <- stepTime - mac <- mac + mac <- SysMAC.mac case (res, mac) of - (Just (c, t), Just (MAC a' b' c' d' e' f')) -> do - let - (tL, tM, tH) = word64ToTimePieces t - (cL, cH) = word16ToClockSeqPieces c - return $ Just $ UUID tL tM tH cH cL $ Node a' b' c' d' e' f' + (Just (c, t), Just m) -> return $ Just $ makeUUID t c m _ -> return Nothing --- |The bit layout and version number here used are described in clause 13 of --- ITU X.667, from September 2004. -word64ToTimePieces :: Word64 -> (Word32, Word16, Word16) -word64ToTimePieces w = (lo, mi, hi) - where - lo = fromIntegral $ (w `shiftL` 32) `shiftR` 32 - mi = fromIntegral $ (w `shiftL` 16) `shiftR` 48 - hi = (fromIntegral $ w `shiftR` 48) `setBit` 15 +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 State c0 h0 <- readIORef state h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime - if h1 > h0 + if h1 > h0 then do - writeIORef state $ State 0 h1 - return $ Just (0, h1) + writeIORef state $ State c0 h1 + return $ Just (c0, h1) else do let c1 = succ c0 - if c1 < 2^14 + if c1 <= 0x3fff -- when clock is initially randomized, + -- then this test will need to change then do - writeIORef state $ State c1 h0 - return $ Just (c1, h0) + writeIORef state $ State c1 h1 + return $ Just (c1, h1) else do return Nothing {-# NOINLINE state #-} +state :: IORef State state = unsafePerformIO $ do h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime - newIORef $ State 0 h0 + newIORef $ State 0 h0 -- the 0 should be a random number data State = State @@ -97,12 +103,5 @@ gregorianReform = UTCTime (fromGregorian 1582 10 15) 0 dt = t `diffUTCTime` gregorianReform - --- |Per clause 13 of ITU X.667, from September 2004. -word16ToClockSeqPieces :: Word16 -> (Word8, Word8) -word16ToClockSeqPieces w = (lo, hi) - where - lo = fromIntegral $ (w `shiftL` 8) `shiftR` 8 - hi = (fromIntegral $ w `shiftR` 8) `setBit` 7 diff --git a/Data/UUID/V3.hs b/Data/UUID/V3.hs new file mode 100644 --- /dev/null +++ b/Data/UUID/V3.hs @@ -0,0 +1,67 @@ +-- | +-- 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 diff --git a/Data/UUID/V5.hs b/Data/UUID/V5.hs --- a/Data/UUID/V5.hs +++ b/Data/UUID/V5.hs @@ -7,8 +7,8 @@ -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable --- --- +-- +-- -- This module implements Version 5 UUIDs as specified -- in RFC 4122. -- @@ -20,82 +20,28 @@ module Data.UUID.V5 (generateNamed - ,namespaceDNS - ,namespaceURL - ,namespaceOID - ,namespaceX500 + ,Shared.namespaceDNS + ,Shared.namespaceURL + ,Shared.namespaceOID + ,Shared.namespaceX500 ) where - -import Data.UUID.Internal - -import Data.Binary -import Data.Bits -import Data.Maybe - -import qualified Data.ByteString.Lazy as BS -import Data.ByteString.Lazy (ByteString) +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. +-- 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 namespace object = - let chunk = BS.unpack (encode namespace) ++ object - SHA1.Word160 w1 w2 w3 w4 w5 = SHA1.hash chunk - - tl = w1 - tm = high16 w2 - th = (versionSHA .|.) $ (versionMask .&.) $ low16 w2 - ch = (reserved .|.) $ (reservedMask .&.) $ high8 $ high16 w3 - cl = low8 $ high16 w3 - node = Node (high8 (low16 w3)) - (low8 (low16 w3)) - (high8 (high16 w4)) - (low8 (high16 w4)) - (high8 (low16 w4)) - (low8 (low16 w4)) - in UUID tl tm th ch cl node - --- HASH 0 1 - 2 3 : w1 --- 4 5 - 6 7 : w2 --- 8 9 - 10 11 : w3 --- 12 13 - 14 15 : w4 --- 16 17 - 18 19 : w5 - -low16 :: Word32 -> Word16 -low16 = fromIntegral . (.&. 0x0000FFFF) - -high16 :: Word32 -> Word16 -high16 = fromIntegral . flip shiftR 16 - -low8 :: Word16 -> Word8 -low8 = fromIntegral . (.&. 0x00FF) - -high8 :: Word16 -> Word8 -high8 = fromIntegral . flip shiftR 8 - -versionSHA = 5 `shiftL` 12 - -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" - -namespaceOID :: UUID -namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8" - -namespaceX500 :: UUID -namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8" +generateNamed = Shared.generateNamed hash 5 + where hash bytes + = case SHA1.hash bytes of + SHA1.Word160 w1 w2 w3 w4 _w5 -> (w1, w2, w3, w4) diff --git a/tests/BenchUUID.hs b/tests/BenchUUID.hs new file mode 100644 --- /dev/null +++ b/tests/BenchUUID.hs @@ -0,0 +1,126 @@ +import Control.Parallel.Strategies +import Criterion.Main +import Data.Char (ord) +import Data.Maybe (fromJust) +import Data.Word +import qualified Data.Set as Set +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Internal as BL +import qualified Data.UUID.Internal as U +import qualified Data.UUID.V1 as U +import qualified Data.UUID.V3 as U3 +import qualified Data.UUID.V5 as U5 +import System.Random + + +instance NFData BL.ByteString where + rnf BL.Empty = () + rnf (BL.Chunk _ ts) = rnf ts + +instance NFData U.UUID where + rnf u = () + + + + +main :: IO () +main = do + u1 <- randomIO + let s1 = U.toString u1 + b1 = U.toByteString u1 + n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8] + nil2 = fromJust $ + U.fromString "00000000-0000-0000-0000-000000000000" + u2a = fromJust $ U.fromString "169a5a43-c051-4a16-98f4-08447ddd5dc0" + u2b = fromJust $ U.fromByteString $ + BL.pack [0x16, 0x9a, 0x5a, 0x43, 0xc0, 0x51, 0x4a, 0x16, + 0x98, 0xf4, 0x08, 0x44, 0x7d, 0xdd, 0x5d, 0xc0] + u3 = fromJust $ U.fromString "dea6f619-1038-438b-b4af-f1cdec1e6e23" + defaultMain [ + bgroup "testing" [ + bench "null non-nil" $ whnf U.null u1, + bench "null nil" $ whnf U.null U.nil, + bench "null nil2" $ whnf U.null nil2, + bench "eq same" $ whnf (==u2a) u2b, + bench "eq differ" $ whnf (==u2a) u3 + ], + bgroup "conversion" [ + bench "toString" $ nf U.toString u1, + bench "fromString" $ nf U.fromString s1, + bench "toByteString" $ nf U.toByteString u1, + bench "fromByteString" $ nf U.fromByteString b1 + ], + bgroup "generation" [ + bench "V1" $ nfIO U.nextUUID, + bench "V4" $ nfIO (randomIO :: IO U.UUID), + bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1, + bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1 + ], + bench "set making" $ nf Set.fromList uuids + ] + +-- 50 uuids, so tests can be repeatable +uuids :: [U.UUID] +uuids + = map (fromJust . U.fromString) + [ + "35d42593-1fca-4465-b588-a2e78cb996ba", + "1e97e407-eca7-4c5d-a947-6fbe9dc168b6", + "a41fd7ce-a053-4c0a-a742-77c95b85da2a", + "f7e3913a-0fd7-4355-a92f-d73f9b046efa", + "8961a35d-55c2-42f3-8680-08fce3986647", + "96246c58-d0b4-4e56-a543-356bd59686a9", + "72c46194-648c-4b1e-a9fb-2eba060ab43b", + "0fc252d4-a37b-4eca-9309-e3d2a59a3a22", + "a8aceb5a-6a8e-43f3-85bb-9653a3c1ebcd", + "b23d1118-6bc8-4add-9d56-99634d78949f", + "5f8c7896-9c4f-4d7e-a4d2-961bda298012", + "219a4137-7bc5-42b1-ac95-490948a978e1", + "5af5024f-fbe9-45ab-991d-49b655994437", + "569dfb33-185d-4a3c-99c4-bc2b83250a7c", + "43a58442-aa51-4a5d-8e00-b8a83b5fc5b0", + "2865ced1-b54d-4725-8f01-b408f4617424", + "b8cfaff0-4dee-4f32-af2f-0469b3e535fc", + "63f45bc0-f303-4f1a-b0d6-76f876be626d", + "d171eaf3-f20d-45d6-9268-0cc22dfbe887", + "7c28f457-ad27-494a-8642-6e47e7f3efb8", + "f8de9193-66ff-49e8-9826-fc50858d7855", + "2af85f28-cace-4740-b8bb-2b5860f5fdb3", + "b12a7a22-edb3-4694-b8f4-0532eaad6112", + "5e052a08-8e49-4668-bbe7-77cdbc4679a3", + "42d5a68d-3f08-4e39-9b8c-71cc17c538ed", + "ba2b1487-b3a4-4a19-98cc-59530f36613f", + "e4a5c569-b8ac-4851-8ad2-fbdb89986be2", + "35b4a1b6-b5ca-4646-803b-c337ee730d9a", + "f0df1206-05d9-49d6-a726-d49fb253e645", + "9656a0f0-89b2-4cec-bb1c-fdf5633e1cd7", + "d13382f5-04a1-422d-94d6-e47219425816", + "b8d0c762-4c6b-4bd0-ad0b-f68988a87166", + "06360e85-f18a-44f6-aa72-45f1e60b6b77", + "347491ca-62b3-48e8-ac94-6ffebe1318ed", + "014339d0-7b2d-4dda-914b-14ee5cb4391b", + "dc57931b-4744-41be-b3c4-e24dbeeb606a", + "2c9fdcf0-e1d6-4a2d-951d-4766b99032cb", + "b6bde422-eea8-4231-bf1c-ee0e56699511", + "921073c5-f7c1-4583-ac03-aeb7aef8662b", + "eff6a517-aeb1-453e-9810-1b4b324c5a1e", + "eadaae8c-cbf8-4e0b-ab80-e34284b07dad", + "4d307c36-70d9-453f-8455-ec7e2ba405ed", + "53ddef9a-2413-4f7f-8363-cff56ee17c6c", + "4dd4c27a-b300-4a00-ab87-eef505275492", + "4a5d7001-f0c1-4e2f-8362-8833bda2114b", + "0c46f438-9365-406a-b04e-34436806ec25", + "b35469cf-05f8-40ff-a38b-117604347957", + "f1c54df0-5f59-4891-b3c6-82bac0d814ca", + "8091837c-6456-42c3-a686-f4731a41d4f9", + "2a0e2efb-a11c-4a44-81ee-3efc37379b48" + ] + +#if !(MIN_VERSION_criterion(0,4,0)) +nf f arg = B ( rnf . f) arg +whnf f arg = B f arg +#endif + +#if !(MIN_VERSION_criterion(0,4,1)) +nfIO act = rnf `fmap` act +#endif diff --git a/tests/TestUUID.hs b/tests/TestUUID.hs new file mode 100644 --- /dev/null +++ b/tests/TestUUID.hs @@ -0,0 +1,162 @@ +import Control.Monad (replicateM) +import Data.Bits +import qualified Data.ByteString.Lazy as B +import Data.Char (ord) +import Data.List (nub, (\\)) +import Data.Maybe +import Data.Word +import qualified Data.UUID as U +import qualified Data.UUID.V1 as U +import qualified Data.UUID.V3 as U3 +import qualified Data.UUID.V5 as U5 +import Test.HUnit +import Test.QuickCheck +import System.IO +import System.Random + + +isValidVersion :: Int -> U.UUID -> Bool +isValidVersion v u = lenOK && variantOK && versionOK + where bs = U.toByteString u + lenOK = B.length bs == 16 + variantOK = (B.index bs 8) .&. 0xc0 == 0x80 + versionOK = (B.index bs 6) .&. 0xf0 == fromIntegral (v `shiftL` 4) + + +instance Arbitrary U.UUID where + arbitrary = (fst . random) `fmap` rand + coarbitrary = undefined + +instance Arbitrary Word8 where + arbitrary = (fromIntegral . fst . randomR (0,255::Int)) `fmap` rand + coarbitrary = undefined + + +test_null :: Test +test_null = TestList [ + "nil is null" ~: assertBool "" (U.null U.nil), + "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS) + ] + +test_nil :: Test +test_nil = TestList [ + "nil string" ~: U.toString U.nil @?= "00000000-0000-0000-0000-000000000000", + "nil bytes" ~: U.toByteString U.nil @?= B.pack (replicate 16 0) + ] + +test_conv :: Test +test_conv = TestList [ + "conv bytes to string" ~: + maybe "" (U.toString) (U.fromByteString b16) @?= s16, + "conv string to bytes" ~: + maybe B.empty (U.toByteString) (U.fromString s16) @?= b16 + ] + where b16 = B.pack [1..16] + s16 = "01020304-0506-0708-090a-0b0c0d0e0f10" + +test_v1 :: [Maybe U.UUID] -> Test +test_v1 v1s = TestList [ + "V1 unique" ~: nub (v1s \\ nub v1s) @?= [], + "V1 not null" ~: TestList $ map (testUUID (not . U.null)) v1s, + "V1 valid" ~: TestList $ map (testUUID (isValidVersion 1)) v1s + ] + where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test + testUUID p u = maybe False p u ~? show u + +test_v3 :: Test +test_v3 = TestList [ + "V3 computation" ~: + U3.generateNamed U3.namespaceDNS name @?= uV3 + ] + where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8] + uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29" + +test_v5 :: Test +test_v5 = TestList [ + "V5 computation" ~: + U5.generateNamed U5.namespaceDNS name @?= uV5 + ] + where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8] + uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a" + +prop_stringRoundTrip :: Property +prop_stringRoundTrip = label "String round trip" stringRoundTrip + where stringRoundTrip :: U.UUID -> Bool + stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u) + +prop_byteStringRoundTrip :: Property +prop_byteStringRoundTrip = label "ByteString round trip" byteStringRoundTrip + where byteStringRoundTrip :: U.UUID -> Bool + byteStringRoundTrip u = maybe False (== u) + $ U.fromByteString (U.toByteString u) + +prop_stringLength :: Property +prop_stringLength = label "String length" stringLength + where stringLength :: U.UUID -> Bool + stringLength u = length (U.toString u) == 36 + +prop_byteStringLength :: Property +prop_byteStringLength = label "ByteString length" byteStringLength + where byteStringLength :: U.UUID -> Bool + byteStringLength u = B.length (U.toByteString u) == 16 + +prop_randomsDiffer :: Property +prop_randomsDiffer = label "Randoms differ" randomsDiffer + where randomsDiffer :: (U.UUID, U.UUID) -> Bool + randomsDiffer (u1, u2) = u1 /= u2 + +prop_randomNotNull :: Property +prop_randomNotNull = label "Random not null" randomNotNull + where randomNotNull :: U.UUID -> Bool + randomNotNull = not. U.null + +prop_randomsValid :: Property +prop_randomsValid = label "Random valid" randomsValid + where randomsValid :: U.UUID -> Bool + randomsValid = isValidVersion 4 + +prop_v3NotNull :: Property +prop_v3NotNull = label "V3 not null" v3NotNull + where v3NotNull :: [Word8] -> Bool + v3NotNull = not . U.null . U3.generateNamed U3.namespaceDNS + +prop_v3Valid :: Property +prop_v3Valid = label "V3 valid" v3Valid + where v3Valid :: [Word8] -> Bool + v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS + +prop_v5NotNull :: Property +prop_v5NotNull = label "V5 not null" v5NotNull + where v5NotNull :: [Word8] -> Bool + v5NotNull = not . U.null . U5.generateNamed U5.namespaceDNS + +prop_v5Valid :: Property +prop_v5Valid = label "V5 valid" v5Valid + where v5Valid :: [Word8] -> Bool + v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS + + +main :: IO () +main = do + v1s <- replicateM 100 U.nextUUID + runTestText (putTextToHandle stderr False) (TestList [ + test_null, + test_nil, + test_conv, + test_v1 v1s, + test_v3, + test_v5 + ]) + mapM_ quickCheck $ [ + prop_stringRoundTrip, + prop_byteStringRoundTrip, + prop_stringLength, + prop_byteStringLength, + prop_randomsDiffer, + prop_randomNotNull, + prop_randomsValid, + prop_v3NotNull, + prop_v3Valid, + prop_v5NotNull, + prop_v5Valid + ] diff --git a/uuid.cabal b/uuid.cabal --- a/uuid.cabal +++ b/uuid.cabal @@ -1,6 +1,6 @@ Name: uuid -Version: 1.1.1 -Copyright: (c) 2008 Antoine Latter +Version: 1.2.0 +Copyright: (c) 2008-2009 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com License: BSD3 @@ -17,8 +17,17 @@ Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers -Homepage: http://community.haskell.org/~aslatter/code/uuid/ +Homepage: http://projects.haskell.org/uuid/ +Bug-Reports: mailto:aslatter@gmail.com +Extra-Source-Files: + CHANGES + CONTRIBUTORS + +Flag test + Description: Build unit test and benchmark programs. + Default: False + Library Build-Depends: random, binary, bytestring, Crypto, maccatcher, time, base >=3, base < 5 @@ -26,10 +35,44 @@ 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 + +Executable benchuuid + Main-Is: BenchUUID.hs + HS-Source-Dirs: tests . + Extensions: DeriveDataTypeable, CPP + If flag(test) + Buildable: True + Build-Depends: random, binary, bytestring, Crypto, maccatcher, + time, base >=3, base < 5, containers, + criterion >= 0.3 && < 0.5, parallel >= 2.1 && < 2.3 + Else + Buildable: False + +Executable testuuid + Main-Is: TestUUID.hs + HS-Source-Dirs: tests . + Extensions: DeriveDataTypeable + Ghc-Prof-Options: -auto-all -caf-all + Ghc-Shared-Options: + Ghc-Options: -Wall -fno-warn-orphans + + If flag(test) + Buildable: True + Build-Depends: random, binary, bytestring, Crypto, maccatcher, + time, base >=3, base < 5, + HUnit >=1.2 && < 1.3, QuickCheck >=1.2 && < 1.3 + Else + Buildable: False