Merge branch 'master' into remote-desktop

src/Simplex/Chat/Controller.hs

@@ -38,8 +38,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map.Strict (Map)
 import Data.String
 import Data.Text (Text)
-import Data.Time (NominalDiffTime)
-import Data.Time.Clock (UTCTime)
+import Data.Time (NominalDiffTime, UTCTime)
 import Data.Version (showVersion)
 import GHC.Generics (Generic)
 import Language.Haskell.TH (Exp, Q, runIO)
@@ -159,21 +158,11 @@ defaultInlineFilesConfig =
       receiveInstant = True -- allow receiving instant files, within receiveChunks limit
     }
 
-data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
-  deriving (Eq)
-
-chatActiveTo :: ChatName -> ActiveTo
-chatActiveTo (ChatName cType name) = case cType of
-  CTDirect -> ActiveC name
-  CTGroup -> ActiveG name
-  _ -> ActiveNone
-
 data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLiteStore}
 
 data ChatController = ChatController
   { currentUser :: TVar (Maybe User),
     currentRemoteHost :: TVar (Maybe RemoteHostId),
-    activeTo :: TVar ActiveTo,
     firstTime :: Bool,
     smpAgent :: AgentClient,
     agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))),
@@ -182,8 +171,6 @@ data ChatController = ChatController
     idsDrg :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
     outputQ :: TBQueue (Maybe CorrId, Maybe RemoteHostId, ChatResponse),
-    notifyQ :: TBQueue Notification,
-    sendNotification :: Notification -> IO (),
     subscriptionMode :: TVar SubscriptionMode,
     chatLock :: Lock,
     sndFiles :: TVar (Map Int64 Handle),
@@ -313,6 +300,7 @@ data ChatCommand
   | APIGetNetworkConfig
   | ReconnectAllServers
   | APISetChatSettings ChatRef ChatSettings
+  | APISetMemberSettings GroupId GroupMemberId GroupMemberSettings
   | APIContactInfo ContactId
   | APIGroupInfo GroupId
   | APIGroupMemberInfo GroupId GroupMemberId
@@ -328,8 +316,9 @@ data ChatCommand
   | APIVerifyGroupMember GroupId GroupMemberId (Maybe Text)
   | APIEnableContact ContactId
   | APIEnableGroupMember GroupId GroupMemberId
-  | SetShowMessages ChatName Bool
+  | SetShowMessages ChatName MsgFilter
   | SetSendReceipts ChatName (Maybe Bool)
+  | SetShowMemberMessages GroupName ContactName Bool
   | ContactInfo ContactName
   | ShowGroupInfo GroupName
   | GroupMemberInfo GroupName ContactName
@@ -350,6 +339,7 @@ data ChatCommand
   | APIAddContact UserId IncognitoEnabled
   | AddContact IncognitoEnabled
   | APISetConnectionIncognito Int64 IncognitoEnabled
+  | APIConnectPlan UserId AConnectionRequestUri
   | APIConnect UserId IncognitoEnabled (Maybe AConnectionRequestUri)
   | Connect IncognitoEnabled (Maybe AConnectionRequestUri)
   | ConnectSimplex IncognitoEnabled -- UserId (not used in UI)
@@ -473,14 +463,14 @@ allowRemoteCommand = \case
 data ChatResponse
   = CRActiveUser {user :: User}
   | CRUsersList {users :: [UserInfo]}
-  | CRChatStarted {_nullary :: Maybe Int}
-  | CRChatRunning {_nullary :: Maybe Int}
-  | CRChatStopped {_nullary :: Maybe Int}
-  | CRChatSuspended {_nullary :: Maybe Int}
+  | CRChatStarted
+  | CRChatRunning
+  | CRChatStopped
+  | CRChatSuspended
   | CRApiChats {user :: User, chats :: [AChat]}
   | CRChats {chats :: [AChat]}
   | CRApiChat {user :: User, chat :: AChat}
-  | CRChatItems {user :: User, chatItems :: [AChatItem]}
+  | CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]}
   | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo}
   | CRChatItemId User (Maybe ChatItemId)
   | CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
@@ -537,6 +527,7 @@ data ChatResponse
   | CRVersionInfo {versionInfo :: CoreVersionInfo, chatMigrations :: [UpMigration], agentMigrations :: [UpMigration]}
   | CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation, connection :: PendingContactConnection}
   | CRConnectionIncognitoUpdated {user :: User, toConnection :: PendingContactConnection}
+  | CRConnectionPlan {user :: User, connectionPlan :: ConnectionPlan}
   | CRSentConfirmation {user :: User}
   | CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
   | CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
@@ -640,14 +631,14 @@ data ChatResponse
   | CRRemoteHostDeleted {remoteHostId :: RemoteHostId}
   | CRRemoteCtrlList {remoteCtrls :: [RemoteCtrlInfo]}
   | CRRemoteCtrlRegistered {remoteCtrlId :: RemoteCtrlId}
