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

remote protocol (#3225)

Browse Source 
* draft remote protocol types and external api

* types (it compiles)

* add error

* move remote controller from http to remote host client protocol

* refactor (doesnt compile)

* fix compile

* Connect remote session

* WIP: wire in remote protocol

* add commands and events

* cleanup

* fix desktop shutdown

* prepare for testing remote files

* Add file IO

* update simplexmq to master

with http2 to 4.1.4

* use json transcoder

* update simplexmq

* collapse RemoteHostSession states

* fold RemoteHello back into the protocol command
move http-command-response-http wrapper to protocol

* use sendRemoteCommand with optional attachments
use streaming request/response

* ditch lazy body streaming

* fix formatting

* put body builder/processor closer together

* wrap handleRemoteCommand around sending files

* handle ChatError's too

* remove binary, use 32-bit encoding for JSON bodies

* enable tests

* refactor

* refactor request handling

* return ChatError

* Flatten remote host

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
2023-10-22 11:42:19 +03:00
committed by GitHub
parent 0444367002
commit 0d1a080a6e
15 changed files with 693 additions and 537 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+8 -4
View File
@@ -109,6 +109,7 @@ import System.Random (randomRIO)
import Text.Read (readMaybe)
import UnliftIO.Async
import UnliftIO.Concurrent (forkFinally, forkIO, mkWeakThreadId, threadDelay)
import qualified UnliftIO.Exception as E
import UnliftIO.Directory
import UnliftIO.IO (hClose, hSeek, hTell, openFile)
import UnliftIO.STM
@@ -389,17 +390,20 @@ execChatCommand rh s = do
case parseChatCommand s of
Left e -> pure $ chatCmdError u e
Right cmd -> case rh of
Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId (s, cmd)
Just remoteHostId | allowRemoteCommand cmd -> execRemoteCommand u remoteHostId s
_ -> execChatCommand_ u cmd
execChatCommand' :: ChatMonad' m => ChatCommand -> m ChatResponse
execChatCommand' cmd = asks currentUser >>= readTVarIO >>= (`execChatCommand_` cmd)
execChatCommand_ :: ChatMonad' m => Maybe User -> ChatCommand -> m ChatResponse
execChatCommand_ u cmd = either (CRChatCmdError u) id <$> runExceptT (processChatCommand cmd)
execChatCommand_ u cmd = handleCommandError u $ processChatCommand cmd
execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> (ByteString, ChatCommand) -> m ChatResponse
execRemoteCommand u rhId scmd = either (CRChatCmdError u) id <$> runExceptT (getRemoteHostSession rhId >>= (`processRemoteCommand` scmd))
execRemoteCommand :: ChatMonad' m => Maybe User -> RemoteHostId -> ByteString -> m ChatResponse
execRemoteCommand u rhId s = handleCommandError u $ getRemoteHostSession rhId >>= \rh -> processRemoteCommand rhId rh s
handleCommandError :: ChatMonad' m => Maybe User -> ExceptT ChatError m ChatResponse -> m ChatResponse
handleCommandError u a = either (CRChatCmdError u) id <$> (runExceptT a `E.catch` (pure . Left . mkChatError))
parseChatCommand :: ByteString -> Either String ChatCommand
parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace