From 6f9dddd527fa9a3a19413fe8ae30d45f0eed8896 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Tue, 4 Jun 2024 13:08:52 +0300 Subject: [PATCH] replace cryptoBox with nacl afternm --- src/Simplex/Messaging/Crypto.hs | 51 ++++++++- src/Simplex/Messaging/Crypto/NaCl/Bindings.hs | 107 +----------------- tests/CoreTests/CryptoTests.hs | 86 ++++++++++++-- 3 files changed, 128 insertions(+), 116 deletions(-) diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 7aefbd709..1fafbc257 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/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 #-} diff --git a/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs b/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs index 921bf87ba..b5d652843 100644 --- a/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs +++ b/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); diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index 1908d98dc..03fbf0351 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/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