core: auto accept via address and incognito mode specified (#1233)

* core: Auto accept via address and incognito mode specified

* Fix test

* Refactoring

* No forcing

* Apply suggestions from code review

* refactor

* refactor AutoAccept

* Test

* Test

* allow different test output order

* rename

* rename

Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
This commit is contained in:
Stanislav Dmitrenko
2022-10-21 17:14:12 +01:00
committed by GitHub
co-authored by Evgeny Poberezkin JRoberts
parent 5bcb725ea5
commit 1470b8d128
10 changed files with 108 additions and 51 deletions
+9 -7
View File
@@ -34,7 +34,7 @@ import Simplex.Chat.Help
import Simplex.Chat.Markdown
import Simplex.Chat.Messages hiding (NewChatItem (..))
import Simplex.Chat.Protocol
import Simplex.Chat.Store (StoreError (..))
import Simplex.Chat.Store (AutoAccept (..), StoreError (..), UserContactLink (..))
import Simplex.Chat.Styled
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
@@ -87,8 +87,8 @@ responseToView testView = \case
HSSettings -> settingsInfo
CRWelcome user -> chatWelcome user
CRContactsList cs -> viewContactsList cs
CRUserContactLink cReqUri autoAccept autoReply -> connReqContact_ "Your chat address:" cReqUri <> autoAcceptStatus_ autoAccept autoReply
CRUserContactLinkUpdated _ autoAccept autoReply -> autoAcceptStatus_ autoAccept autoReply
CRUserContactLink UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
CRUserContactLinkUpdated UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept
CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
CRGroupCreated g -> viewGroupCreated g
CRGroupMembers g -> viewGroupMembers g
@@ -428,10 +428,12 @@ connReqContact_ intro cReq =
"to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
]
autoAcceptStatus_ :: Bool -> Maybe MsgContent -> [StyledString]
autoAcceptStatus_ autoAccept autoReply =
("auto_accept " <> if autoAccept then "on" else "off") :
maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
autoAcceptStatus_ :: Maybe AutoAccept -> [StyledString]
autoAcceptStatus_ = \case
Just AutoAccept {acceptIncognito, autoReply} ->
("auto_accept on" <> if acceptIncognito then ", incognito" else "") :
maybe [] ((["auto reply:"] <>) . ttyMsgContent) autoReply
_ -> ["auto_accept off"]
groupLink_ :: StyledString -> GroupInfo -> ConnReqContact -> [StyledString]
groupLink_ intro g cReq =