686b46b · typeable/uuid

Data/UUID/Internal.hs+1

compare with master

unifiedsplit

@@ -21,6 +21,7 @@ module Data.UUID.Internal

21 ,toString

22 ,fromWords

23 ,toWords

24+ ,toList

24 ,buildFromBytes

25 ,buildFromBytes

25 ,buildFromWords

26 ,buildFromWords

26 ) where

27 ) where

Data/UUID/Named.hs+12−7

@@ -28,23 +28,28 @@ module Data.UUID.Named

28

29import Data.UUID.Internal

30

31−import Data.Binary

31+import Control.Applicative ((<*>),(<$>))

32+import Data.Binary.Get (runGet, getWord32be)

32import Data.Maybe

33import Data.Maybe

34+import Data.Word (Word8)

33

35

34−import qualified Data.ByteString.Lazy as BS

36+import qualified Data.ByteString as B

37+import qualified Data.ByteString.Lazy as BL

35

38

36-- |Generate a 'UUID' within the specified namespace out of the given

39-- |Generate a 'UUID' within the specified namespace out of the given

37-- object.

40-- object.

38−generateNamed :: ([Word8] -> (Word32, Word32, Word32, Word32)) -- ^Hash

41+generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash

39 -> Word8 -- ^Version

42 -> Word8 -- ^Version

40 -> UUID -- ^Namespace

43 -> UUID -- ^Namespace

41 -> [Word8] -- ^Object

44 -> [Word8] -- ^Object

42 -> UUID

45 -> UUID

43generateNamed hash version namespace object =

46generateNamed hash version namespace object =

44− let chunk = BS.unpack (toByteString namespace) ++ object

47+ let chunk = B.pack $ toList namespace ++ object

45− (w1, w2, w3, w4) = hash chunk

48+ bytes = BL.fromChunks . (:[]) $ hash chunk

49+ w = getWord32be

50+ unpackBytes = runGet $

46− in buildFromWords version w1 w2 w3 w4

51+ buildFromWords version <$> w <*> w <*> w <*> w

47−

52+ in unpackBytes bytes

48

53

49

54

50unsafeFromString :: String -> UUID

55unsafeFromString :: String -> UUID

Data/UUID/V3.hs+1−24

@@ -27,8 +27,6 @@ module Data.UUID.V3

27 ) where

28

29import Data.Word

30−import Data.Bits

31−import qualified Data.ByteString as B

32

30

33import Data.UUID.Internal

31import Data.UUID.Internal

34import qualified Data.UUID.Named as Shared

32import qualified Data.UUID.Named as Shared

@@ -43,26 +41,5 @@ import qualified Crypto.Hash.MD5 as MD5

43generateNamed :: UUID -- ^Namespace

41generateNamed :: UUID -- ^Namespace

44 -> [Word8] -- ^Object

42 -> [Word8] -- ^Object

45 -> UUID

43 -> UUID

46−generateNamed = Shared.generateNamed hash 3

44+generateNamed = Shared.generateNamed MD5.hash 3

47

45

48−hash :: [Word8] -> (Word32, Word32, Word32, Word32)

49−hash bytes

50− = case map f $ chunk 4 $ B.unpack $ MD5.hash $ B.pack bytes of

51− w1:w2:w3:w4:_ -> (w1, w2, w3, w4)

52− _ -> error "Data.UUID.V3.hash: fatal error"

53−

54− where f [b1, b2, b3, b4]

55− = sum

56− [ fromIntegral b4

57− , fromIntegral b3 `shiftL` 8

58− , fromIntegral b2 `shiftL` 16

59− , fromIntegral b1 `shiftL` 24

60− ]

61− f _ = error "Data.UUID.V3.hash: fatal error"

62−

63−chunk :: Int -> [a] -> [[a]]

64−chunk n = go n []

65− where go _ [] [] = []

66− go _ ys [] = reverse ys:[]

67− go 0 ys xs = reverse ys:go n [] xs

68− go m ys (x:xs) = go (m-1) (x:ys) xs

Data/UUID/V5.hs+1−17

@@ -27,8 +27,6 @@ module Data.UUID.V5

27 ) where

28

29import Data.Word

30−import Data.Bits

31−import qualified Data.ByteString as B

32

30

33import Data.UUID.Internal

31import Data.UUID.Internal

34import qualified Data.UUID.Named as Shared

32import qualified Data.UUID.Named as Shared

@@ -43,19 +41,5 @@ import qualified Crypto.Hash.SHA1 as SHA1

43generateNamed :: UUID -- ^Namespace

41generateNamed :: UUID -- ^Namespace

44 -> [Word8] -- ^Object

42 -> [Word8] -- ^Object

45 -> UUID

43 -> UUID

46−generateNamed = Shared.generateNamed hash 5

44+generateNamed = Shared.generateNamed SHA1.hash 5

47− where hash bytes

48− = case B.unpack $ SHA1.hash $ B.pack bytes of

49− a1:b1:c1:d1: a2:b2:c2:d2: a3:b3:c3:d3: a4:b4:c4:d4:_ ->

50− ( toWord a1 b1 c1 d1

51− , toWord a2 b2 c2 d2

52− , toWord a3 b3 c3 d3

53− , toWord a4 b4 c4 d4

54− )

55− _ -> error "Data.UUID.V5.hash: fatal error"

56

45

57−toWord :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

58−toWord a b c d = fromIntegral a `shiftL` 24

59− .|. fromIntegral b `shiftL` 16

60− .|. fromIntegral c `shiftL` 8

61− .|. fromIntegral d