-  | CRRemoteCtrlStarted {_nullary :: Maybe Int}
+  | CRRemoteCtrlStarted
   | CRRemoteCtrlAnnounce {fingerprint :: C.KeyHash} -- unregistered fingerprint, needs confirmation
   | CRRemoteCtrlFound {remoteCtrl :: RemoteCtrl} -- registered fingerprint, may connect
   | CRRemoteCtrlAccepted {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlRejected {remoteCtrlId :: RemoteCtrlId}
   | CRRemoteCtrlConnecting {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
   | CRRemoteCtrlConnected {remoteCtrlId :: RemoteCtrlId, displayName :: Text}
-  | CRRemoteCtrlStopped {_nullary :: Maybe Int}
+  | CRRemoteCtrlStopped
   | CRRemoteCtrlDeleted {remoteCtrlId :: RemoteCtrlId}
   | CRSQLResult {rows :: [Text]}
   | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]}
@@ -732,6 +723,76 @@ data RemoteCtrlInfo = RemoteCtrlInfo
 
 instance ToJSON RemoteCtrlInfo where toEncoding = J.genericToEncoding J.defaultOptions
 
+data ConnectionPlan
+  = CPInvitationLink {invitationLinkPlan :: InvitationLinkPlan}
+  | CPContactAddress {contactAddressPlan :: ContactAddressPlan}
+  | CPGroupLink {groupLinkPlan :: GroupLinkPlan}
+  deriving (Show, Generic)
+
+instance FromJSON ConnectionPlan where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CP"
+
+instance ToJSON ConnectionPlan where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CP"
+
+data InvitationLinkPlan
+  = ILPOk
+  | ILPOwnLink
+  | ILPConnecting {contact_ :: Maybe Contact}
+  | ILPKnown {contact :: Contact}
+  deriving (Show, Generic)
+
+instance FromJSON InvitationLinkPlan where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "ILP"
+
+instance ToJSON InvitationLinkPlan where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "ILP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "ILP"
+
+data ContactAddressPlan
+  = CAPOk
+  | CAPOwnLink
+  | CAPConnecting {contact :: Contact}
+  | CAPKnown {contact :: Contact}
+  deriving (Show, Generic)
+
+instance FromJSON ContactAddressPlan where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "CAP"
+
+instance ToJSON ContactAddressPlan where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "CAP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "CAP"
+
+data GroupLinkPlan
+  = GLPOk
+  | GLPOwnLink {groupInfo :: GroupInfo}
+  | GLPConnecting {groupInfo_ :: Maybe GroupInfo}
+  | GLPKnown {groupInfo :: GroupInfo}
+  deriving (Show, Generic)
+
+instance FromJSON GroupLinkPlan where
+  parseJSON = J.genericParseJSON . sumTypeJSON $ dropPrefix "GLP"
+
+instance ToJSON GroupLinkPlan where
+  toJSON = J.genericToJSON . sumTypeJSON $ dropPrefix "GLP"
+  toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "GLP"
+
+connectionPlanOk :: ConnectionPlan -> Bool
+connectionPlanOk = \case
+  CPInvitationLink ilp -> case ilp of
+    ILPOk -> True
+    ILPOwnLink -> True
+    _ -> False
+  CPContactAddress cap -> case cap of
+    CAPOk -> True
+    CAPOwnLink -> True
+    _ -> False
+  CPGroupLink glp -> case glp of
+    GLPOk -> True
+    GLPOwnLink _ -> True
+    _ -> False
+
 newtype UserPwd = UserPwd {unUserPwd :: Text}
   deriving (Eq, Show)
 
@@ -1013,6 +1074,7 @@ data ChatErrorType
   | CEChatNotStarted
   | CEChatNotStopped
   | CEChatStoreChanged
+  | CEConnectionPlan {connectionPlan :: ConnectionPlan}
   | CEInvalidConnReq
   | CEInvalidChatMessage {connection :: Connection, msgMeta :: Maybe MsgMetaJSON, messageData :: Text, message :: String}
   | CEContactNotFound {contactName :: ContactName, suspectedMember :: Maybe (GroupInfo, GroupMember)}
@@ -1173,8 +1235,7 @@ data RemoteCtrlSession = RemoteCtrlSession
     hostServer :: Maybe (Async ()),
     discovered :: TMap C.KeyHash TransportHost,
     accepted :: TMVar RemoteCtrlId,
-    remoteOutputQ :: TBQueue ChatResponse,
-    remoteNotifyQ :: TBQueue Notification
+    remoteOutputQ :: TBQueue ChatResponse
   }
 
 type ChatMonad' m = (MonadUnliftIO m, MonadReader ChatController m)
@@ -1212,14 +1273,6 @@ mkChatError = ChatError . CEException . show
 chatCmdError :: Maybe User -> String -> ChatResponse
 chatCmdError user = CRChatCmdError user . ChatError . CECommandError
 
-setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
-setActive to = asks activeTo >>= atomically . (`writeTVar` to)
-
-unsetActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
-unsetActive a = asks activeTo >>= atomically . (`modifyTVar` unset)
-  where
-    unset a' = if a == a' then ActiveNone else a'
-
 -- | Emit local events.
 toView :: ChatMonad' m => ChatResponse -> m ()
 toView event = do