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

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