uuid-types-1.0.5.1/0000755000000000000000000000000007346545000012155 5ustar0000000000000000uuid-types-1.0.5.1/ChangeLog.md0000644000000000000000000000114007346545000014322 0ustar0000000000000000## 1.0.5 (2021-05-03) - Add (Template Haskell) `Lift UUID` instance ## 1.0.4.0 - Declare `Data.UUID.Types` module "`Trustworthy`" with respect to SafeHaskell. - Use more compact heap object representation which saves 16 bytes on 64bit platforms. - Add `toWords64`/`fromWords64` functions - Drop support for GHC < 7. - Add support for `random-1.2`, i.e. idiomatic `Random` and added `Uniform` instances. ## 1.0.3 - Bump package dependencies. ## 1.0.2 - Add `toText`/`fromText` functions. ## 1.0.1 - Update dependencies in tests and benchmarks. ## 1.0.0 - Initial split from "`uuid-1.3.8`" package. uuid-types-1.0.5.1/LICENSE0000644000000000000000000000266007346545000013166 0ustar0000000000000000Copyright (c) 2008, Antoine Latter All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * The names of the authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. uuid-types-1.0.5.1/Setup.hs0000644000000000000000000000007507346545000013613 0ustar0000000000000000import Distribution.Simple main :: IO () main = defaultMain uuid-types-1.0.5.1/src/Data/UUID/0000755000000000000000000000000007346545000014363 5ustar0000000000000000uuid-types-1.0.5.1/src/Data/UUID/Types.hs0000644000000000000000000000226207346545000016025 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif {- | Module : Data.UUID.Types Copyright : (c) 2017-2018 Herbert Valerio Riedel (c) 2008,2012 Antoine Latter License : BSD-style Maintainer : hvr@gnu.org Portability : portable This library is useful for comparing, parsing and printing . See for the specification. -} module Data.UUID.Types ( -- * The 'UUID' Type UUID -- * Nil UUID , nil , null -- * Textual Representation , toString , fromString , toText , fromText , toASCIIBytes , fromASCIIBytes , toLazyASCIIBytes , fromLazyASCIIBytes -- * Binary Representation , toByteString , fromByteString -- * Integer Representation , toWords , fromWords , toWords64 , fromWords64 ) where import Data.UUID.Types.Internal import Prelude () -- Everything is really implemented in Data.UUID.Types.Internal, but I -- don't want to export the constructors out of the package. uuid-types-1.0.5.1/src/Data/UUID/Types/0000755000000000000000000000000007346545000015467 5ustar0000000000000000uuid-types-1.0.5.1/src/Data/UUID/Types/Internal.hs0000644000000000000000000005202707346545000017605 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Unsafe #-} #endif #if __GLASGOW_HASKELL__ >=800 {-# LANGUAGE DeriveLift #-} {-# LANGUAGE StandaloneDeriving #-} #endif {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.UUID.Types.Internal -- Copyright : (c) 2017-2018 Herbert Valerio Riedel -- (c) 2008-2009, 2012 Antoine Latter -- (c) 2009 Mark Lentczner -- -- License : BSD-style -- -- Maintainer : hvr@gnu.org -- Portability : portable module Data.UUID.Types.Internal ( UUID(..) , null , nil , fromByteString , toByteString , fromString , toString , fromText , toText , fromWords , toWords , fromWords64 , toWords64 , 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 (guard, liftM2) import Data.Bits import Data.Char import Data.Data import Data.Functor ((<$>)) import Data.Hashable import Data.List (elemIndices) import Foreign.Ptr (Ptr) import Foreign.Storable import Data.Binary import Data.Binary.Get import Data.Binary.Put 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.Text (Text) import qualified Data.Text.Encoding as T import Data.UUID.Types.Internal.Builder #if MIN_VERSION_random(1,2,0) import System.Random (Random (..), uniform) import System.Random.Stateful (Uniform (..), uniformWord64) #else import System.Random (Random (..), next) #endif #if __GLASGOW_HASKELL__ >=800 import Language.Haskell.TH.Syntax (Lift) #else import Language.Haskell.TH (appE, varE) import Language.Haskell.TH.Syntax (Lift (..), mkNameG_v, Lit (IntegerL), Exp (LitE)) #endif -- | Type representing as specified in -- . data UUID = UUID {-# UNPACK #-} !Word64 {-# UNPACK #-} !Word64 deriving (Eq, Ord, Typeable) {- Prior to uuid-types-1.0.4: !Word32 !Word32 !Word32 !Word32 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. -} -- | Convert a 'UUID' into a sequence of 'Word32' values. -- Useful for when you need to serialize a UUID and -- neither 'Storable' nor 'Binary' are appropriate. -- -- >>> toWords <$> fromString "550e8400-e29b-41d4-a716-446655440000" -- Just (1427014656,3801825748,2803254374,1430519808) -- -- See also 'toWords64'. -- -- /Since: @uuid-1.2.2@/ -- -- @since 1.0.0 toWords :: UUID -> (Word32, Word32, Word32, Word32) toWords (UUID w12 w34) = (w1, w2, w3, w4) where w1 = fromIntegral (w12 `unsafeShiftR` 32) w2 = fromIntegral w12 w3 = fromIntegral (w34 `unsafeShiftR` 32) w4 = fromIntegral w34 -- | Create a 'UUID' from a sequence of 'Word32'. The -- inverse of 'toWords'. Useful when you need a total -- function for constructing 'UUID' values. -- -- See also 'fromWords64'. -- -- /Since: @uuid-1.2.2@/ -- -- @since 1.0.0 fromWords :: Word32 -> Word32 -> Word32 -> Word32 -> UUID fromWords w1 w2 w3 w4 = UUID (w32to64 w1 w2) (w32to64 w3 w4) -- | Convert a 'UUID' into a pair of 'Word64's. -- -- >>> toWords64 <$> fromString "550e8400-e29b-41d4-a716-446655440000" -- Just (6128981282234515924,12039885860129472512) -- -- See also 'toWords'. -- -- @since 1.0.4 toWords64 :: UUID -> (Word64, Word64) toWords64 (UUID w12 w34) = (w12,w34) -- | Create a 'UUID' from a pair of 'Word64's. -- -- Inverse of 'toWords64'. See also 'fromWords'. -- -- @since 1.0.4 fromWords64 :: Word64 -> Word64 -> UUID fromWords64 = 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) = build /-/ w0 /-/ w1 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 `unsafeShiftL` 24) .|. (fromIntegral b `unsafeShiftL` 16) .|. (fromIntegral c `unsafeShiftL` 8) .|. (fromIntegral d ) -- |Extract a Word8 from a Word64. Bytes, high to low, are numbered from 7 to 0, byte :: Int -> Word64 -> Word8 byte i w = fromIntegral (w `shiftR` (i * 8)) -- |Build a Word16 from two Word8 values, presented in big-endian order. w8to16 :: Word8 -> Word8 -> Word16 w8to16 w0s w1s = (w0 `unsafeShiftL` 8) .|. w1 where w0 = fromIntegral w0s w1 = fromIntegral w1s -- | Construct 'Word64' from low/high 'Word32's w32to64 :: Word32 -> Word32 -> Word64 w32to64 w0 w1 = (fromIntegral w0 `unsafeShiftL` 32) .|. (fromIntegral w1) -- |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 = fromWords 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 -- |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 = fromWords 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) = [byte 7 w0, byte 6 w0, byte 5 w0, byte 4 w0, byte 3 w0, byte 2 w0, byte 1 w0, byte 0 w0, byte 7 w1, byte 6 w1, byte 5 w1, byte 4 w1, byte 3 w1, byte 2 w1, byte 1 w1, byte 0 w1] -- |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 . -- It is a UUID of all zeros. @'null' u@ /iff/ @'u' == 'nil'@. nil :: UUID nil = UUID 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. -- -- This uses the same encoding as the 'Binary' instance. 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" -- Just 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 $ fromWords 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" -- Just "550e8400-e29b-41d4-a716-446655440000" -- -- toString :: UUID -> String toString uuid = hexw0 w0 $ hexw1 w1 "" where hexw0 :: Word64 -> String -> String hexw0 w s = hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48 : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32 : '-' : 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 hexw1 :: Word64 -> String -> String hexw1 w s = '-' : hexn w 60 : hexn w 56 : hexn w 52 : hexn w 48 : '-' : hexn w 44 : hexn w 40 : hexn w 36 : hexn w 32 : 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 :: Word64 -> Int -> Char hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf) (w0,w1) = toWords64 uuid -- | If the passed in `Text` can be parsed as an ASCII representation of -- a `UUID`, it will be. The hyphens may not be omitted. fromText :: Text -> Maybe UUID fromText = fromASCIIBytes . T.encodeUtf8 -- | Convert a UUID into a hyphentated string using lower-case letters. toText :: UUID -> Text toText = T.decodeLatin1 . toASCIIBytes -- | 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 -- -- | This 'Random' instance produces __insecure__ version 4 UUIDs as -- specified in . #if MIN_VERSION_random(1,2,0) instance Random UUID where random = uniform randomR _ = random -- range is ignored -- @since 1.0.4 instance Uniform UUID where uniformM gen = do w0 <- uniformWord64 gen w1 <- uniformWord64 gen pure $ buildFromBytes 4 /-/ w0 /-/ w1 #else 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) #endif -- |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 `unsafeShiftR` 16) b2 = fromIntegral (w `unsafeShiftR` 8) b3 = fromIntegral w instance NFData UUID where rnf = flip seq () instance Hashable UUID where hash (toWords -> (w0,w1,w2,w3)) = hash w0 `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 hashWithSalt s (toWords -> (w0,w1,w2,w3)) = s `hashWithSalt` w0 `hashWithSalt` w1 `hashWithSalt` w2 `hashWithSalt` w3 -- | Pretty prints a 'UUID' (without quotation marks). See also 'toString'. -- -- >>> show nil -- "00000000-0000-0000-0000-000000000000" -- 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)] -- | This 'Storable' instance uses the memory layout as described in , but in contrast to the 'Binary' instance, __the fields are stored in host byte order__. 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 -- | This 'Binary' instance is compatible with , storing the fields in network order as 16 bytes. instance Binary UUID where put (UUID w0 w1) = putWord64be w0 >> putWord64be w1 get = liftM2 UUID getWord64be getWord64be -- 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.Types.UUID" #if !MIN_VERSION_base(4,5,0) unsafeShiftR, unsafeShiftL :: Bits w => w -> Int -> w {-# INLINE unsafeShiftR #-} unsafeShiftR = shiftR {-# INLINE unsafeShiftL #-} unsafeShiftL = shiftL #endif #if __GLASGOW_HASKELL__ >=800 deriving instance Lift UUID #else instance Lift UUID where lift (UUID w1 w2) = varE fromWords64Name `appE` liftW64 w1 `appE` liftW64 w2 where fromWords64Name = mkNameG_v currentPackageKey "Data.UUID.Types.Internal" "fromWords64" liftW64 x = return (LitE (IntegerL (fromIntegral x))) currentPackageKey :: String #ifdef CURRENT_PACKAGE_KEY currentPackageKey = CURRENT_PACKAGE_KEY #else currentPackageKey = "uuid-types-1.0.5" #endif #endif uuid-types-1.0.5.1/src/Data/UUID/Types/Internal/0000755000000000000000000000000007346545000017243 5ustar0000000000000000uuid-types-1.0.5.1/src/Data/UUID/Types/Internal/Builder.hs0000644000000000000000000000673707346545000021202 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Unsafe #-} #endif {-# OPTIONS_HADDOCK hide #-} -- | Module : Data.UUID.Types.Internal.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.Types.Internal.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 Takes8Bytes g = Word8 -> Word8 -> Word8 -> Word8 -> 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 Word64 g = Takes8Bytes 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 Word64 where f /-/ w = f b1 b2 b3 b4 b5 b6 b7 b8 where b1 = fromIntegral (w `shiftR` 56) b2 = fromIntegral (w `shiftR` 48) b3 = fromIntegral (w `shiftR` 40) b4 = fromIntegral (w `shiftR` 32) b5 = fromIntegral (w `shiftR` 24) b6 = fromIntegral (w `shiftR` 16) b7 = fromIntegral (w `shiftR` 8) b8 = 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 uuid-types-1.0.5.1/tests/0000755000000000000000000000000007346545000013317 5ustar0000000000000000uuid-types-1.0.5.1/tests/TestUUID.hs0000644000000000000000000001623407346545000015267 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} import Data.Binary (encode) import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8 import Data.Char (ord) import Data.Functor ((<$>)) import qualified Data.UUID.Types as U import Data.Word import Foreign (alloca, castPtr, peek, poke, sizeOf) import GHC.ByteOrder (ByteOrder(..), targetByteOrder) import System.IO.Unsafe (unsafePerformIO) import Test.QuickCheck (Arbitrary (arbitrary), choose) import Test.Tasty (TestTree, defaultMain, testGroup) import Test.Tasty.HUnit (assertBool, testCase, (@=?), (@?=)) import Test.Tasty.QuickCheck (testProperty) -- orphan instance Arbitrary U.UUID where -- the UUID random instance ignores bounds arbitrary = choose (U.nil, U.nil) type Test = TestTree test_null :: Test test_null = testCase "nil is null" $ assertBool "" (U.null U.nil) test_nil :: Test test_nil = testGroup "nil" [ testCase "nil string" $ U.toString U.nil @?= "00000000-0000-0000-0000-000000000000", testCase "nil bytes" $ U.toByteString U.nil @?= BL.pack (replicate 16 0) ] test_lift :: Test test_lift = testCase "TH.Lift" $ do let uuid = U.fromWords64 123456789 987654321 uuid @?= $( [| uuid |] ) test_conv :: Test test_conv = testGroup "conversions" [ testCase "conv bytes to string" $ maybe "" (U.toString) (U.fromByteString b16) @?= s16, testCase "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 fromByteString with a fixed-input. test_fromByteString :: Test test_fromByteString = testCase "UUID fromByteString" $ Just inputUUID @=? U.fromByteString (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") -- | Test fromWords with a fixed-input test_fromWords :: Test test_fromWords = testCase "UUID fromWords" $ inputUUID @=? U.fromWords 0xa5ca8566 0xd9c54835 0x99c8e1f1 0x3e73b5e2 test_Storeable :: Test test_Storeable = testCase "UUID Storeable(poke)" $ case targetByteOrder of LittleEndian -> BC8.pack "\x66\x85\xca\xa5\xc5\xd9\x35\x48\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID BigEndian -> BC8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2" @=? pokeAsBS inputUUID where pokeAsBS :: U.UUID -> BC8.ByteString pokeAsBS uuid = unsafePerformIO $ do alloca $ \ptr -> do poke ptr uuid BC8.packCStringLen (castPtr ptr, sizeOf uuid) test_Binary :: Test test_Binary = testCase "UUID Binary(encode)" $ (BL8.pack "\xa5\xca\x85\x66\xd9\xc5\x48\x35\x99\xc8\xe1\xf1\x3e\x73\xb5\xe2") @=? encode inputUUID 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_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 defaultMain $ testGroup "tests" $ concat $ [ [ test_null, test_nil, test_lift, test_conv, test_fromByteString, test_fromWords, test_Storeable, test_Binary ] , [ prop_stringRoundTrip, prop_readShowRoundTrip, prop_byteStringRoundTrip, prop_storableRoundTrip, prop_stringLength, prop_byteStringLength, prop_randomsDiffer, prop_randomNotNull ] , [ 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-types-1.0.5.1/uuid-types.cabal0000644000000000000000000000514407346545000015255 0ustar0000000000000000cabal-version: 1.12 name: uuid-types version: 1.0.5.1 copyright: (c) 2017-2018 Herbert Valerio Riedel (c) 2008-2014 Antoine Latter author: Antoine Latter maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE category: Data build-type: Simple tested-with: GHC ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.4 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3 || ==9.8.1 synopsis: Type definitions for Universally Unique Identifiers description: This library contains type definitions for (as specified in ) and basic conversion functions. . See also the providing a high-level API for managing the different UUID versions. homepage: https://github.com/haskell-hvr/uuid bug-reports: https://github.com/haskell-hvr/uuid/issues extra-source-files: ChangeLog.md source-repository head type: git location: https://github.com/haskell-hvr/uuid.git subdir: uuid-types library build-depends: base >=4.5 && <5 , binary >=0.5.1.0 && <0.9 , bytestring >=0.9.2.1 && <0.13 , deepseq >=1.3.0.0 && <1.6 , hashable >=1.2.7.0 && <1.5 , random >=1.1 && <1.3 , template-haskell >=2.7.0.0 && <2.22 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2 exposed-modules: Data.UUID.Types -- Exposed for companion projects; *NOT* part of the official API: exposed-modules: Data.UUID.Types.Internal Data.UUID.Types.Internal.Builder default-language: Haskell2010 other-extensions: DeriveDataTypeable TypeFamilies ghc-options: -Wall hs-source-dirs: src test-suite testuuid type: exitcode-stdio-1.0 main-is: TestUUID.hs hs-source-dirs: tests default-language: Haskell2010 other-extensions: ViewPatterns ghc-options: -Wall -- inherited constraints build-depends: base , binary , bytestring , template-haskell , uuid-types -- deps w/o inherited constraints build-depends: QuickCheck >=2.14.2 && <2.15 , tasty >=1.4.0.1 && <1.6 , tasty-hunit >=0.10 && <0.11 , tasty-quickcheck >=0.10 && <0.11 if !impl(ghc >=8.4) build-depends: ghc-byteorder >=4.11 && <4.12