-----------------------------------------------------------------------------
-- |
-- Module      :  Data.RNG
-- Copyright   :  Soostone Inc, Snap Framework Authors
-- License     :  BSD3
--
-- Maintainer  :  Ozgun Ataman <ozgun.ataman@soostone.com>
-- Stability   :  experimental
--
-- Convenience thread-safe wrapper around mwc-random library for
-- practical supply of random numbers in a concurrent environment.
----------------------------------------------------------------------------

module Data.RNG
    ( RNG
    , mkRNG
    , seedRNG
    , packRNG
    , withRNG
    , randomToken

    -- * Re-export MWC for convenience.
    , module System.Random.MWC
    ) where

------------------------------------------------------------------------------
import           Control.Applicative
import           Control.Concurrent
import           Control.Monad
import           Data.ByteString       (ByteString)
import qualified Data.ByteString.Char8 as B
import           Data.Vector           (Vector)
import qualified Data.Vector           as V
import           Data.Word
import           Numeric
import           System.Random.MWC
-------------------------------------------------------------------------------


------------------------------------------------------------------------------
-- | High speed, mutable random number generator state
newtype RNG = RNG (MVar GenIO)

------------------------------------------------------------------------------
-- | Perform given action, mutating the RNG state underneath.
withRNG :: RNG
        -> (GenIO -> IO a)
        -> IO a
withRNG (RNG rng) m = withMVar rng m


------------------------------------------------------------------------------
-- | Create a new RNG in the IO monad using 'withSystemRandom'.
mkRNG :: IO RNG
mkRNG = withSystemRandom (newMVar >=> return . RNG)


------------------------------------------------------------------------------
-- | Create a new RNG with a user-specified seed.
seedRNG :: [Word32] -> IO RNG
seedRNG seed = do
    rng <- initialize (V.fromList seed)
    newMVar rng >>= return . RNG


-------------------------------------------------------------------------------
-- | Pack your own rng into the 'RNG' type.
packRNG :: GenIO -> IO RNG
packRNG rng = newMVar rng >>= return . RNG


------------------------------------------------------------------------------
-- | Generates a random salt of given length
randomToken :: Int -> RNG -> IO ByteString
randomToken n rng = do
    is <- withRNG rng $ \gen -> sequence . take n . repeat $ mk gen
    return . B.pack . concat . map (flip showHex "") $ is
  where
    mk :: GenIO -> IO Int
    mk = uniformR (0,15)