{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# 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.
type SecureRandom :: Type -> Type
newtype SecureRandom a = SecureRandom
  { forall a. SecureRandom a -> IO a
runSecureRandom :: IO a
  }
  deriving (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
<$ :: forall a b. a -> SecureRandom b -> SecureRandom a
$c<$ :: forall a b. a -> SecureRandom b -> SecureRandom a
fmap :: forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
$cfmap :: forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
Functor, Functor SecureRandom
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
<* :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
$c<* :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
*> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
$c*> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
liftA2 :: forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
$cliftA2 :: forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
<*> :: forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
$c<*> :: forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
pure :: forall a. a -> SecureRandom a
$cpure :: forall a. a -> SecureRandom a
Applicative, Applicative SecureRandom
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 :: forall a. a -> SecureRandom a
$creturn :: forall a. a -> SecureRandom a
>> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
$c>> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
>>= :: forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
$c>>= :: forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
Monad)

instance MonadRandom SecureRandom where
  getRandomBytes :: forall byteArray.
ByteArray byteArray =>
Int -> SecureRandom byteArray
getRandomBytes Int
n = forall a. IO a -> SecureRandom a
SecureRandom (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 :: forall a. ByteString -> MonadPseudoRandom ChaChaDRG a -> a
deterministic ByteString
seed MonadPseudoRandom ChaChaDRG a
gen = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall ba. ByteArrayAccess ba => ba -> Integer
os2ip 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 :: forall (m :: * -> *). MonadRandom m => Integer -> m Integer
randomNumber Integer
n
  | Integer
n forall a. Ord a => a -> a -> Bool
<= Integer
0 = forall a. HasCallStack => Text -> a
panic Text
"randomNumber: n <= 0"
  | Bool
otherwise = m Integer
gen
  where
    size :: Int
size = 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 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
size forall a. Num a => a -> a -> a
* Int
8) forall a. Integral a => a -> a -> a
`rem` Integer
n -- 2^x mod n
    gen :: m Integer
    gen :: m Integer
gen = do
      Integer
x <- forall ba. ByteArrayAccess ba => ba -> Integer
os2ip @ByteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
size
      if Integer
x forall a. Ord a => a -> a -> Bool
< Integer
rangeMod then m Integer
gen else forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
x 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 :: forall (m :: * -> *).
MonadRandom m =>
Integer -> Integer -> m Integer
randomNumberInRange Integer
a Integer
b
  | Integer
a forall a. Ord a => a -> a -> Bool
> Integer
b = forall a. HasCallStack => Text -> a
panic Text
"randomNumberInRange: a > b"
  | Bool
otherwise = (Integer
a forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadRandom m => Integer -> m Integer
randomNumber (Integer
b forall a. Num a => a -> a -> a
- Integer
a forall a. Num a => a -> a -> a
+ Integer
1)