diff --git a/apps/ios/Shared/Views/Helpers/StickyScrollView.swift b/apps/ios/Shared/Views/Helpers/StickyScrollView.swift index 0ba539772f..71bee4f548 100644 --- a/apps/ios/Shared/Views/Helpers/StickyScrollView.swift +++ b/apps/ios/Shared/Views/Helpers/StickyScrollView.swift @@ -44,7 +44,7 @@ struct StickyScrollView: UIViewRepresentable { withVelocity velocity: CGPoint, targetContentOffset: UnsafeMutablePointer ) { - if targetContentOffset.pointee.x < 64 { + if targetContentOffset.pointee.x < 32 { targetContentOffset.pointee.x = 0 } } diff --git a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt index 6adaa1d4e0..40e8ffa9bc 100644 --- a/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt +++ b/apps/multiplatform/android/src/main/java/chat/simplex/app/SimplexApp.kt @@ -287,13 +287,23 @@ class SimplexApp: Application(), LifecycleEventObserver { // Blend status bar color to the animated color val colors = CurrentColors.value.colors val baseBackgroundColor = if (toolbarOnTop) colors.background.mixWith(colors.onBackground, 0.97f) else colors.background - window.statusBarColor = baseBackgroundColor.mixWith(drawerShadingColor.copy(1f), 1 - drawerShadingColor.alpha).toArgb() - val navBar = navBarColor.toArgb() + var statusBar = baseBackgroundColor.mixWith(drawerShadingColor.copy(1f), 1 - drawerShadingColor.alpha).toArgb() + var statusBarLight = isLight + // SimplexGreen while in call + if (window.statusBarColor == SimplexGreen.toArgb()) { + statusBarColorAfterCall.intValue = statusBar + statusBar = SimplexGreen.toArgb() + statusBarLight = false + } + window.statusBarColor = statusBar + val navBar = navBarColor.toArgb() + if (windowInsetController?.isAppearanceLightStatusBars != statusBarLight) { + windowInsetController?.isAppearanceLightStatusBars = statusBarLight + } if (window.navigationBarColor != navBar) { window.navigationBarColor = navBar } - if (windowInsetController?.isAppearanceLightNavigationBars != isLight) { windowInsetController?.isAppearanceLightNavigationBars = isLight } @@ -313,11 +323,13 @@ class SimplexApp: Application(), LifecycleEventObserver { backgroundColor } }).toArgb() + var statusBarLight = isLight // SimplexGreen while in call if (window.statusBarColor == SimplexGreen.toArgb()) { statusBarColorAfterCall.intValue = statusBar statusBar = SimplexGreen.toArgb() + statusBarLight = false } val navBar = (if (hasBottom && appPrefs.onboardingStage.get() == OnboardingStage.OnboardingComplete) { backgroundColor.mixWith(CurrentColors.value.colors.onBackground, 0.97f) @@ -327,8 +339,8 @@ class SimplexApp: Application(), LifecycleEventObserver { if (window.statusBarColor != statusBar) { window.statusBarColor = statusBar } - if (windowInsetController?.isAppearanceLightStatusBars != isLight) { - windowInsetController?.isAppearanceLightStatusBars = isLight + if (windowInsetController?.isAppearanceLightStatusBars != statusBarLight) { + windowInsetController?.isAppearanceLightStatusBars = statusBarLight } if (window.navigationBarColor != navBar) { window.navigationBarColor = navBar diff --git a/cabal.project b/cabal.project index f2a652d721..d5e17ea299 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: bef11e4cbe0a3776f0910375f2adb60399043835 + tag: 7dcac19a671f76dedbe769030742714783946bd3 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 730a0f9501..91e5e8866f 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."bef11e4cbe0a3776f0910375f2adb60399043835" = "195hir9crv51iyli8yjk8sivk7wagxxjfmhzq6ahydvbkrpd3258"; + "https://github.com/simplex-chat/simplexmq.git"."7dcac19a671f76dedbe769030742714783946bd3" = "0c1jygir4c1s8g4hdz7b6vw69bvcrknbih9rq8y8rv3d8zl32qpq"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat/Remote.hs b/src/Simplex/Chat/Remote.hs index 76d3754f17..0d39951b90 100644 --- a/src/Simplex/Chat/Remote.hs +++ b/src/Simplex/Chat/Remote.hs @@ -54,6 +54,7 @@ import Simplex.Chat.Util (encryptFile, liftIOEither) import Simplex.FileTransfer.Description (FileDigest (..)) import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Protocol (AgentErrorType (RCP)) +import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Encoding.String (StrEncoding (..)) @@ -497,31 +498,32 @@ handleRemoteCommand :: (ByteString -> CM' ChatResponse) -> RemoteCrypto -> TBQue handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do logDebug "handleRemoteCommand" liftIO (tryRemoteError' parseRequest) >>= \case - Right (getNext, rc) -> do + Right (rfKN, getNext, rc) -> do chatReadVar' currentUser >>= \case Nothing -> replyError $ ChatError CENoActiveUser - Just user -> processCommand user getNext rc `catchChatError'` replyError + Just user -> processCommand user rfKN getNext rc `catchChatError'` replyError Left e -> reply $ RRProtocolError e where - parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand) + parseRequest :: ExceptT RemoteProtocolError IO (C.SbKeyNonce, GetChunk, RemoteCommand) parseRequest = do - (header, getNext) <- parseDecryptHTTP2Body encryption request reqBody - (getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header) + (rfKN, header, getNext) <- parseDecryptHTTP2Body encryption request reqBody + (rfKN,getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header) replyError = reply . RRChatResponse . CRChatCmdError Nothing - processCommand :: User -> GetChunk -> RemoteCommand -> CM () - processCommand user getNext = \case + processCommand :: User -> C.SbKeyNonce -> GetChunk -> RemoteCommand -> CM () + processCommand user rfKN getNext = \case RCSend {command} -> lift $ handleSend execChatCommand command >>= reply RCRecv {wait = time} -> lift $ liftIO (handleRecv time remoteOutputQ) >>= reply - RCStoreFile {fileName, fileSize, fileDigest} -> lift $ handleStoreFile encryption fileName fileSize fileDigest getNext >>= reply - RCGetFile {file} -> handleGetFile encryption user file replyWith + RCStoreFile {fileName, fileSize, fileDigest} -> lift $ handleStoreFile rfKN fileName fileSize fileDigest getNext >>= reply + RCGetFile {file} -> handleGetFile user file replyWith reply :: RemoteResponse -> CM' () - reply = (`replyWith` \_ -> pure ()) + reply = (`replyWith` \_ _ -> pure ()) replyWith :: Respond - replyWith rr attach = - liftIO (tryRemoteError' . encryptEncodeHTTP2Body encryption $ J.encode rr) >>= \case + replyWith rr attach = do + (corrId, cmdKN, sfKN) <- atomically $ getRemoteSndKeys encryption + liftIO (tryRemoteError' . encryptEncodeHTTP2Body corrId cmdKN encryption $ J.encode rr) >>= \case Right resp -> liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do send resp - attach send + attach sfKN send flush Left e -> toView' . CRChatError Nothing . ChatErrorRemoteCtrl $ RCEProtocolError e @@ -532,7 +534,7 @@ type GetChunk = Int -> IO ByteString type SendChunk = Builder -> IO () -type Respond = RemoteResponse -> (SendChunk -> IO ()) -> CM' () +type Respond = RemoteResponse -> (C.SbKeyNonce -> SendChunk -> IO ()) -> CM' () liftRC :: ExceptT RemoteProtocolError IO a -> CM a liftRC = liftError (ChatErrorRemoteCtrl . RCEProtocolError) @@ -559,8 +561,8 @@ handleRecv time events = do -- TODO this command could remember stored files and return IDs to allow removing files that are not needed. -- Also, there should be some process removing unused files uploaded to remote host (possibly, all unused files). -handleStoreFile :: RemoteCrypto -> FilePath -> Word32 -> FileDigest -> GetChunk -> CM' RemoteResponse -handleStoreFile encryption fileName fileSize fileDigest getChunk = +handleStoreFile :: C.SbKeyNonce -> FilePath -> Word32 -> FileDigest -> GetChunk -> CM' RemoteResponse +handleStoreFile rfKN fileName fileSize fileDigest getChunk = either RRProtocolError RRFileStored <$> (chatReadVar' filesFolder >>= storeFile) where storeFile :: Maybe FilePath -> CM' (Either RemoteProtocolError FilePath) @@ -570,11 +572,11 @@ handleStoreFile encryption fileName fileSize fileDigest getChunk = storeFileTo :: FilePath -> CM' (Either RemoteProtocolError FilePath) storeFileTo dir = liftIO . tryRemoteError' $ do filePath <- liftIO $ dir `uniqueCombine` fileName - receiveEncryptedFile encryption getChunk fileSize fileDigest filePath + receiveEncryptedFile rfKN getChunk fileSize fileDigest filePath pure filePath -handleGetFile :: RemoteCrypto -> User -> RemoteFile -> Respond -> CM () -handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do +handleGetFile :: User -> RemoteFile -> Respond -> CM () +handleGetFile User {userId} RemoteFile {userId = commandUserId, fileId, sent, fileSource = cf'@CryptoFile {filePath}} reply = do logDebug $ "GetFile: " <> tshow filePath unless (userId == commandUserId) $ throwChatError $ CEDifferentActiveUser {commandUserId, activeUserId = userId} path <- maybe filePath ( filePath) <$> chatReadVar filesFolder @@ -582,11 +584,12 @@ handleGetFile encryption User {userId} RemoteFile {userId = commandUserId, fileI cf <- getLocalCryptoFile db commandUserId fileId sent unless (cf == cf') $ throwError $ SEFileNotFound fileId liftRC (tryRemoteError $ getFileInfo path) >>= \case - Left e -> lift $ reply (RRProtocolError e) $ \_ -> pure () + Left e -> lift $ reply (RRProtocolError e) $ \_ _ -> pure () Right (fileSize, fileDigest) -> - ExceptT . withFile path ReadMode $ \h -> runExceptT $ do - encFile <- liftRC $ prepareEncryptedFile encryption (h, fileSize) - lift $ reply RRFile {fileSize, fileDigest} $ sendEncryptedFile encFile + lift . withFile path ReadMode $ \h -> do + reply RRFile {fileSize, fileDigest} $ \sfKN send -> void . runExceptT $ do + encFile <- prepareEncryptedFile sfKN (h, fileSize) + liftIO $ sendEncryptedFile encFile send listRemoteCtrls :: CM [RemoteCtrlInfo] listRemoteCtrls = do diff --git a/src/Simplex/Chat/Remote/Protocol.hs b/src/Simplex/Chat/Remote/Protocol.hs index fe07a940ae..00fc56f897 100644 --- a/src/Simplex/Chat/Remote/Protocol.hs +++ b/src/Simplex/Chat/Remote/Protocol.hs @@ -43,6 +43,8 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..)) import Simplex.Messaging.Crypto.Lazy (LazyByteString) import Simplex.Messaging.Encoding import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON, pattern SingleFieldJSONTag, pattern TaggedObjectJSONData, pattern TaggedObjectJSONTag) +import qualified Simplex.Messaging.TMap as TM +import Simplex.Messaging.Transport (TSbChainKeys) import Simplex.Messaging.Transport.Buffer (getBuffered) import Simplex.Messaging.Transport.HTTP2 (HTTP2Body (..), HTTP2BodyChunk, getBodyChunk) import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, HTTP2Response (..), closeHTTP2Client, sendRequestDirect) @@ -77,11 +79,9 @@ $(deriveJSON (taggedObjectJSON $ dropPrefix "RR") ''RemoteResponse) mkRemoteHostClient :: HTTP2Client -> HostSessKeys -> SessionCode -> FilePath -> HostAppInfo -> CM RemoteHostClient mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {encoding, deviceName, encryptFiles} = do - drg <- asks random - counter <- newTVarIO 1 - let HostSessKeys {hybridKey, idPrivKey, sessPrivKey} = sessionKeys + let HostSessKeys {chainKeys, idPrivKey, sessPrivKey} = sessionKeys signatures = RSSign {idPrivKey, sessPrivKey} - encryption = RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures} + encryption <- liftIO $ mkRemoteCrypto sessionCode chainKeys signatures pure RemoteHostClient { hostEncoding = encoding, @@ -93,11 +93,16 @@ mkRemoteHostClient httpClient sessionKeys sessionCode storePath HostAppInfo {enc } mkCtrlRemoteCrypto :: CtrlSessKeys -> SessionCode -> CM RemoteCrypto -mkCtrlRemoteCrypto CtrlSessKeys {hybridKey, idPubKey, sessPubKey} sessionCode = do - drg <- asks random - counter <- newTVarIO 1 +mkCtrlRemoteCrypto CtrlSessKeys {chainKeys, idPubKey, sessPubKey} sessionCode = let signatures = RSVerify {idPubKey, sessPubKey} - pure RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures} + in liftIO $ mkRemoteCrypto sessionCode chainKeys signatures + +mkRemoteCrypto :: SessionCode -> TSbChainKeys -> RemoteSignatures -> IO RemoteCrypto +mkRemoteCrypto sessionCode chainKeys signatures = do + sndCounter <- newTVarIO 0 + rcvCounter <- newTVarIO 0 + skippedKeys <- liftIO TM.emptyIO + pure RemoteCrypto {sessionCode, sndCounter, rcvCounter, chainKeys, skippedKeys, signatures} closeRemoteHostClient :: RemoteHostClient -> IO () closeRemoteHostClient RemoteHostClient {httpClient} = closeHTTP2Client httpClient @@ -125,26 +130,30 @@ remoteStoreFile c localPath fileName = do r -> badResponse r remoteGetFile :: RemoteHostClient -> FilePath -> RemoteFile -> ExceptT RemoteProtocolError IO () -remoteGetFile c@RemoteHostClient {encryption} destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} = +remoteGetFile c destDir rf@RemoteFile {fileSource = CryptoFile {filePath}} = sendRemoteCommand c Nothing RCGetFile {file = rf} >>= \case - (getChunk, RRFile {fileSize, fileDigest}) -> do + (rfKN, getChunk, RRFile {fileSize, fileDigest}) -> do -- TODO we could optimize by checking size and hash before receiving the file let localPath = destDir takeFileName filePath - receiveEncryptedFile encryption getChunk fileSize fileDigest localPath - (_, r) -> badResponse r + receiveEncryptedFile rfKN getChunk fileSize fileDigest localPath + (_, _, r) -> badResponse r -- TODO validate there is no attachment in response sendRemoteCommand' :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO RemoteResponse -sendRemoteCommand' c attachment_ rc = snd <$> sendRemoteCommand c attachment_ rc +sendRemoteCommand' c attachment_ rc = do + (_, _, r) <- sendRemoteCommand c attachment_ rc + pure r -sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse) +sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, Int -> IO ByteString, RemoteResponse) sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ cmd = do - encFile_ <- mapM (prepareEncryptedFile encryption) file_ - req <- httpRequest encFile_ <$> encryptEncodeHTTP2Body encryption (J.encode cmd) + (corrId, cmdKN, sfKN) <- atomically $ getRemoteSndKeys encryption + encCmd <- encryptEncodeHTTP2Body corrId cmdKN encryption $ J.encode cmd + encFile_ <- mapM (prepareEncryptedFile sfKN) file_ + let req = httpRequest encFile_ encCmd HTTP2Response {response, respBody} <- liftError' (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing - (header, getNext) <- parseDecryptHTTP2Body encryption response respBody + (rfKN, header, getNext) <- parseDecryptHTTP2Body encryption response respBody rr <- liftEitherWith (RPEInvalidJSON . fromString) $ J.eitherDecode header >>= JT.parseEither J.parseJSON . convertJSON hostEncoding localEncoding - pure (getNext, rr) + pure (rfKN, getNext, rr) where httpRequest encFile_ cmdBld = H.requestStreaming N.methodPost "/" mempty $ \send flush -> do send cmdBld @@ -213,13 +222,11 @@ pattern OwsfTag = (SingleFieldJSONTag, J.Bool True) -- See https://github.com/simplex-chat/simplexmq/blob/master/rfcs/2023-10-25-remote-control.md for encoding -encryptEncodeHTTP2Body :: RemoteCrypto -> LazyByteString -> ExceptT RemoteProtocolError IO Builder -encryptEncodeHTTP2Body RemoteCrypto {drg, counter, sessionCode, hybridKey, signatures} s = do - corrId <- atomically $ stateTVar counter $ \c -> (c, c + 1) - let pfx = smpEncode (sessionCode, corrId) - (nonce, ct) <- liftError PRERemoteControl $ RC.rcEncryptBody drg hybridKey $ LB.fromStrict pfx <> s +encryptEncodeHTTP2Body :: Word32 -> C.SbKeyNonce -> RemoteCrypto -> LazyByteString -> ExceptT RemoteProtocolError IO Builder +encryptEncodeHTTP2Body corrId cmdKN RemoteCrypto {sessionCode, signatures} s = do + ct <- liftError PRERemoteControl $ RC.rcEncryptBody cmdKN $ LB.fromStrict (smpEncode sessionCode) <> s let ctLen = encodeWord32 (fromIntegral $ LB.length ct) - signed = LB.fromStrict (smpEncode nonce <> ctLen) <> ct + signed = LB.fromStrict (encodeWord32 corrId <> ctLen) <> ct sigs <- bodySignatures signed pure $ lazyByteString signed <> sigs where @@ -235,24 +242,25 @@ encryptEncodeHTTP2Body RemoteCrypto {drg, counter, sessionCode, hybridKey, signa sign k = C.signatureBytes . C.sign' k . BA.convert . CH.hashFinalize -- | Parse and decrypt HTTP2 request/response -parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (LazyByteString, Int -> IO ByteString) -parseDecryptHTTP2Body RemoteCrypto {hybridKey, sessionCode, signatures} hr HTTP2Body {bodyBuffer} = do - (nonce, ct) <- getBody - s <- liftError PRERemoteControl $ RC.rcDecryptBody hybridKey nonce ct - (,getNext) <$> parseBody s +parseDecryptHTTP2Body :: HTTP2BodyChunk a => RemoteCrypto -> a -> HTTP2Body -> ExceptT RemoteProtocolError IO (C.SbKeyNonce, LazyByteString, Int -> IO ByteString) +parseDecryptHTTP2Body rc@RemoteCrypto {sessionCode, signatures} hr HTTP2Body {bodyBuffer} = do + (corrId, ct) <- getBody + (cmdKN, rfKN) <- ExceptT $ atomically $ getRemoteRcvKeys rc corrId + s <- liftError PRERemoteControl $ RC.rcDecryptBody cmdKN ct + s' <- parseBody s + pure (rfKN, s', getNext) where - getBody :: ExceptT RemoteProtocolError IO (C.CbNonce, LazyByteString) + getBody :: ExceptT RemoteProtocolError IO (Word32, LazyByteString) getBody = do - nonceStr <- liftIO $ getNext 24 - nonce <- liftEitherWith RPEInvalidBody $ smpDecode nonceStr + corrIdStr <- liftIO $ getNext 4 ctLenStr <- liftIO $ getNext 4 let ctLen = decodeWord32 ctLenStr when (ctLen > fromIntegral (maxBound :: Int)) $ throwError RPEInvalidSize chunks <- liftIO $ getLazy $ fromIntegral ctLen - let hc = CH.hashUpdates (CH.hashInit @SHA512) [nonceStr, ctLenStr] + let hc = CH.hashUpdates (CH.hashInit @SHA512) [corrIdStr, ctLenStr] hc' = CH.hashUpdates hc chunks verifySignatures hc' - pure (nonce, LB.fromChunks chunks) + pure (decodeWord32 corrIdStr, LB.fromChunks chunks) getLazy :: Int -> IO [ByteString] getLazy 0 = pure [] getLazy n = do @@ -279,9 +287,8 @@ parseDecryptHTTP2Body RemoteCrypto {hybridKey, sessionCode, signatures} hr HTTP2 parseBody s = case LB.uncons s of Nothing -> throwError $ RPEInvalidBody "empty body" Just (scLen, rest) -> do - (sessCode', rest') <- takeBytes (fromIntegral scLen) rest + (sessCode', s') <- takeBytes (fromIntegral scLen) rest unless (sessCode' == sessionCode) $ throwError PRESessionCode - (_corrId, s') <- takeBytes 8 rest' pure s' where takeBytes n s' = do diff --git a/src/Simplex/Chat/Remote/Transport.hs b/src/Simplex/Chat/Remote/Transport.hs index 774aeccda2..933936aa4d 100644 --- a/src/Simplex/Chat/Remote/Transport.hs +++ b/src/Simplex/Chat/Remote/Transport.hs @@ -1,5 +1,6 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module Simplex.Chat.Remote.Transport where @@ -20,27 +21,25 @@ import Simplex.RemoteControl.Types (RCErrorType (..)) import UnliftIO import UnliftIO.Directory (getFileSize) -type EncryptedFile = ((Handle, Word32), C.CbNonce, LC.SbState) +type EncryptedFile = ((Handle, Word32), LC.SbState) -prepareEncryptedFile :: RemoteCrypto -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile -prepareEncryptedFile RemoteCrypto {drg, hybridKey} f = do - nonce <- atomically $ C.randomCbNonce drg - sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.kcbInit hybridKey nonce - pure (f, nonce, sbState) +prepareEncryptedFile :: C.SbKeyNonce -> (Handle, Word32) -> ExceptT RemoteProtocolError IO EncryptedFile +prepareEncryptedFile (sk, nonce) f = do + sbState <- liftEitherWith (const $ PRERemoteControl RCEEncrypt) $ LC.sbInit sk nonce + pure (f, sbState) sendEncryptedFile :: EncryptedFile -> (Builder -> IO ()) -> IO () -sendEncryptedFile ((h, sz), nonce, sbState) send = do - send $ byteString $ smpEncode ('\x01', nonce, sz + fromIntegral C.authTagSize) +sendEncryptedFile ((h, sz), sbState) send = do + send $ byteString $ smpEncode ('\x01', sz + fromIntegral C.authTagSize) sendEncFile h send sbState sz -receiveEncryptedFile :: RemoteCrypto -> (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO () -receiveEncryptedFile RemoteCrypto {hybridKey} getChunk fileSize fileDigest toPath = do +receiveEncryptedFile :: C.SbKeyNonce -> (Int -> IO ByteString) -> Word32 -> FileDigest -> FilePath -> ExceptT RemoteProtocolError IO () +receiveEncryptedFile (sk, nonce) getChunk fileSize fileDigest toPath = do c <- liftIO $ getChunk 1 unless (c == "\x01") $ throwError RPENoFile - nonce <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 24 size <- liftError' RPEInvalidBody $ smpDecode <$> getChunk 4 unless (size == fileSize + fromIntegral C.authTagSize) $ throwError RPEFileSize - sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.kcbInit hybridKey nonce + sbState <- liftEitherWith (const $ PRERemoteControl RCEDecrypt) $ LC.sbInit sk nonce liftError' fErr $ withFile toPath WriteMode $ \h -> receiveSbFile getChunk h sbState fileSize digest <- liftIO $ LC.sha512Hash <$> LB.readFile toPath unless (FileDigest digest == fileDigest) $ throwError RPEFileDigest diff --git a/src/Simplex/Chat/Remote/Types.hs b/src/Simplex/Chat/Remote/Types.hs index d85dde9e87..a5396e7945 100644 --- a/src/Simplex/Chat/Remote/Types.hs +++ b/src/Simplex/Chat/Remote/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} @@ -11,22 +12,22 @@ module Simplex.Chat.Remote.Types where import Control.Concurrent.Async (Async) -import Control.Concurrent.STM (TVar) +import Control.Concurrent.STM import Control.Exception (Exception) -import Crypto.Random (ChaChaDRG) +import Control.Monad (when) import qualified Data.Aeson.TH as J import Data.ByteString (ByteString) import Data.Int (Int64) import Data.Text (Text) -import Data.Word (Word16) +import Data.Word (Word16, Word32) import Simplex.Chat.Remote.AppVersion import Simplex.Chat.Types (verificationCode) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Crypto.File (CryptoFile) -import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret) import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON) -import Simplex.Messaging.Transport (TLS (..)) +import Simplex.Messaging.Transport (TLS (..), TSbChainKeys (..)) import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client) +import qualified Simplex.Messaging.TMap as TM import Simplex.RemoteControl.Client import Simplex.RemoteControl.Types @@ -40,13 +41,45 @@ data RemoteHostClient = RemoteHostClient } data RemoteCrypto = RemoteCrypto - { drg :: TVar ChaChaDRG, - counter :: TVar Int64, - sessionCode :: ByteString, - hybridKey :: KEMHybridSecret, + { sessionCode :: ByteString, + sndCounter :: TVar Word32, + rcvCounter :: TVar Word32, + chainKeys :: TSbChainKeys, + skippedKeys :: TM.TMap Word32 (C.SbKeyNonce, C.SbKeyNonce), signatures :: RemoteSignatures } +getRemoteSndKeys :: RemoteCrypto -> STM (Word32, C.SbKeyNonce, C.SbKeyNonce) +getRemoteSndKeys RemoteCrypto {sndCounter, chainKeys = TSbChainKeys {sndKey}} = do + corrId <- stateTVar sndCounter $ \c -> let !c' = c + 1 in (c', c') + cmdKN <- stateTVar sndKey C.sbcHkdf + fileKN <- stateTVar sndKey C.sbcHkdf + pure (corrId, cmdKN, fileKN) + +getRemoteRcvKeys :: RemoteCrypto -> Word32 -> STM (Either RemoteProtocolError (C.SbKeyNonce, C.SbKeyNonce)) +getRemoteRcvKeys RemoteCrypto {rcvCounter, chainKeys = TSbChainKeys {rcvKey}, skippedKeys} !corrId = + readTVar rcvCounter >>= getRcvKeys + where + getRcvKeys prevCorrId + | prevCorrId > corrId = + let err = PREEarlierId $ prevCorrId - corrId + in maybe (Left err) Right <$> TM.lookupDelete corrId skippedKeys + | prevCorrId == corrId = + pure $ Left PREDuplicateId + | prevCorrId + maxSkip < corrId = + pure $ Left $ RPEManySkippedIds (corrId - prevCorrId) + | otherwise = do -- prevCorrId < corrId + writeTVar rcvCounter corrId + skipKeys (prevCorrId + 1) + Right <$> getKeys + maxSkip = 256 + getKeys = (,) <$> stateTVar rcvKey C.sbcHkdf <*> stateTVar rcvKey C.sbcHkdf + skipKeys !cId = + when (cId < corrId) $ do + keys <- getKeys + TM.insert cId keys skippedKeys + skipKeys (cId + 1) + data RemoteSignatures = RSSign { idPrivKey :: C.PrivateKeyEd25519, @@ -110,6 +143,9 @@ data RemoteProtocolError | RPENoFile | RPEFileSize | RPEFileDigest + | RPEManySkippedIds Word32 + | PREEarlierId Word32 + | PREDuplicateId | -- | Wrong response received for the command sent RPEUnexpectedResponse {response :: Text} | -- | A file already exists in the destination position