additional lazy crypto for XRCP (#890)

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