module Data.TinyID 
  ( urlSafeAlphabet
  , nextRandomFromAlphabet
  , nextRandom
  ) where

import            Data.ByteString       (ByteString)
import  qualified Data.ByteString as BS 
import            System.Entropy        (getEntropy)
import            Data.String           (fromString)

-- | A URL-friendly alphabet.
--
-- See section 2.3 of [RFC3986](https://www.ietf.org/rfc/rfc3986.txt) for more information.
urlSafeAlphabet :: ByteString
urlSafeAlphabet :: ByteString
urlSafeAlphabet = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'A'..Char
'Z'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Char
'0'..Char
'9'] String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-_"

-- | Generates a (cryptographically) secure ID with a specified 
-- alphabet at a given length from system entropy.
nextRandomFromAlphabet 
  :: ByteString         -- ^ Alphabet 
  -> Int                -- ^ Length of ID
  -> IO ByteString
nextRandomFromAlphabet :: ByteString -> Int -> IO ByteString
nextRandomFromAlphabet ByteString
alphabet Int
n =
  (Word8 -> Word8) -> ByteString -> ByteString
BS.map (\Word8
x -> ByteString -> Int -> Word8
BS.index ByteString
alphabet (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` ByteString -> Int
BS.length ByteString
alphabet) (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> IO ByteString
getEntropy Int
n

-- | Generates a (cryptographically) secure and URL-friendly ID from system entropy.
nextRandom 
  :: Int            -- ^ Length of ID 
  -> IO ByteString
nextRandom :: Int -> IO ByteString
nextRandom = ByteString -> Int -> IO ByteString
nextRandomFromAlphabet ByteString
urlSafeAlphabet