uuid 1.2.14.1 → 1.3.16.1
raw patch · 22 files changed
Files
- CHANGES +0/−103
- CHANGES.md +186/−0
- CONTRIBUTORS +0/−9
- Data/UUID.hs +0/−43
- Data/UUID/Builder.hs +0/−88
- Data/UUID/Internal.hs +0/−319
- Data/UUID/Named.hs +0/−72
- Data/UUID/V1.hs +0/−137
- Data/UUID/V3.hs +0/−50
- Data/UUID/V4.hs +0/−29
- Data/UUID/V5.hs +0/−45
- src/Data/UUID.hs +52/−0
- src/Data/UUID/Named.hs +72/−0
- src/Data/UUID/Util.hs +53/−0
- src/Data/UUID/V1.hs +135/−0
- src/Data/UUID/V3.hs +49/−0
- src/Data/UUID/V4.hs +33/−0
- src/Data/UUID/V5.hs +44/−0
- src/Data/Word/Util.hs +20/−0
- tests/BenchUUID.hs +0/−129
- tests/TestUUID.hs +40/−98
- uuid.cabal +84/−79
− CHANGES
@@ -1,103 +0,0 @@-1.2.14.1--- Maintainance release for supporting GHC 7.4 through GHC 8.6--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)
+ CHANGES.md view
@@ -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)
− CONTRIBUTORS
@@ -1,9 +0,0 @@-In order of appearance:--Antoine Latter-Jason Dusek-Tim Newsham-Mark Lentczner-Neil Mitchell-Bas van Dijk-Sergei Trofimovich
− Data/UUID.hs
@@ -1,43 +0,0 @@-{- |-Module : Data.UUID-Copyright : (c) 2008,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable---This library is useful for comparing, parsing and-printing Universally Unique Identifiers.-See <http://en.wikipedia.org/wiki/UUID> for the general idea.-See <http://tools.ietf.org/html/rfc4122> for the specification.--* Random UUIDs may be generated using 'Data.UUID.V4.nextRandom' or-your favorite instance of 'System.Random.Random'.--* We have an implementation of generating a UUID from the hardware-MAC address and current system time in "Data.UUID.V1".--* For name-based generation of UUIDs using SHA-1 hashing see-"Data.UUID.V5".--}--module Data.UUID(UUID- ,toString- ,fromString- ,toByteString- ,fromByteString- ,toWords- ,fromWords- ,null- ,nil- ) where--import Prelude () -- we need to hide Prelude.null-import Data.UUID.Internal---- Everything is really implemented in Data.UUID.Internal,--- but I don't want to export the constructors out of the--- package.
− Data/UUID/Builder.hs
@@ -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
− Data/UUID/Internal.hs
@@ -1,319 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}---- |--- Module : Data.UUID--- Copyright : (c) 2008-2009, 2012 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- ,toList- ,buildFromBytes- ,buildFromWords- ) where--import Prelude hiding (null)--import Control.Monad (liftM4)-import Data.Char-import Data.Maybe-import Data.Bits-import Data.List (elemIndices)--#if MIN_VERSION_base(4,0,0)-import Data.Data-#else-import Data.Generics.Basics-#endif--import Foreign.Storable--import Data.Binary-import Data.Binary.Put-import Data.Binary.Get-import qualified Data.ByteString.Lazy as Lazy--import Data.UUID.Builder--import System.Random----- |The UUID type. A 'Random' instance is provided which produces--- version 4 UUIDs as specified in RFC 4122. The 'Storable' and--- 'Binary' instances are compatible with RFC 4122, storing the fields--- in network order as 16 bytes.-data UUID- = UUID- {-# UNPACK #-} !Word32- {-# UNPACK #-} !Word32- {-# UNPACK #-} !Word32- {-# UNPACK #-} !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.--- Introduced in version 1.2.2.-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'. Useful when you need a total--- function for constructing 'UUID' values.--- Introduced in version 1.2.2.-fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID-fromWords = UUID------- UTILITIES------- |Build a Word32 from four Word8 values, presented in big-endian order-word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-word a b c d = (fromIntegral a `shiftL` 24)- .|. (fromIntegral b `shiftL` 16)- .|. (fromIntegral c `shiftL` 8)- .|. (fromIntegral d )---- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,-byte :: Int -> Word32 -> Word8-byte i w = fromIntegral (w `shiftR` (i * 8))----- |Make a UUID from sixteen Word8 values-makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> UUID-makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf- = UUID w0 w1 w2 w3- where w0 = word b0 b1 b2 b3- w1 = word b4 b5 b6 b7- w2 = word b8 b9 ba bb- w3 = word bc bd be bf---- |Make a UUID from four Word32 values-makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID-makeFromWords = UUID---- |A Builder for constructing a UUID of a given version.-buildFromBytes :: Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> Word8 -> Word8 -> Word8 -> Word8- -> UUID-buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =- makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf- where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)- b8' = b8 .&. 0x3f .|. 0x80---- |Build a UUID of a given version from Word32 values.-buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID-buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3- where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)- w2' = w2 .&. 0x3fffffff .|. 0x80000000----- |Return the bytes that make up the UUID-toList :: UUID -> [Word8]-toList (UUID w0 w1 w2 w3) =- [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,- byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,- byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,- byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]---- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't--- exactly sixteen bytes long-fromList :: [Word8] -> Maybe UUID-fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =- Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf-fromList _ = Nothing-------- UUID API------- |Returns true if the passed-in UUID is the 'nil' UUID.-null :: UUID -> Bool-null = (== nil)- -- Note: This actually faster than:- -- null (UUID 0 0 0 0) = True- -- null _ = False---- |The nil UUID, as defined in RFC 4122.--- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.-nil :: UUID-nil = UUID 0 0 0 0---- |Extract a UUID from a 'ByteString' in network byte order.--- The argument must be 16 bytes long, otherwise 'Nothing' is returned.-fromByteString :: Lazy.ByteString -> Maybe UUID-fromByteString = fromList . Lazy.unpack---- |Encode a UUID into a 'ByteString' in network order.-toByteString :: UUID -> Lazy.ByteString-toByteString = Lazy.pack . toList---- |If the passed in 'String' can be parsed as a 'UUID', it will be.--- The hyphens may not be omitted.--- Example:------ @--- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"--- @------ Hex digits may be upper or lower-case.-fromString :: String -> Maybe UUID-fromString xs | validFmt = fromString' xs- | otherwise = Nothing- where validFmt = elemIndices '-' xs == [8,13,18,23]--fromString' :: String -> Maybe UUID-fromString' s0 = do- (w0, s1) <- hexWord s0- (w1, s2) <- hexWord s1- (w2, s3) <- hexWord s2- (w3, s4) <- hexWord s3- if s4 /= "" then Nothing- else Just $ UUID w0 w1 w2 w3- where hexWord :: String -> Maybe (Word32, String)- hexWord s = Just (0, s) >>= hexByte >>= hexByte- >>= hexByte >>= hexByte-- hexByte :: (Word32, String) -> Maybe (Word32, String)- hexByte (w, '-':ds) = hexByte (w, ds)- hexByte (w, hi:lo:ds)- | bothHex = Just ((w `shiftL` 8) .|. octet, ds)- | otherwise = Nothing- where bothHex = isHexDigit hi && isHexDigit lo- octet = fromIntegral (16 * digitToInt hi + digitToInt lo)- hexByte _ = Nothing---- | Convert a UUID into a hypenated string using lower-case letters.--- Example:------ @--- toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\"--- @-toString :: UUID -> String-toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""- where hexw :: Word32 -> String -> String- hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16- : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s-- hexw' :: Word32 -> String -> String- hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16- : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s-- hexn :: Word32 -> Int -> Char- hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)-------- Class Instances-----instance Random UUID where- random g = (fromGenNext w0 w1 w2 w3 w4, g4)- where (w0, g0) = next g- (w1, g1) = next g0- (w2, g2) = next g1- (w3, g3) = next g2- (w4, g4) = next g3- randomR _ = random -- range is ignored---- |Build a UUID from the results of five calls to next on a StdGen.--- While next on StdGet returns an Int, it doesn't provide 32 bits of--- randomness. This code relies on at last 28 bits of randomness in the--- and optimizes its use so as to make only five random values, not six.-fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID-fromGenNext w0 w1 w2 w3 w4 =- buildFromBytes 4 /-/ (ThreeByte w0)- /-/ (ThreeByte w1)- /-/ w2 -- use all 4 bytes because we know the version- -- field will "cover" the upper, non-random bits- /-/ (ThreeByte w3)- /-/ (ThreeByte w4)---- |A ByteSource to extract only three bytes from an Int, since next on StdGet--- only returns 31 bits of randomness.-type instance ByteSink ThreeByte g = Takes3Bytes g-newtype ThreeByte = ThreeByte Int-instance ByteSource ThreeByte where- f /-/ (ThreeByte w) = f b1 b2 b3- where b1 = fromIntegral (w `shiftR` 16)- b2 = fromIntegral (w `shiftR` 8)- b3 = fromIntegral w---instance Show UUID where- show = toString--instance Read UUID where- readsPrec _ str =- let noSpaces = dropWhile isSpace str- in case fromString (take 36 noSpaces) of- Nothing -> []- Just u -> [(u,drop 36 noSpaces)]---instance Storable UUID where- sizeOf _ = 16- alignment _ = 1 -- UUIDs are stored as individual octets-- peekByteOff p off =- mapM (peekByteOff p) [off..(off+15)] >>= return . fromJust . fromList -- pokeByteOff p off u =- sequence_ $ zipWith (pokeByteOff p) [off..] (toList u)---instance Binary UUID where- put (UUID w0 w1 w2 w3) =- putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3 - get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be----- My goal with this instance was to make it work just enough to do what--- I want when used with the HStringTemplate library.-instance Data UUID where- toConstr uu = mkConstr uuidType (show uu) [] (error "fixity")- gunfold _ _ = error "gunfold"- dataTypeOf _ = uuidType--uuidType :: DataType-uuidType = mkNoRepType "Data.UUID.UUID"--#if !(MIN_VERSION_base(4,2,0))-mkNoRepType :: String -> DataType-mkNoRepType = mkNorepType-#endif-
− Data/UUID/Named.hs
@@ -1,72 +0,0 @@--- |--- Module : Data.UUID.Named--- Copyright : (c) 2008 Antoine Latter------ License : BSD-style------ Maintainer : aslatter@gmail.com--- Stability : experimental--- Portability : portable--------- This module implements Version 3/5 UUIDs as specified--- in RFC 4122.------ These UUIDs identify an object within a namespace,--- and are deterministic.------ The namespace is identified by a UUID. Several sample--- namespaces are enclosed.--module Data.UUID.Named- (generateNamed- ,namespaceDNS- ,namespaceURL- ,namespaceOID- ,namespaceX500- ) where--import Data.UUID.Internal--import Control.Applicative ((<*>),(<$>))-import Data.Binary.Get (runGet, getWord32be)-import Data.Maybe-import Data.Word (Word8)--import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as BL---- |Generate a 'UUID' within the specified namespace out of the given--- object.-generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash- -> Word8 -- ^Version- -> UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed hash version namespace object =- let chunk = B.pack $ toList namespace ++ object- bytes = BL.fromChunks . (:[]) $ hash chunk- w = getWord32be- unpackBytes = runGet $- buildFromWords version <$> w <*> w <*> w <*> w- in unpackBytes bytes---unsafeFromString :: String -> UUID-unsafeFromString = fromJust . fromString---- |The namespace for DNS addresses-namespaceDNS :: UUID-namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for URLs-namespaceURL :: UUID-namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for ISO OIDs-namespaceOID :: UUID-namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"---- |The namespace for X.500 DNs-namespaceX500 :: UUID-namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"
− Data/UUID/V1.hs
@@ -1,137 +0,0 @@-{-# OPTIONS_GHC -fno-cse #-}-{-# LANGUAGE TypeFamilies #-}--{- |-Module : Data.UUID.V1-Copyright : (c) 2008 Jason Dusek- (c) 2009 Mark Lentczner- (c) 2009-2010,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable--RFC 4122 Version 1 UUID state machine.--The generated UUID is based on the hardware MAC-address and the system clock.--If we cannot lookup the MAC address we seed the-generator with a psuedo-random number.--}--module Data.UUID.V1(nextUUID)-where--import Data.Time--import Data.Bits-import Data.Word--import Control.Applicative ((<$>),(<*>))-import Control.Concurrent.MVar-import System.IO.Unsafe--import qualified System.Random as R--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 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 =- SysMAC.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- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO- <*> R.randomIO--data State = State- {-# UNPACK #-} !MAC- {-# UNPACK #-} !Word16- {-# UNPACK #-} !Word64- deriving (Show)----hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64-hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt- where- gregorianReform = UTCTime (fromGregorian 1582 10 15) 0- dt = t `diffUTCTime` gregorianReform---
− Data/UUID/V3.hs
@@ -1,50 +0,0 @@-{- |-Module : Data.UUID.V3-Copyright : (c) 2010,2012 Antoine Latter--License : BSD-style--Maintainer : aslatter@gmail.com-Stability : experimental-Portability : portable--NOTE: This module uses MD5 hashing. Unless you know-you need to use this module, you should probably be-using "Data.UUID.V5", which offers the same sort of-functionality as this module except implemented with-SHA-1 hashing.--This module implements Version 3 UUIDs as specified-in RFC 4122.--These UUIDs identify an object within a namespace,-and are deterministic.--The namespace is identified by a UUID. Several sample-namespaces are enclosed.--}-module Data.UUID.V3- (generateNamed- ,Shared.namespaceDNS- ,Shared.namespaceURL- ,Shared.namespaceOID- ,Shared.namespaceX500- ) where--import Data.Word--import Data.UUID.Internal-import qualified Data.UUID.Named as Shared-import qualified Crypto.Hash.MD5 as MD5----- |Generate a 'UUID' within the specified namespace out of the given--- object.------ Uses an MD5 hash. The UUID is built from first 128 bits of the hash of--- the namespace UUID and the name (as a series of Word8).-generateNamed :: UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed = Shared.generateNamed MD5.hash 3-
− Data/UUID/V4.hs
@@ -1,29 +0,0 @@-{- |- Module : Data.UUID.V4- Copyright : (c) 2012 Antoine Latter-- License : BSD-style-- Maintainer : aslatter@gmail.com- Stability : experimental- Portability : portable-- This module implements Version 4 UUIDs as specified- in RFC 4122.-- These UUIDs are generated from a psuedo-random generator.- We use the System.Random 'R.StdGen' as our random source.-- All of the logic is encapsulated in the 'R.Random' instance- for the UUID type, so you are also free to use the random generator- of your choice.--}-module Data.UUID.V4 (nextRandom) where--import Data.UUID-import qualified System.Random as R---- | Generate a random UUID. Introduced in version 1.2.6.-nextRandom :: IO UUID-nextRandom = R.randomIO-
− Data/UUID/V5.hs
@@ -1,45 +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 Crypto.Hash.SHA1 as SHA1----- |Generate a 'UUID' within the specified namespace out of the given--- object.------ Uses a SHA1 hash. The UUID is built from first 128 bits of the hash of--- the namespace UUID and the name (as a series of Word8).-generateNamed :: UUID -- ^Namespace- -> [Word8] -- ^Object- -> UUID-generateNamed = Shared.generateNamed SHA1.hash 5-
+ src/Data/UUID.hs view
@@ -0,0 +1,52 @@+{- |+Module : Data.UUID+Copyright : (c) 2008,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable+++This library is useful for comparing, parsing and+printing Universally Unique Identifiers.+See <http://en.wikipedia.org/wiki/UUID> for the general idea.+See <http://tools.ietf.org/html/rfc4122> for the specification.++* Use 'Data.UUID.V4.nextRandom' to generate secure random UUIDs, and your+favorite instance of 'System.Random.Random' for faster but insecure+generation of UUIDs.++* We have an implementation of generating a UUID from the hardware+MAC address and current system time in "Data.UUID.V1".++* For name-based generation of UUIDs using SHA-1 hashing see+"Data.UUID.V5".+-}+module Data.UUID(UUID+ ,toString+ ,fromString+ ,toText+ ,fromText+ ,toASCIIBytes+ ,fromASCIIBytes+ ,toLazyASCIIBytes+ ,fromLazyASCIIBytes+ ,toByteString+ ,fromByteString+ ,toWords+ ,fromWords+ ,toWords64+ ,fromWords64+ ,null+ ,nil+ ) where++import Prelude () -- we need to hide Prelude.null+import Data.UUID.Types++-- We use explicit re-exports of everything from Data.UUID.Types in+-- preference to just re-exporting the whole module. This is to avoid+-- unforeseen transitive API breakage if the Data.UUID.Types module+-- should change.
+ src/Data/UUID/Named.hs view
@@ -0,0 +1,72 @@+-- |+-- Module : Data.UUID.Named+-- Copyright : (c) 2008 Antoine Latter+--+-- License : BSD-style+--+-- Maintainer : aslatter@gmail.com+-- Stability : experimental+-- Portability : portable+--+--+-- This module implements Version 3/5 UUIDs as specified+-- in RFC 4122.+--+-- These UUIDs identify an object within a namespace,+-- and are deterministic.+--+-- The namespace is identified by a UUID. Several sample+-- namespaces are enclosed.++module Data.UUID.Named+ (generateNamed+ ,namespaceDNS+ ,namespaceURL+ ,namespaceOID+ ,namespaceX500+ ) where++import Data.UUID.Types.Internal++import Control.Applicative ((<*>),(<$>))+import Data.Binary.Get (runGet, getWord32be)+import Data.Maybe+import Data.Word (Word8)++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash+ -> Word8 -- ^Version+ -> UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed hash version namespace object =+ let chunk = B.pack $ toList namespace ++ object+ bytes = BL.fromChunks . (:[]) $ hash chunk+ w = getWord32be+ unpackBytes = runGet $+ buildFromWords version <$> w <*> w <*> w <*> w+ in unpackBytes bytes+++unsafeFromString :: String -> UUID+unsafeFromString = fromJust . fromString++-- |The namespace for DNS addresses+namespaceDNS :: UUID+namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for URLs+namespaceURL :: UUID+namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for ISO OIDs+namespaceOID :: UUID+namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"++-- |The namespace for X.500 DNs+namespaceX500 :: UUID+namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"
+ src/Data/UUID/Util.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE TypeFamilies #-}+module Data.UUID.Util (+ UnpackedUUID(..)+ , unpack, pack+ , version+ , extractMac+ , extractTime+ , setTime+ ) where++import Prelude hiding (null)+import Data.Word+import Data.Word.Util+import Data.Bits+import Data.UUID.Types.Internal+import Network.Info+import Data.Int (Int64)++version :: UUID -> Int+version uuid =+ fromEnum ((time_hi_and_version unpacked `shiftR` 12) .&. 0xF)+ where+ unpacked = unpack uuid++-- Note UUID time is in 10^-7 seconds.+setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID+setTime uuid t =+ if version uuid == 1+ then Just $ pack $ (unpack uuid){time_low = new_low_bits, time_mid = new_mid_bits, time_hi_and_version = new_hi_and_version_bits}+ else Nothing+ where new_low_bits = fromIntegral $ t .&. 0xFFFFFFFF+ new_mid_bits = fromIntegral $ (t `shiftR` 32) .&. 0xFFFF+ new_hi_and_version_bits = fromIntegral $ 0x1000 .|. ((t `shiftR` 48) .&. 0x0FFF)++extractTime :: UUID -> Maybe Int64+extractTime uuid =+ if version uuid == 1+ then Just $ fromIntegral $ w32to64 (w16to32 (timeAndVersionToTime $ time_hi_and_version unpacked) $ time_mid unpacked) (time_low unpacked)+ else Nothing+ where+ unpacked = unpack uuid++timeAndVersionToTime :: Word16 -> Word16+timeAndVersionToTime tv = tv .&. 0x0FFF++extractMac :: UUID -> Maybe MAC+extractMac uuid =+ if version uuid == 1+ then Just $+ MAC (node_0 unpacked) (node_1 unpacked) (node_2 unpacked) (node_3 unpacked) (node_4 unpacked) (node_5 unpacked)+ else Nothing+ where+ unpacked = unpack uuid
+ src/Data/UUID/V1.hs view
@@ -0,0 +1,135 @@+{-# OPTIONS_GHC -fno-cse #-}+{-# LANGUAGE TypeFamilies #-}++{- |+Module : Data.UUID.V1+Copyright : (c) 2008 Jason Dusek+ (c) 2009 Mark Lentczner+ (c) 2009-2010,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable++RFC 4122 Version 1 UUID state machine.++The generated UUID is based on the hardware MAC+address and the system clock.++If we cannot lookup the MAC address we seed the+generator with a pseudo-random number.+-}++module Data.UUID.V1(nextUUID)+where+++import Data.Bits+import Data.Maybe+import Data.Time+import Data.Word++import Control.Applicative ((<$>),(<*>))+import Control.Concurrent.MVar+import System.IO.Unsafe++import qualified System.Random as R++import Network.Info++import Data.UUID.Types.Internal.Builder+import Data.UUID.Types.Internal++-- | Returns a new UUID derived from the local hardware MAC+-- address and the current system time.+-- Is generated according to the Version 1 UUID specified in+-- RFC 4122.+--+-- Returns 'Nothing' if you request UUIDs too quickly.+nextUUID :: IO (Maybe UUID)+nextUUID = do+ res <- stepTime+ case res of+ Just (mac', c, t) -> return $ Just $ makeUUID t c mac'+ _ -> return Nothing+++makeUUID :: Word64 -> Word16 -> MAC -> UUID+makeUUID time clock mac' =+ buildFromBytes 1 /-/ tLow /-/ tMid /-/ tHigh /-/ clock /-/ (MACSource mac')+ where tLow = (fromIntegral time) :: Word32+ tMid = (fromIntegral (time `shiftR` 32)) :: Word16+ tHigh = (fromIntegral (time `shiftR` 48)) :: Word16++newtype MACSource = MACSource MAC+instance ByteSource MACSource where+ z /-/ (MACSource (MAC a b c d e f)) = z a b c d e f+type instance ByteSink MACSource g = Takes3Bytes (Takes3Bytes g)+++-- |Approximates the clock algorithm in RFC 4122, section 4.2+-- Isn't system wide or thread safe, nor does it properly randomize+-- the clock value on initialization.+stepTime :: IO (Maybe (MAC, Word16, Word64))+stepTime = do+ h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+ modifyMVar state $ \s@(State mac' c0 h0) ->+ if h1 > h0+ then+ return (State mac' c0 h1, Just (mac', c0, h1))+ else+ let+ c1 = succ c0+ in if c1 <= 0x3fff -- when clock is initially randomized,+ -- then this test will need to change+ then+ return (State mac' c1 h1, Just (mac', c1, h1))+ else+ return (s, Nothing)+++{-# NOINLINE state #-}+state :: MVar State+state = unsafePerformIO $ do+ h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime+ mac' <- getMac+ newMVar $ State mac' 0 h0 -- the 0 should be a random number++-- SysMAC.mac can fail on some machines.+-- In those cases we fake it with a random+-- 6 bytes seed.+getMac :: IO MAC+getMac =+ getNetworkInterfaces >>=+ return . listToMaybe . filter (minBound /=) . map mac >>=+ \macM -> case macM of+ Just m -> return m+ Nothing -> randomMac++randomMac :: IO MAC+randomMac =+ -- I'm too lazy to thread through+ -- the random state ...+ MAC+ <$> (R.randomIO >>= return . (1 .|.)) -- We must set the multicast bit to True. See section 4.5 of the RFC.+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO+ <*> R.randomIO++data State = State+ {-# UNPACK #-} !MAC+ {-# UNPACK #-} !Word16+ {-# UNPACK #-} !Word64+ deriving (Show)++++hundredsOfNanosSinceGregorianReform :: UTCTime -> Word64+hundredsOfNanosSinceGregorianReform t = floor $ 10000000 * dt+ where+ gregorianReform = UTCTime (fromGregorian 1582 10 15) 0+ dt = t `diffUTCTime` gregorianReform
+ src/Data/UUID/V3.hs view
@@ -0,0 +1,49 @@+{- |+Module : Data.UUID.V3+Copyright : (c) 2010,2012 Antoine Latter++License : BSD-style++Maintainer : aslatter@gmail.com+Stability : experimental+Portability : portable++NOTE\: This module uses MD5 hashing. Unless you know+you need to use this module, you should probably be+using "Data.UUID.V5", which offers the same sort of+functionality as this module except implemented with+SHA-1 hashing.++This module implements Version 3 UUIDs as specified+in RFC 4122.++These UUIDs identify an object within a namespace,+and are deterministic.++The namespace is identified by a UUID. Several sample+namespaces are enclosed.+-}+module Data.UUID.V3+ (generateNamed+ ,Shared.namespaceDNS+ ,Shared.namespaceURL+ ,Shared.namespaceOID+ ,Shared.namespaceX500+ ) where++import Data.Word++import Data.UUID.Types.Internal+import qualified Data.UUID.Named as Shared+import qualified Crypto.Hash.MD5 as MD5+++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+--+-- Uses an MD5 hash. The UUID is built from first 128 bits of the hash of+-- the namespace UUID and the name (as a series of Word8).+generateNamed :: UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed = Shared.generateNamed MD5.hash 3
+ src/Data/UUID/V4.hs view
@@ -0,0 +1,33 @@+{- |+ Module : Data.UUID.V4+ Copyright : (c) 2012-2016 Antoine Latter++ License : BSD-style++ Maintainer : aslatter@gmail.com+ Stability : experimental+ Portability : portable++ This module implements Version 4 UUIDs as specified+ in RFC 4122.++ These UUIDs are generated from a pseudo-random generator.+ We use the 'getEntropy' method from the <https://hackage.haskell.org/package/entropy entropy> package,+ which should provide cryptographically secure random data.+-}+module Data.UUID.V4 (nextRandom) where++import Data.UUID+import Data.UUID.Types.Internal ( buildFromBytes )++import System.Entropy ( getEntropy )+import Data.ByteString ( unpack )++-- | Generate a crytographically secure, random UUID.+--+-- @since 1.2.6+nextRandom :: IO UUID+nextRandom = do+ [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf]+ <- unpack `fmap` getEntropy 16+ return $ buildFromBytes 4 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
+ src/Data/UUID/V5.hs view
@@ -0,0 +1,44 @@+-- |+-- Module : Data.UUID.V5+-- Copyright : (c) 2008-2009 Antoine Latter+--+-- License : BSD-style+--+-- Maintainer : aslatter@gmail.com+-- Stability : experimental+-- Portability : portable+--+--+-- This module implements Version 5 UUIDs as specified+-- in RFC 4122.+--+-- These UUIDs identify an object within a namespace,+-- and are deterministic.+--+-- The namespace is identified by a UUID. Several sample+-- namespaces are enclosed.++module Data.UUID.V5+ (generateNamed+ ,Shared.namespaceDNS+ ,Shared.namespaceURL+ ,Shared.namespaceOID+ ,Shared.namespaceX500+ ) where++import Data.Word++import Data.UUID.Types.Internal+import qualified Data.UUID.Named as Shared+import qualified Crypto.Hash.SHA1 as SHA1+++-- |Generate a 'UUID' within the specified namespace out of the given+-- object.+--+-- Uses a SHA1 hash. The UUID is built from first 128 bits of the hash of+-- the namespace UUID and the name (as a series of Word8).+generateNamed :: UUID -- ^Namespace+ -> [Word8] -- ^Object+ -> UUID+generateNamed = Shared.generateNamed SHA1.hash 5
+ src/Data/Word/Util.hs view
@@ -0,0 +1,20 @@++-- | Internal utilites+module Data.Word.Util where++import Data.Bits+import Data.Word++w16to32 :: Word16 -> Word16 -> Word32+w16to32 w0s w1s =+ (w0 `shiftL` 16) .|. w1+ where+ w0 = fromIntegral w0s+ w1 = fromIntegral w1s++w32to64 :: Word32 -> Word32 -> Word64+w32to64 w0s w1s =+ (w0 `shiftL` 32) .|. w1+ where+ w0 = fromIntegral w0s+ w1 = fromIntegral w1s
− tests/BenchUUID.hs
@@ -1,129 +0,0 @@-{-# LANGUAGE CPP #-}--import Control.DeepSeq-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 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--#if !(MIN_VERSION_bytestring(0,10,0))-instance NFData BL.ByteString where- rnf BL.Empty = ()- rnf (BL.Chunk _ ts) = rnf ts-#endif--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"- ]-
tests/TestUUID.hs view
@@ -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,21 +11,21 @@ import qualified Data.UUID.V1 as U import qualified Data.UUID.V3 as U3 import qualified Data.UUID.V5 as U5-import qualified Test.HUnit as H-import Test.HUnit hiding (Test)-import Test.QuickCheck hiding ((.&.))-import Test.Framework (defaultMain, Test(..))-import Test.Framework.Providers.HUnit (hUnitTestToTests)-import Test.Framework.Providers.QuickCheck2 (testProperty)-import System.IO +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@@ -31,84 +33,39 @@ arbitrary = choose (U.nil, U.nil) -test_null :: H.Test-test_null = H.TestList [- "nil is null" ~: assertBool "" (U.null U.nil),- "namespaceDNS is not null" ~: assertBool "" (not $ U.null U3.namespaceDNS)- ]--test_nil :: H.Test-test_nil = H.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 :: H.Test-test_conv = H.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 :: Test+test_null =+ testCase "namespaceDNS is not null" $+ assertBool "" (not $ U.null U3.namespaceDNS) -test_v1 :: [Maybe U.UUID] -> H.Test-test_v1 v1s = H.TestList [- "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],- "V1 not null" ~: H.TestList $ map (testUUID (not . U.null)) v1s,- "V1 valid" ~: H.TestList $ map (testUUID (isValidVersion 1)) v1s+test_v1 :: [Maybe U.UUID] -> Test+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 -> H.Test- testUUID p u = maybe False p u ~? show u+ where testUUID :: (U.UUID -> Bool) -> Maybe U.UUID -> Test+ testUUID p u =+ testCase (show u) $+ assertBool "" $ maybe False p u -test_v3 :: H.Test-test_v3 = H.TestList [- "V3 computation" ~:+test_v3 :: Test+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" -test_v5 :: H.Test-test_v5 = H.TestList [- "V5 computation" ~:+ where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8]+ uV3 = fromJust $ U.fromString "3d813cbb-47fb-32ba-91df-831e1593ac29"++test_v5 :: Test+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 :: Test-prop_stringRoundTrip = testProperty "String round trip" stringRoundTrip- where stringRoundTrip :: U.UUID -> Bool- stringRoundTrip u = maybe False (== u) $ U.fromString (U.toString u) -prop_byteStringRoundTrip :: Test-prop_byteStringRoundTrip = testProperty "ByteString round trip" byteStringRoundTrip- where byteStringRoundTrip :: U.UUID -> Bool- byteStringRoundTrip u = maybe False (== u)- $ U.fromByteString (U.toByteString u)--prop_stringLength :: Test-prop_stringLength = testProperty "String length" stringLength- where stringLength :: U.UUID -> Bool- stringLength u = length (U.toString u) == 36--prop_byteStringLength :: Test-prop_byteStringLength = testProperty "ByteString length" byteStringLength- where byteStringLength :: U.UUID -> Bool- byteStringLength u = B.length (U.toByteString u) == 16--prop_randomsDiffer :: Test-prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer- where randomsDiffer :: (U.UUID, U.UUID) -> Bool- randomsDiffer (u1, u2) = u1 /= u2--prop_randomNotNull :: Test-prop_randomNotNull = testProperty "Random not null" randomNotNull- where randomNotNull :: U.UUID -> Bool- randomNotNull = not. U.null- prop_randomsValid :: Test prop_randomsValid = testProperty "Random valid" randomsValid where randomsValid :: U.UUID -> Bool@@ -134,37 +91,22 @@ where v5Valid :: [Word8] -> Bool v5Valid = isValidVersion 5 . U5.generateNamed U5.namespaceDNS -prop_readShowRoundTrip :: Test-prop_readShowRoundTrip = testProperty "Read/Show round-trip" prop- where -- we're using 'Maybe UUID' to add a bit of- -- real-world complexity.- prop :: U.UUID -> Bool- prop uuid = read (show (Just uuid)) == Just uuid- main :: IO () main = do v1s <- replicateM 100 U.nextUUID defaultMain $+ testGroup "tests" $ concat $- [ hUnitTestToTests $ H.TestList [+ [ [ test_null,- test_nil,- test_conv, test_v1 v1s, test_v3, test_v5 ]- , [ prop_stringRoundTrip,- prop_readShowRoundTrip,- prop_byteStringRoundTrip,- prop_stringLength,- prop_byteStringLength,- prop_randomsDiffer,- prop_randomNotNull,- prop_randomsValid,+ , [ prop_randomsValid, prop_v3NotNull, prop_v3Valid, prop_v5NotNull, prop_v5Valid ]- ]+ ]
uuid.cabal view
@@ -1,90 +1,95 @@-Cabal-Version: 1.12-Name: uuid-Version: 1.2.14.1--Copyright: (c) 2008-2013 Antoine Latter-Author: Antoine Latter-Maintainer: hvr@gnu.org-License: BSD3-License-file: LICENSE--Category: Data-Build-Type: Simple+cabal-version: 1.12+name: uuid+version: 1.3.16.1+copyright: (c) 2008-2014 Antoine Latter+author: Antoine Latter+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+license: BSD3+license-file: LICENSE+category: Data+build-type: Simple+tested-with:+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.6+ || ==9.8.4+ || ==9.10.1+ || ==9.12.4+ || ==9.14.1 -Description:- This library is useful for creating, comparing, parsing and- printing Universally Unique Identifiers.- .- See <http://en.wikipedia.org/wiki/UUID> for the general idea.+synopsis:+ For creating, comparing, parsing and printing Universally Unique Identifiers -Synopsis: For creating, comparing, parsing and printing Universally Unique Identifiers+description:+ This library is useful for creating, comparing, parsing and+ printing Universally Unique Identifiers.+ .+ See <http://en.wikipedia.org/wiki/UUID> for the general idea. -Homepage: https://github.com/hvr/uuid-Bug-Reports: https://github.com/hvr/uuid/issues+homepage: https://github.com/haskell-hvr/uuid+bug-reports: https://github.com/haskell-hvr/uuid/issues+extra-source-files: CHANGES.md -Extra-Source-Files:- CHANGES- CONTRIBUTORS+source-repository head+ type: git+ location: https://github.com/haskell-hvr/uuid.git+ subdir: uuid -Library- Build-Depends: base >= 4.5 && < 4.13- , binary >= 0.4 && < 0.9- , bytestring >= 0.9 && < 0.11- , cryptohash-md5 >= 0.11.100 && < 0.12- , cryptohash-sha1 >= 0.11.100 && < 0.12- , maccatcher >= 1.0 && < 2.2- , random >= 1.0.1 && < 1.1- , time >= 1.1 && < 1.9+library+ build-depends:+ base >=4.12 && <5+ , binary >=0.8.6.0 && <0.9+ , bytestring >=0.10.8.2 && <0.13+ , cryptohash-md5 >=0.11.100 && <0.12+ , cryptohash-sha1 >=0.11.100 && <0.12+ , entropy >=0.3.7 && <0.5+ , network-info >=0.2 && <0.3+ , random >=1.2.1.2 && <1.4+ , time >=1.4 && <1.16 - Exposed-Modules:- Data.UUID- Data.UUID.V1- Data.UUID.V3- Data.UUID.V4- Data.UUID.V5+ -- strict dependency on uuid-types,+ -- as we re-rexport datatype, thus leak instances etc.+ build-depends: uuid-types >=1.0.6 && <1.0.7+ exposed-modules:+ Data.UUID+ Data.UUID.Util+ Data.UUID.V1+ Data.UUID.V3+ Data.UUID.V4+ Data.UUID.V5 - Other-Modules:- Data.UUID.Builder- Data.UUID.Internal- Data.UUID.Named+ other-modules:+ Data.UUID.Named+ Data.Word.Util - Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable- Ghc-Options: -Wall+ default-language: Haskell2010+ default-extensions: DeriveDataTypeable+ other-extensions: TypeFamilies+ ghc-options: -Wall+ hs-source-dirs: src -Source-Repository head- Type: git- Location: https://github.com/hvr/uuid.git- Subdir: uuid+test-suite test-uuid+ type: exitcode-stdio-1.0+ main-is: TestUUID.hs+ hs-source-dirs: tests+ default-language: Haskell2010+ default-extensions: DeriveDataTypeable+ other-extensions: ViewPatterns+ ghc-options: -Wall -fno-warn-orphans -Benchmark benchmark- Type: exitcode-stdio-1.0- Main-is: BenchUUID.hs- Hs-source-dirs: tests- Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable, CPP- Build-depends: base,- uuid,- bytestring,- containers >= 0.4 && < 0.6,- criterion >= 0.4 && < 0.9,- deepseq >= 1.1 && < 1.5,- mersenne-random-pure64,- random+ -- inherited constraints+ build-depends:+ base+ , bytestring+ , uuid -Test-Suite testuuid- Type: exitcode-stdio-1.0- Main-is: TestUUID.hs- Hs-source-dirs: tests- Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable- Ghc-Options: -Wall -fno-warn-orphans- Build-Depends: base,- uuid,- bytestring,- HUnit == 1.6.*,- QuickCheck == 2.7.*,- random,- test-framework == 0.8.*,- test-framework-hunit == 0.3.*,- test-framework-quickcheck2 == 0.3.*+ -- 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