{-# LANGUAGE DeriveDataTypeable #-}
module Data.ULID.Random (
ULIDRandom,
mkCryptoULIDRandom,
mkULIDRandom,
getULIDRandom
) where
import Control.DeepSeq
import Control.Monad
import Crypto.Random
import Data.Binary
import Data.Binary.Roll
import Data.ByteString as BS hiding (split, take)
import Data.Data
import Data.Maybe
import Data.Word
import Data.Text as T hiding (split, take)
import System.Random
import qualified Data.ULID.Base32 as B32
newtype ULIDRandom = ULIDRandom BS.ByteString
deriving (Eq, Typeable, Data)
instance Show ULIDRandom where
show (ULIDRandom r) = T.unpack $ B32.encode 16.roll.(BS.unpack) $ r
instance Read ULIDRandom where
readsPrec _ = fmap
(\(int, rest) ->
(ULIDRandom $ BS.pack $ unroll numBytes int, T.unpack rest))
. (B32.decode $ 16)
. T.pack
instance Binary ULIDRandom where
put (ULIDRandom r) = mapM_ put (BS.unpack $ r)
get = ULIDRandom <$> (BS.pack) <$> replicateM numBytes get
instance NFData ULIDRandom where
rnf (ULIDRandom r) = rnf r
numBytes = 10
mkCryptoULIDRandom :: CryptoRandomGen g => g -> Either GenError (ULIDRandom, g)
mkCryptoULIDRandom g = do
(b, g2) <- genBytes numBytes g
return (ULIDRandom b, g2)
mkULIDRandom :: RandomGen g => g -> (ULIDRandom, g)
mkULIDRandom g = let
(g1, g2) = split g
genbytes = (BS.pack) . take numBytes . randoms
in (ULIDRandom $ genbytes g, g2)
getULIDRandom :: IO ULIDRandom
getULIDRandom =
fst <$> mkULIDRandom <$> newStdGen