uuid 1.2.14.1 → 1.3.0
raw patch · 11 files changed
+538/−87 lines, 11 filesdep +cryptohashdep +hashabledep +network-infodep −cryptohash-md5dep −cryptohash-sha1dep −maccatcherdep ~HUnitdep ~QuickCheckdep ~base
Dependencies added: cryptohash, hashable, network-info
Dependencies removed: cryptohash-md5, cryptohash-sha1, maccatcher
Dependency ranges changed: HUnit, QuickCheck, base, binary, bytestring, criterion, deepseq, random, time
Files
- CHANGES +7/−2
- CONTRIBUTORS +2/−0
- Data/UUID.hs +4/−0
- Data/UUID/Internal.hs +211/−12
- Data/UUID/Util.hs +54/−0
- Data/UUID/V1.hs +15/−14
- Data/Word/Util.hs +36/−0
- tests/BenchByteString.hs +82/−0
- tests/BenchUUID.hs +16/−5
- tests/TestUUID.hs +56/−11
- uuid.cabal +55/−43
CHANGES view
@@ -1,6 +1,11 @@-1.2.14.1+1.3.0 -- Maintainance release for supporting GHC 7.4 through GHC 8.6+- 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
CONTRIBUTORS view
@@ -7,3 +7,5 @@ Neil Mitchell Bas van Dijk Sergei Trofimovich+davean+Francesco Mazzoli
Data/UUID.hs view
@@ -27,6 +27,10 @@ module Data.UUID(UUID ,toString ,fromString+ ,toASCIIBytes+ ,fromASCIIBytes+ ,toLazyASCIIBytes+ ,fromLazyASCIIBytes ,toByteString ,fromByteString ,toWords
Data/UUID/Internal.hs view
@@ -24,15 +24,26 @@ ,toList ,buildFromBytes ,buildFromWords+ ,fromASCIIBytes+ ,toASCIIBytes+ ,fromLazyASCIIBytes+ ,toLazyASCIIBytes+ ,UnpackedUUID(..)+ ,pack+ ,unpack ) where import Prelude hiding (null) -import Control.Monad (liftM4)+import Control.Applicative ((<*>))+import Control.DeepSeq (NFData(..))+import Control.Monad (liftM4, guard)+import Data.Functor ((<$>)) import Data.Char-import Data.Maybe import Data.Bits+import Data.Hashable import Data.List (elemIndices)+import Foreign.Ptr (Ptr) #if MIN_VERSION_base(4,0,0) import Data.Data@@ -45,9 +56,13 @@ import Data.Binary import Data.Binary.Put import Data.Binary.Get-import qualified Data.ByteString.Lazy as Lazy+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 @@ -89,6 +104,54 @@ 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 --@@ -175,12 +238,12 @@ -- |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+fromByteString :: BL.ByteString -> Maybe UUID+fromByteString = fromList . BL.unpack -- |Encode a UUID into a 'ByteString' in network order.-toByteString :: UUID -> Lazy.ByteString-toByteString = Lazy.pack . toList+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.@@ -221,7 +284,7 @@ -- Example: -- -- @--- toString $ fromString \"550e8400-e29b-41d4-a716-446655440000\"+-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\" -- @ toString :: UUID -> String toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""@@ -236,8 +299,106 @@ 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 = BL.fromStrict . 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 (BL.toStrict bs) else Nothing++-- -- Class Instances -- @@ -273,7 +434,20 @@ 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 @@ -287,14 +461,39 @@ instance Storable UUID where sizeOf _ = 16- alignment _ = 1 -- UUIDs are stored as individual octets+ alignment _ = 4 peekByteOff p off =- mapM (peekByteOff p) [off..(off+15)] >>= return . fromJust . fromList + 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 =- sequence_ $ zipWith (pokeByteOff p) [off..] (toList 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) =
+ Data/UUID/Util.hs view
@@ -0,0 +1,54 @@+{-# 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.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+
Data/UUID/V1.hs view
@@ -25,9 +25,10 @@ module Data.UUID.V1(nextUUID) where -import Data.Time import Data.Bits+import Data.Maybe+import Data.Time import Data.Word import Control.Applicative ((<$>),(<*>))@@ -36,8 +37,7 @@ import qualified System.Random as R -import qualified System.Info.MAC as SysMAC-import Data.MAC+import Network.Info import Data.UUID.Builder import Data.UUID.Internal@@ -52,13 +52,13 @@ nextUUID = do res <- stepTime case res of- Just (mac, c, t) -> return $ Just $ makeUUID t c mac+ 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)+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 @@ -75,17 +75,17 @@ stepTime :: IO (Maybe (MAC, Word16, Word64)) stepTime = do h1 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime- modifyMVar state $ \s@(State mac c0 h0) ->+ modifyMVar state $ \s@(State mac' c0 h0) -> if h1 > h0 then- return (State mac c0 h1, Just (mac, c0, h1))+ 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))+ return (State mac' c1 h1, Just (mac', c1, h1)) else return (s, Nothing) @@ -94,16 +94,17 @@ state :: MVar State state = unsafePerformIO $ do h0 <- fmap hundredsOfNanosSinceGregorianReform getCurrentTime- mac <- getMac- newMVar $ State mac 0 h0 -- the 0 should be a random number+ 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+ getNetworkInterfaces >>=+ return . listToMaybe . filter (minBound /=) . map mac >>=+ \macM -> case macM of Just m -> return m Nothing -> randomMac @@ -112,7 +113,7 @@ -- I'm too lazy to thread through -- the random state ... MAC- <$> R.randomIO+ <$> (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
+ Data/Word/Util.hs view
@@ -0,0 +1,36 @@++-- | Internal utilites+module Data.Word.Util where++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+ 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/BenchByteString.hs view
@@ -0,0 +1,82 @@+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,6 +1,10 @@ {-# 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@@ -8,11 +12,11 @@ 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 Foreign (alloca, peek, poke) import System.Random import System.Random.Mersenne.Pure64 @@ -22,9 +26,6 @@ rnf (BL.Chunk _ ts) = rnf ts #endif -instance NFData U.UUID where-- main :: IO () main = do u1 <- randomIO@@ -47,6 +48,11 @@ writeIORef randomState state' return uuid + -- setup for Storable benchmark+ alloca $ \ uuidPtr -> do++ poke uuidPtr u1+ defaultMain [ bgroup "testing" [ bench "null non-nil" $ whnf U.null u1,@@ -67,7 +73,12 @@ bench "V3" $ nf (U3.generateNamed U3.namespaceURL) n1, bench "V5" $ nf (U5.generateNamed U5.namespaceURL) n1 ],- bench "set making" $ nf Set.fromList uuids+ 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
tests/TestUUID.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE ViewPatterns #-} import Control.Monad (replicateM) import Data.Bits-import qualified Data.ByteString.Lazy as B+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@@ -9,21 +12,22 @@ 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 ((.&.))-import Test.Framework (defaultMain, Test(..))+import Test.Framework (defaultMain, Test) import Test.Framework.Providers.HUnit (hUnitTestToTests) import Test.Framework.Providers.QuickCheck2 (testProperty)-import System.IO 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@@ -40,7 +44,7 @@ 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)+ "nil bytes" ~: U.toByteString U.nil @?= BL.pack (replicate 16 0) ] test_conv :: H.Test@@ -48,9 +52,9 @@ "conv bytes to string" ~: maybe "" (U.toString) (U.fromByteString b16) @?= s16, "conv string to bytes" ~:- maybe B.empty (U.toByteString) (U.fromString s16) @?= b16+ maybe BL.empty (U.toByteString) (U.fromString s16) @?= b16 ]- where b16 = B.pack [1..16]+ where b16 = BL.pack [1..16] s16 = "01020304-0506-0708-090a-0b0c0d0e0f10" test_v1 :: [Maybe U.UUID] -> H.Test@@ -97,7 +101,7 @@ prop_byteStringLength :: Test prop_byteStringLength = testProperty "ByteString length" byteStringLength where byteStringLength :: U.UUID -> Bool- byteStringLength u = B.length (U.toByteString u) == 16+ byteStringLength u = BL.length (U.toByteString u) == 16 prop_randomsDiffer :: Test prop_randomsDiffer = testProperty "Randoms differ" randomsDiffer@@ -141,6 +145,40 @@ 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)++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@@ -157,6 +195,7 @@ , [ prop_stringRoundTrip, prop_readShowRoundTrip, prop_byteStringRoundTrip,+ prop_storableRoundTrip, prop_stringLength, prop_byteStringLength, prop_randomsDiffer,@@ -167,4 +206,10 @@ 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+ ]+ ]
uuid.cabal view
@@ -1,43 +1,44 @@-Cabal-Version: 1.12 Name: uuid-Version: 1.2.14.1-+Version: 1.3.0 Copyright: (c) 2008-2013 Antoine Latter Author: Antoine Latter-Maintainer: hvr@gnu.org+Maintainer: aslatter@gmail.com License: BSD3 License-file: LICENSE Category: Data Build-Type: Simple+Cabal-Version: >= 1.8 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 -Homepage: https://github.com/hvr/uuid-Bug-Reports: https://github.com/hvr/uuid/issues+Homepage: http://projects.haskell.org/uuid/+Bug-Reports: mailto:aslatter@gmail.com Extra-Source-Files: CHANGES CONTRIBUTORS + 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+ Build-Depends: base >=3 && < 5,+ binary >= 0.4 && < 0.8,+ bytestring >= 0.9 && < 1.1,+ cryptohash >= 0.7 && < 0.12,+ deepseq == 1.3.*,+ hashable == 1.2.*,+ network-info == 0.2.*,+ random >= 1.0.1 && < 1.1,+ time >= 1.1 && < 1.5 Exposed-Modules: Data.UUID+ Data.UUID.Util Data.UUID.V1 Data.UUID.V3 Data.UUID.V4@@ -47,44 +48,55 @@ Data.UUID.Builder Data.UUID.Internal Data.UUID.Named+ Data.Word.Util - Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable+ Extensions: DeriveDataTypeable Ghc-Options: -Wall -Source-Repository head- Type: git- Location: https://github.com/hvr/uuid.git- Subdir: uuid--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+source-repository head+ type: darcs+ location: http://code.haskell.org/uuid Test-Suite testuuid Type: exitcode-stdio-1.0 Main-is: TestUUID.hs Hs-source-dirs: tests- Default-Language: Haskell2010- Default-Extensions: DeriveDataTypeable+ Extensions: DeriveDataTypeable Ghc-Options: -Wall -fno-warn-orphans- Build-Depends: base,+ Build-Depends: base >= 3 && < 5, uuid,- bytestring,- HUnit == 1.6.*,- QuickCheck == 2.7.*,- random,+ bytestring >= 0.9 && < 1.1,+ HUnit >=1.2 && < 1.3,+ QuickCheck >=2.4 && < 2.7,+ random >= 1.0.1 && < 1.1, test-framework == 0.8.*, test-framework-hunit == 0.3.*, test-framework-quickcheck2 == 0.3.*++benchmark benchmark+ Type: exitcode-stdio-1.0+ Main-is: BenchUUID.hs+ Hs-source-dirs: tests+ Extensions: DeriveDataTypeable, CPP+ 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.1++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+