dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-03-29 16:39:58 +00:00
Code Issues Packages Projects Releases Wiki Activity

smp agent: use static RNG function to avoid dynamic C stub created by Haskell FFI wrapper (#1556)

Browse Source
This commit is contained in:
Evgeny
2025-06-02 20:11:27 +01:00
committed by GitHub
parent 56851365b1
commit 90e8c3adf6
2 changed files with 14 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
src/Simplex/Messaging/Crypto/SNTRUP761/Bindings.hs
View File

@@ -10,11 +10,10 @@ import Data.Bifunctor (bimap)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
import Foreign (nullPtr)
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (rngFuncPtr, withDRG)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
@@ -43,7 +42,7 @@ sntrup761Keypair drg =
c_SNTRUP761_SECRETKEY_SIZE
( \skPtr ->
BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
withDRG drg $ \cxtPtr -> c_sntrup761_keypair pkPtr skPtr cxtPtr rngFuncPtr
)
sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
@@ -54,7 +53,7 @@ sntrup761Enc drg (KEMPublicKey pk) =
c_SNTRUP761_SIZE
( \kPtr ->
BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
withDRG drg $ c_sntrup761_enc cPtr kPtr pkPtr nullPtr
withDRG drg $ \cxtPtr -> c_sntrup761_enc cPtr kPtr pkPtr cxtPtr rngFuncPtr
)
sntrup761Dec :: KEMCiphertext -> KEMSecretKey -> IO KEMSharedKey

20
src/Simplex/Messaging/Crypto/SNTRUP761/Bindings/RNG.hs
View File

@@ -1,5 +1,6 @@
module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
( withDRG,
rngFuncPtr,
RNGContext,
RNGFunc,
) where
@@ -12,19 +13,20 @@ import Foreign
import Foreign.C
import qualified Simplex.Messaging.Crypto as C
withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
withDRG :: TVar ChaChaDRG -> (Ptr RNGContext -> IO a) -> IO a
withDRG drg = bracket (castStablePtrToPtr <$> newStablePtr drg) (freeStablePtr . castPtrToStablePtr)
createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
createRNGFunc drg =
mkRNGFunc $ \_ctx sz buf -> do
bs <- atomically $ C.randomBytes (fromIntegral sz) drg
copyByteArrayToPtr bs buf
rngFunc :: RNGFunc
rngFunc cxt sz buf = do
drg <- deRefStablePtr $ castPtrToStablePtr cxt
bs <- atomically $ C.randomBytes (fromIntegral sz) drg
copyByteArrayToPtr bs buf
type RNGContext = ()
-- typedef void random_func (void *ctx, size_t length, uint8_t *dst);
type RNGFunc = Ptr RNGContext -> CSize -> Ptr Word8 -> IO ()
foreign import ccall "wrapper"
mkRNGFunc :: RNGFunc -> IO (FunPtr RNGFunc)
foreign export ccall "haskell_rng_func" rngFunc :: RNGFunc
foreign import ccall "&haskell_rng_func" rngFuncPtr :: FunPtr RNGFunc