additional lazy crypto for XRCP (#890)

rfcs/2023-10-25-remote-control.md

@@ -253,15 +253,21 @@ tlsunique channel binding from TLS session MUST be included in commands (include
 The syntax for encrypted command and response body encoding:
 
 ```
-commandBody = length encrypted(tlsunique counter length command) sessSignature idSignature
-responseBody = length encrypted(tlsunique counter length response) ; should match counter in the command
+commandBody = encBody sessSignature idSignature (attachment / noAttachment)
+responseBody = encBody attachment; should match counter in the command
+encBody = nonce encLength32 encrypted(tlsunique counter body)
+attachment = %x01 nonce encLength32 encrypted(attachment)
+noAttachment = %x00
 tlsunique = length 1*OCTET
 counter = 8*8 OCTET ; int64
+encLength32 = 4*4 OCTET ; uint32, includes authTag
 ```
 
+If the command or response includes attachment, it's hash must be included in command/response and validated.
+
 ## Key agreement for announcement packet and for session
 
-Initial announcement is shared out-of-band, and it is not encrypted.
+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 containt 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 cyphertext in plaintext part) and subsequent session commands and responses.
 
@@ -275,25 +281,28 @@ To describe it in pseudocode:
 // session 1
 hostHelloSecret(1) = dhSecret(1)
 sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
-dhSecret(1) = dh(hostHelloDhKey(1), controllerAnnouncementDhKey(1))
+dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
 kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
 // kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
 kemSecret(1) = dec(kemCiphertext(1), kemDecKey(1))
 
-// announcement for session n
-announcementSecret(n) = sha256(dhSecret(n') || kemSecret(n - 1))
-dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerAnnouncementDhKey(n))
+// multicast announcement for session n
+announcementSecret(n) = sha256(dhSecret(n'))
+dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
 
 // session n
 hostHelloSecret(n) = dhSecret(n)
 sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
-dhSecret(n) = dh(hostHelloDhKey(n), controllerAnnouncementDhKey(n))
+dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
+// controllerDhKey(n) is either from invitation or from multicast announcement
 kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
 kemSecret(n) = dec(kemCiphertext(n), kemDecKey(n))
 ```
 
 If controller fails to store the new host DH key after receiving HELLO block, the encryption will become out of sync and the host won't be able to decrypt the next announcement. To mitigate it, the host should keep the last session DH key and also previous session DH key to try to decrypt the next announcement computing shared secret using both keys (first the new one, and in case it fails - the previous).
 
+To decrypt multicast announcement, the host should try to decrypt it using the keys of all known (paired) remote controllers.
+
 ## Other options
 
 The proposed design has these pros/cons:

src/Simplex/Messaging/Agent/Client.hs

@@ -74,6 +74,7 @@ module Simplex.Messaging.Agent.Client
     removeSubscription,
     hasActiveSubscription,
     agentClientStore,
+    agentDRG,
     getAgentSubscriptions,
     SubscriptionsInfo (..),
     SubInfo (..),
@@ -117,7 +118,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
 import Control.Monad.Reader
-import Crypto.Random (getRandomBytes)
+import Crypto.Random (ChaChaDRG, getRandomBytes)
 import qualified Data.Aeson.TH as J
 import Data.Bifunctor (bimap, first, second)
 import Data.ByteString.Base64
@@ -380,6 +381,9 @@ newAgentClient InitialAgentServers {smp, ntf, xftp, netCfg} agentEnv = do
 agentClientStore :: AgentClient -> SQLiteStore
 agentClientStore AgentClient {agentEnv = Env {store}} = store
 
+agentDRG :: AgentClient -> TVar ChaChaDRG
+agentDRG AgentClient {agentEnv = Env {random}} = random
+
 class (Encoding err, Show err) => ProtocolServerClient err msg | msg -> err where
   type Client msg = c | c -> msg
   getProtocolServerClient :: AgentMonad m => AgentClient -> TransportSession msg -> m (Client msg)

src/Simplex/Messaging/Crypto.hs

@@ -85,6 +85,7 @@ module Simplex.Messaging.Crypto
     SignatureAlgorithm,
     AlgorithmI (..),
     sign,
+    sign',
     verify,
     verify',
     validSignatureSize,

src/Simplex/Messaging/Crypto/Lazy.hs

@@ -14,13 +14,16 @@ module Simplex.Messaging.Crypto.Lazy
     sbEncrypt,
     sbDecrypt,
     sbEncryptTailTag,
+    kcbEncryptTailTag,
     sbDecryptTailTag,
+    kcbDecryptTailTag,
     fastReplicate,
     secretBox,
     secretBoxTailTag,
     SbState,
     cbInit,
     sbInit,
+    kcbInit,
     sbEncryptChunk,
     sbDecryptChunk,
     sbEncryptChunkLazy,
@@ -48,6 +51,7 @@ 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.SNTRUP761 (KEMHybridSecret (..))
 import Simplex.Messaging.Encoding
 
 type LazyByteString = LB.ByteString
@@ -127,13 +131,33 @@ secretBox sbProcess secret nonce msg = run <$> sbInit_ secret nonce
 
 -- | NaCl @secret_box@ lazy encrypt with a symmetric 256-bit key and 192-bit nonce with appended auth tag (more efficient with large files).
 sbEncryptTailTag :: SbKey -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
-sbEncryptTailTag (SbKey key) (CbNonce nonce) msg len paddedLen =
+sbEncryptTailTag (SbKey key) = sbEncryptTailTag_ key
+{-# INLINE sbEncryptTailTag #-}
+
+-- | NaCl @crypto_box@ lazy encrypt with with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
+kcbEncryptTailTag :: KEMHybridSecret -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
+kcbEncryptTailTag (KEMHybridSecret key) = sbEncryptTailTag_ key
+{-# INLINE kcbEncryptTailTag #-}
+
+sbEncryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> LazyByteString -> Int64 -> Int64 -> Either CryptoError LazyByteString
+sbEncryptTailTag_ key (CbNonce nonce) msg len paddedLen =
   LB.fromChunks <$> (secretBoxTailTag sbEncryptChunk key nonce =<< pad msg len paddedLen)
 
 -- | 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)
-sbDecryptTailTag (SbKey key) (CbNonce nonce) paddedLen packet =
+sbDecryptTailTag (SbKey key) = sbDecryptTailTag_ key
+{-# INLINE sbDecryptTailTag #-}
+
+-- | NaCl @crypto_box@ lazy decrypt with a shared hybrid KEM+DH 256-bit secret and 192-bit nonce with appended auth tag (more efficient with large strings/files).
+-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
+kcbDecryptTailTag :: KEMHybridSecret -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
+kcbDecryptTailTag (KEMHybridSecret key) = sbDecryptTailTag_ key
+{-# INLINE kcbDecryptTailTag #-}
+
+-- paddedLen should NOT include the tag length, it should be the same number that is passed to sbEncrypt / sbEncryptTailTag.
+sbDecryptTailTag_ :: ByteArrayAccess key => key -> CbNonce -> Int64 -> LazyByteString -> Either CryptoError (Bool, LazyByteString)
+sbDecryptTailTag_ key (CbNonce nonce) paddedLen packet =
   case secretBox sbDecryptChunk key nonce c of
     Right (tag :| cs) ->
       let valid = LB.length tag' == 16 && BA.constEq (LB.toStrict tag') tag
@@ -165,6 +189,10 @@ sbInit :: SbKey -> CbNonce -> Either CryptoError SbState
 sbInit (SbKey secret) (CbNonce nonce) = sbInit_ secret nonce
 {-# INLINE sbInit #-}
 
+kcbInit :: KEMHybridSecret -> CbNonce -> Either CryptoError SbState
+kcbInit (KEMHybridSecret k) (CbNonce nonce) = sbInit_ k nonce
+{-# INLINE kcbInit #-}
+
 sbInit_ :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
 sbInit_ secret nonce = (state2,) <$> cryptoPassed (Poly1305.initialize rs)
   where

src/Simplex/RemoteControl/Client.hs

@@ -21,6 +21,9 @@ module Simplex.RemoteControl.Client
     confirmCtrlSession,
     cancelCtrlClient,
     RCStepTMVar,
+    rcEncryptBody,
+    rcDecryptBody,
+    xrcpBlockSize,
   ) where
 
 import Control.Applicative ((<|>))
@@ -46,6 +49,8 @@ import Network.Socket (PortNumber)
 import qualified Network.TLS as TLS
 import Simplex.Messaging.Agent.Client ()
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Crypto.Lazy (LazyByteString)
+import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Crypto.SNTRUP761
 import Simplex.Messaging.Crypto.SNTRUP761.Bindings
 import Simplex.Messaging.Encoding
@@ -386,3 +391,20 @@ cancelCtrlClient :: RCCtrlClient -> IO ()
 cancelCtrlClient RCCtrlClient {action, client_ = RCCClient_ {endSession}} = do
   atomically $ putTMVar endSession ()
   uninterruptibleCancel action
+
+-- * Session encryption
+
+rcEncryptBody :: TVar ChaChaDRG -> KEMHybridSecret -> LazyByteString -> ExceptT RCErrorType IO (C.CbNonce, LazyByteString)
+rcEncryptBody drg hybridKey s = do
+  nonce <- atomically $ C.pseudoRandomCbNonce drg
+  let len = LB.length s
+  ct <- liftEitherWith (const RCEEncrypt) $ LC.kcbEncryptTailTag hybridKey nonce s len (len + 8)
+  pure (nonce, ct)
+
+rcDecryptBody :: KEMHybridSecret -> C.CbNonce -> LazyByteString -> ExceptT RCErrorType IO LazyByteString
+rcDecryptBody hybridKey nonce ct = do
+  let len = LB.length ct - 16
+  when (len < 0) $ throwError RCEDecrypt
+  (ok, s) <- liftEitherWith (const RCEDecrypt) $ LC.kcbDecryptTailTag hybridKey nonce len ct
+  unless ok $ throwError RCEDecrypt
+  pure s

src/Simplex/RemoteControl/Types.hs

@@ -37,6 +37,7 @@ data RCErrorType
   | RCECtrlNotFound
   | RCECtrlError {ctrlErr :: String}
   | RCEVersion
+  | RCEEncrypt
   | RCEDecrypt
   | RCEBlockSize
   | RCESyntax {syntaxErr :: String}
@@ -53,6 +54,7 @@ instance StrEncoding RCErrorType where
     RCECtrlNotFound -> "CTRL_NOT_FOUND"
     RCECtrlError err -> "CTRL_ERROR" <> text err
     RCEVersion -> "VERSION"
+    RCEEncrypt -> "ENCRYPT"
     RCEDecrypt -> "DECRYPT"
     RCEBlockSize -> "BLOCK_SIZE"
     RCESyntax err -> "SYNTAX" <> text err
@@ -69,6 +71,7 @@ instance StrEncoding RCErrorType where
       "CTRL_NOT_FOUND" -> pure RCECtrlNotFound
       "CTRL_ERROR" -> RCECtrlError <$> textP
       "VERSION" -> pure RCEVersion
+      "ENCRYPT" -> pure RCEEncrypt
       "DECRYPT" -> pure RCEDecrypt
       "BLOCK_SIZE" -> pure RCEBlockSize
       "SYNTAX" -> RCESyntax <$> textP