replace cryptoBox with nacl afternm

src/Simplex/Messaging/Crypto.hs

@@ -185,6 +185,8 @@ module Simplex.Messaging.Crypto
     maxLenBS,
     unsafeMaxLenBS,
     appendMaxLenBS,
+    hsalsa20,
+    cryptoBoxAfternm,
   )
 where
 
@@ -228,12 +230,15 @@ import Data.X509
 import Data.X509.Validation (Fingerprint (..), getFingerprint)
 import Database.SQLite.Simple.FromField (FromField (..))
 import Database.SQLite.Simple.ToField (ToField (..))
+import Foreign.C.ConstPtr (ConstPtr (..))
 import GHC.TypeLits (ErrorMessage (..), KnownNat, Nat, TypeError, natVal, type (+))
 import Network.Transport.Internal (decodeWord16, encodeWord16)
+import qualified Simplex.Messaging.Crypto.NaCl.Bindings as NaCl
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (blobFieldDecoder, parseAll, parseString)
 import Simplex.Messaging.Util ((<$?>))
+import System.IO.Unsafe (unsafePerformIO)
 
 -- | Cryptographic algorithms.
 data Algorithm = Ed25519 | Ed448 | X25519 | X448
@@ -1210,10 +1215,7 @@ cbEncryptMaxLenBS :: KnownNat i => DhSecret X25519 -> CbNonce -> MaxLenBS i -> B
 cbEncryptMaxLenBS (DhSecretX25519 secret) (CbNonce nonce) = cryptoBox secret nonce . unMaxLenBS . padMaxLenBS
 
 cryptoBox :: ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString
-cryptoBox secret nonce s = BA.convert tag <> c
-  where
-    (rs, c) = xSalsa20 secret nonce s
-    tag = Poly1305.auth rs c
+cryptoBox secret nonce msg = either (error . show) id $ hsalsa20 secret >>= \sk -> cryptoBoxAfternm sk nonce msg
 
 -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce.
 cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString
@@ -1392,3 +1394,44 @@ keyError :: (a, [ASN1]) -> Either String b
 keyError = \case
   (_, []) -> Left "unknown key algorithm"
   _ -> Left "more than one key"
