sntrup761 (#865)

* add sntrup761 source

* it compiles

* Wrap bindings in non-FFI types

Test passes with a dummy RNG.

* pass ChaChaDRG via FunPtr

* Add iOS smoke test at createAgentStore

* style

* add "ssl" library dep

Attempt to fix missing _SHA512 symbol on macos.

* remove sha512 wrapper and use openssl directly

* restore names, remove dummy RNG

* Revert "remove sha512 wrapper and use openssl directly"

This reverts commit f9f7781f09.

* restore code from RFC

* shorter names

* enable all tests

* remove run test

---------

Co-authored-by: IC Rainbow <aenor.realm@gmail.com>

cbits/README.md

@@ -0,0 +1,3 @@
+# Streamlined NTRU Prime: sntrup761
+
+The implementation of sntrup761 is the _exact_ copy from this [Internet draft](https://www.ietf.org/archive/id/draft-josefsson-ntruprime-streamlined-00.html).

cbits/sha512.c

@@ -0,0 +1,9 @@
+#include <openssl/sha.h>
+#include "sha512.h"
+
+void crypto_hash_sha512 (unsigned char *out,
+                         const unsigned char *in,
+                         unsigned long long inlen)
+{
+  SHA512(in, inlen, out);
+}

cbits/sha512.h

@@ -0,0 +1,3 @@
+void crypto_hash_sha512 (unsigned char *out,
+                         const unsigned char *in,
+                         unsigned long long inlen);

cbits/sntrup761.h

@@ -0,0 +1,33 @@
+/*
+ * Derived from public domain source, written by (in alphabetical order):
+ * - Daniel J. Bernstein
+ * - Chitchanok Chuengsatiansup
+ * - Tanja Lange
+ * - Christine van Vredendaal
+ */
+
+#ifndef SNTRUP761_H
+#define SNTRUP761_H
+
+#include <string.h>
+#include <stdint.h>
+
+#define SNTRUP761_SECRETKEY_SIZE 1763
+#define SNTRUP761_PUBLICKEY_SIZE 1158
+#define SNTRUP761_CIPHERTEXT_SIZE 1039
+#define SNTRUP761_SIZE 32
+
+typedef void sntrup761_random_func (void *ctx, size_t length, uint8_t *dst);
+
+void
+sntrup761_keypair (uint8_t *pk, uint8_t *sk,
+                   void *random_ctx, sntrup761_random_func *random);
+
+void
+sntrup761_enc (uint8_t *c, uint8_t *k, const uint8_t *pk,
+               void *random_ctx, sntrup761_random_func *random);
+
+void
+sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
+
+#endif /* SNTRUP761_H */

package.yaml

@@ -20,6 +20,8 @@ category: Chat, Network, Web, System, Cryptography
 extra-source-files:
   - README.md
   - CHANGELOG.md
+  - cbits/sha512.h
+  - cbits/sntrup761.h
 
 dependencies:
   - aeson == 2.2.*
@@ -88,6 +90,11 @@ when:
 
 library:
   source-dirs: src
+  c-sources:
+    - cbits/sha512.c
+    - cbits/sntrup761.c
+  include-dirs: cbits
+  extra-libraries: crypto
 
 executables:
   smp-server:

simplexmq.cabal

@@ -26,6 +26,8 @@ build-type:     Simple
 extra-source-files:
     README.md
     CHANGELOG.md
+    cbits/sha512.h
+    cbits/sntrup761.h
 
 flag swift
   description: Enable swift JSON format
@@ -99,6 +101,10 @@ library
       Simplex.Messaging.Crypto.File
       Simplex.Messaging.Crypto.Lazy
       Simplex.Messaging.Crypto.Ratchet
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+      Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
       Simplex.Messaging.Encoding
       Simplex.Messaging.Encoding.String
       Simplex.Messaging.Notifications.Client
@@ -149,6 +155,13 @@ library
   hs-source-dirs:
       src
   ghc-options: -Wall -Wcompat -Werror=incomplete-patterns -Wredundant-constraints -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-type-patterns
+  include-dirs:
+      cbits
+  c-sources:
+      cbits/sha512.c
+      cbits/sntrup761.c
+  extra-libraries:
+      crypto
   build-depends:
       aeson ==2.2.*
     , ansi-terminal >=0.10 && <0.12

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

@@ -0,0 +1,38 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings where
+
+import Data.ByteArray (ScrubbedBytes)
+import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+import Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG (RNG (..))
+
+type PublicKey = ByteString
+
+type SecretKey = ScrubbedBytes
+
+type Ciphertext = ByteString
+
+type Key = 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
+
+sntrup761Enc :: RNG -> PublicKey -> IO (Ciphertext, Key)
+sntrup761Enc RNG {rngContext, rngFunc} 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
+
+sntrup761Dec :: Ciphertext -> SecretKey -> IO Key
+sntrup761Dec c sk =
+  BA.withByteArray sk $ \skPtr ->
+    BA.withByteArray c $ \cPtr ->
+      BA.alloc c_SNTRUP761_SIZE $ \kPtr ->
+        c_sntrup761_dec kPtr cPtr skPtr

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

@@ -0,0 +1,17 @@
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.Defines where
+
+import Foreign.C
+
+#include "sntrup761.h"
+
+c_SNTRUP761_SECRETKEY_SIZE :: Int
+c_SNTRUP761_SECRETKEY_SIZE = #{const SNTRUP761_SECRETKEY_SIZE}
+
+c_SNTRUP761_PUBLICKEY_SIZE :: Int
+c_SNTRUP761_PUBLICKEY_SIZE = #{const SNTRUP761_PUBLICKEY_SIZE}
+
+c_SNTRUP761_CIPHERTEXT_SIZE :: Int
+c_SNTRUP761_CIPHERTEXT_SIZE = #{const SNTRUP761_CIPHERTEXT_SIZE}
+
+c_SNTRUP761_SIZE :: Int
+c_SNTRUP761_SIZE = #{const SNTRUP761_SIZE}

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

@@ -0,0 +1,23 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.FFI
+  ( c_sntrup761_keypair,
+    c_sntrup761_enc,
+    c_sntrup761_dec,
+  ) where
+
+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);
+foreign import ccall "sntrup761_keypair"
+  c_sntrup761_keypair :: Ptr Word8 -> Ptr Word8 -> 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 ()
+
+-- void sntrup761_dec (uint8_t *k, const uint8_t *c, const uint8_t *sk);
+foreign import ccall "sntrup761_dec"
+  c_sntrup761_dec :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ()

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

@@ -0,0 +1,48 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Simplex.Messaging.Crypto.SNTRUP761.Bindings.RNG
+  ( RNG (..),
+    withRNG,
+    createRNG,
+    freeRNG,
+    RNGContext,
+    RNGFunc,
+    mkRNGFunc,
+  ) where
+
+import Foreign
+import Foreign.C
+
+import Crypto.Random (drgNew, randomBytesGenerate)
+import Data.ByteArray (ByteArrayAccess (copyByteArrayToPtr), Bytes)
+import Data.IORef (atomicModifyIORef', newIORef)
+import UnliftIO (bracket)
+
+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
+    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
+
+-- 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)

tests/CoreTests/CryptoTests.hs

@@ -15,6 +15,8 @@ import qualified Data.Text.Lazy as LT
 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
@@ -87,6 +89,8 @@ cryptoTests = do
     describe "Ed448" $ testEncoding C.SEd448
     describe "X25519" $ testEncoding C.SX25519
     describe "X448" $ testEncoding C.SX448
+  describe "sntrup761" $
+    it "should enc/dec key" testSNTRUP761
 
 testPadUnpadFile :: IO ()
 testPadUnpadFile = do
@@ -197,3 +201,9 @@ testEncoding alg = it "should encode / decode key" . ioProperty $ do
   pure $ \(_ :: Int) ->
     C.decodePubKey (C.encodePubKey k) == Right k
       && 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