1{-# LANGUAGE DeriveDataTypeable, TypeFamilies, CPP #-}
5-- Copyright : (c) 2008-2009, 2012 Antoine Latter
6-- (c) 2009 Mark Lentczner
10-- Maintainer : aslatter@gmail.com
11-- Stability : experimental
12-- Portability : portable
14module Data.UUID.Internal
33import Prelude hiding (null)
35import Control.Applicative ((<*>))
36import Control.DeepSeq (NFData(..))
37import Control.Monad (liftM4, guard)
38import Data.Functor ((<$>))
43import Data.List (elemIndices)
44import Foreign.Ptr (Ptr)
46#if MIN_VERSION_base(4,0,0)
49import Data.Generics.Basics
52import Foreign.Storable
57import qualified Data.ByteString as B
58import qualified Data.ByteString.Internal as BI
59import qualified Data.ByteString.Lazy as BL
60import qualified Data.ByteString.Unsafe as BU
62import Data.UUID.Builder
67-- |The UUID type. A 'Random' instance is provided which produces
68-- version 4 UUIDs as specified in RFC 4122. The 'Storable' and
69-- 'Binary' instances are compatible with RFC 4122, storing the fields
70-- in network order as 16 bytes.
73 {-# UNPACK #-} !Word32
74 {-# UNPACK #-} !Word32
75 {-# UNPACK #-} !Word32
76 {-# UNPACK #-} !Word32
77 deriving (Eq, Ord, Typeable)
79 Other representations that we tried are:
80 Mimic V1 structure: !Word32 !Word16 !Word16 !Word16
81 !Word8 !Word8 !Word8 !Word8 !Word8 !Word8
82 Sixteen bytes: !Word8 ... (x 16)
83 Simple list of bytes: [Word8]
84 ByteString (strict) ByteString
85 Immutable array: UArray Int Word8
87 None was as fast, overall, as the representation used here.
90-- | Covert a 'UUID' into a sequence of 'Word32' values.
91-- Usefull for when you need to serialize a UUID and
92-- neither 'Storable' nor 'Binary' are appropriate.
93-- Introduced in version 1.2.2.
94toWords :: UUID -> (Word32, Word32, Word32, Word32)
95toWords (UUID w1 w2 w3 w4) = (w1, w2, w3, w4)
97-- | Create a 'UUID' from a sequence of 'Word32'. The
98-- opposite of 'toWords'. Useful when you need a total
99-- function for constructing 'UUID' values.
100-- Introduced in version 1.2.2.
101fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
108-- |Build a Word32 from four Word8 values, presented in big-endian order
109word :: Word8 -> Word8 -> Word8 -> Word8 -> Word32
110word a b c d = (fromIntegral a `shiftL` 24)
111 .|. (fromIntegral b `shiftL` 16)
112 .|. (fromIntegral c `shiftL` 8)
113 .|. (fromIntegral d )
115-- |Extract a Word8 from a Word32. Bytes, high to low, are numbered from 3 to 0,
116byte :: Int -> Word32 -> Word8
117byte i w = fromIntegral (w `shiftR` (i * 8))
120-- |Make a UUID from sixteen Word8 values
121makeFromBytes :: Word8 -> Word8 -> Word8 -> Word8
122 -> Word8 -> Word8 -> Word8 -> Word8
123 -> Word8 -> Word8 -> Word8 -> Word8
124 -> Word8 -> Word8 -> Word8 -> Word8
126makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
128 where w0 = word b0 b1 b2 b3
129 w1 = word b4 b5 b6 b7
130 w2 = word b8 b9 ba bb
131 w3 = word bc bd be bf
133-- |Make a UUID from four Word32 values
134makeFromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID
137-- |A Builder for constructing a UUID of a given version.
138buildFromBytes :: Word8
139 -> Word8 -> Word8 -> Word8 -> Word8
140 -> Word8 -> Word8 -> Word8 -> Word8
141 -> Word8 -> Word8 -> Word8 -> Word8
142 -> Word8 -> Word8 -> Word8 -> Word8
144buildFromBytes v b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf =
145 makeFromBytes b0 b1 b2 b3 b4 b5 b6' b7 b8' b9 ba bb bc bd be bf
146 where b6' = b6 .&. 0x0f .|. (v `shiftL` 4)
147 b8' = b8 .&. 0x3f .|. 0x80
149-- |Build a UUID of a given version from Word32 values.
150buildFromWords :: Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
151buildFromWords v w0 w1 w2 w3 = makeFromWords w0 w1' w2' w3
152 where w1' = w1 .&. 0xffff0fff .|. ((fromIntegral v) `shiftL` 12)
153 w2' = w2 .&. 0x3fffffff .|. 0x80000000
156-- |Return the bytes that make up the UUID
157toList :: UUID -> [Word8]
158toList (UUID w0 w1 w2 w3) =
159 [byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0,
160 byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1,
161 byte 3 w2, byte 2 w2, byte 1 w2, byte 0 w2,
162 byte 3 w3, byte 2 w3, byte 1 w3, byte 0 w3]
164-- |Construct a UUID from a list of Word8. Returns Nothing if the list isn't
165-- exactly sixteen bytes long
166fromList :: [Word8] -> Maybe UUID
167fromList [b0, b1, b2, b3, b4, b5, b6, b7, b8, b9, ba, bb, bc, bd, be, bf] =
168 Just $ makeFromBytes b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 ba bb bc bd be bf
176-- |Returns true if the passed-in UUID is the 'nil' UUID.
179 -- Note: This actually faster than:
180 -- null (UUID 0 0 0 0) = True
183-- |The nil UUID, as defined in RFC 4122.
184-- It is a UUID of all zeros. @'null' u@ iff @'u' == 'nil'@.
188-- |Extract a UUID from a 'ByteString' in network byte order.
189-- The argument must be 16 bytes long, otherwise 'Nothing' is returned.
190fromByteString :: BL.ByteString -> Maybe UUID
191fromByteString = fromList . BL.unpack
193-- |Encode a UUID into a 'ByteString' in network order.
194toByteString :: UUID -> BL.ByteString
195toByteString = BL.pack . toList
197-- |If the passed in 'String' can be parsed as a 'UUID', it will be.
198-- The hyphens may not be omitted.
202-- fromString \"c2cc10e1-57d6-4b6f-9899-38d972112d8c\"
205-- Hex digits may be upper or lower-case.
206fromString :: String -> Maybe UUID
207fromString xs | validFmt = fromString' xs
208 | otherwise = Nothing
209 where validFmt = elemIndices '-' xs == [8,13,18,23]
211fromString' :: String -> Maybe UUID
213 (w0, s1) <- hexWord s0
214 (w1, s2) <- hexWord s1
215 (w2, s3) <- hexWord s2
216 (w3, s4) <- hexWord s3
217 if s4 /= "" then Nothing
218 else Just $ UUID w0 w1 w2 w3
219 where hexWord :: String -> Maybe (Word32, String)
220 hexWord s = Just (0, s) >>= hexByte >>= hexByte
221 >>= hexByte >>= hexByte
223 hexByte :: (Word32, String) -> Maybe (Word32, String)
224 hexByte (w, '-':ds) = hexByte (w, ds)
225 hexByte (w, hi:lo:ds)
226 | bothHex = Just ((w `shiftL` 8) .|. octet, ds)
227 | otherwise = Nothing
228 where bothHex = isHexDigit hi && isHexDigit lo
229 octet = fromIntegral (16 * digitToInt hi + digitToInt lo)
232-- | Convert a UUID into a hypenated string using lower-case letters.
236-- toString \<$\> fromString \"550e8400-e29b-41d4-a716-446655440000\"
238toString :: UUID -> String
239toString (UUID w0 w1 w2 w3) = hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""
240 where hexw :: Word32 -> String -> String
241 hexw w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
242 : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
244 hexw' :: Word32 -> String -> String
245 hexw' w s = '-' : hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16
246 : '-' : hexn w 12 : hexn w 8 : hexn w 4 : hexn w 0 : s
248 hexn :: Word32 -> Int -> Char
249 hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)
251-- | Convert a UUID into a hyphentated string using lower-case letters, packed
252-- as ASCII bytes into `B.ByteString`.
254-- This should be equivalent to `toString` with `Data.ByteString.Char8.pack`.
255toASCIIBytes :: UUID -> B.ByteString
256toASCIIBytes uuid = BI.unsafeCreate 36 (pokeASCII uuid)
258-- | Helper function for `toASCIIBytes`
259pokeASCII :: UUID -> Ptr Word8 -> IO ()
260pokeASCII uuid ptr = do
270 (w0, w1, w2, w3) = toWords uuid
273 pokeDash ix = pokeElemOff ptr ix 45
277 pokeWord (ix + 1) w 24
278 pokeWord (ix + 2) w 20
279 pokeWord (ix + 3) w 16
280 pokeWord (ix + 4) w 12
281 pokeWord (ix + 5) w 8
282 pokeWord (ix + 6) w 4
283 pokeWord (ix + 7) w 0
285 -- We skip the dash in the middle
288 pokeWord (ix + 1) w 24
289 pokeWord (ix + 2) w 20
290 pokeWord (ix + 3) w 16
291 pokeWord (ix + 5) w 12
292 pokeWord (ix + 6) w 8
293 pokeWord (ix + 7) w 4
294 pokeWord (ix + 8) w 0
297 pokeElemOff ptr ix (fromIntegral (toDigit ((w `shiftR` r) .&. 0xf)))
299 toDigit :: Word32 -> Word32
300 toDigit w = if w < 10 then 48 + w else 97 + w - 10
302-- | If the passed in `B.ByteString` can be parsed as an ASCII representation of
303-- a `UUID`, it will be. The hyphens may not be omitted.
305-- This should be equivalent to `fromString` with `Data.ByteString.Char8.unpack`.
306fromASCIIBytes :: B.ByteString -> Maybe UUID
307fromASCIIBytes bs = do
309 fromWords <$> single 0 <*> double 9 14 <*> double 19 24 <*> single 28
312 dashIx bs' ix = BU.unsafeIndex bs' ix == 45
314 -- Important: check the length first, given the `unsafeIndex` later.
316 B.length bs == 36 && dashIx bs 8 && dashIx bs 13 &&
317 dashIx bs 18 && dashIx bs 23
319 single ix = combine <$> octet ix <*> octet (ix + 2)
320 <*> octet (ix + 4) <*> octet (ix + 6)
321 double ix0 ix1 = combine <$> octet ix0 <*> octet (ix0 + 2)
322 <*> octet ix1 <*> octet (ix1 + 2)
324 combine o0 o1 o2 o3 = shiftL o0 24 .|. shiftL o1 16 .|. shiftL o2 8 .|. o3
327 hi <- fromIntegral <$> toDigit (BU.unsafeIndex bs ix)
328 lo <- fromIntegral <$> toDigit (BU.unsafeIndex bs (ix + 1))
329 return (16 * hi + lo)
331 toDigit :: Word8 -> Maybe Word8
334 | w >= 48 && w <= 57 = Just (w - 48)
336 | w >= 65 && w <= 70 = Just (10 + w - 65)
338 | w >= 97 && w <= 102 = Just (10 + w - 97)
339 | otherwise = Nothing
341-- | Similar to `toASCIIBytes` except we produce a lazy `BL.ByteString`.
342toLazyASCIIBytes :: UUID -> BL.ByteString
343toLazyASCIIBytes = BL.fromStrict . toASCIIBytes
345-- | Similar to `fromASCIIBytes` except parses from a lazy `BL.ByteString`.
346fromLazyASCIIBytes :: BL.ByteString -> Maybe UUID
347fromLazyASCIIBytes bs =
348 if BL.length bs == 36 then fromASCIIBytes (BL.toStrict bs) else Nothing
354instance Random UUID where
355 random g = (fromGenNext w0 w1 w2 w3 w4, g4)
356 where (w0, g0) = next g
361 randomR _ = random -- range is ignored
363-- |Build a UUID from the results of five calls to next on a StdGen.
364-- While next on StdGet returns an Int, it doesn't provide 32 bits of
365-- randomness. This code relies on at last 28 bits of randomness in the
366-- and optimizes its use so as to make only five random values, not six.
367fromGenNext :: Int -> Int -> Int -> Int -> Int -> UUID
368fromGenNext w0 w1 w2 w3 w4 =
369 buildFromBytes 4 /-/ (ThreeByte w0)
371 /-/ w2 -- use all 4 bytes because we know the version
372 -- field will "cover" the upper, non-random bits
376-- |A ByteSource to extract only three bytes from an Int, since next on StdGet
377-- only returns 31 bits of randomness.
378type instance ByteSink ThreeByte g = Takes3Bytes g
379newtype ThreeByte = ThreeByte Int
380instance ByteSource ThreeByte where
381 f /-/ (ThreeByte w) = f b1 b2 b3
382 where b1 = fromIntegral (w `shiftR` 16)
383 b2 = fromIntegral (w `shiftR` 8)
386instance NFData UUID where
389instance Hashable UUID where
390 hash (UUID w0 w1 w2 w3) =
391 hash w0 `hashWithSalt` w1
394 hashWithSalt s (UUID w0 w1 w2 w3) =
400instance Show UUID where
403instance Read UUID where
405 let noSpaces = dropWhile isSpace str
406 in case fromString (take 36 noSpaces) of
408 Just u -> [(u,drop 36 noSpaces)]
411instance Storable UUID where
413 alignment _ = 1 -- UUIDs are stored as individual octets
416 mapM (peekByteOff p) [off..(off+15)] >>= return . fromJust . fromList
418 pokeByteOff p off u =
419 sequence_ $ zipWith (pokeByteOff p) [off..] (toList u)
422instance Binary UUID where
423 put (UUID w0 w1 w2 w3) =
424 putWord32be w0 >> putWord32be w1 >> putWord32be w2 >> putWord32be w3
425 get = liftM4 UUID getWord32be getWord32be getWord32be getWord32be
428-- My goal with this instance was to make it work just enough to do what
429-- I want when used with the HStringTemplate library.
430instance Data UUID where
431 toConstr uu = mkConstr uuidType (show uu) [] (error "fixity")
432 gunfold _ _ = error "gunfold"
433 dataTypeOf _ = uuidType
436uuidType = mkNoRepType "Data.UUID.UUID"
438#if !(MIN_VERSION_base(4,2,0))
439mkNoRepType :: String -> DataType
440mkNoRepType = mkNorepType
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list