{- |
   Module      : Text.Pandoc.UUID
   Copyright   : Copyright (C) 2010-2020 John MacFarlane
   License     : GNU GPL, version 2 or above

   Maintainer  : John MacFarlane <jgm@berkeley.edu>
   Stability   : alpha
   Portability : portable

UUID generation using Version 4 (random method) described
in RFC4122. See http://tools.ietf.org/html/rfc4122
-}

module Text.Pandoc.UUID ( UUID(..), getRandomUUID ) where

import Data.Bits (clearBit, setBit)
import Data.Word
import System.Random (RandomGen, randoms)
import Text.Printf (printf)
import Text.Pandoc.Class.PandocMonad

data UUID = UUID Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8
                 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8

instance Show UUID where
  show :: UUID -> String
show (UUID Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f Word8
g Word8
h Word8
i Word8
j Word8
k Word8
l Word8
m Word8
n Word8
o Word8
p) =
   String
"urn:uuid:" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
a String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
b String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
c String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
d String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
e String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
f String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
g String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
h String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
i String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
j String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
k String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
l String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
m String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
n String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
o String -> ShowS
forall a. [a] -> [a] -> [a]
++
   String -> Word8 -> String
forall r. PrintfType r => String -> r
printf String
"%02x" Word8
p

getUUID :: RandomGen g => g -> UUID
getUUID :: g -> UUID
getUUID g
gen =
  case Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take Int
16 (g -> [Word8]
forall a g. (Random a, RandomGen g) => g -> [a]
randoms g
gen :: [Word8]) of
       [Word8
a,Word8
b,Word8
c,Word8
d,Word8
e,Word8
f,Word8
g,Word8
h,Word8
i,Word8
j,Word8
k,Word8
l,Word8
m,Word8
n,Word8
o,Word8
p] ->
         -- set variant
         let i' :: Word8
i' = Word8
i Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
6
         -- set version (0100 for random)
             g' :: Word8
g' = Word8
g Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
7 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Int
6 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
5 Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Int
4
         in  Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> Word8
-> UUID
UUID Word8
a Word8
b Word8
c Word8
d Word8
e Word8
f Word8
g' Word8
h Word8
i' Word8
j Word8
k Word8
l Word8
m Word8
n Word8
o Word8
p
       [Word8]
_ -> String -> UUID
forall a. HasCallStack => String -> a
error String
"not enough random numbers for UUID" -- should not happen

getRandomUUID :: PandocMonad m => m UUID
getRandomUUID :: m UUID
getRandomUUID = StdGen -> UUID
forall g. RandomGen g => g -> UUID
getUUID (StdGen -> UUID) -> m StdGen -> m UUID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m StdGen
forall (m :: * -> *). PandocMonad m => m StdGen
newStdGen