From c38a14194b0c86fb5bbe2bc678d56109fd699dc5 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Tue, 4 Jun 2024 16:32:45 +0300 Subject: [PATCH] replace sbDecryptNoPad_ with nacl secretBoxOpen --- src/Simplex/Messaging/Crypto.hs | 51 +++++++-------- src/Simplex/Messaging/Crypto/NaCl/Bindings.hs | 6 ++ tests/CoreTests/CryptoTests.hs | 62 ++++++++++++++----- 3 files changed, 77 insertions(+), 42 deletions(-) diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 583b7b520..c7fc139b0 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -186,7 +186,8 @@ module Simplex.Messaging.Crypto unsafeMaxLenBS, appendMaxLenBS, hsalsa20, - cryptoBoxAfternm, + secretBox, + secretBoxOpen, ) where @@ -197,10 +198,8 @@ import Control.Monad.Except import Control.Monad.Trans.Except import Crypto.Cipher.AES (AES256) import qualified Crypto.Cipher.Types as AES -import qualified Crypto.Cipher.XSalsa as XSalsa import qualified Crypto.Error as CE import Crypto.Hash (Digest, SHA256 (..), SHA512 (..), hash, hashDigestSize) -import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 import qualified Crypto.PubKey.Ed25519 as Ed25519 @@ -1215,7 +1214,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 msg = either (error . show) id $ hsalsa20 secret >>= \sk -> cryptoBoxAfternm sk nonce msg +cryptoBox secret nonce msg = either error id $! hsalsa20 secret >>= \sk -> secretBox sk nonce msg -- TODO: fuse -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce. cbDecrypt :: DhSecret X25519 -> CbNonce -> ByteString -> Either CryptoError ByteString @@ -1235,14 +1234,7 @@ sbDecrypt_ secret nonce = unPad <=< sbDecryptNoPad_ secret nonce -- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding). sbDecryptNoPad_ :: ByteArrayAccess key => key -> CbNonce -> ByteString -> Either CryptoError ByteString -sbDecryptNoPad_ secret (CbNonce nonce) packet - | B.length packet < 16 = Left CBDecryptError - | BA.constEq tag' tag = Right msg - | otherwise = Left CBDecryptError - where - (tag', c) = B.splitAt 16 packet - (rs, msg) = xSalsa20 secret nonce c - tag = Poly1305.auth rs c +sbDecryptNoPad_ secret (CbNonce nonce) packet = first (const CBDecryptError) $! hsalsa20 secret >>= \sk -> secretBoxOpen sk nonce packet -- TODO: fuse -- type for authentication scheme using NaCl @crypto_box@ over the sha512 digest of the message. newtype CbAuthenticator = CbAuthenticator ByteString deriving (Eq, Show) @@ -1336,16 +1328,6 @@ unsafeSbKey s = either error id $ sbKey s randomSbKey :: TVar ChaChaDRG -> STM SbKey randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar -xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString) -xSalsa20 secret nonce msg = (rs, msg') - where - zero = B.replicate 16 $ toEnum 0 - (iv0, iv1) = B.splitAt 8 nonce - state0 = XSalsa.initialize 20 secret (zero `B.append` iv0) - state1 = XSalsa.derive state0 iv1 - (rs, state2) = XSalsa.generate state1 32 - (msg', _) = XSalsa.combine state2 msg - publicToX509 :: PublicKey a -> PubKey publicToX509 = \case PublicKeyEd25519 k -> PubKeyEd25519 k @@ -1416,16 +1398,31 @@ hsalsa20 key = unsafePerformIO $ do c_0 = B.replicate 16 '\0' {-# NOINLINE hsalsa20 #-} -cryptoBoxAfternm :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString -cryptoBoxAfternm sk nonce msg = unsafePerformIO $ do +secretBox :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString -- TODO: tag? +secretBox 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 "crypto_box_afternm" else Right (B.drop NaCl.crypto_box_BOXZEROBYTES c) + NaCl.c_crypto_secretbox cPtr (ConstPtr mPtr) (fromIntegral $ B.length msg0) (ConstPtr noncePtr) (ConstPtr skPtr) + pure $! if r /= 0 then Left "crypto_secretbox" 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 #-} +{-# NOINLINE secretBox #-} + +secretBoxOpen :: NaclDhSecret -> ByteString -> ByteString -> Either String ByteString +secretBoxOpen sk nonce ciphertext = unsafePerformIO $ do + (r, m) <- + BA.withByteArray ciphertext0 $ \cPtr -> + BA.withByteArray nonce $ \noncePtr -> + BA.withByteArray sk $ \skPtr -> + BA.allocRet cLen $ \mPtr -> + NaCl.c_crypto_secretbox_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr noncePtr) (ConstPtr skPtr) + pure $! if r /= 0 then Left "crypto_secretbox_open" else Right (B.drop NaCl.crypto_box_ZEROBYTES m) + where + ciphertext0 = boxZeroBytes <> ciphertext + boxZeroBytes = B.replicate NaCl.crypto_box_BOXZEROBYTES '\0' + cLen = B.length ciphertext0 +{-# NOINLINE secretBoxOpen #-} diff --git a/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs b/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs index b5d652843..5d8261915 100644 --- a/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs +++ b/src/Simplex/Messaging/Crypto/NaCl/Bindings.hs @@ -69,6 +69,12 @@ foreign import capi "tweetnacl.h crypto_box_beforenm" foreign import capi "tweetnacl.h crypto_core_hsalsa20" c_crypto_core_hsalsa20 :: Ptr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt +foreign import capi "tweetnacl.h crypto_secretbox" + c_crypto_secretbox :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt + +foreign import capi "tweetnacl.h crypto_secretbox_open" + c_crypto_secretbox_open :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt + -- type NaclDhSecret = C.DhSecret 'C.X25519 type NaclDhSecret = ScrubbedBytes diff --git a/tests/CoreTests/CryptoTests.hs b/tests/CoreTests/CryptoTests.hs index 303780851..ac7759825 100644 --- a/tests/CoreTests/CryptoTests.hs +++ b/tests/CoreTests/CryptoTests.hs @@ -8,7 +8,9 @@ module CoreTests.CryptoTests (cryptoTests) where import Control.Concurrent.STM import Control.Monad.Except +import qualified Crypto.Cipher.XSalsa as XSalsa import qualified Crypto.Error as CE +import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Crypto.PubKey.Curve25519 as X25519 import Data.Bifunctor (bimap) import Data.ByteArray (ScrubbedBytes) @@ -290,30 +292,33 @@ testNaCl = do (aPub :: C.PublicKeyX25519, aPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg (bPub :: C.PublicKeyX25519, bPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair drg let abShared@(C.DhSecretX25519 abShared') = C.dh' aPub bPriv - let baShared = C.dh' bPub aPriv + let baShared@(C.DhSecretX25519 baShared') = C.dh' bPub aPriv abShared `shouldBe` baShared - naclShared <- either fail pure $ dhNacl aPub bPriv + naclShared <- either error pure $ dhNacl aPub bPriv naclShared `shouldBe` abShared - naclBeforeNm <- either fail pure $ cryptoBoxBeforenm aPub bPriv - abSharedH <- either fail pure $ C.hsalsa20 abShared' + naclBeforeNm <- either error pure $ cryptoBoxBeforenm aPub bPriv + abSharedH <- either error pure $ C.hsalsa20 abShared' naclBeforeNm `shouldBe` BA.convert abSharedH let msg = "hello long-enough world" 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 $ C.cryptoBoxAfternm abSharedH nonce' msg + naclCiphertext <- either (error . mappend "cryptoBox: " . show) pure $ cryptoBoxNaCl aPub bPriv nonce msg + let refCiphertext = ref_cryptoBox abShared' nonce' msg + (B.length naclCiphertext, naclCiphertext) `shouldBe` (B.length refCiphertext, refCiphertext) + naclCiphertextAfternm <- either error pure $ C.secretBox 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 + refMsg <- either (error . show) pure $ ref_sbDecryptNoPad_ baShared' nonce naclCiphertext + refMsg `shouldBe` msg - naclMsg <- either (fail . mappend "cryptoBoxOpen: ") pure $ cryptoBoxOpenNaCl bPub aPriv nonce ourCiphertext + naclMsg <- either error pure $ cryptoBoxOpenNaCl bPub aPriv nonce refCiphertext naclMsg `shouldBe` msg + naclMsgAfternm <- either error pure $ C.secretBoxOpen abSharedH nonce' naclCiphertext + naclMsgAfternm `shouldBe` msg + -- | A replica of C.dh' using NaCl (sans hsalsa20 step) dhNacl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either String (C.DhSecret 'C.X25519) dhNacl (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do @@ -348,16 +353,43 @@ cryptoBoxNaCl (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg zeroBytes = B.replicate NaCl.crypto_box_ZEROBYTES '\0' cryptoBoxOpenNaCl :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> C.CbNonce -> ByteString -> Either String ByteString -cryptoBoxOpenNaCl (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) ciphertext = unsafePerformIO $ do +cryptoBoxOpenNaCl (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) (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.withByteArray pub $ \pubPtr -> + BA.withByteArray priv $ \privPtr -> BA.allocRet cLen $ \mPtr -> - NaCl.c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pkPtr) (ConstPtr skPtr) + NaCl.c_crypto_box_open mPtr (ConstPtr cPtr) (fromIntegral cLen) (ConstPtr nPtr) (ConstPtr pubPtr) (ConstPtr privPtr) pure $! if r /= 0 then Left "crypto_box_open" 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 + +ref_cryptoBox :: BA.ByteArrayAccess key => key -> ByteString -> ByteString -> ByteString +ref_cryptoBox secret nonce s = BA.convert tag <> c + where + (rs, c) = ref_xSalsa20 secret nonce s + tag = Poly1305.auth rs c + +-- | NaCl @crypto_box@ decrypt with a shared DH secret and 192-bit nonce (without unpadding). +ref_sbDecryptNoPad_ :: BA.ByteArrayAccess key => key -> C.CbNonce -> ByteString -> Either C.CryptoError ByteString +ref_sbDecryptNoPad_ secret (C.CbNonce nonce) packet + | B.length packet < 16 = Left C.CBDecryptError + | BA.constEq tag' tag = Right msg + | otherwise = Left C.CBDecryptError + where + (tag', c) = B.splitAt 16 packet + (rs, msg) = ref_xSalsa20 secret nonce c + tag = Poly1305.auth rs c + +ref_xSalsa20 :: BA.ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString) +ref_xSalsa20 secret nonce msg = (rs, msg') + where + zero = B.replicate 16 $ toEnum 0 + (iv0, iv1) = B.splitAt 8 nonce + state0 = XSalsa.initialize 20 secret (zero `B.append` iv0) + state1 = XSalsa.derive state0 iv1 + (rs, state2) = XSalsa.generate state1 32 + (msg', _) = XSalsa.combine state2 msg