71 lines
2.4 KiB
Haskell
71 lines
2.4 KiB
Haskell
-- 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
|