hybrid shared secret X25519 + sntrup761 (#881)

* hybrid shared secret X25519 + sntrup761

* use IORef

* enable all tests

* update

* update

* use newtype

* move withDRG

simplexmq.cabal

@@ -101,6 +101,7 @@ library
       Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
       Simplex.Messaging.Crypto.Ratchet
+      Simplex.Messaging.Crypto.SNTRUP761
       Simplex.Messaging.Crypto.SNTRUP761.Bindings
       Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
       Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI

src/Simplex/Messaging/Crypto.hs

@@ -115,6 +115,8 @@ module Simplex.Messaging.Crypto
     cbEncrypt,
     cbEncryptMaxLenBS,
     cbDecrypt,
+    sbDecrypt_,
+    sbEncrypt_,
     cbNonce,
     randomCbNonce,
     pseudoRandomCbNonce,

src/Simplex/Messaging/Crypto/SNTRUP761.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761 where
+
+import Crypto.Hash (Digest, SHA256, hash)
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import Simplex.Messaging.Crypto
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings
+
+-- Hybrid shared secret for crypto_box is defined as SHA256(DHSecret || KEMSharedKey),
+-- similar to https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/
+
+newtype KEMHybridSecret = KEMHybridSecret ScrubbedBytes
+
+-- | NaCl @crypto_box@ decrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
+kcbDecrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Either CryptoError ByteString
+kcbDecrypt (KEMHybridSecret secret) = sbDecrypt_ secret
+
+-- | NaCl @crypto_box@ encrypt with a shared hybrid DH + KEM secret and 192-bit nonce.
+kcbEncrypt :: KEMHybridSecret -> CbNonce -> ByteString -> Int -> Either CryptoError ByteString
+kcbEncrypt (KEMHybridSecret secret) = sbEncrypt_ secret
+
+kemHybridSecret :: DhSecret 'X25519 -> KEMSharedKey -> KEMHybridSecret
+kemHybridSecret (DhSecretX25519 k1) (KEMSharedKey k2) =
+  KEMHybridSecret $ BA.convert (hash $ BA.convert k1 <> k2 :: Digest SHA256)

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings.hs

@@ -1,38 +1,64 @@
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
 
+import Control.Concurrent.STM
+import Crypto.Random (ChaChaDRG)
+import Data.Bifunctor (bimap)
 import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
+import Foreign (nullPtr)
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNG (..))
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (withDRG)
+import Simplex.Messaging.Encoding
+import Simplex.Messaging.Encoding.String
 
-type PublicKey = ByteString
+newtype KEMPublicKey = KEMPublicKey ByteString
 
-type SecretKey = ScrubbedBytes
+newtype KEMSecretKey = KEMSecretKey ScrubbedBytes
 
-type Ciphertext = ByteString
+newtype KEMCiphertext = KEMCiphertext ByteString
 
-type Key = ScrubbedBytes
+newtype KEMSharedKey = KEMSharedKey ScrubbedBytes
 
-sntrup761Keypair :: RNG -> IO (PublicKey, SecretKey)
-sntrup761Keypair RNG {rngContext, rngFunc} = do
-  BA.allocRet c_SNTRUP761_SECRETKEY_SIZE $ \skPtr ->
-    BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
-      c_sntrup761_keypair pkPtr skPtr rngContext rngFunc
+sntrup761Keypair :: TVar ChaChaDRG -> IO (KEMPublicKey, KEMSecretKey)
+sntrup761Keypair drg =
+  bimap KEMPublicKey KEMSecretKey
+    <$> BA.allocRet
+      c_SNTRUP761_SECRETKEY_SIZE
+      ( \skPtr ->
+          BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
+            withDRG drg $ c_sntrup761_keypair pkPtr skPtr nullPtr
+      )
 
-sntrup761Enc :: RNG -> PublicKey -> IO (Ciphertext, Key)
-sntrup761Enc RNG {rngContext, rngFunc} pk =
+sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
+sntrup761Enc drg (KEMPublicKey pk) =
   BA.withByteArray pk $ \pkPtr ->
-    BA.allocRet c_SNTRUP761_SIZE $ \kPtr ->
-      BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
-        c_sntrup761_enc cPtr kPtr pkPtr rngContext rngFunc
+    bimap KEMCiphertext KEMSharedKey
+      <$> BA.allocRet
+        c_SNTRUP761_SIZE
+        ( \kPtr ->
+            BA.alloc c_SNTRUP761_CIPHERTEXT_SIZE $ \cPtr ->
+              withDRG drg $ c_sntrup761_enc cPtr kPtr pkPtr nullPtr
+        )
 
-sntrup761Dec :: Ciphertext -> SecretKey -> IO Key
-sntrup761Dec c sk =
+sntrup761Dec :: KEMCiphertext -> KEMSecretKey -> IO KEMSharedKey
+sntrup761Dec (KEMCiphertext c) (KEMSecretKey sk) =
   BA.withByteArray sk $ \skPtr ->
     BA.withByteArray c $ \cPtr ->
