-- |
-- Module      : Data.UUID.Named
-- Copyright   : (c) 2008 Antoine Latter
--
-- License     : BSD-style
--
-- Maintainer  : aslatter@gmail.com
-- Stability   : experimental
-- Portability : portable
--
--
-- This module implements Version 3/5 UUIDs as specified
-- in RFC 4122.
--
-- These UUIDs identify an object within a namespace,
-- and are deterministic.
--
-- The namespace is identified by a UUID.  Several sample
-- namespaces are enclosed.

module Data.UUID.Named
    (generateNamed
    ,namespaceDNS
    ,namespaceURL
    ,namespaceOID
    ,namespaceX500
    ) where

import Data.UUID.Types.Internal

import Control.Applicative ((<*>),(<$>))
import Data.Binary.Get (runGet, getWord32be)
import Data.Maybe
import Data.Word (Word8)

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL

-- |Generate a 'UUID' within the specified namespace out of the given
-- object.
generateNamed :: (B.ByteString -> B.ByteString) -- ^Hash
              -> Word8   -- ^Version
              ->  UUID   -- ^Namespace
              -> [Word8] -- ^Object
              -> UUID
generateNamed :: (ByteString -> ByteString) -> Word8 -> UUID -> [Word8] -> UUID
generateNamed ByteString -> ByteString
hash Word8
version UUID
namespace [Word8]
object =
    let chunk :: ByteString
chunk = [Word8] -> ByteString
B.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ UUID -> [Word8]
toList UUID
namespace [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8]
object
        bytes :: ByteString
bytes = [ByteString] -> ByteString
BL.fromChunks ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[]) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
hash ByteString
chunk
        w :: Get Word32
w = Get Word32
getWord32be
        unpackBytes :: ByteString -> UUID
unpackBytes = Get UUID -> ByteString -> UUID
forall a. Get a -> ByteString -> a
runGet (Get UUID -> ByteString -> UUID) -> Get UUID -> ByteString -> UUID
forall a b. (a -> b) -> a -> b
$
         Word8 -> Word32 -> Word32 -> Word32 -> Word32 -> UUID
buildFromWords Word8
version (Word32 -> Word32 -> Word32 -> Word32 -> UUID)
-> Get Word32 -> Get (Word32 -> Word32 -> Word32 -> UUID)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
w Get (Word32 -> Word32 -> Word32 -> UUID)
-> Get Word32 -> Get (Word32 -> Word32 -> UUID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
w Get (Word32 -> Word32 -> UUID)
-> Get Word32 -> Get (Word32 -> UUID)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
w Get (Word32 -> UUID) -> Get Word32 -> Get UUID
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Word32
w
    in ByteString -> UUID
unpackBytes ByteString
bytes


unsafeFromString :: String -> UUID
unsafeFromString :: String -> UUID
unsafeFromString = Maybe UUID -> UUID
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe UUID -> UUID) -> (String -> Maybe UUID) -> String -> UUID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe UUID
fromString

-- |The namespace for DNS addresses
namespaceDNS :: UUID
namespaceDNS :: UUID
namespaceDNS = String -> UUID
unsafeFromString String
"6ba7b810-9dad-11d1-80b4-00c04fd430c8"

-- |The namespace for URLs
namespaceURL :: UUID
namespaceURL :: UUID
namespaceURL = String -> UUID
unsafeFromString String
"6ba7b811-9dad-11d1-80b4-00c04fd430c8"

-- |The namespace for ISO OIDs
namespaceOID :: UUID
namespaceOID :: UUID
namespaceOID = String -> UUID
unsafeFromString String
"6ba7b812-9dad-11d1-80b4-00c04fd430c8"

-- |The namespace for X.500 DNs
namespaceX500 :: UUID
namespaceX500 :: UUID
namespaceX500 = String -> UUID
unsafeFromString String
"6ba7b814-9dad-11d1-80b4-00c04fd430c8"