Cryptographic RNG for MLockedSeed

IntersectMBO · Aug 24, 2023 · 71974b9 · 71974b9
1 parent d6db7d9
commit 71974b9
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 2 deletions.
diff --git a/cardano-crypto-class/src/Cardano/Crypto/Libsodium/C.hs b/cardano-crypto-class/src/Cardano/Crypto/Libsodium/C.hs
@@ -29,6 +29,8 @@ module Cardano.Crypto.Libsodium.C (
     c_crypto_sign_ed25519_detached,
     c_crypto_sign_ed25519_verify_detached,
     c_crypto_sign_ed25519_sk_to_pk,
+    -- * RNG
+    c_sodium_randombytes_buf,
     -- * Helpers
     c_sodium_compare,
     -- * Constants
@@ -182,3 +184,6 @@ foreign import capi unsafe "sodium.h crypto_sign_ed25519_sk_to_pk" c_crypto_sign
 --
 -- <https://libsodium.gitbook.io/doc/helpers#comparing-large-numbers>
 foreign import capi unsafe "sodium.h sodium_compare" c_sodium_compare :: Ptr a -> Ptr a -> CSize -> IO Int
+
+-- | @void randombytes_buf(void * const buf, const size_t size);@
+foreign import capi unsafe "sodium/randombytes.h randombytes_buf" c_sodium_randombytes_buf :: Ptr a -> CSize -> IO ()
diff --git a/cardano-crypto-class/src/Cardano/Crypto/Libsodium/MLockedSeed.hs b/cardano-crypto-class/src/Cardano/Crypto/Libsodium/MLockedSeed.hs
@@ -2,7 +2,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Crypto.Libsodium.MLockedSeed
 where
@@ -20,12 +21,16 @@ import Cardano.Crypto.Libsodium.Memory (
   MLockedAllocator,
   mlockedMalloc,
  )
+import Cardano.Crypto.Libsodium.C (
+  c_sodium_randombytes_buf,
+ )
 import Cardano.Foreign (SizedPtr)
 import Control.DeepSeq (NFData)
 import Control.Monad.Class.MonadST (MonadST)
+import Data.Proxy (Proxy (..))
 import Data.Word (Word8)
 import Foreign.Ptr (Ptr)
-import GHC.TypeNats (KnownNat)
+import GHC.TypeNats (KnownNat, natVal)
 import NoThunks.Class (NoThunks)
 
 -- | A seed of size @n@, stored in mlocked memory. This is required to prevent
@@ -66,6 +71,18 @@ mlockedSeedNewZeroWith :: (KnownNat n, MonadST m) => MLockedAllocator m -> m (ML
 mlockedSeedNewZeroWith allocator =
   MLockedSeed <$> mlsbNewZeroWith allocator
 
+mlockedSeedNewRandom :: forall n. (KnownNat n) => IO (MLockedSeed n)
+mlockedSeedNewRandom = mlockedSeedNewRandomWith mlockedMalloc
+
+mlockedSeedNewRandomWith :: forall n. (KnownNat n) => MLockedAllocator IO -> IO (MLockedSeed n)
+mlockedSeedNewRandomWith allocator = do
+  mls <- MLockedSeed <$> mlsbNewZeroWith allocator
+  mlockedSeedUseAsCPtr mls $ \dst -> do
+    c_sodium_randombytes_buf dst size
+  return mls
+  where
+    size = fromIntegral $ natVal (Proxy @n)
+
 mlockedSeedFinalize :: (MonadST m) => MLockedSeed n -> m ()
 mlockedSeedFinalize = mlsbFinalize . mlockedSeedMLSB