{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Secure generation of random numbers and 'ByteString's
module Cardano.Crypto.Random
  ( SecureRandom (..),
    deterministic,
    randomNumber,
    randomNumberInRange,
  )
where

import Cardano.Prelude
import Crypto.Number.Basic (numBytes)
import Crypto.Number.Serialize (os2ip)
import Crypto.Random
  ( ChaChaDRG,
    MonadPseudoRandom,
    MonadRandom,
    drgNewSeed,
    getRandomBytes,
    seedFromInteger,
    withDRG,
  )
import Crypto.Random.Entropy (getEntropy)

-- | You can use 'runSecureRandom' on any 'MonadRandom' computation to
-- use the operating  system entropy source to satisfy every request for
-- randomness. That is, this does not use a fixed entropy pool shared across
-- all requests; it gets entropy from the operating  system for every request.
--
-- This is suitable for key generation but is inappropriate for other uses
-- since it can quickly drain the operating system entropy.
newtype SecureRandom a = SecureRandom
  { SecureRandom a -> IO a
runSecureRandom :: IO a
  }
  deriving (a -> SecureRandom b -> SecureRandom a
(a -> b) -> SecureRandom a -> SecureRandom b
(forall a b. (a -> b) -> SecureRandom a -> SecureRandom b)
-> (forall a b. a -> SecureRandom b -> SecureRandom a)
-> Functor SecureRandom
forall a b. a -> SecureRandom b -> SecureRandom a
forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SecureRandom b -> SecureRandom a
$c<$ :: forall a b. a -> SecureRandom b -> SecureRandom a
fmap :: (a -> b) -> SecureRandom a -> SecureRandom b
$cfmap :: forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
Functor, Functor SecureRandom
a -> SecureRandom a
Functor SecureRandom
-> (forall a. a -> SecureRandom a)
-> (forall a b.
    SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b)
-> (forall a b c.
    (a -> b -> c)
    -> SecureRandom a -> SecureRandom b -> SecureRandom c)
-> (forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b)
-> (forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a)
-> Applicative SecureRandom
SecureRandom a -> SecureRandom b -> SecureRandom b
SecureRandom a -> SecureRandom b -> SecureRandom a
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
forall a. a -> SecureRandom a
forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: SecureRandom a -> SecureRandom b -> SecureRandom a
$c<* :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
*> :: SecureRandom a -> SecureRandom b -> SecureRandom b
$c*> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
liftA2 :: (a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
<*> :: SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
$c<*> :: forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
pure :: a -> SecureRandom a
$cpure :: forall a. a -> SecureRandom a
$cp1Applicative :: Functor SecureRandom
Applicative, Applicative SecureRandom
a -> SecureRandom a
Applicative SecureRandom
-> (forall a b.
    SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b)
-> (forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b)
-> (forall a. a -> SecureRandom a)
-> Monad SecureRandom
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
SecureRandom a -> SecureRandom b -> SecureRandom b
forall a. a -> SecureRandom a
forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> SecureRandom a
$creturn :: forall a. a -> SecureRandom a
>> :: SecureRandom a -> SecureRandom b -> SecureRandom b
$c>> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
>>= :: SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
$c>>= :: forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
$cp1Monad :: Applicative SecureRandom
Monad)

instance MonadRandom SecureRandom where
  getRandomBytes :: Int -> SecureRandom byteArray
getRandomBytes Int
n = IO byteArray -> SecureRandom byteArray
forall a. IO a -> SecureRandom a
SecureRandom (Int -> IO byteArray
forall byteArray. ByteArray byteArray => Int -> IO byteArray
getEntropy Int
n)

-- | You can use 'deterministic' on any 'MonadRandom' computation to make it use
--   a seed (hopefully produced by a Really Secure™ randomness source). The seed
--   has to have enough entropy to make this function secure.
deterministic :: ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic :: ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed MonadPseudoRandom ChaChaDRG a
gen = (a, ChaChaDRG) -> a
forall a b. (a, b) -> a
fst ((a, ChaChaDRG) -> a) -> (a, ChaChaDRG) -> a
forall a b. (a -> b) -> a -> b
$ ChaChaDRG -> MonadPseudoRandom ChaChaDRG a -> (a, ChaChaDRG)
forall gen a. DRG gen => gen -> MonadPseudoRandom gen a -> (a, gen)
withDRG ChaChaDRG
chachaSeed MonadPseudoRandom ChaChaDRG a
gen
  where
    chachaSeed :: ChaChaDRG
chachaSeed = Seed -> ChaChaDRG
drgNewSeed (Seed -> ChaChaDRG)
-> (ByteString -> Seed) -> ByteString -> ChaChaDRG
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Seed
seedFromInteger (Integer -> Seed) -> (ByteString -> Integer) -> ByteString -> Seed
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip (ByteString -> ChaChaDRG) -> ByteString -> ChaChaDRG
forall a b. (a -> b) -> a -> b
$ ByteString
seed

-- | Generate a random number in range [0, n)
--
--   We want to avoid modulo bias, so we use the arc4random_uniform
--   implementation (http://stackoverflow.com/a/20051580/615030). Specifically,
--   we repeatedly generate a random number in range [0, 2^x) until we hit on
--   something outside of [0, 2^x mod n), which means that it'll be in range
--   [2^x mod n, 2^x). The amount of numbers in this interval is guaranteed to
--   be divisible by n, and thus applying 'mod' to it will be safe.
randomNumber :: forall m. MonadRandom m => Integer -> m Integer
randomNumber :: Integer -> m Integer
randomNumber Integer
n
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 = Text -> m Integer
forall a. HasCallStack => Text -> a
panic Text
"randomNumber: n <= 0"
  | Bool
otherwise = m Integer
gen
  where
    size :: Int
size = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 (Integer -> Int
numBytes Integer
n) -- size of integers, in bytes
    rangeMod :: Integer
rangeMod = Integer
2 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
n -- 2^x mod n
    gen :: m Integer
    gen :: m Integer
gen = do
      Integer
x <- ByteArrayAccess ByteString => ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip @ByteString (ByteString -> Integer) -> m ByteString -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m ByteString
forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
size
      if Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
rangeMod then m Integer
gen else Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`rem` Integer
n)

-- | Generate a random number in range [a, b]
randomNumberInRange :: MonadRandom m => Integer -> Integer -> m Integer
randomNumberInRange :: Integer -> Integer -> m Integer
randomNumberInRange Integer
a Integer
b
  | Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
b = Text -> m Integer
forall a. HasCallStack => Text -> a
panic Text
"randomNumberInRange: a > b"
  | Bool
otherwise = (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> m Integer -> m Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> m Integer
forall (m :: * -> *). MonadRandom m => Integer -> m Integer
randomNumber (Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1)