dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-05-26 11:56:21 +00:00
Code Issues Packages Projects Releases Wiki Activity

replace sbDecryptNoPad_ with nacl secretBoxOpen

Browse Source
This commit is contained in:
Alexander Bondarenko
2024-06-04 16:32:45 +03:00
parent f63b360d6c
commit c38a14194b
3 changed files with 77 additions and 42 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Crypto.hs
+24 -27
View File
@@ -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 #-}
src/Simplex/Messaging/Crypto/NaCl/Bindings.hs
+6
View File
@@ -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
tests/CoreTests/CryptoTests.hs
+47 -15
View File
@@ -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