{-# 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 -> 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
$cfmap :: forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
fmap :: forall a b. (a -> b) -> SecureRandom a -> SecureRandom b
$c<$ :: forall a b. a -> SecureRandom b -> SecureRandom a
<$ :: forall a b. a -> SecureRandom b -> SecureRandom a
Functor, Functor SecureRandom
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
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
$cpure :: forall a. a -> SecureRandom a
pure :: forall a. a -> SecureRandom a
$c<*> :: forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
<*> :: forall a b.
SecureRandom (a -> b) -> SecureRandom a -> SecureRandom b
$cliftA2 :: forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
liftA2 :: forall a b c.
(a -> b -> c) -> SecureRandom a -> SecureRandom b -> SecureRandom c
$c*> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
*> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
$c<* :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
<* :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom a
Applicative, Applicative SecureRandom
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
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
$c>>= :: forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
>>= :: forall a b.
SecureRandom a -> (a -> SecureRandom b) -> SecureRandom b
$c>> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
>> :: forall a b. SecureRandom a -> SecureRandom b -> SecureRandom b
$creturn :: forall a. a -> SecureRandom a
return :: forall a. a -> SecureRandom a
Monad)

instance MonadRandom SecureRandom where
  getRandomBytes :: forall byteArray.
ByteArray byteArray =>
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 :: forall a. 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 b c a. (b -> c) -> (a -> b) -> a -> c
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 b c a. (b -> c) -> (a -> b) -> a -> c
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 :: forall (m :: * -> *). MonadRandom m => 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 <- 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 byteArray. ByteArray byteArray => Int -> m byteArray
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 a. a -> m a
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 :: forall (m :: * -> *).
MonadRandom m =>
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)