+
+type NaclDhSecret = BA.ScrubbedBytes
+
+-- type NaclDhSecret = C.DhSecret 'C.X25519h -- hashed DH used by NaCl "afternm" functions.
+
+-- Run salsa20 in a hash mode to make our DH keys match 'c_crypto_box_beforenm' output.
+hsalsa20 :: ByteArrayAccess key => key -> Either CE.CryptoError NaclDhSecret
+hsalsa20 key = unsafePerformIO $ do
+  (r, ba :: NaclDhSecret) <- BA.withByteArray c_0 $ \inpPtr ->
+    BA.withByteArray key $ \keyPtr ->
+      BA.withByteArray sigma $ \sigmaPtr ->
+        BA.allocRet 32 $ \outPtr ->
+          NaCl.c_crypto_core_hsalsa20 outPtr (ConstPtr inpPtr) (ConstPtr keyPtr) (ConstPtr sigmaPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else Right ba
+  where
+    -- sigma[16] = "expand 32-byte k";
+    sigma :: ByteString
+    sigma = "expand 32-byte k"
+    c_0 :: ByteString
+    c_0 = B.replicate 16 '\0'
+{-# NOINLINE hsalsa20 #-}
+
+cryptoBoxAfternm :: NaclDhSecret -> ByteString -> ByteString -> Either CE.CryptoError ByteString
+cryptoBoxAfternm sk nonce msg = unsafePerformIO $ do
+  (r, c) <-
+    BA.withByteArray msg0 $ \mPtr ->
+      BA.withByteArray nonce $ \noncePtr ->
+        BA.withByteArray sk $ \skPtr ->
+          BA.allocRet (B.length msg0) $ \cPtr ->
+            NaCl.c_crypto_box_afternm cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr noncePtr) (ConstPtr skPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c)
+  where
+    zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0'
+    msg0 = zeroBytes <> BA.convert msg
+{-# NOINLINE cryptoBoxAfternm #-}

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

@@ -1,23 +1,17 @@
 {-# LANGUAGE CApiFFI #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use camelCase" #-}
 
 module Simplex.Messaging.Crypto.NaCl.Bindings where
 
-import Crypto.Error (CryptoError, eitherCryptoError)
-import Crypto.PubKey.Curve25519 (dhSecret)
 import Data.ByteArray (ScrubbedBytes)
-import qualified Data.ByteArray as BA
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as B
-import Data.Memory.PtrMethods (memSet)
 import Foreign
 import Foreign.C.ConstPtr
 import Foreign.C.Types
-import GHC.IO (unsafePerformIO)
-import qualified Simplex.Messaging.Crypto as C
 
 crypto_box_PUBLICKEYBYTES :: Num a => a
 crypto_box_PUBLICKEYBYTES = 32
@@ -37,23 +31,6 @@ crypto_box_ZEROBYTES = 32
 crypto_box_BOXZEROBYTES :: Num a => a
 crypto_box_BOXZEROBYTES = 16
 
--- XXX: message should be ScrubbedBytes or something like that
-cryptoBox :: BA.ByteArrayAccess msg => C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> msg -> Either Int ByteString
-cryptoBox (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = unsafePerformIO $ do
-  (r, c) <-
-    BA.withByteArray msg0 $ \mPtr ->
-      BA.withByteArray n $ \nPtr ->
-        BA.withByteArray pk $ \pkPtr ->
-          BA.withByteArray sk $ \skPtr ->
-            BA.allocRet (B.length msg0) $ \cPtr ->
-              c_crypto_box cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
-  pure $
-    if r /= 0
-      then Left (fromIntegral r)
-      else Right (B.drop crypto_box_BOXZEROBYTES c)
-  where
-    msg0 = B.replicate crypto_box_ZEROBYTES 0 <> BA.convert msg
-
 -- int crypto_box(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *y,const u8 *x)
 -- {
 --   u8 k[32];
@@ -63,23 +40,6 @@ cryptoBox (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = u
 foreign import capi "tweetnacl.h crypto_box"
   c_crypto_box :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
-cryptoBoxOpen :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> Either Int ByteString
-cryptoBoxOpen (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) ciphertext = unsafePerformIO $ do
-  (r, msg) <-
-    BA.withByteArray ciphertext0 $ \cPtr ->
-      BA.withByteArray n $ \nPtr ->
-        BA.withByteArray pk $ \pkPtr ->
-          BA.withByteArray sk $ \skPtr ->
-            BA.allocRet cLen $ \mPtr ->
-              c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
-  pure $
-    if r /= 0
-      then Left (fromIntegral r)
-      else Right (B.drop crypto_box_ZEROBYTES msg)
-  where
-    ciphertext0 = B.replicate crypto_box_BOXZEROBYTES 0 <> ciphertext
-    cLen = B.length ciphertext0
-
 -- int crypto_box_open(u8 *m,const u8 *c,u64 d,const u8 *n,const u8 *y,const u8 *x)
 -- {
 --   u8 k[32];
@@ -96,81 +56,22 @@ foreign import capi "crypto_box_open"
 foreign import capi "tweetnacl.h crypto_scalarmult"
   crypto_scalarmult :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
--- | A replica of C.dh' using NaCl (sans hsalsa20 step)
-dh :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either CryptoError (C.DhSecret 'C.X25519)
-dh (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
-  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
-    BA.withByteArray priv $ \privPtr ->
-      BA.allocRet 32 $ \sharedPtr -> do
-        memSet sharedPtr 0 32
-        crypto_scalarmult sharedPtr (ConstPtr privPtr) (ConstPtr pubPtr)
-  pure $
-    if r /= 0
-      then Left (toEnum $ fromIntegral r)
-      else C.DhSecretX25519 <$> eitherCryptoError (dhSecret ba)
-
+-- XXX: does NOT result in the same DH key we/crypton use as it throws HSalsa20 at the result of the scalarmult op above
 -- int crypto_box_beforenm(u8 *k,const u8 *y,const u8 *x)
 -- {
 --   u8 s[32];
 --   crypto_scalarmult(s,x,y);
 --   return crypto_core_hsalsa20(k,_0,s,sigma);
 -- }
-cryptoBoxBeforenm :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either CryptoError ScrubbedBytes
-cryptoBoxBeforenm (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
-  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
-    BA.withByteArray priv $ \privPtr ->
-      BA.allocRet 32 $ \kPtr -> do
-        memSet kPtr 0 32
-        c_crypto_box_beforenm kPtr (ConstPtr pubPtr) (ConstPtr privPtr)
-  pure $
-    if r /= 0
-      then Left (toEnum $ fromIntegral r)
-      else Right ba
-
--- XXX: does NOT result in the same DH key we/crypton use as it throws HSalsa20 at the result of the scalarmult op above
 foreign import capi "tweetnacl.h crypto_box_beforenm"
   c_crypto_box_beforenm :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
--- Run salsa20 in a hash mode to make our DH keys match 'c_crypto_box_beforenm' output.
-hsalsa20 :: C.DhSecret 'C.X25519 -> Either CryptoError NaclDhSecret
-hsalsa20 (C.DhSecretX25519 key) = unsafePerformIO $ do
-  (r, ba :: NaclDhSecret) <- BA.withByteArray c_0 $ \inpPtr ->
-    BA.withByteArray key $ \keyPtr ->
-      BA.withByteArray sigma $ \sigmaPtr ->
-      BA.allocRet 32 $ \outPtr ->
-        c_crypto_core_hsalsa20 outPtr (ConstPtr inpPtr) (ConstPtr keyPtr) (ConstPtr sigmaPtr)
-  pure $
-    if r /= 0
-      then Left (toEnum $ fromIntegral r)
-      else Right ba
-  where
-    -- sigma[16] = "expand 32-byte k";
-    sigma :: ByteString
-    sigma = "expand 32-byte k"
-    c_0 :: ByteString
-    c_0 = B.replicate 16 0
-
 foreign import capi "tweetnacl.h crypto_core_hsalsa20"
   c_crypto_core_hsalsa20 :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
 
 -- type NaclDhSecret = C.DhSecret 'C.X25519
 type NaclDhSecret = ScrubbedBytes
 
-cryptoBoxAfternm :: BA.ByteArrayAccess msg => NaclDhSecret -> C.CbNonce -> msg -> Either Int ByteString
-cryptoBoxAfternm sk (C.CbNonce n) msg = unsafePerformIO $ do
-  (r, c) <-
-    BA.withByteArray msg0 $ \mPtr ->
-      BA.withByteArray n $ \nPtr ->
-          BA.withByteArray sk $ \skPtr ->
-            BA.allocRet (B.length msg0) $ \cPtr ->
-              c_crypto_box_afternm cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr nPtr) (ConstPtr skPtr)
-  pure $
-    if r /= 0
-      then Left (fromIntegral r)
-      else Right (B.drop crypto_box_BOXZEROBYTES c)
-  where
-    msg0 = B.replicate crypto_box_ZEROBYTES 0 <> BA.convert msg
-
 -- int crypto_box_afternm(u8 *c,const u8 *m,u64 d,const u8 *n,const u8 *k)
 -- {
 --   return crypto_secretbox(c,m,d,n,k);

tests/CoreTests/CryptoTests.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -7,11 +8,16 @@ module CoreTests.CryptoTests (cryptoTests) where
 
 import Control.Concurrent.STM
 import Control.Monad.Except
+import qualified Crypto.Error as CE
+import qualified Crypto.PubKey.Curve25519 as X25519
+import Data.ByteArray (ScrubbedBytes)
 import qualified Data.ByteArray as BA
+import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Either (isRight)
 import Data.Int (Int64)
+import Data.Memory.PtrMethods (memSet)
 import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.Lazy as LT
@@ -20,12 +26,14 @@ import Data.Type.Equality
 import qualified Data.X509 as X
 import qualified Data.X509.CertificateStore as XS
 import qualified Data.X509.Validation as XV
+import Foreign.C.ConstPtr (ConstPtr (..))
 import qualified SMPClient
 import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import qualified Simplex.Messaging.Crypto.NaCl.Bindings as NaCl
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Transport.Client
+import System.IO.Unsafe (unsafePerformIO)
 import Test.Hspec
 import Test.Hspec.QuickCheck (modifyMaxSuccess)
 import Test.QuickCheck
@@ -102,7 +110,7 @@ cryptoTests = do
     it "should validate certificates" testValidateX509
   describe "sntrup761" $
     it "should enc/dec key" testSNTRUP761
-  fdescribe "NaCl" $
+  describe "NaCl" $
     it "cryptobox is compatible" testNaCl
 
 instance Eq C.APublicKey where
@@ -280,27 +288,87 @@ testNaCl = do
   drg <- C.newRandom
   (aPub :: C.PublicKeyX25519, aPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg
   (bPub :: C.PublicKeyX25519, bPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg
-  let abShared = C.dh' aPub bPriv
+  let abShared@(C.DhSecretX25519 abShared') = C.dh' aPub bPriv
   let baShared = C.dh' bPub aPriv
   abShared `shouldBe` baShared
 
-  naclShared <- either (fail . show) pure $ NaCl.dh aPub bPriv
+  naclShared <- either (fail . show) pure $ dhNacl aPub bPriv
   naclShared `shouldBe` abShared
 
-  naclBeforeNm <- either (fail . show) pure $ NaCl.cryptoBoxBeforenm aPub bPriv
-  abSharedH <- either (fail . show) pure $ NaCl.hsalsa20 abShared
+  naclBeforeNm <- either (fail . show) pure $ cryptoBoxBeforenm aPub bPriv
+  abSharedH <- either (fail . show) pure $ C.hsalsa20 abShared'
   naclBeforeNm `shouldBe` BA.convert abSharedH
 
   let msg = "hello long-enough world"
-  nonce <- atomically $ C.randomCbNonce drg
-  naclCiphertext <- either (fail . mappend "cryptoBox: " . show) pure $ NaCl.cryptoBox aPub bPriv nonce msg
+  nonce@(C.CbNonce nonce') <- atomically $ C.randomCbNonce drg
+  naclCiphertext <- either (fail . mappend "cryptoBox: " . show) pure $ cryptoBoxNaCl aPub bPriv nonce msg
   let ourCiphertext = C.cbEncryptNoPad abShared nonce msg
   (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length ourCiphertext, ourCiphertext)
-  naclCiphertextAfternm <- either (fail . mappend "cryptoBox: " . show) pure $ NaCl.cryptoBoxAfternm abSharedH nonce msg
+  naclCiphertextAfternm <- either (fail . mappend "cryptoBox: " . show) pure $ C.cryptoBoxAfternm abSharedH nonce' msg
   (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length naclCiphertextAfternm, naclCiphertextAfternm)
 
   ourMsg <- either (fail . show) pure $ C.cbDecryptNoPad baShared nonce naclCiphertext
   ourMsg `shouldBe` msg
 
-  naclMsg <- either (fail . mappend "cryptoBoxOpen: " . show) pure $ NaCl.cryptoBoxOpen bPub aPriv nonce ourCiphertext
+  naclMsg <- either (fail . mappend "cryptoBoxOpen: " . show) pure $ cryptoBoxOpenNaCl bPub aPriv nonce ourCiphertext
   naclMsg `shouldBe` msg
+
+-- | A replica of C.dh' using NaCl (sans hsalsa20 step)
+dhNacl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either CE.CryptoError (C.DhSecret 'C.X25519)
+dhNacl (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
+  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
+    BA.withByteArray priv $ \privPtr ->
+      BA.allocRet 32 $ \sharedPtr -> do
+        memSet sharedPtr 0 32
+        NaCl.crypto_scalarmult sharedPtr (ConstPtr privPtr) (ConstPtr pubPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else C.DhSecretX25519 <$> CE.eitherCryptoError (X25519.dhSecret ba)
+
+cryptoBoxBeforenm :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either CE.CryptoError ScrubbedBytes
+cryptoBoxBeforenm (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
+  (r, ba :: ScrubbedBytes) <- BA.withByteArray pub $ \pubPtr ->
+    BA.withByteArray priv $ \privPtr ->
+      BA.allocRet 32 $ \kPtr -> do
+        memSet kPtr 0 32
+        NaCl.c_crypto_box_beforenm kPtr (ConstPtr pubPtr) (ConstPtr privPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else Right ba
+
+cryptoBoxNaCl :: BA.ByteArrayAccess msg => C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> msg -> Either Int ByteString
+cryptoBoxNaCl (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = unsafePerformIO $ do
+  (r, c) <-
+    BA.withByteArray msg0 $ \mPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pk $ \pkPtr ->
+          BA.withByteArray sk $ \skPtr ->
+            BA.allocRet (B.length msg0) $ \cPtr ->
+              NaCl.c_crypto_box cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c)
+  where
+    msg0 = zeroBytes <> BA.convert msg
+    zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0'
+
+cryptoBoxOpenNaCl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> Either CE.CryptoError ByteString
+cryptoBoxOpenNaCl (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) ciphertext = unsafePerformIO $ do
+  (r, msg) <-
+    BA.withByteArray ciphertext0 $ \cPtr ->
+      BA.withByteArray n $ \nPtr ->
+        BA.withByteArray pk $ \pkPtr ->
+          BA.withByteArray sk $ \skPtr ->
+            BA.allocRet cLen $ \mPtr ->
+              NaCl.c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr)
+  pure $
+    if r /= 0
+      then Left (toEnum $ fromIntegral r)
+      else Right (B.drop NaCl.crypto_box_ZEROBYTES msg)
+  where
+    ciphertext0 = boxZeroBytes <> ciphertext
+    boxZeroBytes = B.replicate NaCl.crypto_box_BOXZEROBYTES '\0'
+    cLen = B.length ciphertext0