sntrup761: bound KeyGen retries on R3 inversion

cbits/sntrup761.c

@@ -719,23 +719,32 @@ Small_random (small * out, void *random_ctx, sntrup761_random_func * random)
 
 /* ----- Streamlined NTRU Prime Core */
 
+/* x^p-x-1 has a degree-19 factor mod 3, so a random g is not invertible in R3
+   with probability about 3^-19; KeyGen_attempts failures in a row mean a broken RNG */
+#define KeyGen_attempts 10
+
 /* h,(f,ginv) = KeyGen() */
-static void
+/* returns 0 if KeyGen succeeded; else -1 */
+static int
 KeyGen (Fq * h, small * f, small * ginv, void *random_ctx,
         sntrup761_random_func * random)
 {
   small g[p];
   Fq finv[p];
+  int i;
 
-  for (;;)
+  for (i = 0; i < KeyGen_attempts; ++i)
     {
       Small_random (g, random_ctx, random);
       if (R3_recip (ginv, g) == 0)
         break;
     }
+  if (i == KeyGen_attempts)
+    return -1;
   Short_random (f, random_ctx, random);
   Rq_recip3 (finv, f);          /* always works */
   Rq_mult_small (h, finv, g);
+  return 0;
 }
 
 /* c = Encrypt(r,h) */
@@ -884,18 +893,21 @@ typedef small Inputs[p];        /* passed by reference */
 #define PublicKeys_bytes Rq_bytes
 
 /* pk,sk = ZKeyGen() */
-static void
+/* returns 0 if KeyGen succeeded; else -1 */
+static int
 ZKeyGen (unsigned char *pk, unsigned char *sk, void *random_ctx,
          sntrup761_random_func * random)
 {
   Fq h[p];
   small f[p], v[p];
 
-  KeyGen (h, f, v, random_ctx, random);
+  if (KeyGen (h, f, v, random_ctx, random) != 0)
+    return -1;
   Rq_encode (pk, h);
   Small_encode (sk, f);
   sk += Small_bytes;
   Small_encode (sk, v);
+  return 0;
 }
 
 /* C = ZEncrypt(r,pk) */
@@ -960,19 +972,21 @@ HashSession (unsigned char *k, int b, const unsigned char *y,
 /* ----- Streamlined NTRU Prime */
 
 /* pk,sk = KEM_KeyGen() */
-void
+int
 sntrup761_keypair (unsigned char *pk, unsigned char *sk, void *random_ctx,
                    sntrup761_random_func * random)
 {
   int i;
 
-  ZKeyGen (pk, sk, random_ctx, random);
+  if (ZKeyGen (pk, sk, random_ctx, random) != 0)
+    return -1;
   sk += SecretKeys_bytes;
   for (i = 0; i < PublicKeys_bytes; ++i)
     *sk++ = pk[i];
   random (random_ctx, Inputs_bytes, sk);
   sk += Inputs_bytes;
   Hash_prefix (sk, 4, pk, PublicKeys_bytes);
+  return 0;
 }
 
 /* c,r_enc = Hide(r,pk,cache); cache is Hash4(pk) */

cbits/sntrup761.h

@@ -19,7 +19,8 @@
 
 typedef void sntrup761_random_func (void *ctx, size_t length, uint8_t *dst);
 
-void
+/* returns 0 on success, -1 if the RNG never produced an invertible polynomial */
+int
 sntrup761_keypair (uint8_t *pk, uint8_t *sk,
                    void *random_ctx, sntrup761_random_func *random);
 

src/Simplex/Messaging/Crypto.hs

@@ -931,6 +931,8 @@ data CryptoError
     CERatchetEarlierMessage Word32
   | -- | duplicate message number
     CERatchetDuplicateMessage
+  | -- | KEM key generation failed, indicating a broken RNG
+    CryptoKEMKeyGenError
   deriving (Eq, Show, Exception)
 
 aesKeySize :: Int

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

@@ -16,6 +16,8 @@ module Simplex.Messaging.Crypto.SNTRUP761.Bindings
   ) where
 
 import Control.Concurrent.STM
+import Control.Exception (throwIO)
+import Control.Monad (when)
 import Crypto.Random (ChaChaDRG)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.Bifunctor (bimap)
@@ -23,6 +25,7 @@ import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
 import Data.ByteString (ByteString)
 import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..))
+import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (rngFuncPtr, withDRG)
@@ -55,14 +58,13 @@ pattern KEMSharedKey s <- KEMSharedKey_ s
 type KEMKeyPair = (KEMPublicKey, KEMSecretKey)
 
 sntrup761Keypair :: TVar ChaChaDRG -> IO KEMKeyPair
