Compare commits

...

2 Commits

Author SHA1 Message Date
Evgeny Poberezkin
c7f5443920 fix 2023-04-07 11:01:33 +01:00
Evgeny Poberezkin
ccff79aa59 core: allow messages with contact requests 2023-04-07 10:15:19 +01:00
5 changed files with 35 additions and 31 deletions

View File

@ -1070,8 +1070,9 @@ processChatCommand = \case
pure $ CRInvitation user cReq
AddContact -> withUser $ \User {userId} ->
processChatCommand $ APIAddContact userId
APIConnect userId (Just (ACR SCMInvitation cReq)) -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
APIConnect userId (Just (ACR SCMInvitation cReq)) mc_ -> withUserId userId $ \user -> withChatLock "connect" . procCmd $ do
-- [incognito] generate profile to send
when (isJust mc_) $ throwChatError CEConnReqMessageProhibited
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing
@ -1079,13 +1080,11 @@ processChatCommand = \case
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined $ incognitoProfile $> profileToSend
toView $ CRNewContactConnection user conn
pure $ CRSentConfirmation user
APIConnect userId (Just (ACR SCMContact cReq)) -> withUserId userId (`connectViaContact` cReq)
APIConnect _ Nothing -> throwChatError CEInvalidConnReq
Connect cReqUri -> withUser $ \User {userId} ->
processChatCommand $ APIConnect userId cReqUri
ConnectSimplex -> withUser $ \user ->
-- [incognito] generate profile to send
connectViaContact user adminContactReq
APIConnect userId (Just (ACR SCMContact cReq)) mc_ -> withUserId userId $ \user -> connectViaContact user cReq mc_
APIConnect _ Nothing _ -> throwChatError CEInvalidConnReq
Connect cReqUri msg_ -> withUser $ \User {userId} ->
processChatCommand $ APIConnect userId cReqUri $ MCText <$> msg_
ConnectSimplex msg_ -> withUser $ \user -> connectViaContact user adminContactReq $ MCText <$> msg_
DeleteContact cName -> withContactName cName $ APIDeleteChat . ChatRef CTDirect
ClearContact cName -> withContactName cName $ APIClearChat . ChatRef CTDirect
APIListContacts userId -> withUserId userId $ \user ->
@ -1536,12 +1535,14 @@ processChatCommand = \case
CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg
CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg
_ -> throwChatError $ CECommandError "not supported"
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> m ChatResponse
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
connectViaContact :: User -> ConnectionRequestUri 'CMContact -> Maybe MsgContent -> m ChatResponse
connectViaContact user@User {userId} cReq@(CRContactUri ConnReqUriData {crClientData}) mc_ = withChatLock "connectViaContact" $ do
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
withStore' (\db -> getConnReqContactXContactId db user cReqHash) >>= \case
(Just contact, _) -> pure $ CRContactAlreadyExists user contact
(_, xContactId_) -> procCmd $ do
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
when (isJust groupLinkId && isJust mc_) $ throwChatError CEConnReqMessageProhibited
let randomXContactId = XContactId <$> drgRandomBytes 16
xContactId <- maybe randomXContactId pure xContactId_
-- [incognito] generate profile to send
@ -1552,8 +1553,7 @@ processChatCommand = \case
incognito <- readTVarIO =<< asks incognitoMode
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
let profileToSend = userProfileToSend user incognitoProfile Nothing
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend $ Just xContactId)
let groupLinkId = crClientData >>= decodeJSON >>= \(CRDataGroup gli) -> Just gli
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq $ directMessage (XContact profileToSend (Just xContactId) mc_)
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId
toView $ CRNewContactConnection user conn
pure $ CRSentInvitation user incognitoProfile
@ -2921,8 +2921,8 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
REQ invId _ connInfo -> do
ChatMessage {chatMsgEvent} <- parseChatMessage connInfo
case chatMsgEvent of
XContact p xContactId_ -> profileContactRequest invId p xContactId_
XInfo p -> profileContactRequest invId p Nothing
XContact p xContactId_ mc_ -> profileContactRequest invId p xContactId_ mc_
XInfo p -> profileContactRequest invId p Nothing Nothing
-- TODO show/log error, other events in contact request
_ -> pure ()
MERR _ err -> do
@ -2934,19 +2934,21 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
-- TODO add debugging output
_ -> pure ()
where
profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> m ()
profileContactRequest invId p xContactId_ = do
profileContactRequest :: InvitationId -> Profile -> Maybe XContactId -> Maybe MsgContent -> m ()
profileContactRequest invId p xContactId_ _mc_ = do
withStore (\db -> createOrUpdateContactRequest db user userContactLinkId invId p xContactId_) >>= \case
CORContact contact -> toView $ CRContactRequestAlreadyAccepted user contact
CORRequest cReq@UserContactRequest {localDisplayName} -> do
withStore' (\db -> getUserContactLinkById db userId userContactLinkId) >>= \case
Just (UserContactLink {autoAccept}, groupId_, _) ->
-- TODO add chat item for contact request
case autoAccept of
Just AutoAccept {acceptIncognito} -> case groupId_ of
Nothing -> do
-- [incognito] generate profile to send, create connection with incognito profile
incognitoProfile <- if acceptIncognito then Just . NewIncognito <$> liftIO generateRandomProfile else pure Nothing
ct <- acceptContactRequestAsync user cReq incognitoProfile
-- TODO move chat item to contact
toView $ CRAcceptingContactRequest user ct
Just groupId -> do
gInfo@GroupInfo {membership = membership@GroupMember {memberProfile}} <- withStore $ \db -> getGroupInfo db user groupId
@ -4546,9 +4548,9 @@ chatCommandP =
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
"/_connect " *> (APIConnect <$> A.decimal <* A.space <*> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> optional (A.space *> msgContentP)),
"/_connect " *> (APIAddContact <$> A.decimal),
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeByteString $> Nothing)),
("/connect " <|> "/c ") *> (Connect <$> ((Just <$> strP) <|> A.takeTill (== ' ') $> Nothing) <*> optional (A.space *> msgTextP)),
("/connect" <|> "/c") $> AddContact,
SendMessage <$> chatNameP <* A.space <*> msgTextP,
"/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")),
@ -4572,7 +4574,7 @@ chatCommandP =
("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
"/simplex" $> ConnectSimplex,
"/simplex" *> (ConnectSimplex <$> optional (A.space *> msgTextP)),
"/_address " *> (APICreateMyAddress <$> A.decimal),
("/address" <|> "/ad") $> CreateMyAddress,
"/_delete_address " *> (APIDeleteMyAddress <$> A.decimal),

View File

@ -298,9 +298,9 @@ data ChatCommand
| Welcome
| APIAddContact UserId
| AddContact
| APIConnect UserId (Maybe AConnectionRequestUri)
| Connect (Maybe AConnectionRequestUri)
| ConnectSimplex -- UserId (not used in UI)
| APIConnect UserId (Maybe AConnectionRequestUri) (Maybe MsgContent)
| Connect (Maybe AConnectionRequestUri) (Maybe Text)
| ConnectSimplex (Maybe Text)
| DeleteContact ContactName
| ClearContact ContactName
| APIListContacts UserId
@ -769,6 +769,7 @@ data ChatErrorType
| CEChatStoreChanged
| CEInvalidConnReq
| CEInvalidChatMessage {message :: String}
| CEConnReqMessageProhibited
| CEContactNotReady {contact :: Contact}
| CEContactDisabled {contact :: Contact}
| CEConnectionDisabled {connection :: Connection}

View File

@ -189,7 +189,7 @@ data ChatMsgEvent (e :: MsgEncoding) where
XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json
XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
XInfo :: Profile -> ChatMsgEvent 'Json
XContact :: Profile -> Maybe XContactId -> ChatMsgEvent 'Json
XContact :: Profile -> Maybe XContactId -> Maybe MsgContent -> ChatMsgEvent 'Json
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
@ -605,7 +605,7 @@ toCMEventTag msg = case msg of
XFileAcptInv {} -> XFileAcptInv_
XFileCancel _ -> XFileCancel_
XInfo _ -> XInfo_
XContact _ _ -> XContact_
XContact {} -> XContact_
XGrpInv _ -> XGrpInv_
XGrpAcpt _ -> XGrpAcpt_
XGrpMemNew _ -> XGrpMemNew_
@ -692,7 +692,7 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName"
XFileCancel_ -> XFileCancel <$> p "msgId"
XInfo_ -> XInfo <$> p "profile"
XContact_ -> XContact <$> p "profile" <*> opt "contactReqId"
XContact_ -> XContact <$> p "profile" <*> opt "contactReqId" <*> opt "content"
XGrpInv_ -> XGrpInv <$> p "groupInvitation"
XGrpAcpt_ -> XGrpAcpt <$> p "memberId"
XGrpMemNew_ -> XGrpMemNew <$> p "memberInfo"
@ -747,7 +747,7 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName]
XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId]
XInfo profile -> o ["profile" .= profile]
XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile]
XContact profile xContactId content -> o $ ("contactReqId" .=? xContactId) $ ("content" .=? content) ["profile" .= profile]
XGrpInv groupInv -> o ["groupInvitation" .= groupInv]
XGrpAcpt memId -> o ["memberId" .= memId]
XGrpMemNew memInfo -> o ["memberInfo" .= memInfo]

