git.iko.soy/typeable/uuid
on a5fdff1 help sign in
typeable/uuid/Data/UUID/V5.hs
101 lines 2.6 kB history raw
1-- |
2-- Module : Data.UUID.V5
3-- Copyright : (c) 2008 Antoine Latter
4--
5-- License : BSD-style
6--
7-- Maintainer : aslatter@gmail.com
8-- Stability : experimental
9-- Portability : portable
10--
11--
12-- This module implements Version 5 UUIDs as specified
13-- in RFC 4122.
14--
15-- These UUIDs identify an object within a namespace,
16-- and are deterministic.
17--
18-- The namespace is identified by a UUID. Several sample
19-- namespaces are enclosed.
21module Data.UUID.V5
22 (generateNamed
23 ,namespaceDNS
24 ,namespaceURL
25 ,namespaceOID
26 ,namespaceX500
27 ) where
30import Data.UUID.Internal
32import Data.Binary
33import Data.Bits
34import Data.Maybe
36import qualified Data.ByteString.Lazy as BS
37import Data.ByteString.Lazy (ByteString)
39import qualified Data.Digest.SHA1 as SHA1
42-- |Generate a 'UUID' within the specified namespace out of the given
43-- object.
44--
45-- Uses a SHA1 hash.
46generateNamed :: UUID -- ^Namespace
47 -> [Word8] -- ^Object
48 -> UUID
49generateNamed namespace object =
50 let chunk = BS.unpack (encode namespace) ++ object
51 SHA1.Word160 w1 w2 w3 w4 w5 = SHA1.hash chunk
53 tl = w1
54 tm = high16 w2
55 th = (versionSHA .|.) $ (versionMask .&.) $ low16 w2
56 ch = (reserved .|.) $ (reservedMask .&.) $ high8 $ high16 w3
57 cl = low8 $ high16 w3
58 node = Node (high8 (low16 w3))
59 (low8 (low16 w3))
60 (high8 (high16 w4))
61 (low8 (high16 w4))
62 (high8 (low16 w4))
63 (low8 (low16 w4))
64 in UUID tl tm th ch cl node
66-- HASH 0 1 - 2 3 : w1
67-- 4 5 - 6 7 : w2
68-- 8 9 - 10 11 : w3
69-- 12 13 - 14 15 : w4
70-- 16 17 - 18 19 : w5
72low16 :: Word32 -> Word16
73low16 = fromIntegral . (.&. 0x0000FFFF)
75high16 :: Word32 -> Word16
76high16 = fromIntegral . flip shiftR 16
78low8 :: Word16 -> Word8
79low8 = fromIntegral . (.&. 0x00FF)
81high8 :: Word16 -> Word8
82high8 = fromIntegral . flip shiftR 8
84versionSHA = 5 `shiftL` 12
86unsafeFromString :: String -> UUID
87unsafeFromString = fromJust . fromString
89-- |The namespace for DNS addresses
90namespaceDNS :: UUID
91namespaceDNS = unsafeFromString "6ba7b810-9dad-11d1-80b4-00c04fd430c8"
93-- |The namespace for URLs
94namespaceURL :: UUID
95namespaceURL = unsafeFromString "6ba7b811-9dad-11d1-80b4-00c04fd430c8"
97namespaceOID :: UUID
98namespaceOID = unsafeFromString "6ba7b812-9dad-11d1-80b4-00c04fd430c8"
100namespaceX500 :: UUID
101namespaceX500 = unsafeFromString "6ba7b814-9dad-11d1-80b4-00c04fd430c8"