-sntrup761Keypair drg =
-  bimap KEMPublicKey_ KEMSecretKey
-    <$> BA.allocRet
-      c_SNTRUP761_SECRETKEY_SIZE
-      ( \skPtr ->
-          BA.alloc c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
-            withDRG drg $ \cxtPtr -> c_sntrup761_keypair pkPtr skPtr cxtPtr rngFuncPtr
-      )
+sntrup761Keypair drg = do
+  ((r, pk), sk) <-
+    BA.allocRet c_SNTRUP761_SECRETKEY_SIZE $ \skPtr ->
+      BA.allocRet c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
+        withDRG drg $ \cxtPtr -> c_sntrup761_keypair pkPtr skPtr cxtPtr rngFuncPtr
+  when (r /= 0) $ throwIO C.CryptoKEMKeyGenError
+  pure (KEMPublicKey_ pk, KEMSecretKey sk)
 
 sntrup761Enc :: TVar ChaChaDRG -> KEMPublicKey -> IO (KEMCiphertext, KEMSharedKey)
 sntrup761Enc drg (KEMPublicKey pk) =

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

@@ -10,9 +10,9 @@ import Foreign
 import Foreign.C
 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);
+-- int 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 -> Ptr RNGContext -> FunPtr RNGFunc -> IO ()
+  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> Ptr RNGContext -> FunPtr RNGFunc -> IO CInt
 
 -- 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"

tests/CoreTests/CryptoTests.hs

@@ -6,8 +6,9 @@
 
 module CoreTests.CryptoTests (cryptoTests) where
 
+import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
 import Control.Concurrent.STM
-import Control.Exception (evaluate)
+import Control.Exception (bracket, evaluate)
 import Control.Monad.Except
 import qualified Data.Aeson as J
 import qualified Data.ByteString.Char8 as B
@@ -22,9 +23,12 @@ import Data.Time.Clock (UTCTime (..))
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Encoding as LE
 import Data.Type.Equality
+import Data.Word (Word8)
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.Validation as XV
+import Foreign (FunPtr, allocaBytes, fillBytes, freeHaskellFunPtr, nullPtr)
+import Foreign.C.Types (CInt, CSize (..))
 import qualified SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
@@ -32,9 +36,12 @@ import Simplex.Messaging.Crypto.BBS
 import Simplex.Messaging.Crypto.Entitlement
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI (c_sntrup761_keypair)
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNGFunc)
 import Simplex.Messaging.Encoding (Large (..), smpDecode, smpEncode)
 import Simplex.Messaging.Encoding.String (strDecode, strEncode)
 import Simplex.Messaging.Transport.Client
+import System.Timeout (timeout)
 import Test.Hspec hiding (fit, it)
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck hiding (Large)
@@ -113,6 +120,7 @@ cryptoTests = do
   describe "sntrup761" $ do
     it "should enc/dec key" testSNTRUP761
     it "should reject malformed KEM encodings" testSNTRUP761RejectsMalformedEncodings
+    it "should fail key generation with degenerate RNG" testSNTRUP761KeypairDegenerateRNG
   describe "BBS+" $ do
     it "should sign and verify" testBBSSignVerify
     it "should derive public key from secret key" testBBSPublicKeyDerivation
@@ -298,6 +306,26 @@ testSNTRUP761 = do
   KEMSharedKey k' <- sntrup761Dec c sk
   k' `shouldBe` k
 
+foreign import ccall "wrapper"
+  mkRNGFunc :: RNGFunc -> IO (FunPtr RNGFunc)
+
+testSNTRUP761KeypairDegenerateRNG :: IO ()
+testSNTRUP761KeypairDegenerateRNG = do
+  -- constant byte 0 draws invertible g = -(1 + x + ... + x^760), byte 0x20 draws g = 0
+  keypairWithConstantRNG 0 `shouldReturn` Just 0
+  keypairWithConstantRNG 0x20 `shouldReturn` Just (-1)
+  where
+    keypairWithConstantRNG :: Word8 -> IO (Maybe CInt)
+    keypairWithConstantRNG b = do
+      result <- newEmptyMVar
+      -- timeout cannot interrupt a foreign call, so the call runs in another thread
+      _ <- forkIO $
+        bracket (mkRNGFunc $ \_ sz buf -> fillBytes buf b (fromIntegral sz)) freeHaskellFunPtr $ \rng ->
+          allocaBytes c_SNTRUP761_PUBLICKEY_SIZE $ \pkPtr ->
+            allocaBytes c_SNTRUP761_SECRETKEY_SIZE $ \skPtr ->
+              c_sntrup761_keypair pkPtr skPtr nullPtr rng >>= putMVar result
+      timeout 10000000 $ takeMVar result
+
 testSNTRUP761RejectsMalformedEncodings :: IO ()
 testSNTRUP761RejectsMalformedEncodings = do
   smpDecode @KEMPublicKey (smpEncode $ Large shortPublicKey) `shouldSatisfy` isLeft