blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: remote control command/response encryption and signing inside TLS (#3339)

Browse Source 
* core: remote control command/response encryption inside TLS (except files, no signing)

* sign/verify

* update simplexmq

* fix lazy

* remove RSNone
This commit is contained in:
Evgeny Poberezkin
2023-11-10 16:10:10 +00:00
committed by GitHub
parent f41861c026
commit 02225df274
6 changed files with 187 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Remote.hs
+12 -10
View File
@@ -60,7 +60,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
import qualified Simplex.Messaging.Crypto.File as CF
import Simplex.Messaging.Encoding.String (StrEncoding (..))
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (TLS, closeConnection)
import Simplex.Messaging.Transport (TLS, closeConnection, tlsUniq)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError, closeHTTP2Client)
import Simplex.Messaging.Transport.HTTP2.File (hSendFile)
@@ -178,7 +178,7 @@ startRemoteHost' rh_ = do
atomically $ writeTMVar currentKey rhKey'
disconnected <- toIO $ onDisconnected remoteHostId
httpClient <- liftEitherError (httpError rhKey') $ attachRevHTTP2Client disconnected tls
let rhClient = mkRemoteHostClient httpClient sessionKeys storePath hostInfo
rhClient <- mkRemoteHostClient httpClient sessionKeys sessId storePath hostInfo
pollAction <- async $ pollEvents remoteHostId rhClient
withRemoteHostSession rhKey' $ \case
RHSessionConfirmed _ RHPendingSession {} -> Right ((), RHSessionConnected {tls, rhClient, pollAction, storePath})
@@ -358,8 +358,8 @@ connectRemoteCtrl inv@RCSignedInvitation {invitation = RCInvitation {ca, app}} =
encryptFiles <- chatReadVar encryptLocalFiles
pure HostAppInfo {appVersion, deviceName = hostDeviceName, encoding = localEncoding, encryptFiles}
handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> CtrlSessKeys -> TBQueue ChatResponse -> HTTP2Request -> m ()
handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
handleRemoteCommand :: forall m. ChatMonad m => (ByteString -> m ChatResponse) -> RemoteCrypto -> TBQueue ChatResponse -> HTTP2Request -> m ()
handleRemoteCommand execChatCommand encryption remoteOutputQ HTTP2Request {request, reqBody, sendResponse} = do
logDebug "handleRemoteCommand"
liftRC (tryRemoteError parseRequest) >>= \case
Right (getNext, rc) -> do
@@ -370,8 +370,8 @@ handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {req
where
parseRequest :: ExceptT RemoteProtocolError IO (GetChunk, RemoteCommand)
parseRequest = do
(header, getNext) <- parseHTTP2Body request reqBody
(getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecodeStrict' header)
(header, getNext) <- parseDecryptHTTP2Body encryption request reqBody
(getNext,) <$> liftEitherWith RPEInvalidJSON (J.eitherDecode header)
replyError = reply . RRChatResponse . CRChatCmdError Nothing
processCommand :: User -> GetChunk -> RemoteCommand -> m ()
processCommand user getNext = \case
@@ -382,9 +382,10 @@ handleRemoteCommand execChatCommand _sessionKeys remoteOutputQ HTTP2Request {req
reply :: RemoteResponse -> m ()
reply = (`replyWith` \_ -> pure ())
replyWith :: Respond m
replyWith rr attach =
replyWith rr attach = do
resp <- liftRC $ encryptEncodeHTTP2Body encryption $ J.encode rr
liftIO . sendResponse . responseStreaming N.status200 [] $ \send flush -> do
send $ sizePrefixedEncode rr
send resp
attach send
flush
@@ -482,11 +483,12 @@ verifyRemoteCtrlSession execChatCommand sessCode' = cleanupOnError $ do
_ -> throwError $ ChatErrorRemoteCtrl RCEBadState
let verified = sameVerificationCode sessCode' sessionCode
liftIO $ confirmCtrlSession client verified
unless verified $ throwError $ ChatErrorRemoteCtrl RCEBadVerificationCode
unless verified $ throwError $ ChatErrorRemoteCtrl $ RCEProtocolError PRESessionCode
(rcsSession@RCCtrlSession {tls, sessionKeys}, rcCtrlPairing) <- takeRCStep vars
rc@RemoteCtrl {remoteCtrlId} <- upsertRemoteCtrl ctrlName rcCtrlPairing
remoteOutputQ <- asks (tbqSize . config) >>= newTBQueueIO
http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand sessionKeys remoteOutputQ
encryption <- mkCtrlRemoteCrypto sessionKeys $ tlsUniq tls
http2Server <- async $ attachHTTP2Server tls $ handleRemoteCommand execChatCommand encryption remoteOutputQ
void . forkIO $ monitor http2Server
withRemoteCtrlSession $ \case
RCSessionPendingConfirmation {} -> Right ((), RCSessionConnected {remoteCtrlId, rcsClient = client, rcsSession, tls, http2Server, remoteOutputQ})