diff --git a/CHANGES b/CHANGES deleted file mode 100644 --- a/CHANGES +++ /dev/null @@ -1,28 +0,0 @@ -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) diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,186 @@ +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, + but GHCJS is now no longer supported. +- Update cabal-spec to version 1.10 + +1.3.12 + +- Update package dependencies +- Use `cryptonite` for crypto +- The function `V4.nextRandom` is now implemented with functions from + `Crypto.Random` in package `cryptonite`. This does slow-down random + UUID generation but provides for far greater randomness. The + `Random` instance for `UUID` can be used to re-gain the old + behavior. + +1.3.11 + +- Add `toText`/`fromText` + +1.3.10 + +- Update dependencies in tests and benchmarks. + +1.3.9 + +- Split definition of UUID data type into separate Cabal package to + enable 3rd party libraries to avoid some of the larger dependencies. + +1.3.8 + +- Allow building against newer `deepseq`. + +1.3.7 + +- Allow building against newer `time`. + +1.3.6 + +- Move to GitHub. + +1.3.5 + +- Allow building against newer `random`. + +1.3.4 + +- Allow building against newer `QuickCheck`. + +1.3.3 + +- More complex version constraints on `hashable`, to avoid building against + versions less than 1.1.1.0 or equal to 1.2.0.*. + +1.3.2 + +- Fix for building against `bytestring` 0.9.* + +1.3.1 + +- Allow building against `hashable` 1.1.* in addition to 1.2.* + +1.3.0 + +- New functions for parsing and printing UUIDs to and from ASCII BytesStrings +- New module `Data.UUID.Util`. This module includes the type `UnpackedUUID`, + whose fields correspond to the UUID fields described in RFC 4122. +- The `Storable` instance now stores a UUID in host byte-order instead of + big endian. +- There is now an instance for `Hashable UUID`. + +1.2.13 + +Benchmark only changes: + +- Allow `criterion` 0.8.* + +1.2.12 + +Test only changes: + +- Allow `QuickCheck` 2.6.* + +1.2.11 + +- Allow `binary` 0.7.* + +1.2.10 + +- Allow `cryptohash` version 0.9.* +- Cleanup tests + +1.2.9 + +- Bumped dependency on `cryptohash`. + +1.2.8 + +- Bumped various dependencies and cleaned up dependencies in general. + +1.2.7 + +- Added stricter constraints on `random` package. + +1.2.6 + +- Add module `V4` to direct attention to our Random instance + +- In module `V1` seed the generator with a random number + if the hardware MAC address could not be discovered. + +- Fix and cleanup various haddocks. + +- In module docs, warn about MD5 use in Data.UUID.V3 and + encourage the reader to use Data.UUID.V5 instead. + +1.2.5 + +- Use `cryptohash` package for MD5 and SHA1 instead of `Crypto` + +1.2.4 + +- Unpack Word32 values into UUID constructor. + +- Update test suite to QuickCheck 2 + +- Bump other dependencies in tests/benchmarks + +1.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) diff --git a/CONTRIBUTORS b/CONTRIBUTORS deleted file mode 100644 --- a/CONTRIBUTORS +++ /dev/null @@ -1,6 +0,0 @@ -In order of appearance: - -Antoine Latter -Jason Dusek -Tim Newsham -Mark Lentczner diff --git a/Data/UUID.hs b/Data/UUID.hs deleted file mode 100644 --- a/Data/UUID.hs +++ /dev/null @@ -1,36 +0,0 @@ --- | --- 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 hiding (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. diff --git a/Data/UUID/Builder.hs b/Data/UUID/Builder.hs deleted file mode 100644 --- a/Data/UUID/Builder.hs +++ /dev/null @@ -1,88 +0,0 @@ -{-# 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 deleted file mode 100644 --- a/Data/UUID/Internal.hs +++ /dev/null @@ -1,309 +0,0 @@ -{-# 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 qualified Prelude - -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 = 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 deleted file mode 100644 --- a/Data/UUID/Named.hs +++ /dev/null @@ -1,67 +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.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 deleted file mode 100644 --- a/Data/UUID/V1.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# 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 -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 - - - diff --git a/Data/UUID/V3.hs b/Data/UUID/V3.hs deleted file mode 100644 --- a/Data/UUID/V3.hs +++ /dev/null @@ -1,67 +0,0 @@ --- | --- 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 deleted file mode 100644 --- a/Data/UUID/V5.hs +++ /dev/null @@ -1,47 +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.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) diff --git a/src/Data/UUID.hs b/src/Data/UUID.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID.hs @@ -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 for the general idea. +See 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. diff --git a/src/Data/UUID/Named.hs b/src/Data/UUID/Named.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/Named.hs @@ -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" diff --git a/src/Data/UUID/Util.hs b/src/Data/UUID/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/Util.hs @@ -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 diff --git a/src/Data/UUID/V1.hs b/src/Data/UUID/V1.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/V1.hs @@ -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 diff --git a/src/Data/UUID/V3.hs b/src/Data/UUID/V3.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/V3.hs @@ -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 diff --git a/src/Data/UUID/V4.hs b/src/Data/UUID/V4.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/V4.hs @@ -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 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 diff --git a/src/Data/UUID/V5.hs b/src/Data/UUID/V5.hs new file mode 100644 --- /dev/null +++ b/src/Data/UUID/V5.hs @@ -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 diff --git a/src/Data/Word/Util.hs b/src/Data/Word/Util.hs new file mode 100644 --- /dev/null +++ b/src/Data/Word/Util.hs @@ -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 diff --git a/tests/BenchUUID.hs b/tests/BenchUUID.hs deleted file mode 100644 --- a/tests/BenchUUID.hs +++ /dev/null @@ -1,133 +0,0 @@ -import Control.Parallel.Strategies -import Criterion.Main -import Data.Char (ord) -import Data.IORef -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 -import System.Random.Mersenne.Pure64 - -instance NFData BL.ByteString where - rnf BL.Empty = () - rnf (BL.Chunk _ ts) = rnf ts - -instance NFData U.UUID where - - -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" - - -- setup for random generation - randomState <- newPureMT >>= newIORef - let randomUUID = do - state <- readIORef randomState - let (uuid, state') = random state - writeIORef randomState state' - return uuid - - 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 (randomUUID :: 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 --- a/tests/TestUUID.hs +++ b/tests/TestUUID.hs @@ -1,6 +1,8 @@ +{-# LANGUAGE ViewPatterns #-} + import Control.Monad (replicateM) import Data.Bits -import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy as BL import Data.Char (ord) import Data.List (nub, (\\)) import Data.Maybe @@ -9,154 +11,102 @@ 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 +import Test.QuickCheck ( Arbitrary(arbitrary), choose ) +import Test.Tasty ( TestTree, testGroup, defaultMain ) +import Test.Tasty.HUnit + ( assertBool, (@?=), testCase ) +import Test.Tasty.QuickCheck ( testProperty ) +type Test = TestTree + 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) + lenOK = BL.length bs == 16 + variantOK = (BL.index bs 8) .&. 0xc0 == 0x80 + versionOK = (BL.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 + -- the UUID random instance ignores bounds + arbitrary = choose (U.nil, U.nil) 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_null = + testCase "namespaceDNS is not null" $ + assertBool "" (not $ U.null U3.namespaceDNS) 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 +test_v1 v1s = testGroup "version 1" [ + testCase "V1 unique" $ nub (v1s \\ nub v1s) @?= [], + testGroup "V1 not null" $ map (testUUID (not . U.null)) v1s, + testGroup "V1 valid" $ map (testUUID (isValidVersion 1)) v1s ] where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test - testUUID p u = maybe False p u ~? show u + testUUID p u = + testCase (show u) $ + assertBool "" $ maybe False p u test_v3 :: Test -test_v3 = TestList [ - "V3 computation" ~: +test_v3 = + testCase "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" + 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" ~: +test_v5 = + testCase "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 +prop_randomsValid :: Test +prop_randomsValid = testProperty "Random valid" randomsValid where randomsValid :: U.UUID -> Bool randomsValid = isValidVersion 4 -prop_v3NotNull :: Property -prop_v3NotNull = label "V3 not null" v3NotNull +prop_v3NotNull :: Test +prop_v3NotNull = testProperty "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 +prop_v3Valid :: Test +prop_v3Valid = testProperty "V3 valid" v3Valid where v3Valid :: [Word8] -> Bool v3Valid = isValidVersion 3 . U3.generateNamed U3.namespaceDNS -prop_v5NotNull :: Property -prop_v5NotNull = label "V5 not null" v5NotNull +prop_v5NotNull :: Test +prop_v5NotNull = testProperty "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 +prop_v5Valid :: Test +prop_v5Valid = testProperty "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 [ + defaultMain $ + testGroup "tests" $ + concat $ + [ [ 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 ] + , [ 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,79 +1,95 @@ -Name: uuid -Version: 1.2.2 -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.6 - -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 +cabal-version: 1.12 +name: uuid +version: 1.3.16.1 +copyright: (c) 2008-2014 Antoine Latter +author: Antoine Latter +maintainer: Oleg Grenrus +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 -Homepage: http://projects.haskell.org/uuid/ -Bug-Reports: mailto:aslatter@gmail.com +synopsis: + For creating, comparing, parsing and printing Universally Unique Identifiers -Extra-Source-Files: - CHANGES - CONTRIBUTORS +description: + This library is useful for creating, comparing, parsing and + printing Universally Unique Identifiers. + . + See for the general idea. -Flag test - Description: Build unit test and benchmark programs. - Default: False +homepage: https://github.com/haskell-hvr/uuid +bug-reports: https://github.com/haskell-hvr/uuid/issues +extra-source-files: CHANGES.md -Library - Build-Depends: random, binary, bytestring, Crypto, maccatcher, - time, base >=3, base < 5 +source-repository head + type: git + location: https://github.com/haskell-hvr/uuid.git + subdir: uuid - Exposed-Modules: - Data.UUID - Data.UUID.V1 - Data.UUID.V3 - Data.UUID.V5 +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 - Other-Modules: - Data.UUID.Builder - Data.UUID.Internal - Data.UUID.Named + -- 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 - Extensions: DeriveDataTypeable - Ghc-Prof-Options: -auto-all -caf-all - Ghc-Shared-Options: - Ghc-Options: -Wall + other-modules: + Data.UUID.Named + Data.Word.Util -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, - mersenne-random-pure64 >= 0.2 && < 0.3 - Else - Buildable: False + default-language: Haskell2010 + default-extensions: DeriveDataTypeable + other-extensions: TypeFamilies + ghc-options: -Wall + hs-source-dirs: src -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 +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 - 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 + -- 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