{- |
   Module      : Text.Pandoc.UUID
   Copyright   : Copyright (C) 2010-2023 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:" forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
a forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
b forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
c forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
d forall a. [a] -> [a] -> [a]
++
   String
"-" forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
e forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
f forall a. [a] -> [a] -> [a]
++
   String
"-" forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
g forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
h forall a. [a] -> [a] -> [a]
++
   String
"-" forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
i forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
j forall a. [a] -> [a] -> [a]
++
   String
"-" forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
k forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
l forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
m forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
n forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
o forall a. [a] -> [a] -> [a]
++
   forall r. PrintfType r => String -> r
printf String
"%02x" Word8
p

getUUID :: RandomGen g => g -> UUID
getUUID :: forall g. RandomGen g => g -> UUID
getUUID g
gen =
  case forall a. Int -> [a] -> [a]
take Int
16 (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 forall a. Bits a => a -> Int -> a
`setBit` Int
7 forall a. Bits a => a -> Int -> a
`clearBit` Int
6
         -- set version (0100 for random)
             g' :: Word8
g' = Word8
g forall a. Bits a => a -> Int -> a
`clearBit` Int
7 forall a. Bits a => a -> Int -> a
`setBit` Int
6 forall a. Bits a => a -> Int -> a
`clearBit` Int
5 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]
_ -> forall a. HasCallStack => String -> a
error String
"not enough random numbers for UUID" -- should not happen

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