1{- | 2 Module : Text.Pandoc.UUID 3 Copyright : Copyright (C) 2010-2021 John MacFarlane 4 License : GNU GPL, version 2 or above 5 6 Maintainer : John MacFarlane <jgm@berkeley.edu> 7 Stability : alpha 8 Portability : portable 9 10UUID generation using Version 4 (random method) described 11in RFC4122. See http://tools.ietf.org/html/rfc4122 12-} 13 14module Text.Pandoc.UUID ( UUID(..), getRandomUUID ) where 15 16import Data.Bits (clearBit, setBit) 17import Data.Word 18import System.Random (RandomGen, randoms) 19import Text.Printf (printf) 20import Text.Pandoc.Class.PandocMonad 21 22data UUID = UUID Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 23 Word8 Word8 Word8 Word8 Word8 Word8 Word8 Word8 24 25instance Show UUID where 26 show (UUID a b c d e f g h i j k l m n o p) = 27 "urn:uuid:" ++ 28 printf "%02x" a ++ 29 printf "%02x" b ++ 30 printf "%02x" c ++ 31 printf "%02x" d ++ 32 "-" ++ 33 printf "%02x" e ++ 34 printf "%02x" f ++ 35 "-" ++ 36 printf "%02x" g ++ 37 printf "%02x" h ++ 38 "-" ++ 39 printf "%02x" i ++ 40 printf "%02x" j ++ 41 "-" ++ 42 printf "%02x" k ++ 43 printf "%02x" l ++ 44 printf "%02x" m ++ 45 printf "%02x" n ++ 46 printf "%02x" o ++ 47 printf "%02x" p 48 49getUUID :: RandomGen g => g -> UUID 50getUUID gen = 51 case take 16 (randoms gen :: [Word8]) of 52 [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p] -> 53 -- set variant 54 let i' = i `setBit` 7 `clearBit` 6 55 -- set version (0100 for random) 56 g' = g `clearBit` 7 `setBit` 6 `clearBit` 5 `clearBit` 4 57 in UUID a b c d e f g' h i' j k l m n o p 58 _ -> error "not enough random numbers for UUID" -- should not happen 59 60getRandomUUID :: PandocMonad m => m UUID 61getRandomUUID = getUUID <$> newStdGen 62