View File

@ -1271,6 +1271,7 @@ viewChatError logLevel = \case
CEChatStoreChanged -> ["error: chat store changed, please restart chat"]
CEInvalidConnReq -> viewInvalidConnReq
CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
CEConnReqMessageProhibited -> ["message is not allowed with this connection link"]
CEContactNotReady c -> [ttyContact' c <> ": not ready"]
CEContactDisabled Contact {localDisplayName = c} -> [ttyContact c <> ": disabled, to enable: " <> highlight ("/enable " <> c) <> ", to delete: " <> highlight ("/d " <> c)]
CEConnectionDisabled Connection {connId, connType} -> [plain $ "connection " <> textEncode connType <> " (" <> tshow connId <> ") is disabled" | logLevel <= CLLWarning]

View File

@ -201,16 +201,16 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
#==# XInfo Profile {displayName = "alice", fullName = "", image = Nothing, preferences = testChatPreferences}
it "x.contact with xContactId" $
"{\"event\":\"x.contact\",\"params\":{\"contactReqId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}"
#==# XContact testProfile (Just $ XContactId "\1\2\3\4")
#==# XContact testProfile (Just $ XContactId "\1\2\3\4") Nothing
it "x.contact without XContactId" $
"{\"event\":\"x.contact\",\"params\":{\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}"
#==# XContact testProfile Nothing
#==# XContact testProfile Nothing Nothing
it "x.contact with content null" $
"{\"event\":\"x.contact\",\"params\":{\"content\":null,\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}"
==# XContact testProfile Nothing
it "x.contact with content (ignored)" $
==# XContact testProfile Nothing Nothing
it "x.contact with content" $
"{\"event\":\"x.contact\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"voice\":{\"allow\":\"yes\"}}}}}"
==# XContact testProfile Nothing
#==# XContact testProfile Nothing (Just $ MCText "hello")
it "x.grp.inv" $
"{\"event\":\"x.grp.inv\",\"params\":{\"groupInvitation\":{\"connRequest\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"invitedMember\":{\"memberRole\":\"member\",\"memberId\":\"BQYHCA==\"},\"groupProfile\":{\"fullName\":\"Team\",\"displayName\":\"team\",\"groupPreferences\":{\"voice\":{\"enable\":\"on\"}}},\"fromMember\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\"}}}}"
#==# XGrpInv GroupInvitation {fromMember = MemberIdRole (MemberId "\1\2\3\4") GRAdmin, invitedMember = MemberIdRole (MemberId "\5\6\7\8") GRMember, connRequest = testConnReq, groupProfile = testGroupProfile, groupLinkId = Nothing}