uuid 1.3.8 → 1.3.9
raw patch · 16 files changed
+29/−1011 lines, 16 filesdep +uuid-typesdep −containersdep −deepseqdep −hashabledep ~QuickCheckdep ~basedep ~bytestring
Dependencies added: uuid-types
Dependencies removed: containers, deepseq, hashable
Dependency ranges changed: QuickCheck, base, bytestring, criterion, random
Files
- CHANGES +5/−0
- CONTRIBUTORS +1/−0
- Data/UUID.hs +5/−5
- Data/UUID/Builder.hs +0/−88
- Data/UUID/Internal.hs +0/−530
- Data/UUID/Named.hs +1/−1
- Data/UUID/Util.hs +3/−4
- Data/UUID/V1.hs +3/−6
- Data/UUID/V3.hs +1/−2
- Data/UUID/V4.hs +0/−1
- Data/UUID/V5.hs +1/−2
- Data/Word/Util.hs +0/−16
- tests/BenchByteString.hs +0/−82
- tests/BenchUUID.hs +2/−108
- tests/TestUUID.hs +2/−142
- uuid.cabal +5/−24
CHANGES view
@@ -1,3 +1,8 @@+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.
CONTRIBUTORS view
@@ -10,3 +10,4 @@ davean Francesco Mazzoli Michael Snoyman+Bardur Arantsson
Data/UUID.hs view
@@ -23,7 +23,6 @@ * For name-based generation of UUIDs using SHA-1 hashing see "Data.UUID.V5". -}- module Data.UUID(UUID ,toString ,fromString@@ -40,8 +39,9 @@ ) where import Prelude () -- we need to hide Prelude.null-import Data.UUID.Internal+import Data.UUID.Types --- Everything is really implemented in Data.UUID.Internal,--- but I don't want to export the constructors out of the--- package.+-- 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.
− 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,530 +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- ,fromASCIIBytes- ,toASCIIBytes- ,fromLazyASCIIBytes- ,toLazyASCIIBytes- ,UnpackedUUID(..)- ,pack- ,unpack- ) where--import Prelude hiding (null)--import Control.Applicative ((<*>))-import Control.DeepSeq (NFData(..))-import Control.Monad (liftM4, guard)-import Data.Functor ((<$>))-import Data.Char-import Data.Bits-import Data.Hashable-import Data.List (elemIndices)-import Foreign.Ptr (Ptr)--#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 as B-import qualified Data.ByteString.Internal as BI-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Unsafe as BU--import Data.UUID.Builder-import Data.Word.Util--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--data UnpackedUUID =- UnpackedUUID {- time_low :: Word32 -- 0-3- , time_mid :: Word16 -- 4-5- , time_hi_and_version :: Word16 -- 6-7- , clock_seq_hi_res :: Word8 -- 8- , clock_seq_low :: Word8 -- 9- , node_0 :: Word8- , node_1 :: Word8- , node_2 :: Word8- , node_3 :: Word8- , node_4 :: Word8- , node_5 :: Word8- }- deriving (Read, Show, Eq, Ord)--unpack :: UUID -> UnpackedUUID-unpack (UUID w0 w1 w2 w3) =- build /-/ w0 /-/ w1 /-/ w2 /-/ w3-- where- build x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF =- UnpackedUUID {- time_low = word x0 x1 x2 x3- , time_mid = w8to16 x4 x5- , time_hi_and_version = w8to16 x6 x7- , clock_seq_hi_res = x8- , clock_seq_low = x9- , node_0 = xA- , node_1 = xB- , node_2 = xC- , node_3 = xD- , node_4 = xE- , node_5 = xF- }--pack :: UnpackedUUID -> UUID-pack unpacked =- makeFromBytes /-/ (time_low unpacked) - /-/ (time_mid unpacked) - /-/ (time_hi_and_version unpacked) - /-/ (clock_seq_hi_res unpacked) - /-/ (clock_seq_low unpacked)- /-/ (node_0 unpacked) /-/ (node_1 unpacked) - /-/ (node_2 unpacked) /-/ (node_3 unpacked) - /-/ (node_4 unpacked) /-/ (node_5 unpacked)-------- 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 :: BL.ByteString -> Maybe UUID-fromByteString = fromList . BL.unpack---- |Encode a UUID into a 'ByteString' in network order.-toByteString :: UUID -> BL.ByteString-toByteString = BL.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)---- | Convert a UUID into a hyphentated string using lower-case letters, packed--- as ASCII bytes into `B.ByteString`.------ This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.-toASCIIBytes :: UUID -> B.ByteString-toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)---- | Helper function for `toASCIIBytes`-pokeASCII :: UUID -> Ptr Word8 -> IO ()-pokeASCII uuid ptr = do- pokeDash 8- pokeDash 13- pokeDash 18- pokeDash 23- pokeSingle 0 w0- pokeDouble 9 w1- pokeDouble 19 w2- pokeSingle 28 w3- where- (w0, w1, w2, w3) = toWords uuid-- -- ord '-' ==> 45- pokeDash ix = pokeElemOff ptr ix 45-- pokeSingle ix w = do- pokeWord ix w 28- pokeWord (ix + 1) w 24- pokeWord (ix + 2) w 20- pokeWord (ix + 3) w 16- pokeWord (ix + 4) w 12- pokeWord (ix + 5) w 8- pokeWord (ix + 6) w 4- pokeWord (ix + 7) w 0-- -- We skip the dash in the middle- pokeDouble ix w = do- pokeWord ix w 28- pokeWord (ix + 1) w 24- pokeWord (ix + 2) w 20- pokeWord (ix + 3) w 16- pokeWord (ix + 5) w 12- pokeWord (ix + 6) w 8- pokeWord (ix + 7) w 4- pokeWord (ix + 8) w 0-- pokeWord ix w r =- pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))-- toDigit :: Word32 -> Word32- toDigit w = if w < 10 then 48 + w else 97 + w - 10---- | If the passed in `B.ByteString` can be parsed as an ASCII representation of--- a `UUID`, it will be. The hyphens may not be omitted.------ This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.-fromASCIIBytes :: B.ByteString -> Maybe UUID-fromASCIIBytes bs = do- guard wellFormed- fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28- where- -- ord '-' ==> 45- dashIx bs' ix = BU.unsafeIndex bs' ix == 45-- -- Important: check the length first, given the `unsafeIndex` later.- wellFormed =- B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&- dashIx bs 18 && dashIx bs 23-- single ix = combine <$> octet ix <*> octet (ix + 2)- <*> octet (ix + 4) <*> octet (ix + 6)- double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)- <*> octet ix1 <*> octet (ix1 + 2)-- combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3-- octet ix = do- hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)- lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))- return (16 * hi + lo)-- toDigit :: Word8 -> Maybe Word8- toDigit w- -- Digit- | w >= 48 && w <= 57 = Just (w - 48)- -- Uppercase- | w >= 65 && w <= 70 = Just (10 + w - 65)- -- Lowercase- | w >= 97 && w <= 102 = Just (10 + w - 97)- | otherwise = Nothing---- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.-toLazyASCIIBytes :: UUID -> BL.ByteString-toLazyASCIIBytes =-#if MIN_VERSION_bytestring(0,10,0)- BL.fromStrict-#else- BL.fromChunks . return-#endif- . toASCIIBytes---- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.-fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID-fromLazyASCIIBytes bs =- if BL.length bs == 36 then fromASCIIBytes (-#if MIN_VERSION_bytestring(0,10,0)- BL.toStrict bs-#else- B.concat $ BL.toChunks bs-#endif- ) else Nothing------- 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 NFData UUID where- rnf = rnf . toWords--instance Hashable UUID where- hash (UUID w0 w1 w2 w3) =- hash w0 `hashWithSalt` w1- `hashWithSalt` w2- `hashWithSalt` w3- hashWithSalt s (UUID w0 w1 w2 w3) =- s `hashWithSalt` w0- `hashWithSalt` w1- `hashWithSalt` w2- `hashWithSalt` w3--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 _ = 4-- peekByteOff p off =- pack <$>- (UnpackedUUID- <$> peekByteOff p off -- Word32- <*> peekByteOff p (off+4) -- Word16- <*> peekByteOff p (off+6) -- Word16- <*> peekByteOff p (off+8) -- Word8- <*> peekByteOff p (off+9) -- Word8- <*> peekByteOff p (off+10) -- Word8- <*> peekByteOff p (off+11) -- Word8- <*> peekByteOff p (off+12) -- Word8- <*> peekByteOff p (off+13) -- Word8- <*> peekByteOff p (off+14) -- Word8- <*> peekByteOff p (off+15) -- Word8- )-- pokeByteOff p off u =- case unpack u of- (UnpackedUUID x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) ->- do- pokeByteOff p off x0- pokeByteOff p (off+4) x1- pokeByteOff p (off+6) x2- pokeByteOff p (off+8) x3- pokeByteOff p (off+9) x4- pokeByteOff p (off+10) x5- pokeByteOff p (off+11) x6- pokeByteOff p (off+12) x7- pokeByteOff p (off+13) x8- pokeByteOff p (off+14) x9- pokeByteOff p (off+15) x10--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 view
@@ -26,7 +26,7 @@ ,namespaceX500 ) where -import Data.UUID.Internal+import Data.UUID.Types.Internal import Control.Applicative ((<*>),(<$>)) import Data.Binary.Get (runGet, getWord32be)
Data/UUID/Util.hs view
@@ -12,7 +12,7 @@ import Data.Word import Data.Word.Util import Data.Bits-import Data.UUID.Internal+import Data.UUID.Types.Internal import Network.Info import Data.Int (Int64) @@ -44,11 +44,10 @@ timeAndVersionToTime tv = tv .&. 0x0FFF extractMac :: UUID -> Maybe MAC-extractMac uuid = +extractMac uuid = if version uuid == 1- then Just $ + 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-
Data/UUID/V1.hs view
@@ -39,8 +39,8 @@ import Network.Info -import Data.UUID.Builder-import Data.UUID.Internal+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.@@ -61,7 +61,7 @@ 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 + tHigh = (fromIntegral (time `shiftR` 48)) :: Word16 newtype MACSource = MACSource MAC instance ByteSource MACSource where@@ -133,6 +133,3 @@ where gregorianReform = UTCTime (fromGregorian 1582 10 15) 0 dt = t `diffUTCTime` gregorianReform---
Data/UUID/V3.hs view
@@ -33,7 +33,7 @@ import Data.Word -import Data.UUID.Internal+import Data.UUID.Types.Internal import qualified Data.UUID.Named as Shared import qualified Crypto.Hash.MD5 as MD5 @@ -47,4 +47,3 @@ -> [Word8] -- ^Object -> UUID generateNamed = Shared.generateNamed MD5.hash 3-
Data/UUID/V4.hs view
@@ -26,4 +26,3 @@ -- | Generate a random UUID. Introduced in version 1.2.6. nextRandom :: IO UUID nextRandom = R.randomIO-
Data/UUID/V5.hs view
@@ -28,7 +28,7 @@ import Data.Word -import Data.UUID.Internal+import Data.UUID.Types.Internal import qualified Data.UUID.Named as Shared import qualified Crypto.Hash.SHA1 as SHA1 @@ -42,4 +42,3 @@ -> [Word8] -- ^Object -> UUID generateNamed = Shared.generateNamed SHA1.hash 5-
Data/Word/Util.hs view
@@ -5,22 +5,6 @@ import Data.Bits import Data.Word -w8to32 :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-w8to32 w0s w1s w2s w3s =- (w0 `shiftL` 24) .|. (w1 `shiftL` 16) .|. (w2 `shiftL` 8) .|. w3- where- w0 = fromIntegral w0s- w1 = fromIntegral w1s- w2 = fromIntegral w2s- w3 = fromIntegral w3s--w8to16 :: Word8 -> Word8 -> Word16-w8to16 w0s w1s = - (w0 `shiftL` 8) .|. w1- where- w0 = fromIntegral w0s- w1 = fromIntegral w1s- w16to32 :: Word16 -> Word16 -> Word32 w16to32 w0s w1s = (w0 `shiftL` 16) .|. w1
− tests/BenchByteString.hs
@@ -1,82 +0,0 @@-import Control.Applicative ((<*>))-import Data.Functor ((<$>))--import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BC8-import System.Random-import Test.QuickCheck--import Criterion-import Criterion.Main--import Data.UUID--instance Arbitrary UUID where- arbitrary =- fromWords <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary---- Testing what we do in the codebase-fromASCIIBytes_naive :: ByteString -> Maybe UUID-fromASCIIBytes_naive = fromString . BC8.unpack--toASCIIBytes_naive :: UUID -> ByteString-toASCIIBytes_naive = BC8.pack . toString--randomUUIDs :: IO [UUID]-randomUUIDs = sample' arbitrary--randomCorrect :: IO [String]-randomCorrect = map toString <$> randomUUIDs--randomSlightlyWrong :: IO [String]-randomSlightlyWrong = mapM screw =<< randomCorrect- where- screw s = do- ix <- randomRIO (0, length s - 1)- return (take ix s ++ "x" ++ drop (ix + 1) s)--randomVeryWrong :: IO [String]-randomVeryWrong = sample' arbitrary--main :: IO ()-main = do- uuids <- randomUUIDs- correct <- randomCorrect- let correctBytes = map BC8.pack correct- slightlyWrong <- randomSlightlyWrong- let slightlyWrongBytes = map BC8.pack slightlyWrong- veryWrong <- randomVeryWrong- let veryWrongBytes = map BC8.pack veryWrong-- defaultMain- [ bgroup "decoding"- [ bcompare- [ bgroup "correct"- [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) correctBytes)- , bench "fromString" (nf (map fromString) correct)- , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) correctBytes)- ]- ]- , bcompare- [ bgroup "slightly wrong"- [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) slightlyWrongBytes)- , bench "fromString" (nf (map fromString) slightlyWrong)- , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) slightlyWrongBytes)- ]- ]- , bcompare- [ bgroup "very wrong"- [ bench "fromASCIIBytes" (nf (map fromASCIIBytes) veryWrongBytes)- , bench "fromString" (nf (map fromString) veryWrong)- , bench "fromASCIIBytes_naive" (nf (map fromASCIIBytes_naive) veryWrongBytes)- ]- ]- ]- , bcompare- [ bgroup "encoding"- [ bench "toASCIIBytes" (nf (map toASCIIBytes) uuids)- , bench "toString" (nf (map toString) uuids)- , bench "toASCIIBytes_naive" (nf (map toASCIIBytes_naive) uuids)- ]- ]- ]
tests/BenchUUID.hs view
@@ -1,44 +1,19 @@ {-# LANGUAGE CPP #-} -#if !(MIN_VERSION_bytestring(0,10,0))--- Needed for NFData instance-import Control.DeepSeq-import qualified Data.ByteString.Lazy.Internal as BL-#endif 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.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 Foreign (alloca, peek, poke) 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- 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"+ let n1 = (map (fromIntegral . ord) "http://www.haskell.org/") :: [Word8] -- setup for random generation randomState <- newPureMT >>= newIORef@@ -48,93 +23,12 @@ writeIORef randomState state' return uuid - -- setup for Storable benchmark- alloca $ \ uuidPtr -> do-- poke uuidPtr u1-+ -- benchmark UUID generation 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,- - bgroup "storable" [- bench "peek" $ nfIO (peek uuidPtr),- bench "poke" $ poke uuidPtr u1 ] ]---- 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,11 +1,8 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} import Control.Monad (replicateM) import Data.Bits import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Char8 as BC8 import Data.Char (ord)-import Data.Functor ((<$>)) import Data.List (nub, (\\)) import Data.Maybe import Data.Word@@ -13,8 +10,6 @@ import qualified Data.UUID.V1 as U import qualified Data.UUID.V3 as U3 import qualified Data.UUID.V5 as U5-import Foreign (alloca, peek, poke)-import System.IO.Unsafe (unsafePerformIO) import qualified Test.HUnit as H import Test.HUnit hiding (Test) import Test.QuickCheck hiding ((.&.))@@ -38,26 +33,9 @@ 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 @?= BL.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 BL.empty (U.toByteString) (U.fromString s16) @?= b16- ]- where b16 = BL.pack [1..16]- s16 = "01020304-0506-0708-090a-0b0c0d0e0f10"- test_v1 :: [Maybe U.UUID] -> H.Test test_v1 v1s = H.TestList [ "V1 unique" ~: nub (v1s \\ nub v1s) @?= [],@@ -84,52 +62,6 @@ uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a" --- | Test fromByteString with a fixed-input.-test_fromByteString :: H.Test-test_fromByteString =- "UUID fromByteString" ~:- Just inputUUID @=? U.fromByteString "\165\202\133f\217\197H5\153\200\225\241>s\181\226"---- | Test fromWords with a fixed-input-test_fromWords :: H.Test-test_fromWords =- "UUID fromWords" ~:- inputUUID @=? U.fromWords 2781513062 3653584949 2580079089 1047770594--inputUUID :: U.UUID-inputUUID = read "a5ca8566-d9c5-4835-99c8-e1f13e73b5e2"--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 = BL.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@@ -155,58 +87,6 @@ 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---- Mostly going to test for wrong UUIDs-fromASCIIBytes_fromString1 :: String -> Bool-fromASCIIBytes_fromString1 s =- if all (\c -> ord c < 256) s- then U.fromString s == U.fromASCIIBytes (BC8.pack s)- else True--fromASCIIBytes_fromString2 :: U.UUID -> Bool-fromASCIIBytes_fromString2 (U.toString -> s) =- U.fromString s == U.fromASCIIBytes (BC8.pack s)--toASCIIBytes_toString :: U.UUID -> Bool-toASCIIBytes_toString uuid =- U.toString uuid == BC8.unpack (U.toASCIIBytes uuid)--fromASCIIBytes_toASCIIBytes :: U.UUID -> Bool-fromASCIIBytes_toASCIIBytes (BC8.pack . U.toString -> bs) =- Just bs == (U.toASCIIBytes <$> U.fromASCIIBytes bs)--toASCIIBytes_fromASCIIBytes :: U.UUID -> Bool-toASCIIBytes_fromASCIIBytes uuid =- Just uuid == U.fromASCIIBytes (U.toASCIIBytes uuid)--toWords_fromWords :: U.UUID -> Bool-toWords_fromWords uuid =- uuid == myUncurry4 U.fromWords (U.toWords uuid)--fromWords_toWords :: (Word32, Word32, Word32, Word32) -> Bool-fromWords_toWords wds =- wds == U.toWords (myUncurry4 U.fromWords wds)--myUncurry4 :: (x1 -> x2 -> x3 -> x4 -> y) -> (x1, x2, x3, x4) -> y-myUncurry4 f (a,b,c,d) = f a b c d--prop_storableRoundTrip :: Test-prop_storableRoundTrip =- testProperty "Storeable round-trip" $ unsafePerformIO . prop- where- prop :: U.UUID -> IO Bool- prop uuid =- alloca $ \ptr -> do- poke ptr uuid- uuid2 <- peek ptr- return $ uuid == uuid2- main :: IO () main = do v1s <- replicateM 100 U.nextUUID@@ -214,34 +94,14 @@ concat $ [ hUnitTestToTests $ H.TestList [ test_null,- test_nil,- test_conv, test_v1 v1s, test_v3,- test_v5,- test_fromByteString,- test_fromWords+ test_v5 ]- , [ prop_stringRoundTrip,- prop_readShowRoundTrip,- prop_byteStringRoundTrip,- prop_storableRoundTrip,- prop_stringLength,- prop_byteStringLength,- prop_randomsDiffer,- prop_randomNotNull,- prop_randomsValid,+ , [ prop_randomsValid, prop_v3NotNull, prop_v3Valid, prop_v5NotNull, prop_v5Valid ]- , [ testProperty "fromASCIIBytes_fromString1" fromASCIIBytes_fromString1- , testProperty "fromASCIIBytes_fromString2" fromASCIIBytes_fromString2- , testProperty "fromASCIIBytes_toString" toASCIIBytes_toString- , testProperty "fromASCIIBytes_toASCIIBytes" fromASCIIBytes_toASCIIBytes- , testProperty "toASCIIBytes_fromASCIIBytes" toASCIIBytes_fromASCIIBytes- , testProperty "toWords_fromWords" toWords_fromWords- , testProperty "fromWords_toWords" fromWords_toWords- ] ]
uuid.cabal view
@@ -1,5 +1,5 @@ Name: uuid-Version: 1.3.8+Version: 1.3.9 Copyright: (c) 2008-2014 Antoine Latter Author: Antoine Latter Maintainer: aslatter@gmail.com@@ -28,13 +28,12 @@ Library Build-Depends: base >=3 && < 5, binary >= 0.4 && < 0.8,- bytestring >= 0.9 && < 1.1,+ bytestring >= 0.9 && < 0.11, cryptohash >= 0.7 && < 0.12,- deepseq >= 1.3 && < 1.5,- hashable (>= 1.1.1.0 && < 1.2.0) || (>= 1.2.1 && < 1.3), network-info == 0.2.*, random >= 1.0.1 && < 1.2,- time >= 1.1 && < 1.6+ time >= 1.1 && < 1.6,+ uuid-types >= 1.0 && < 2 Exposed-Modules: Data.UUID@@ -45,8 +44,6 @@ Data.UUID.V5 Other-Modules:- Data.UUID.Builder- Data.UUID.Internal Data.UUID.Named Data.Word.Util @@ -65,7 +62,7 @@ Ghc-Options: -Wall -fno-warn-orphans Build-Depends: base >= 3 && < 5, uuid,- bytestring >= 0.9 && < 1.1,+ bytestring >= 0.9 && < 0.11, HUnit >=1.2 && < 1.3, QuickCheck >=2.4 && < 2.8, random >= 1.0.1 && < 1.2,@@ -81,22 +78,6 @@ Ghc-Options: -Wall -fno-warn-orphans Build-depends: base == 4.*, uuid,- bytestring >= 0.9 && < 1.1,- containers >= 0.4 && < 0.6, criterion >= 0.4 && < 0.9,- deepseq >= 1.1 && < 1.4, mersenne-random-pure64, random >= 1.0.1 && < 1.2--benchmark benchbytestring- Type: exitcode-stdio-1.0- Hs-Source-Dirs: tests- Main-Is: BenchByteString.hs- Ghc-Options: -threaded -rtsopts -Wall -O2 -fno-warn-orphans- Build-Depends: base >= 4 && < 5- , uuid- , bytestring >= 0.10- , criterion >= 0.8- , random >= 1.0- , QuickCheck >= 2-