-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Handler.Utils.Random
  ( secretBoxCSPRNGT, secretBoxCSPRNGPure
  , secretBoxCSPRNG'
  ) where
  
import Import.NoModel

import qualified Crypto.MAC.KMAC as Crypto
import qualified Crypto.Saltine.Class as Saltine
import Crypto.Hash.Algorithms (SHAKE256)
import Data.ByteArray (ByteArrayAccess)
import qualified Data.ByteArray as BA

import qualified Crypto.Random as Crypto
import Crypto.Error (onCryptoFailure)

import Control.Monad.Random.Lazy (RandT, Rand, evalRandT)


secretBoxCSPRNG' :: forall m m' string ba chunk a.
                    ( MonadSecretBox m
                    , MonadThrow m
                    , Monad m'
                    , ByteArrayAccess string
                    , ByteArrayAccess chunk
                    , LazySequence ba chunk
                    )
                 => (forall b. m' b -> m b)
                 -> string -- ^ Customization string
                 -> ba -- ^ Seed
                 -> RandT ChaChaDRG m' a
                 -> m a
secretBoxCSPRNG' nat str seed act = do
  sBoxKey <- secretBoxKey
  let seed' = toDigest $ kmaclazy str (Saltine.encode sBoxKey) seed
        where toDigest :: Crypto.KMAC (SHAKE256 320) -> ByteString
              toDigest = BA.convert
  csprng <- fmap Crypto.drgNewSeed . onCryptoFailure throwM return $ Crypto.seedFromBinary seed'

  nat $ evalRandT act csprng

secretBoxCSPRNGT :: forall m string ba chunk a.
                    ( MonadSecretBox m
                    , MonadThrow m
                    , ByteArrayAccess string
                    , ByteArrayAccess chunk
                    , LazySequence ba chunk
                    )
                 => string -- ^ Customization string
                 -> ba -- ^ Seed
                 -> RandT ChaChaDRG m a
                 -> m a
secretBoxCSPRNGT = secretBoxCSPRNG' id

secretBoxCSPRNGPure :: forall m string ba chunk a.
                       ( MonadSecretBox m
                       , MonadThrow m
                       , ByteArrayAccess string
                       , ByteArrayAccess chunk
                       , LazySequence ba chunk
                       )
                    => string -- ^ Customization string
                    -> ba -- ^ Seed
                    -> Rand ChaChaDRG a
                    -> m a
secretBoxCSPRNGPure = secretBoxCSPRNG' generalize