-      BA.alloc c_SNTRUP761_SIZE $ \kPtr ->
-        c_sntrup761_dec kPtr cPtr skPtr
+      KEMSharedKey
+        <$> BA.alloc c_SNTRUP761_SIZE (\kPtr -> c_sntrup761_dec kPtr cPtr skPtr)
+
+instance Encoding KEMPublicKey where
+  smpEncode (KEMPublicKey pk) = smpEncode (BA.convert pk :: ByteString)
+  smpP = KEMPublicKey . BA.convert <$> smpP @ByteString
+
+instance StrEncoding KEMPublicKey where
+  strEncode (KEMPublicKey pk) = strEncode (BA.convert pk :: ByteString)
+  strP = KEMPublicKey . BA.convert <$> strP @ByteString
+
+instance Encoding KEMCiphertext where
+  smpEncode (KEMCiphertext c) = smpEncode (BA.convert c :: ByteString)
+  smpP = KEMCiphertext . BA.convert <$> smpP @ByteString

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings/Defines.hsc

@@ -1,7 +1,5 @@
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines where
 
-import Foreign.C
-
 #include "sntrup761.h"
 
 c_SNTRUP761_SECRETKEY_SIZE :: Int

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings/FFI.hs

@@ -12,11 +12,11 @@ import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNGContext, RNGFunc)
 
 -- void sntrup761_keypair (uint8_t *pk, uint8_t *sk, void *random_ctx, sntrup761_random_func *random);
 foreign import ccall "sntrup761_keypair"
-  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> RNGContext -> FunPtr RNGFunc -> IO ()
+  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
 
 -- void sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk, void *random_ctx, sntrup761_random_func *random);
 foreign import ccall "sntrup761_enc"
-  c_sntrup761_enc :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> RNGContext -> FunPtr RNGFunc -> IO ()
+  c_sntrup761_enc :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
 
 -- void sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
 foreign import ccall "sntrup761_dec"

src/Simplex/Messaging/Crypto/SNTRUP761/Bindings/RNG.hs

@@ -1,45 +1,27 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
 module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
-  ( RNG (..),
-    withRNG,
-    createRNG,
-    freeRNG,
+  ( withDRG,
     RNGContext,
     RNGFunc,
-    mkRNGFunc,
   ) where
 
+import Control.Concurrent.STM
+import Control.Exception (bracket)
+import Crypto.Random (ChaChaDRG)
+import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr))
 import Foreign
 import Foreign.C
+import qualified Simplex.Messaging.Crypto as C
 
-import Crypto.Random (drgNew, randomBytesGenerate)
-import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr), Bytes)
-import Data.IORef (atomicModifyIORef', newIORef)
-import UnliftIO (bracket)
+withDRG :: TVar ChaChaDRG -> (FunPtr RNGFunc -> IO a) -> IO a
+withDRG drg = bracket (createRNGFunc drg) freeHaskellFunPtr
 
-data RNG = RNG
-  { rngContext :: RNGContext,
-    rngFunc :: FunPtr RNGFunc
-  }
-
-withRNG :: (RNG -> IO c) -> IO c
-withRNG = bracket createRNG freeRNG
-
-createRNG :: IO RNG
-createRNG = do
-  chachaState <- drgNew >>= newIORef -- XXX: ctxPtr could be used to store drg state, but cryptonite doesn't provide ByteAccess for ChaChaDRG
-  rngFunc <- mkRNGFunc $ \_ctxPtr sz buf -> do
-    bs <- atomicModifyIORef' chachaState $ swap . randomBytesGenerate (fromIntegral sz) :: IO Bytes
+createRNGFunc :: TVar ChaChaDRG -> IO (FunPtr RNGFunc)
+createRNGFunc drg =
+  mkRNGFunc $ \_ctx sz buf -> do
+    bs <- atomically $ C.pseudoRandomBytes (fromIntegral sz) drg
     copyByteArrayToPtr bs buf
-  pure RNG {rngContext = nullPtr, rngFunc}
-  where
-    swap (a, b) = (b, a)
 
-freeRNG :: RNG -> IO ()
-freeRNG RNG {rngFunc} = freeHaskellFunPtr rngFunc
-
-type RNGContext = Ptr RNG
+type RNGContext = ()
 
 -- typedef void random_func (void *ctx, size_t length, uint8_t *dst);
 type RNGFunc = Ptr RNGContext -> CSize -> Ptr Word8 -> IO ()

tests/CoreTests/CryptoTests.hs

@@ -3,8 +3,9 @@
 
 module CoreTests.CryptoTests (cryptoTests) where
 
+import Control.Concurrent.STM
 import Control.Monad.Except
-import Crypto.Random (getRandomBytes)
+import Crypto.Random (drgNew, getRandomBytes)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (isRight)
@@ -16,7 +17,6 @@ import qualified Data.Text.Lazy.Encoding as LE
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
-import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -203,7 +203,9 @@ testEncoding alg = it "should encode / decode key" . ioProperty $ do
       && C.decodePrivKey (C.encodePrivKey pk) == Right pk
 
 testSNTRUP761 :: IO ()
-testSNTRUP761 = withRNG $ \rng -> do
-  (pk, sk) <- sntrup761Keypair rng
-  (c, k) <- sntrup761Enc rng pk
-  sntrup761Dec c sk `shouldReturn` k
+testSNTRUP761 = do
+  drg <- newTVarIO =<< drgNew
+  (pk, sk) <- sntrup761Keypair drg
+  (c, KEMSharedKey k) <- sntrup761Enc drg pk
+  KEMSharedKey k' <- sntrup761Dec c sk
+  k' `shouldBe` k