diff --git a/CONTRIBUTORS b/CONTRIBUTORS --- a/CONTRIBUTORS +++ b/CONTRIBUTORS @@ -2,3 +2,4 @@ Antoine Latter Jason Dusek +Tim Newsham diff --git a/Data/UUID.hs b/Data/UUID.hs --- a/Data/UUID.hs +++ b/Data/UUID.hs @@ -1,7 +1,3 @@ -{-# INCLUDE #-} -{-# INCLUDE #-} -{-# LANGUAGE ForeignFunctionInterface #-} - -- | -- Module : Data.UUID -- Copyright : (c) 2008 Antoine Latter @@ -12,205 +8,22 @@ -- Stability : experimental -- Portability : portable -- --- Haskell bindings to /libuuid/. --- The library /libuuid/ is available as a part of e2fsprogs: --- . --- --- This library is useful for creating, comparing, parsing and +-- +-- This library is useful for comparing, parsing and -- printing Universally Unique Identifiers. -- See for the general idea. +-- +-- For generating UUIDs, check out 'Data.UUID.V1', 'Data.UUID.V5' and +-- 'System.Random'. module Data.UUID(UUID - ,fromString ,toString - ,toStringUpper - ,toStringLower - ,generate - ,generateRandom - ,generateTime + ,fromString ,null - ) -where - -import Foreign.C.String -import Foreign.C -import Foreign.ForeignPtr -import Foreign - -import Data.Typeable -import Data.Generics.Basics - -import Prelude hiding (null) + ) where import Data.UUID.Internal -instance Eq UUID where - a == b = compare a b == EQ - -instance Ord UUID where - compare (U fp1) (U fp2) = unsafePerformIO $ - withForeignPtr fp1 $ \p1 -> - withForeignPtr fp2 $ \p2 -> - case c_compare p1 p2 of - 0 -> return EQ - n|n<0 -> return LT - |n>0 -> return GT - -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 Typeable UUID where - typeOf _ = mkTyConApp (mkTyCon "Data.UUID.UUID") [] - -instance Storable UUID where - sizeOf _ = (16 *) $ alignment (undefined :: CChar) - alignment _ = alignment (undefined :: CChar) - - peek psource = do - fp <- mallocForeignPtrArray 16 - withForeignPtr fp $ \pdest -> - memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID) - return $ U fp - - poke pdest (U fp) = withForeignPtr fp $ \psource -> - memcpy pdest psource $ fromIntegral $ sizeOf (undefined :: UUID) - - --- 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 = mkNorepType "Data.UUID.UUID" - - --- |Creates a new 'UUID'. If \/dev\/urandom is available, it will be used. --- Otherwise a UUID will be generated based on the current time and the --- hardware MAC address, if available. -generate :: IO UUID -generate = generateWrap c_generate - --- |Create a new 'UUID'. If \/dev\/urandom is available, it will be used. --- Otherwise a psuedorandom generator will be used. -generateRandom :: IO UUID -generateRandom = generateWrap c_generate_random - --- |Create a new 'UUID'. The UUID will be generated based on the --- current time and the hardware MAC address, if available. -generateTime :: IO UUID -generateTime = generateWrap c_generate_time - -generateWrap :: (C_UUID -> IO ()) -> IO UUID -generateWrap gen = do - fp <- mallocForeignPtrArray 16 - withForeignPtr fp $ \p -> gen p - return $ U fp - --- |Returns 'True' if the passed-in 'UUID' is the null UUID. -null :: UUID -> Bool -null (U fp) = unsafePerformIO $ - withForeignPtr fp $ \p -> - return $ c_null p == 1 - --- |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 s = unsafePerformIO $ do - fp <- mallocForeignPtrArray 16 - res <- withCAString s $ \chars -> - withForeignPtr fp $ \p -> - c_read chars p - case res of - 0 -> return . Just $ U fp - _ -> return Nothing - --- |Returns a 'String' representation of the passed in 'UUID'. --- Hex digits occuring in the output will be either upper or --- lower-case depending on system defaults and locale. -toString :: UUID -> String -toString = toStringWrap c_show - --- |Returns a 'String' representation of the passed in 'UUID'. --- Hex digits occuring in the output will be lower-case. -toStringLower :: UUID -> String -toStringLower = toStringWrap c_show_lower - --- |Returns a 'String' representation of the passed in 'UUID'. --- Hex digits occuring in the output will be upper-case. -toStringUpper :: UUID -> String -toStringUpper = toStringWrap c_show_upper - --- |The passed in function /f/ is given a the raw UUID data --- and a 37-byte buffer to fill with the textual representation --- of the UUID. The buffer is expected to contain a null-terminator --- after /f/ is finished. -toStringWrap :: (C_UUID -> CString -> IO ()) -> UUID -> String -toStringWrap f (U fp) = unsafePerformIO $ - allocaBytes 37 $ \chars -> do - withForeignPtr fp $ \p -> f p chars - peekCAString chars - --- FFI calls to do the work - -type C_UUID = Ptr CChar - --- comparing UUIDs -foreign import ccall unsafe "uuid_compare" - c_compare :: C_UUID -> C_UUID -> CInt - --- making random UUIDs -foreign import ccall unsafe "uuid_generate" - c_generate :: C_UUID -> IO () - -foreign import ccall unsafe "uuid_generate_time" - c_generate_time :: C_UUID -> IO () - -foreign import ccall unsafe "uuid_generate_random" - c_generate_random :: C_UUID -> IO () - --- Null check -foreign import ccall unsafe "uuid_is_null" - c_null :: C_UUID -> CInt - --- Parsing -foreign import ccall unsafe "uuid_parse" - c_read :: CString -> C_UUID ->IO CInt - --- Showing - -foreign import ccall unsafe "uuid_unparse" - c_show :: C_UUID -> CString -> IO () - -foreign import ccall unsafe "uuid_unparse_lower" - c_show_lower :: C_UUID -> CString -> IO () - -foreign import ccall unsafe "uuid_unparse_upper" - c_show_upper :: C_UUID -> CString -> IO () - - --- Queries - -foreign import ccall unsafe "uuid_type" - c_type :: C_UUID -> CInt - -foreign import ccall unsafe "uuid_variant" - c_variant :: C_UUID -> CInt - --- Other - -foreign import ccall unsafe "memcpy" - memcpy :: Ptr a -> Ptr b -> CSize -> IO () +-- Everything is really implemented in Data.UUID.Internal, +-- but I don't want to export the constructors out of the +-- package. diff --git a/Data/UUID/Internal.hs b/Data/UUID/Internal.hs --- a/Data/UUID/Internal.hs +++ b/Data/UUID/Internal.hs @@ -1,5 +1,7 @@ +{-# LANGUAGE DeriveDataTypeable, CPP #-} + -- | --- Module : Data.UUID.Internal +-- Module : Data.UUID -- Copyright : (c) 2008 Antoine Latter -- -- License : BSD-style @@ -7,57 +9,277 @@ -- Maintainer : aslatter@gmail.com -- Stability : experimental -- Portability : portable --- --- If the public interface in "Data.UUID" doesn't give you --- the flexibility you need, you should be able to find --- something here. -module Data.UUID.Internal(UUID(..) - ,toBytes - ,fromBytes - ,unsafeFromBytes - ,toForeignPtr - ,fromForeignPtr - ) where +module Data.UUID.Internal + (UUID(..) + ,Node(..) + ,nodeToList + ,listToNode + ,fromString + ,toString + ,versionMask + ,reservedMask + ,reserved + ) where -import Foreign.ForeignPtr -import Foreign.C -import Foreign +import Data.Word +import Data.Char +import Data.Maybe +import Data.Bits +import Data.List (splitAt, foldl', unfoldr) --- |The UUID type. Represents 128-bits of identification. -newtype UUID = U (ForeignPtr CChar) +import Data.Typeable +import Data.Generics.Basics --- |Returns the passed in UUID as a list of 16 bytes. -toBytes :: UUID -> [Word8] -toBytes (U fp) = unsafePerformIO $ withForeignPtr fp $ \p -> - peekArray 16 (castPtr p) +import Foreign.Ptr +import Foreign.Storable --- |Creates a UUID out of a list of bytes. --- Will throw an error if the list is not of length 16. -fromBytes :: [Word8] -> UUID -fromBytes xs = if length xs == 16 - then unsafeFromBytes xs - else error "Data.UUID.Internal.fromBytes: passed in list of bytes must be of length 16." +import Data.Binary +import Data.Binary.Put +import Data.Binary.Get --- |Creates a UUID out of a list of bytes. --- Does not perform a length check on the passed in list. --- Behavior is undefined for lists not of length 16. -unsafeFromBytes :: [Word8] -> UUID -unsafeFromBytes xs = U $ castForeignPtr $ unsafePerformIO $ do - p <- mallocForeignPtrBytes 16 - withForeignPtr p $ flip pokeArray xs - return p +import System.Random --- |Unsafe. +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 3 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) + +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) + + randomR _ = random -- range is ignored + +versionMask :: Word16 -- 0000 1111 1111 1111 +versionMask = 0x0FFF + +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 + + +nodeToList :: Node -> [Word8] +nodeToList (Node w1 w2 w3 w4 w5 w6) = [w1, w2, w3, w4, w5, w6] + +listToNode :: [Word8] -> Maybe Node +listToNode [w1, w2, w3, w4, w5, w6] = return $ Node w1 w2 w3 w4 w5 w6 +listToNode _ = Nothing + +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 _ = 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 + + get = do + w1 <- getWord8 + w2 <- getWord8 + w3 <- getWord8 + w4 <- getWord8 + w5 <- getWord8 + w6 <- getWord8 + return $ Node w1 w2 w3 w4 w5 w6 + + +-- 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 = mkNorepType "Data.UUID.UUID" + + + + +-- |If the passed in 'String' can be parsed as a 'UUID', it will be. +-- The hyphens may not be omitted. +-- Example: -- --- Given a UUID, returns a pointer to the 16 bytes --- of memory that make up the UUID. -toForeignPtr :: UUID -> ForeignPtr CChar -toForeignPtr (U p) = p +-- @ +-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\" +-- @ +-- +-- Hex digits may be upper or lower-case. +fromString :: String -> Maybe UUID +fromString xs | validFmt = Just uuid + | 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) --- |Unsafe. +-- | 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 + +digitToInteger :: Char -> Integer +digitToInteger = fromIntegral . digitToInt + + +-- | Convert a UUID into a hypenated string using lower-case letters. +-- Example: -- --- The passed in pointer is treated as if it were a pointer --- to 16 bytes of memory, which is then returned as a UUID. -fromForeignPtr :: ForeignPtr CChar -> UUID -fromForeignPtr = U +-- @ +-- 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 + + +-- 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 + +-- 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 + + +-- no random intance for Data.Word types :-( +-- this will work, though + +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) + diff --git a/Data/UUID/V1.hs b/Data/UUID/V1.hs new file mode 100644 --- /dev/null +++ b/Data/UUID/V1.hs @@ -0,0 +1,108 @@ +{-# OPTIONS_GHC -fno-cse #-} + +-- | +-- Module : Data.UUID.V1 +-- Copyright : (c) 2008 Jason Dusek +-- +-- 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 Data.Binary + +import Data.IORef +import System.IO +import System.IO.Unsafe + +import System.Info.MAC +import Data.MAC + +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 <- 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' + _ -> 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 + + +stepTime = do + State c0 h0 <- readIORef state + h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime + if h1 > h0 + then do + writeIORef state $ State 0 h1 + return $ Just (0, h1) + else do + let + c1 = succ c0 + if c1 < 2^14 + then do + writeIORef state $ State c1 h0 + return $ Just (c1, h0) + else do + return Nothing + + +{-# NOINLINE state #-} +state = unsafePerformIO $ do + h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime + newIORef $ State 0 h0 + + +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 + + +-- |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/V5.hs b/Data/UUID/V5.hs new file mode 100644 --- /dev/null +++ b/Data/UUID/V5.hs @@ -0,0 +1,101 @@ +-- | +-- Module : Data.UUID.V5 +-- Copyright : (c) 2008 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 + ,namespaceDNS + ,namespaceURL + ,namespaceOID + ,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 qualified Data.Digest.SHA1 as SHA1 + + +-- |Generate a 'UUID' within the specified namespace out of the given +-- object. +-- +-- Uses a SHA1 hash. +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" diff --git a/Demo.hs b/Demo.hs new file mode 100644 --- /dev/null +++ b/Demo.hs @@ -0,0 +1,16 @@ + +-- timing demo + +import Data.UUID +import System.Random + +newUUID :: IO UUID +newUUID = randomIO + +count = 300000 + +main = sequence_ $ replicate count $ do + x <- newUUID + y <- newUUID + seq (x == y) $ return () + diff --git a/uuid.cabal b/uuid.cabal --- a/uuid.cabal +++ b/uuid.cabal @@ -1,5 +1,5 @@ Name: uuid -Version: 0.1.1 +Version: 1.0.0 Copyright: (c) 2008 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com @@ -11,26 +11,25 @@ Cabal-Version: >= 1.2 Description: - Haskell bindings to libuuid. - . - The library libuuid is available as a part of e2fsprogs: - . - . - . 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://community.haskell.org/~aslatter/code/uuid/ + Library - Build-Depends: base + Build-Depends: base, random, binary, bytestring, Crypto, maccatcher, + time Exposed-Modules: - Data.UUID, + Data.UUID + Data.UUID.V1 + Data.UUID.V5 + + Other-Modules: Data.UUID.Internal - Extensions: ForeignFunctionInterface + Extensions: DeriveDataTypeable - if !os(darwin) - Extra-Libraries: uuid