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

Add commands for remote session credentials (#3161)

Browse Source 
* Add remote host commands

* Make startRemoteHost async

* Add tests

* Trim randomStorePath to 16 chars

* Add chat command tests

* add view, use view output in test

* enable all tests

* Fix discovery listener host

Must use any, not broadcast on macos.

* Fix missing do

* address, names

* Fix session host flow

* fix test

---------

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
This commit is contained in:
Alexander Bondarenko
2023-10-04 18:36:10 +03:00
committed by GitHub
parent bf7917bd67
commit 0bcf5c9c66
13 changed files with 515 additions and 197 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/View.hs
+44 -2
View File
@@ -4,10 +4,10 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE OverloadedRecordDot #-}
module Simplex.Chat.View where
@@ -42,6 +42,7 @@ import Simplex.Chat.Markdown
import Simplex.Chat.Messages hiding (NewChatItem (..))
import Simplex.Chat.Messages.CIContent
import Simplex.Chat.Protocol
import Simplex.Chat.Remote.Types
import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..))
import Simplex.Chat.Styled
import Simplex.Chat.Types
@@ -258,6 +259,23 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
CRNtfMessages {} -> []
CRRemoteHostCreated rhId oobData -> ("remote host " <> sShow rhId <> " created") : viewRemoteCtrlOOBData oobData
CRRemoteHostList hs -> viewRemoteHosts hs
CRRemoteHostStarted rhId -> ["remote host " <> sShow rhId <> " started"]
CRRemoteHostConnected rhId -> ["remote host " <> sShow rhId <> " connected"]
CRRemoteHostStopped rhId -> ["remote host " <> sShow rhId <> " stopped"]
CRRemoteHostDeleted rhId -> ["remote host " <> sShow rhId <> " deleted"]
CRRemoteCtrlList cs -> viewRemoteCtrls cs
CRRemoteCtrlRegistered rcId -> ["remote controller " <> sShow rcId <> " registered"]
CRRemoteCtrlStarted -> ["remote controller started"]
CRRemoteCtrlAnnounce fingerprint -> ["remote controller announced", "connection code:", plain $ strEncode fingerprint]
CRRemoteCtrlFound rc -> ["remote controller found:", viewRemoteCtrl rc]
CRRemoteCtrlAccepted rcId -> ["remote controller " <> sShow rcId <> " accepted"]
CRRemoteCtrlRejected rcId -> ["remote controller " <> sShow rcId <> " rejected"]
CRRemoteCtrlConnecting rcId rcName -> ["remote controller " <> sShow rcId <> " connecting to " <> plain rcName]
CRRemoteCtrlConnected rcId rcName -> ["remote controller " <> sShow rcId <> " connected, " <> plain rcName]
CRRemoteCtrlStopped rcId -> ["remote controller " <> sShow rcId <> " stopped"]
CRRemoteCtrlDeleted rcId -> ["remote controller " <> sShow rcId <> " deleted"]
CRSQLResult rows -> map plain rows
CRSlowSQLQueries {chatQueries, agentQueries} ->
let viewQuery SlowSQLQuery {query, queryStats = SlowQueryStats {count, timeMax, timeAvg}} =
@@ -298,7 +316,6 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView
CRChatError u e -> ttyUser' u $ viewChatError logLevel e
CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
CRTimedAction _ _ -> []
todo'cr -> ["TODO" <> sShow todo'cr]
where
ttyUser :: User -> [StyledString] -> [StyledString]
ttyUser user@User {showNtfs, activeUser} ss
@@ -1539,6 +1556,31 @@ viewVersionInfo logLevel CoreVersionInfo {version, simplexmqVersion, simplexmqCo
where
parens s = " (" <> s <> ")"
viewRemoteCtrlOOBData :: RemoteCtrlOOB -> [StyledString]
viewRemoteCtrlOOBData RemoteCtrlOOB {caFingerprint} =
["connection code:", plain $ strEncode caFingerprint]
viewRemoteHosts :: [RemoteHostInfo] -> [StyledString]
viewRemoteHosts = \case
[] -> ["No remote hosts"]
hs -> "Remote hosts: " : map viewRemoteHostInfo hs
where
viewRemoteHostInfo RemoteHostInfo {remoteHostId, displayName, sessionActive} =
plain $ tshow remoteHostId <> ". " <> displayName <> if sessionActive then " (active)" else ""
viewRemoteCtrls :: [RemoteCtrlInfo] -> [StyledString]
viewRemoteCtrls = \case
[] -> ["No remote controllers"]
hs -> "Remote controllers: " : map viewRemoteCtrlInfo hs
where
viewRemoteCtrlInfo RemoteCtrlInfo {remoteCtrlId, displayName, sessionActive} =
plain $ tshow remoteCtrlId <> ". " <> displayName <> if sessionActive then " (active)" else ""
-- TODO fingerprint, accepted?
viewRemoteCtrl :: RemoteCtrl -> StyledString
viewRemoteCtrl RemoteCtrl {remoteCtrlId, displayName} =
plain $ tshow remoteCtrlId <> ". " <> displayName
viewChatError :: ChatLogLevel -> ChatError -> [StyledString]
viewChatError logLevel = \case
ChatError err -> case err of