IntenseFinance/simplex-chat
3
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: api to abort connection switch; update simplexmq (#2544)

Browse Source
This commit is contained in:
spaced4ndy
2023-06-16 19:05:53 +04:00
committed by GitHub
parent 46c6f5e615
commit 6d3cb0ea2e
8 changed files with 131 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/Simplex/Chat.hs
View File

@@ -1110,6 +1110,17 @@ processChatCommand = \case
case memberConnId m of
Just connId -> withAgent (\a -> switchConnectionAsync a "" connId) >> ok user
_ -> throwChatError CEGroupMemberNotActive
APIAbortSwitchContact contactId -> withUser $ \user -> do
ct <- withStore $ \db -> getContact db user contactId
connectionStats <- withAgent $ \a -> abortConnectionSwitch a $ contactConnId ct
pure $ CRContactSwitchAborted user ct connectionStats
APIAbortSwitchGroupMember gId gMemberId -> withUser $ \user -> do
(g, m) <- withStore $ \db -> (,) <$> getGroupInfo db user gId <*> getGroupMember db user gId gMemberId
case memberConnId m of
Just connId -> do
connectionStats <- withAgent $ \a -> abortConnectionSwitch a connId
pure $ CRGroupMemberSwitchAborted user g m connectionStats
_ -> throwChatError CEGroupMemberNotActive
APIGetContactCode contactId -> withUser $ \user -> do
ct@Contact {activeConn = conn@Connection {connId}} <- withStore $ \db -> getContact db user contactId
code <- getConnectionCode (contactConnId ct)
@@ -1164,6 +1175,8 @@ processChatCommand = \case
GroupMemberInfo gName mName -> withMemberName gName mName APIGroupMemberInfo
SwitchContact cName -> withContactName cName APISwitchContact
SwitchGroupMember gName mName -> withMemberName gName mName APISwitchGroupMember
AbortSwitchContact cName -> withContactName cName APIAbortSwitchContact
AbortSwitchGroupMember gName mName -> withMemberName gName mName APIAbortSwitchGroupMember
GetContactCode cName -> withContactName cName APIGetContactCode
GetGroupMemberCode gName mName -> withMemberName gName mName APIGetGroupMemberCode
VerifyContact cName code -> withContactName cName (`APIVerifyContact` code)
@@ -2810,7 +2823,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
_ -> pure ()
SWITCH qd phase cStats -> do
toView $ CRContactSwitch user ct (SwitchProgress qd phase cStats)
when (phase /= SPConfirmed) $ case qd of
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
QDRcv -> createInternalChatItem user (CDDirectSnd ct) (CISndConnEvent $ SCESwitchQueue phase Nothing) Nothing
QDSnd -> createInternalChatItem user (CDDirectRcv ct) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
OK ->
@@ -2989,7 +3002,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
checkSndInlineFTComplete conn msgId
SWITCH qd phase cStats -> do
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
when (phase /= SPConfirmed) $ case qd of
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
QDRcv -> createInternalChatItem user (CDGroupSnd gInfo) (CISndConnEvent . SCESwitchQueue phase . Just $ groupMemberRef m) Nothing
QDSnd -> createInternalChatItem user (CDGroupRcv gInfo m) (CIRcvConnEvent $ RCESwitchQueue phase) Nothing
OK ->
@@ -4858,8 +4871,12 @@ chatCommandP =
("/info " <|> "/i ") *> char_ '@' *> (ContactInfo <$> displayName),
"/_switch #" *> (APISwitchGroupMember <$> A.decimal <* A.space <*> A.decimal),
"/_switch @" *> (APISwitchContact <$> A.decimal),
"/_abort switch #" *> (APIAbortSwitchGroupMember <$> A.decimal <* A.space <*> A.decimal),
"/_abort switch @" *> (APIAbortSwitchContact <$> A.decimal),
"/switch #" *> (SwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName),
"/switch " *> char_ '@' *> (SwitchContact <$> displayName),
"/abort switch #" *> (AbortSwitchGroupMember <$> displayName <* A.space <* char_ '@' <*> displayName),
"/abort switch " *> char_ '@' *> (AbortSwitchContact <$> displayName),
"/_get code @" *> (APIGetContactCode <$> A.decimal),
"/_get code #" *> (APIGetGroupMemberCode <$> A.decimal <* A.space <*> A.decimal),
"/_verify code @" *> (APIVerifyContact <$> A.decimal <*> optional (A.space *> textP)),

6
src/Simplex/Chat/Controller.hs
View File

@@ -284,6 +284,8 @@ data ChatCommand
| APIGroupMemberInfo GroupId GroupMemberId
| APISwitchContact ContactId
| APISwitchGroupMember GroupId GroupMemberId
| APIAbortSwitchContact ContactId
| APIAbortSwitchGroupMember GroupId GroupMemberId
| APIGetContactCode ContactId
| APIGetGroupMemberCode GroupId GroupMemberId
| APIVerifyContact ContactId (Maybe Text)
@@ -295,6 +297,8 @@ data ChatCommand
| GroupMemberInfo GroupName ContactName
| SwitchContact ContactName
| SwitchGroupMember GroupName ContactName
| AbortSwitchContact ContactName
| AbortSwitchGroupMember GroupName ContactName
| GetContactCode ContactName
| GetGroupMemberCode GroupName ContactName
| VerifyContact ContactName (Maybe Text)
@@ -403,6 +407,8 @@ data ChatResponse
| CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
| CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
| CRContactSwitchAborted {user :: User, contact :: Contact, connectionStats :: ConnectionStats}
| CRGroupMemberSwitchAborted {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats :: ConnectionStats}
| CRContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
| CRGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
| CRContactCode {user :: User, contact :: Contact, connectionCode :: Text}

8
src/Simplex/Chat/Messages/ChatItemContent.hs
View File

@@ -383,14 +383,18 @@ sndGroupEventToText = \case
rcvConnEventToText :: RcvConnEvent -> Text
rcvConnEventToText = \case
RCESwitchQueue phase -> case phase of
SPStarted -> "started changing address for you..."
SPConfirmed -> "confirmed changing address for you..."
SPSecured -> "secured new address for you..."
SPCompleted -> "changed address for you"
_ -> decodeLatin1 (strEncode phase) <> " changing address for you..."
sndConnEventToText :: SndConnEvent -> Text
sndConnEventToText = \case
SCESwitchQueue phase m -> case phase of
SPStarted -> "started changing address" <> forMember m <> "..."
SPConfirmed -> "confirmed changing address" <> forMember m <> "..."
SPSecured -> "secured new address" <> forMember m <> "..."
SPCompleted -> "you changed address" <> forMember m
_ -> decodeLatin1 (strEncode phase) <> " changing address" <> forMember m <> "..."
where
forMember member_ =
maybe "" (\GroupMemberRef {profile = Profile {displayName}} -> " for " <> displayName) member_

43
src/Simplex/Chat/View.hs
View File

@@ -47,6 +47,7 @@ import qualified Simplex.FileTransfer.Protocol as XFTP
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store (canAbortRcvSwitch)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
@@ -80,6 +81,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts
CRNetworkConfig cfg -> viewNetworkConfig cfg
CRContactInfo u ct cStats customUserProfile -> ttyUser u $ viewContactInfo ct cStats customUserProfile
CRGroupMemberInfo u g m cStats -> ttyUser u $ viewGroupMemberInfo g m cStats
CRContactSwitchAborted {} -> ["switch aborted"]
CRGroupMemberSwitchAborted {} -> ["switch aborted"]
CRContactSwitch u ct progress -> ttyUser u $ viewContactSwitch ct progress
CRGroupMemberSwitch u g m progress -> ttyUser u $ viewGroupMemberSwitch g m progress
CRConnectionVerified u verified code -> ttyUser u [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
@@ -918,24 +921,46 @@ viewConnectionVerified (Just _) = "connection verified" -- TODO show verificatio
viewConnectionVerified _ = "connection not verified, use " <> highlight' "/code" <> " command to see security code"
viewConnectionStats :: ConnectionStats -> [StyledString]
viewConnectionStats ConnectionStats {rcvServers, sndServers} =
["receiving messages via: " <> viewServerHosts rcvServers | not $ null rcvServers]
<> ["sending messages via: " <> viewServerHosts sndServers | not $ null sndServers]
viewConnectionStats ConnectionStats {rcvQueuesInfo, sndQueuesInfo} =
["receiving messages via: " <> viewRcvQueuesInfo rcvQueuesInfo | not $ null rcvQueuesInfo]
<> ["sending messages via: " <> viewSndQueuesInfo sndQueuesInfo | not $ null sndQueuesInfo]
viewServers :: ProtocolTypeI p => (a -> ProtoServerWithAuth p) -> NonEmpty a -> [StyledString]
viewServers f = map (plain . B.unpack . strEncode . f) . L.toList
viewServerHosts :: [SMPServer] -> StyledString
viewServerHosts = plain . intercalate ", " . map showSMPServer
viewRcvQueuesInfo :: [RcvQueueInfo] -> StyledString
viewRcvQueuesInfo = plain . intercalate ", " . map showQueueInfo
where
showQueueInfo RcvQueueInfo {rcvServer, rcvSwitchStatus, canAbortSwitch} =
let switchCanBeAborted = if canAbortSwitch then ", can be aborted" else ""
in showSMPServer rcvServer
<> maybe "" (\s -> " (" <> showSwitchStatus s <> switchCanBeAborted <> ")") rcvSwitchStatus
showSwitchStatus = \case
RSSwitchStarted -> "switch started"
RSSendingQADD -> "switch started"
RSSendingQUSE -> "switch confirmed"
RSReceivedMessage -> "switch secured"
viewSndQueuesInfo :: [SndQueueInfo] -> StyledString
viewSndQueuesInfo = plain . intercalate ", " . map showQueueInfo
where
showQueueInfo SndQueueInfo {sndServer, sndSwitchStatus} =
showSMPServer sndServer
<> maybe "" (\s -> " (" <> showSwitchStatus s <> ")") sndSwitchStatus
showSwitchStatus = \case
SSSendingQKEY -> "switch started"
SSSendingQTEST -> "switch secured"
viewContactSwitch :: Contact -> SwitchProgress -> [StyledString]
viewContactSwitch _ (SwitchProgress _ SPConfirmed _) = []
viewContactSwitch _ (SwitchProgress _ SPSecured _) = []
viewContactSwitch ct (SwitchProgress qd phase _) = case qd of
QDRcv -> [ttyContact' ct <> ": you " <> viewSwitchPhase phase]
QDSnd -> [ttyContact' ct <> " " <> viewSwitchPhase phase <> " for you"]
viewGroupMemberSwitch :: GroupInfo -> GroupMember -> SwitchProgress -> [StyledString]
viewGroupMemberSwitch _ _ (SwitchProgress _ SPConfirmed _) = []
viewGroupMemberSwitch _ _ (SwitchProgress _ SPSecured _) = []
viewGroupMemberSwitch g m (SwitchProgress qd phase _) = case qd of
QDRcv -> [ttyGroup' g <> ": you " <> viewSwitchPhase phase <> " for " <> ttyMember m]
QDSnd -> [ttyGroup' g <> ": " <> ttyMember m <> " " <> viewSwitchPhase phase <> " for you"]
@@ -952,8 +977,11 @@ viewSecurityCode name cmd code testView
| otherwise = [name <> " security code:", plain code, "pass this code to your contact and use " <> highlight cmd <> " to verify"]
viewSwitchPhase :: SwitchPhase -> StyledString
viewSwitchPhase SPCompleted = "changed address"
viewSwitchPhase phase = plain (strEncode phase) <> " changing address"
viewSwitchPhase = \case
SPStarted -> "started changing address"
SPConfirmed -> "confirmed changing address"
SPSecured -> "secured new address"
SPCompleted -> "changed address"
viewUserProfileUpdated :: Profile -> Profile -> [StyledString]
viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} =
@@ -1478,6 +1506,7 @@ viewChatError logLevel = \case
DBErrorOpen e -> ["error opening database after encryption: " <> sqliteError' e]
e -> ["chat database error: " <> sShow e]
ChatErrorAgent err entity_ -> case err of
CMD PROHIBITED -> [withConnEntity <> "error: command is prohibited"]
SMP SMP.AUTH ->
[ withConnEntity
<> "error: connection authorization failed - this could happen if connection was deleted,\