diff --git a/protocol/xrcp.md b/protocol/xrcp.md index 2ed2c8d62..c8042f858 100644 --- a/protocol/xrcp.md +++ b/protocol/xrcp.md @@ -67,7 +67,7 @@ The session invitation contains this data: - CA TLS certificate fingerprint of the controller - this is part of long term identity of the controller established during the first session, and repeated in the subsequent session announcements. - Session Ed25519 public key used to verify the announcement and commands - this mitigates the compromise of the long term signature key, as the controller will have to sign each command with this key first. - Long-term Ed25519 public key used to verify the announcement and commands - this is part of the long term controller identity. -- Session X25519 DH key and SNTRUP761 KEM encapsulation key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption. +- Session X25519 DH key to agree session encryption (both for multicast announcement and for commands and responses in TLS), as described in https://datatracker.ietf.org/doc/draft-josefsson-ntruprime-hybrid/. The new keys are used for each session, and if client key is already available (from the previous session), the computed shared secret will be used to encrypt the announcement multicast packet. The out-of-band invitation is unencrypted. DH public key and KEM encapsulation key are sent unencrypted. NaCL crypto_box is used for encryption. Host application decrypts (except the first session) and validates the invitation: - Session signature is valid. @@ -184,7 +184,7 @@ The controller decrypts (including the first session) and validates the received The controller should reply with with `ctrlHello` or `ctrlError` response: ```abnf -ctrlHello = %s"HELLO " kemCiphertext nonce encrypted(unpaddedSize ctrlHelloJSON helloPad) pad +ctrlHello = %s"HELLO " kemCiphertext encrypted(unpaddedSize ctrlHelloJSON helloPad) pad ; ctrlHelloJSON is encrypted with the hybrid secret, ; including both previously agreed DH secret and KEM secret from kemCiphertext unpaddedSize = largeLength @@ -206,6 +206,8 @@ JTD schema for the encrypted part of controller HELLO block `ctrlHelloJSON`: } ``` +Controller `hello` block and all subsequent protocol messages are encrypted with the chain keys derived from the hybrid key (see key exchange below) - that is why conntroller hello block does not include nonce. That provides forward secrecy within the XRCP session. Receiving this `hello` block allows host to compute the same hybrid keys and to derive the same chain keys. + Once the controller replies HELLO to the valid host HELLO block, it should stop accepting new TCP connections. ### Controller/host session operation @@ -223,10 +225,12 @@ tlsunique channel binding from TLS session MUST be included in commands (include The syntax for encrypted command and response body encoding: ```abnf -commandBody = encBody sessSignature idSignature [attachment] -responseBody = encBody [attachment] ; counter must match command -encBody = nonce encLength32 encrypted(tlsunique counter body) -attachment = %x01 nonce encLength32 encrypted(attachment) +commandBody = counter encBody sessSignature idSignature [attachment] +responseBody = counter encBody [attachment] ; counter must match command +; counter is placed outside of encrypted body to allow correlating encryption keys +; with the chain keys (each command and response are encrypted by different keys) +encBody = encLength32 encrypted(tlsunique body) +attachment = %x01 encLength32 encrypted(attachment) noAttachment = %x00 tlsunique = length 1*OCTET counter = 8*8 OCTET ; int64 @@ -239,7 +243,7 @@ If the command or response includes attachment, its hash must be included in com Initial announcement is shared out-of-band (URI with xrcp scheme), and it is not encrypted. -This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA256 over concatenated DH shared secret and KEM encapsulated secret) both for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses. +This announcement contains only DH keys, as KEM key is too large to include in QR code, which are used to agree encryption key for host HELLO block. The host HELLO block will contain DH key in plaintext part and KEM encapsulation (public) key in encrypted part, that will be used to determine the shared secret (using SHA3-256 over concatenated DH shared secret and KEM encapsulated secret) to derive keys for controller HELLO response (that contains KEM ciphertext in plaintext part) and subsequent session commands and responses. During the next session the announcement is sent via encrypted multicast block. The shared key for this announcement and for host HELLO block is determined using the KEM shared secret from the previous session and DH shared secret computed using the host DH key from the previous session and the new controller DH key from the announcement. @@ -273,6 +277,22 @@ If controller fails to store the new host DH key after receiving HELLO block, th To decrypt a multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers. +Once kemSecret is agreed for the session, it is used to derive two chain keys, to receive and to send messages: + +``` +host: sndKey, rcvKey = HKDF(kemSecret, "SimpleXSbChainInit", 64) +controller: rcvKey, sndKey = HKDF(kemSecret, "SimpleXSbChainInit", 64) +``` + +where HKDF is based on SHA512, with empty salt. + +Actual keys and nonces to encrypt and decrypt messages are derived from these chain keys: + +``` +to send: (sndKey', sk, nonce) = HKDF(sndKey, "SimpleXSbChain", 88) +to receive: (rcvKey', sk, nonce) = HKDF(rcvKey, "SimpleXSbChain", 88) +``` + ## Threat model #### A passive network adversary able to monitor the site-local traffic: diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 7aefbd709..05ba861bc 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -152,6 +152,12 @@ module Simplex.Messaging.Crypto unsafeSbKey, randomSbKey, + -- * secret_box chains + SbChainKey, + SbKeyNonce, + sbcInit, + sbcHkdf, + -- * pseudo-random bytes randomBytes, @@ -198,6 +204,7 @@ 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.KDF.HKDF as H import qualified Crypto.MAC.Poly1305 as Poly1305 import qualified Crypto.PubKey.Curve25519 as X25519 import qualified Crypto.PubKey.Curve448 as X448 @@ -1334,6 +1341,26 @@ unsafeSbKey s = either error id $ sbKey s randomSbKey :: TVar ChaChaDRG -> STM SbKey randomSbKey gVar = SecretBoxKey <$> randomBytes 32 gVar +newtype SbChainKey = SecretBoxChainKey {unSbChainKey :: ByteString} + deriving (Eq, Show) + +sbcInit :: ByteArrayAccess secret => ByteString -> secret -> (SbChainKey, SbChainKey) +sbcInit salt secret = (SecretBoxChainKey ck1, SecretBoxChainKey ck2) + where + prk = H.extract salt secret :: H.PRK SHA512 + out = H.expand prk ("SimpleXSbChainInit" :: ByteString) 64 + (ck1, ck2) = B.splitAt 32 out + +type SbKeyNonce = (SbKey, CbNonce) + +sbcHkdf :: SbChainKey -> (SbKeyNonce, SbChainKey) +sbcHkdf (SecretBoxChainKey ck) = ((SecretBoxKey sk, CryptoBoxNonce nonce), SecretBoxChainKey ck') + where + prk = H.extract B.empty ck :: H.PRK SHA512 + out = H.expand prk ("SimpleXSbChain" :: ByteString) 88 -- = 32 (new chain key) + 32 (secret_box key) + 24 (nonce) + (ck', rest) = B.splitAt 32 out + (sk, nonce) = B.splitAt 32 rest + xSalsa20 :: ByteArrayAccess key => key -> ByteString -> ByteString -> (ByteString, ByteString) xSalsa20 secret nonce msg = (rs, msg') where diff --git a/src/Simplex/Messaging/Crypto/Lazy.hs b/src/Simplex/Messaging/Crypto/Lazy.hs index c83d93a07..6c0cf9613 100644 --- a/src/Simplex/Messaging/Crypto/Lazy.hs +++ b/src/Simplex/Messaging/Crypto/Lazy.hs @@ -17,6 +17,8 @@ module Simplex.Messaging.Crypto.Lazy kcbEncryptTailTag, sbDecryptTailTag, kcbDecryptTailTag, + sbEncryptTailTagNoPad, + sbDecryptTailTagNoPad, fastReplicate, secretBox, secretBoxTailTag, @@ -49,7 +51,7 @@ import Data.Composition ((.:.)) import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..)) import Foreign (sizeOf) -import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey) +import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, SbKeyNonce, pattern CbNonce, pattern SbKey) import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret (..)) import Simplex.Messaging.Encoding @@ -142,6 +144,10 @@ sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString -> sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen = LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen) +sbEncryptTailTagNoPad :: SbKeyNonce -> LazyByteString -> Either CryptoError LazyByteString +sbEncryptTailTagNoPad (SbKey key, CbNonce nonce) msg = + LB.fromChunks <$> secretBoxTailTag sbEncryptChunk key nonce msg + -- | NaCl @secret_box@ decrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files). -- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag. sbDecryptTailTag :: SbKey -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString) @@ -165,6 +171,15 @@ sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet = where (c, tag') = LB.splitAt paddedLen packet +sbDecryptTailTagNoPad :: SbKeyNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString) +sbDecryptTailTagNoPad (SbKey key, CbNonce nonce) paddedLen packet = + result <$> secretBox sbDecryptChunk key nonce c + where + result (tag :| cs) = + let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag + in (valid, LB.fromChunks cs) + (c, tag') = LB.splitAt paddedLen packet + secretBoxTailTag :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError [ByteString] secretBoxTailTag sbProcess secret nonce msg = run <$> sbInit_ secret nonce where diff --git a/src/Simplex/Messaging/Transport.hs b/src/Simplex/Messaging/Transport.hs index e681ec396..bc7cc85dd 100644 --- a/src/Simplex/Messaging/Transport.hs +++ b/src/Simplex/Messaging/Transport.hs @@ -72,6 +72,7 @@ module Simplex.Messaging.Transport THandle (..), THandleParams (..), THandleAuth (..), + TSbChainKeys (..), TransportError (..), HandshakeError (..), smpServerHandshake, @@ -85,6 +86,7 @@ module Simplex.Messaging.Transport where import Control.Applicative (optional) +import Control.Concurrent.STM import Control.Monad (forM, (<$!>)) import Control.Monad.Except import Control.Monad.Trans.Except (throwE) @@ -393,6 +395,11 @@ data THandleAuth (p :: TransportPeer) where } -> THandleAuth 'TServer +data TSbChainKeys = TSbChainKeys + { sndKey :: TVar C.SbChainKey, + rcvKey :: TVar C.SbChainKey + } + -- | TLS-unique channel binding type SessionId = ByteString diff --git a/src/Simplex/RemoteControl/Client.hs b/src/Simplex/RemoteControl/Client.hs index 381397c6e..1c0ef94cc 100644 --- a/src/Simplex/RemoteControl/Client.hs +++ b/src/Simplex/RemoteControl/Client.hs @@ -23,6 +23,9 @@ module Simplex.RemoteControl.Client rcEncryptBody, rcDecryptBody, xrcpBlockSize, + -- for tests only + sendRCPacket, + receiveRCPacket, ) where import Control.Applicative ((<|>)) @@ -33,6 +36,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Except import Crypto.Random (ChaChaDRG) import qualified Data.Aeson as J +import Data.Bitraversable (bimapM) import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB @@ -43,6 +47,7 @@ import qualified Data.List.NonEmpty as L import Data.Maybe (isNothing) import qualified Data.Text as T import Data.Time.Clock.System (getSystemTime) +import Data.Tuple (swap) import Data.Word (Word16) import qualified Data.X509 as X509 import Data.X509.Validation (Fingerprint (..), getFingerprint) @@ -57,7 +62,7 @@ import Simplex.Messaging.Crypto.SNTRUP761 import Simplex.Messaging.Crypto.SNTRUP761.Bindings import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String (StrEncoding (..)) -import Simplex.Messaging.Transport (TLS (..), cGet, cPut) +import Simplex.Messaging.Transport (TSbChainKeys (..), TLS (..), cGet, cPut) import Simplex.Messaging.Transport.Buffer (peekBuffered) import Simplex.Messaging.Transport.Client (TransportClientConfig (..), TransportHost (..), defaultTransportClientConfig, runTransportClient) import Simplex.Messaging.Transport.Credentials (genCredentials, tlsCredentials) @@ -214,15 +219,16 @@ prepareHostSession hostHello@RCHostHello {v, ca, kem = kemPubKey} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody unless (ca == tlsHostFingerprint) $ throwE RCEIdentity (kemCiphertext, kemSharedKey) <- liftIO $ sntrup761Enc drg kemPubKey - let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey + let KEMHybridSecret hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey unless (isCompatible v supportedRCPVRange) $ throwE RCEVersion - let keys = HostSessKeys {hybridKey, idPrivKey, sessPrivKey} + (sndKey, rcvKey) <- bimapM newTVarIO newTVarIO $ C.sbcInit "" hybridKey + let keys = HostSessKeys {chainKeys = TSbChainKeys {sndKey, rcvKey}, idPrivKey, sessPrivKey} knownHost' <- updateKnownHost ca dhPubKey let ctrlHello = RCCtrlHello {} -- TODO send error response if something fails - nonce' <- liftIO . atomically $ C.randomCbNonce drg - encBody' <- liftEitherWith (const RCEBlockSize) $ kcbEncrypt hybridKey nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize - let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, nonce = nonce', encBody = encBody'} + (sk, nonce') <- atomically $ stateTVar sndKey C.sbcHkdf + encBody' <- liftEitherWith (const RCEBlockSize) $ C.sbEncrypt sk nonce' (LB.toStrict $ J.encode ctrlHello) helloBlockSize + let ctrlEncHello = RCCtrlEncHello {kem = kemCiphertext, encBody = encBody'} pure (ctrlEncHello, keys, hostHello, pairing {knownHost = Just knownHost'}) where updateKnownHost :: C.KeyHash -> C.PublicKeyX25519 -> ExceptT RCErrorType IO KnownHostPairing @@ -349,13 +355,16 @@ prepareCtrlSession RCInvitation {skey, dh = dhPubKey} sharedKey kemPrivKey = \case - RCCtrlEncHello {kem = kemCiphertext, nonce, encBody} -> do + RCCtrlEncHello {kem = kemCiphertext, encBody} -> do kemSharedKey <- liftIO $ sntrup761Dec kemCiphertext kemPrivKey - let hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey - helloBody <- liftEitherWith (const RCEDecrypt) $ kcbDecrypt hybridKey nonce encBody + let KEMHybridSecret hybridKey = kemHybridSecret dhPubKey dhPrivKey kemSharedKey + -- keys are swapped in controller + (sndKey, rcvKey) <- swap <$> bimapM newTVarIO newTVarIO (C.sbcInit "" hybridKey) + (sk, nonce) <- atomically $ stateTVar rcvKey C.sbcHkdf + helloBody <- liftEitherWith (const RCEDecrypt) $ C.sbDecrypt sk nonce encBody logDebug "Decrypted ctrl HELLO" RCCtrlHello {} <- liftEitherWith RCESyntax $ J.eitherDecodeStrict helloBody - pure CtrlSessKeys {hybridKey, idPubKey, sessPubKey = skey} + pure CtrlSessKeys {chainKeys = TSbChainKeys {sndKey, rcvKey}, idPubKey, sessPubKey = skey} RCCtrlEncError {nonce, encMessage} -> do message <- liftEitherWith (const RCEDecrypt) $ C.cbDecrypt sharedKey nonce encMessage throwE $ RCECtrlError $ T.unpack $ safeDecodeUtf8 message @@ -426,17 +435,14 @@ cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do -- * Session encryption -rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString) -rcEncryptBody drg hybridKey s = do - nonce <- atomically $ C.randomCbNonce drg - let len = LB.length s - ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8) - pure (nonce, ct) +rcEncryptBody :: C.SbKeyNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString +rcEncryptBody keyNonce s = do + liftEitherWith (const RCEEncrypt) $ LC.sbEncryptTailTagNoPad keyNonce s -rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString -rcDecryptBody hybridKey nonce ct = do +rcDecryptBody :: C.SbKeyNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString +rcDecryptBody keyNonce ct = do let len = LB.length ct - 16 when (len < 0) $ throwE RCEDecrypt - (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct + (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.sbDecryptTailTagNoPad keyNonce len ct unless ok $ throwE RCEDecrypt pure s diff --git a/src/Simplex/RemoteControl/Types.hs b/src/Simplex/RemoteControl/Types.hs index e5d885b1d..666878c30 100644 --- a/src/Simplex/RemoteControl/Types.hs +++ b/src/Simplex/RemoteControl/Types.hs @@ -20,12 +20,11 @@ import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) import Data.Word (Word16) import qualified Simplex.Messaging.Crypto as C -import Simplex.Messaging.Crypto.SNTRUP761 import Simplex.Messaging.Crypto.SNTRUP761.Bindings import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, sumTypeJSON) -import Simplex.Messaging.Transport (TLS) +import Simplex.Messaging.Transport (TLS, TSbChainKeys) import Simplex.Messaging.Transport.Client (TransportHost) import Simplex.Messaging.Util (safeDecodeUtf8) import Simplex.Messaging.Version (VersionRange, VersionScope, mkVersionRange) @@ -180,7 +179,7 @@ data RCHostSession = RCHostSession } data HostSessKeys = HostSessKeys - { hybridKey :: KEMHybridSecret, + { chainKeys :: TSbChainKeys, idPrivKey :: C.PrivateKeyEd25519, sessPrivKey :: C.PrivateKeyEd25519 } @@ -193,7 +192,7 @@ data RCCtrlSession = RCCtrlSession } data CtrlSessKeys = CtrlSessKeys - { hybridKey :: KEMHybridSecret, + { chainKeys :: TSbChainKeys, idPubKey :: C.PublicKeyEd25519, sessPubKey :: C.PublicKeyEd25519 } @@ -213,19 +212,19 @@ instance Encoding RCHostEncHello where pure RCHostEncHello {dhPubKey, nonce, encBody} data RCCtrlEncHello - = RCCtrlEncHello {kem :: KEMCiphertext, nonce :: C.CbNonce, encBody :: ByteString} + = RCCtrlEncHello {kem :: KEMCiphertext, encBody :: ByteString} | RCCtrlEncError {nonce :: C.CbNonce, encMessage :: ByteString} deriving (Show) instance Encoding RCCtrlEncHello where smpEncode = \case - RCCtrlEncHello {kem, nonce, encBody} -> "HELLO " <> smpEncode (kem, nonce, Tail encBody) + RCCtrlEncHello {kem, encBody} -> "HELLO " <> smpEncode (kem, Tail encBody) RCCtrlEncError {nonce, encMessage} -> "ERROR " <> smpEncode (nonce, Tail encMessage) smpP = A.takeTill (== ' ') >>= \case "HELLO" -> do - (kem, nonce, Tail encBody) <- _smpP - pure RCCtrlEncHello {kem, nonce, encBody} + (kem, Tail encBody) <- _smpP + pure RCCtrlEncHello {kem, encBody} "ERROR" -> do (nonce, Tail encMessage) <- _smpP pure RCCtrlEncError {nonce, encMessage} diff --git a/tests/RemoteControl.hs b/tests/RemoteControl.hs index c0a32cd4c..4b6db594b 100644 --- a/tests/RemoteControl.hs +++ b/tests/RemoteControl.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,9 +9,11 @@ import AgentTests.FunctionalAPITests (runRight) import Control.Logger.Simple import Crypto.Random (ChaChaDRG) import qualified Data.Aeson as J +import Data.ByteString.Lazy.Char8 as LB import Data.List.NonEmpty (NonEmpty (..)) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String (StrEncoding (..)) +import Simplex.Messaging.Transport (TSbChainKeys (..)) import qualified Simplex.RemoteControl.Client as HC (RCHostClient (action)) import qualified Simplex.RemoteControl.Client as RC import Simplex.RemoteControl.Discovery (mkLastLocalHost, preferAddress) @@ -74,7 +77,16 @@ testNewPairing = do logNote "c 3" Right (sessId, _tls, r') <- atomically $ takeTMVar r logNote "c 4" - Right (_rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r' + Right (rcHostSession, _rcHelloBody, _hp') <- atomically $ takeTMVar r' + let RCHostSession {tls, sessionKeys = HostSessKeys {chainKeys}} = rcHostSession + TSbChainKeys {rcvKey, sndKey} = chainKeys + sndKeyNonce <- atomically $ stateTVar sndKey C.sbcHkdf + encCmd <- RC.rcEncryptBody sndKeyNonce "command message" + RC.sendRCPacket tls $ LB.toStrict encCmd + encResp <- RC.receiveRCPacket tls + rcvKeyNonce <- atomically $ stateTVar rcvKey C.sbcHkdf + resp <- RC.rcDecryptBody rcvKeyNonce $ LB.fromStrict encResp + liftIO $ resp `shouldBe` "response message" logNote "c 5" threadDelay 250000 logNote "ctrl: ciao" @@ -93,7 +105,16 @@ testNewPairing = do logNote "h 3" liftIO $ RC.confirmCtrlSession rcCtrlClient True logNote "h 4" - Right (_rcCtrlSession, _rcCtrlPairing) <- atomically $ takeTMVar r' + Right (rcCtrlSession, _rcCtrlPairing) <- atomically $ takeTMVar r' + let RCCtrlSession {tls, sessionKeys = CtrlSessKeys {chainKeys}} = rcCtrlSession + TSbChainKeys {rcvKey, sndKey} = chainKeys + encCmd <- RC.receiveRCPacket tls + rcvKeyNonce <- atomically $ stateTVar rcvKey C.sbcHkdf + cmd <- RC.rcDecryptBody rcvKeyNonce $ LB.fromStrict encCmd + liftIO $ cmd `shouldBe` "command message" + sndKeyNonce <- atomically $ stateTVar sndKey C.sbcHkdf + encResp <- RC.rcEncryptBody sndKeyNonce "response message" + RC.sendRCPacket tls $ LB.toStrict encResp logNote "h 5" threadDelay 250000 logNote "ctrl: adios"