bind hsalsa20 and test shared secret compatibility with beforenm

This commit is contained in:
Alexander Bondarenko
2024-06-03 22:26:20 +03:00
parent aed739f6e7
commit 4397e975cd
2 changed files with 50 additions and 2 deletions

View File

@@ -1,6 +1,7 @@
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Simplex.Messaging.Crypto.NaCl.Bindings where
@@ -53,6 +54,7 @@ cryptoBox (C.PublicKeyX25519 pk) (C.PrivateKeyX25519 sk _) (C.CbNonce n) msg = u
where
msg0 = B.replicate crypto_box_ZEROBYTES 0 <> BA.convert msg
-- XXX: crypto_box is a `crypto_box_beforenm`, followed by `crypto_box_afternm`. Where beforenm is a DH+HSalsa.
foreign import capi "tweetnacl.h crypto_box"
c_crypto_box :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt
@@ -83,8 +85,8 @@ 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
dh :: C.PublicKeyX25519 -> C.PrivateKeyX25519 -> Either CryptoError (C.DhSecret C.X25519)
-- | 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 ->
@@ -96,10 +98,51 @@ dh (C.PublicKeyX25519 pub) (C.PrivateKeyX25519 priv _) = unsafePerformIO $ do
then Left (toEnum $ fromIntegral r)
else C.DhSecretX25519 <$> eitherCryptoError (dhSecret ba)
-- 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 ByteString
hsalsa20 (C.DhSecretX25519 key) = unsafePerformIO $ do
(r, ba :: ByteString) <- 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
-- foreign import capi "crypto_box_afternm"
-- c_crypto_box_afternm :: Ptr Word8 -> ConstPtr Word8 -> Word64 -> ConstPtr Word8 -> ConstPtr Word8 -> IO CInt

View File

@@ -7,6 +7,7 @@ module CoreTests.CryptoTests (cryptoTests) where
import Control.Concurrent.STM
import Control.Monad.Except
import qualified Data.ByteArray as BA
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Either (isRight)
@@ -286,6 +287,10 @@ testNaCl = do
naclShared <- either (fail . show) pure $ NaCl.dh aPub bPriv
naclShared `shouldBe` abShared
naclBeforeNm <- either (fail . show) pure $ NaCl.cryptoBoxBeforenm aPub bPriv
abSharedH <- either (fail . show) pure $ NaCl.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