mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-01 07:26:05 +00:00
bind hsalsa20 and test shared secret compatibility with beforenm
This commit is contained in:
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user