mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2024-12-17 17:20:21 +01:00
Merge remote-tracking branch 'origin/master' into ab/async-subs
This commit is contained in:
Alexander Bondarenko
+109
-50
@@ -94,7 +94,7 @@ import qualified Simplex.FileTransfer.Description as FD
|
||||
import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
|
||||
import qualified Simplex.FileTransfer.Transport as XFTP
|
||||
import Simplex.Messaging.Agent as Agent
|
||||
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentWorkersDetails, getAgentWorkersSummary, ipAddressProtected, temporaryAgentError, withLockMap)
|
||||
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, getAgentQueuesInfo, getAgentWorkersDetails, getAgentWorkersSummary, ipAddressProtected, temporaryAgentError, withLockMap)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
|
||||
import Simplex.Messaging.Agent.Lock (withLock)
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
@@ -1472,14 +1472,14 @@ processChatCommand' vr = \case
|
||||
ct@Contact {activeConn} <- withStore $ \db -> getContact db vr user contactId
|
||||
case activeConn of
|
||||
Just conn -> do
|
||||
withStore' $ \db -> setConnectionAuthErrCounter db user conn 0
|
||||
withStore' $ \db -> setAuthErrCounter db user conn 0
|
||||
ok user
|
||||
Nothing -> throwChatError $ CEContactNotActive ct
|
||||
APIEnableGroupMember gId gMemberId -> withUser $ \user -> do
|
||||
GroupMember {activeConn} <- withStore $ \db -> getGroupMember db vr user gId gMemberId
|
||||
case activeConn of
|
||||
Just conn -> do
|
||||
withStore' $ \db -> setConnectionAuthErrCounter db user conn 0
|
||||
withStore' $ \db -> setAuthErrCounter db user conn 0
|
||||
ok user
|
||||
_ -> throwChatError CEGroupMemberNotActive
|
||||
SetShowMessages cName ntfOn -> updateChatSettings cName (\cs -> cs {enableNtfs = ntfOn})
|
||||
@@ -1550,8 +1550,8 @@ processChatCommand' vr = \case
|
||||
let chatV = agentToChatVersion agentV
|
||||
dm <- encodeConnInfoPQ pqSup' chatV $ XInfo profileToSend
|
||||
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup'
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup'
|
||||
void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup' subMode
|
||||
conn@PendingContactConnection {pccConnId} <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode chatV pqSup'
|
||||
joinPreparedAgentConnection user pccConnId connId cReq dm pqSup' subMode
|
||||
pure $ CRSentConfirmation user conn
|
||||
APIConnect userId incognito (Just (ACR SCMContact cReq)) -> withUserId userId $ \user -> connectViaContact user incognito cReq
|
||||
APIConnect _ _ Nothing -> throwChatError CEInvalidConnReq
|
||||
@@ -1806,12 +1806,20 @@ processChatCommand' vr = \case
|
||||
dm <- encodeConnInfo $ XGrpAcpt membershipMemId
|
||||
agentConnId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True connRequest PQSupportOff
|
||||
let chatV = vr `peerConnChatVersion` peerChatVRange
|
||||
withStore' $ \db -> do
|
||||
createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode
|
||||
cId <- withStore' $ \db -> do
|
||||
Connection {connId = cId} <- createMemberConnection db userId fromMember agentConnId chatV peerChatVRange subMode
|
||||
updateGroupMemberStatus db userId fromMember GSMemAccepted
|
||||
updateGroupMemberStatus db userId membership GSMemAccepted
|
||||
void . withAgent $ \a -> joinConnection a (aUserId user) (Just agentConnId) True connRequest dm PQSupportOff subMode
|
||||
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` \_ -> pure ()
|
||||
pure cId
|
||||
void (withAgent $ \a -> joinConnection a (aUserId user) (Just agentConnId) True connRequest dm PQSupportOff subMode)
|
||||
`catchChatError` \e -> do
|
||||
withStore' $ \db -> do
|
||||
deleteConnectionRecord db user cId
|
||||
updateGroupMemberStatus db userId fromMember GSMemInvited
|
||||
updateGroupMemberStatus db userId membership GSMemInvited
|
||||
withAgent $ \a -> deleteConnectionAsync a False agentConnId
|
||||
throwError e
|
||||
updateCIGroupInvitationStatus user g CIGISAccepted `catchChatError` (toView . CRChatError (Just user))
|
||||
pure $ CRUserAcceptedGroupSent user g {membership = membership {memberStatus = GSMemAccepted}} Nothing
|
||||
Nothing -> throwChatError $ CEContactNotActive ct
|
||||
APIMemberRole groupId memberId memRole -> withUser $ \user -> do
|
||||
@@ -2239,6 +2247,7 @@ processChatCommand' vr = \case
|
||||
SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m
|
||||
_ -> m
|
||||
GetAgentSubsDetails -> lift $ CRAgentSubsDetails <$> withAgent' getAgentSubscriptions
|
||||
GetAgentQueuesInfo -> lift $ CRAgentQueuesInfo <$> withAgent' getAgentQueuesInfo
|
||||
-- CustomChatCommand is unsupported, it can be processed in preCmdHook
|
||||
-- in a modified CLI app or core - the hook should return Either ChatResponse ChatCommand
|
||||
CustomChatCommand _cmd -> withUser $ \user -> pure $ chatCmdError (Just user) "not supported"
|
||||
@@ -2338,8 +2347,8 @@ processChatCommand' vr = \case
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup
|
||||
joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV
|
||||
conn@PendingContactConnection {pccConnId} <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup
|
||||
joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV
|
||||
pure $ CRSentInvitation user conn incognitoProfile
|
||||
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> CM ChatResponse
|
||||
connectContactViaAddress user incognito ct cReq =
|
||||
@@ -2351,8 +2360,8 @@ processChatCommand' vr = \case
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
ct' <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup
|
||||
joinContact user connId cReq incognitoProfile newXContactId False pqSup chatV
|
||||
(pccConnId, ct') <- withStore $ \db -> createAddressContactConnection db vr user ct connId cReqHash newXContactId incognitoProfile subMode chatV pqSup
|
||||
joinContact user pccConnId connId cReq incognitoProfile newXContactId False pqSup chatV
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
prepareContact :: User -> ConnectionRequestUri 'CMContact -> PQSupport -> CM (ConnId, VersionChat)
|
||||
prepareContact user cReq pqSup = do
|
||||
@@ -2365,12 +2374,19 @@ processChatCommand' vr = \case
|
||||
let chatV = agentToChatVersion agentV
|
||||
connId <- withAgent $ \a -> prepareConnectionToJoin a (aUserId user) True cReq pqSup
|
||||
pure (connId, chatV)
|
||||
joinContact :: User -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM ()
|
||||
joinContact user connId cReq incognitoProfile xContactId inGroup pqSup chatV = do
|
||||
joinContact :: User -> Int64 -> ConnId -> ConnectionRequestUri 'CMContact -> Maybe Profile -> XContactId -> Bool -> PQSupport -> VersionChat -> CM ()
|
||||
joinContact user pccConnId connId cReq incognitoProfile xContactId inGroup pqSup chatV = do
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup
|
||||
dm <- encodeConnInfoPQ pqSup chatV (XContact profileToSend $ Just xContactId)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
void . withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq dm pqSup subMode
|
||||
joinPreparedAgentConnection user pccConnId connId cReq dm pqSup subMode
|
||||
joinPreparedAgentConnection :: User -> Int64 -> ConnId -> ConnectionRequestUri m -> ByteString -> PQSupport -> SubscriptionMode -> CM ()
|
||||
joinPreparedAgentConnection user pccConnId connId cReq connInfo pqSup subMode = do
|
||||
void (withAgent $ \a -> joinConnection a (aUserId user) (Just connId) True cReq connInfo pqSup subMode)
|
||||
`catchChatError` \e -> do
|
||||
withStore' $ \db -> deleteConnectionRecord db user pccConnId
|
||||
withAgent $ \a -> deleteConnectionAsync a False connId
|
||||
throwError e
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
find $ \GroupMember {memberContactId = cId, memberStatus = s} ->
|
||||
@@ -3934,14 +3950,19 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
withAckMessage' "new contact msg" agentConnId meta $
|
||||
void $
|
||||
saveDirectRcvMSG conn meta msgBody
|
||||
SENT msgId _proxy ->
|
||||
SENT msgId _proxy -> do
|
||||
void $ continueSending connEntity conn
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
OK ->
|
||||
-- [async agent commands] continuation on receiving OK
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
QCONT ->
|
||||
void $ continueSending connEntity conn
|
||||
MWARN _ err ->
|
||||
processConnMWARN connEntity conn err
|
||||
MERR _ err -> do
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
incAuthErrCounter connEntity conn err
|
||||
processConnMERR connEntity conn err
|
||||
MERRS _ err -> do
|
||||
-- error cannot be AUTH error here
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
@@ -4072,6 +4093,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
let connectedIncognito = contactConnIncognito ct || incognitoMembership gInfo
|
||||
when (memberCategory m == GCPreMember) $ probeMatchingContactsAndMembers ct connectedIncognito True
|
||||
SENT msgId proxy -> do
|
||||
void $ continueSending connEntity conn
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
checkSndInlineFTComplete conn msgId
|
||||
ci_ <- withStore $ \db -> do
|
||||
@@ -4112,12 +4134,15 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
OK ->
|
||||
-- [async agent commands] continuation on receiving OK
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
MWARN msgId err ->
|
||||
QCONT ->
|
||||
void $ continueSending connEntity conn
|
||||
MWARN msgId err -> do
|
||||
updateDirectItemStatus ct conn msgId (CISSndWarning $ agentSndError err)
|
||||
processConnMWARN connEntity conn err
|
||||
MERR msgId err -> do
|
||||
updateDirectItemStatus ct conn msgId (CISSndError $ agentSndError err)
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
incAuthErrCounter connEntity conn err
|
||||
processConnMERR connEntity conn err
|
||||
MERRS msgIds err -> do
|
||||
-- error cannot be AUTH error here
|
||||
updateDirectItemsStatus ct conn (L.toList msgIds) (CISSndError $ agentSndError err)
|
||||
@@ -4466,9 +4491,11 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
withAckMessage' "group rcvd" agentConnId msgMeta $
|
||||
groupMsgReceived gInfo m conn msgMeta msgRcpt
|
||||
SENT msgId proxy -> do
|
||||
continued <- continueSending connEntity conn
|
||||
sentMsgDeliveryEvent conn msgId
|
||||
checkSndInlineFTComplete conn msgId
|
||||
updateGroupItemStatus gInfo m conn msgId (CISSndSent SSPComplete) (Just $ isJust proxy)
|
||||
when continued $ sendPendingGroupMessages user m conn
|
||||
SWITCH qd phase cStats -> do
|
||||
toView $ CRGroupMemberSwitch user gInfo m (SwitchProgress qd phase cStats)
|
||||
when (phase `elem` [SPStarted, SPCompleted]) $ case qd of
|
||||
@@ -4504,13 +4531,17 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
OK ->
|
||||
-- [async agent commands] continuation on receiving OK
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
MWARN msgId err ->
|
||||
QCONT -> do
|
||||
continued <- continueSending connEntity conn
|
||||
when continued $ sendPendingGroupMessages user m conn
|
||||
MWARN msgId err -> do
|
||||
withStore' $ \db -> updateGroupItemErrorStatus db msgId (groupMemberId' m) (CISSndWarning $ agentSndError err)
|
||||
processConnMWARN connEntity conn err
|
||||
MERR msgId err -> do
|
||||
withStore' $ \db -> updateGroupItemErrorStatus db msgId (groupMemberId' m) (CISSndError $ agentSndError err)
|
||||
-- group errors are silenced to reduce load on UI event log
|
||||
-- toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
incAuthErrCounter connEntity conn err
|
||||
processConnMERR connEntity conn err
|
||||
MERRS msgIds err -> do
|
||||
let newStatus = CISSndError $ agentSndError err
|
||||
-- error cannot be AUTH error here
|
||||
@@ -4640,7 +4671,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
MERR _ err -> do
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
incAuthErrCounter connEntity conn err
|
||||
processConnMERR connEntity conn err
|
||||
ERR err -> do
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
@@ -4692,7 +4723,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
_ -> pure ()
|
||||
MERR _ err -> do
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
incAuthErrCounter connEntity conn err
|
||||
processConnMERR connEntity conn err
|
||||
ERR err -> do
|
||||
toView $ CRChatError (Just user) (ChatErrorAgent err $ Just connEntity)
|
||||
when (corrId /= "") $ withCompletedCommand conn agentMsg $ \_cmdData -> pure ()
|
||||
@@ -4732,17 +4763,40 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
|
||||
| memberRole <= GRObserver = messageError "member is not allowed to send messages"
|
||||
| otherwise = a
|
||||
|
||||
incAuthErrCounter :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
|
||||
incAuthErrCounter connEntity conn err = do
|
||||
processConnMERR :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
|
||||
processConnMERR connEntity conn err = do
|
||||
case err of
|
||||
SMP _ SMP.AUTH -> do
|
||||
authErrCounter' <- withStore' $ \db -> incConnectionAuthErrCounter db user conn
|
||||
authErrCounter' <- withStore' $ \db -> incAuthErrCounter db user conn
|
||||
when (authErrCounter' >= authErrDisableCount) $ case connEntity of
|
||||
RcvDirectMsgConnection ctConn (Just ct) -> do
|
||||
toView $ CRContactDisabled user ct {activeConn = Just ctConn {authErrCounter = authErrCounter'}}
|
||||
_ -> toView $ CRConnectionDisabled connEntity
|
||||
SMP _ SMP.QUOTA ->
|
||||
unless (connInactive conn) $ do
|
||||
withStore' $ \db -> setQuotaErrCounter db user conn quotaErrSetOnMERR
|
||||
toView $ CRConnectionInactive connEntity True
|
||||
_ -> pure ()
|
||||
|
||||
processConnMWARN :: ConnectionEntity -> Connection -> AgentErrorType -> CM ()
|
||||
processConnMWARN connEntity conn err = do
|
||||
case err of
|
||||
SMP _ SMP.QUOTA ->
|
||||
unless (connInactive conn) $ do
|
||||
quotaErrCounter' <- withStore' $ \db -> incQuotaErrCounter db user conn
|
||||
when (quotaErrCounter' >= quotaErrInactiveCount) $
|
||||
toView $ CRConnectionInactive connEntity True
|
||||
_ -> pure ()
|
||||
|
||||
continueSending :: ConnectionEntity -> Connection -> CM Bool
|
||||
continueSending connEntity conn =
|
||||
if connInactive conn
|
||||
then do
|
||||
withStore' $ \db -> setQuotaErrCounter db user conn 0
|
||||
toView $ CRConnectionInactive connEntity False
|
||||
pure True
|
||||
else pure False
|
||||
|
||||
-- TODO v5.7 / v6.0 - together with deprecating old group protocol establishing direct connections?
|
||||
-- we could save command records only for agent APIs we process continuations for (INV)
|
||||
withCompletedCommand :: forall e. AEntityI e => Connection -> ACommand 'Agent e -> (CommandData -> CM ()) -> CM ()
|
||||
@@ -6533,16 +6587,20 @@ sendGroupMemberMessages user conn events groupId = do
|
||||
let idsEvts = L.map (GroupId groupId,) events
|
||||
(errs, msgs) <- lift $ partitionEithers . L.toList <$> createSndMessages idsEvts
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
forM_ (L.nonEmpty msgs) $ \msgs' -> do
|
||||
-- TODO v5.7 based on version (?)
|
||||
-- let shouldCompress = False
|
||||
-- let batched = if shouldCompress then batchSndMessagesBinary msgs' else batchSndMessagesJSON msgs'
|
||||
let batched = batchSndMessagesJSON msgs'
|
||||
let (errs', msgBatches) = partitionEithers batched
|
||||
-- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg
|
||||
unless (null errs') $ toView $ CRChatErrors (Just user) errs'
|
||||
forM_ msgBatches $ \batch ->
|
||||
processSndMessageBatch conn batch `catchChatError` (toView . CRChatError (Just user))
|
||||
forM_ (L.nonEmpty msgs) $ \msgs' ->
|
||||
batchSendGroupMemberMessages user conn msgs'
|
||||
|
||||
batchSendGroupMemberMessages :: User -> Connection -> NonEmpty SndMessage -> CM ()
|
||||
batchSendGroupMemberMessages user conn msgs = do
|
||||
-- TODO v5.7 based on version (?)
|
||||
-- let shouldCompress = False
|
||||
-- let batched = if shouldCompress then batchSndMessagesBinary msgs' else batchSndMessagesJSON msgs'
|
||||
let batched = batchSndMessagesJSON msgs
|
||||
let (errs', msgBatches) = partitionEithers batched
|
||||
-- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg
|
||||
unless (null errs') $ toView $ CRChatErrors (Just user) errs'
|
||||
forM_ msgBatches $ \batch ->
|
||||
processSndMessageBatch conn batch `catchChatError` (toView . CRChatError (Just user))
|
||||
|
||||
processSndMessageBatch :: Connection -> MsgBatch -> CM ()
|
||||
processSndMessageBatch conn@Connection {connId} (MsgBatch batchBody sndMsgs) = do
|
||||
@@ -6700,6 +6758,7 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c
|
||||
Nothing -> pendingOrForwarded
|
||||
Just conn@Connection {connStatus}
|
||||
| connDisabled conn || connStatus == ConnDeleted -> Nothing
|
||||
| connInactive conn -> Just MSAPending
|
||||
| connStatus == ConnSndReady || connStatus == ConnReady -> Just (MSASend conn)
|
||||
| otherwise -> pendingOrForwarded
|
||||
where
|
||||
@@ -6730,21 +6789,20 @@ sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId i
|
||||
MSASend conn -> deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId >> postDeliver
|
||||
MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId introId_
|
||||
|
||||
-- TODO ensure order - pending messages interleave with user input messages
|
||||
sendPendingGroupMessages :: User -> GroupMember -> Connection -> CM ()
|
||||
sendPendingGroupMessages user GroupMember {groupMemberId, localDisplayName} conn = do
|
||||
pendingMessages <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
|
||||
-- TODO ensure order - pending messages interleave with user input messages
|
||||
forM_ pendingMessages $ \pgm ->
|
||||
processPendingMessage pgm `catchChatError` (toView . CRChatError (Just user))
|
||||
sendPendingGroupMessages user GroupMember {groupMemberId} conn = do
|
||||
pgms <- withStore' $ \db -> getPendingGroupMessages db groupMemberId
|
||||
forM_ (L.nonEmpty pgms) $ \pgms' -> do
|
||||
let msgs = L.map (\(sndMsg, _, _) -> sndMsg) pgms'
|
||||
batchSendGroupMemberMessages user conn msgs
|
||||
lift . void . withStoreBatch' $ \db -> L.map (\SndMessage {msgId} -> deletePendingGroupMessage db groupMemberId msgId) msgs
|
||||
lift . void . withStoreBatch' $ \db -> L.map (\(_, tag, introId_) -> updateIntro_ db tag introId_) pgms'
|
||||
where
|
||||
processPendingMessage PendingGroupMessage {msgId, cmEventTag = ACMEventTag _ tag, msgBody, introId_} = do
|
||||
void $ deliverMessage conn tag msgBody msgId
|
||||
withStore' $ \db -> deletePendingGroupMessage db groupMemberId msgId
|
||||
case tag of
|
||||
XGrpMemFwd_ -> case introId_ of
|
||||
Just introId -> withStore' $ \db -> updateIntroStatus db introId GMIntroInvForwarded
|
||||
_ -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName
|
||||
_ -> pure ()
|
||||
updateIntro_ :: DB.Connection -> ACMEventTag -> Maybe Int64 -> IO ()
|
||||
updateIntro_ db tag introId_ = case (tag, introId_) of
|
||||
(ACMEventTag _ XGrpMemFwd_, Just introId) -> updateIntroStatus db introId GMIntroInvForwarded
|
||||
_ -> pure ()
|
||||
|
||||
-- TODO [batch send] refactor direct message processing same as groups (e.g. checkIntegrity before processing)
|
||||
saveDirectRcvMSG :: Connection -> MsgMeta -> MsgBody -> CM (Connection, RcvMessage)
|
||||
@@ -7468,6 +7526,7 @@ chatCommandP =
|
||||
"/get workers" $> GetAgentWorkers,
|
||||
"/get workers details" $> GetAgentWorkersDetails,
|
||||
"/get msgs" $> GetAgentMsgCounts,
|
||||
"/get queues" $> GetAgentQueuesInfo,
|
||||
"//" *> (CustomChatCommand <$> A.takeByteString)
|
||||
]
|
||||
where
|
||||
|
||||
@@ -68,7 +68,7 @@ import Simplex.Chat.Types.UITheme
|
||||
import Simplex.Chat.Util (liftIOEither)
|
||||
import Simplex.FileTransfer.Description (FileDescriptionURI)
|
||||
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
|
||||
import Simplex.Messaging.Agent.Client (AgentLocks, AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, UserNetworkInfo)
|
||||
import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, UserNetworkInfo)
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
|
||||
import Simplex.Messaging.Agent.Lock
|
||||
import Simplex.Messaging.Agent.Protocol
|
||||
@@ -504,6 +504,7 @@ data ChatCommand
|
||||
| GetAgentWorkers
|
||||
| GetAgentWorkersDetails
|
||||
| GetAgentMsgCounts
|
||||
| GetAgentQueuesInfo
|
||||
| -- The parser will return this command for strings that start from "//".
|
||||
-- This command should be processed in preCmdHook
|
||||
CustomChatCommand ByteString
|
||||
@@ -750,8 +751,10 @@ data ChatResponse
|
||||
| CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]}
|
||||
| CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
|
||||
| CRAgentMsgCounts {msgCounts :: [(Text, (Int, Int))]}
|
||||
| CRAgentQueuesInfo {agentQueuesInfo :: AgentQueuesInfo}
|
||||
| CRContactDisabled {user :: User, contact :: Contact}
|
||||
| CRConnectionDisabled {connectionEntity :: ConnectionEntity}
|
||||
| CRConnectionInactive {connectionEntity :: ConnectionEntity, inactive :: Bool}
|
||||
| CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}
|
||||
| CRAgentConnDeleted {agentConnId :: AgentConnId}
|
||||
| CRAgentUserDeleted {agentUserId :: Int64}
|
||||
@@ -1117,7 +1120,6 @@ data ChatErrorType
|
||||
| CECantBlockMemberForSelf {groupInfo :: GroupInfo, member :: GroupMember, setShowMessages :: Bool}
|
||||
| CEGroupMemberUserRemoved
|
||||
| CEGroupMemberNotFound
|
||||
| CEGroupMemberIntroNotFound {contactName :: ContactName}
|
||||
| CEGroupCantResendInvitation {groupInfo :: GroupInfo, contactName :: ContactName}
|
||||
| CEGroupInternal {message :: String}
|
||||
| CEFileNotFound {message :: String}
|
||||
|
||||
@@ -945,13 +945,6 @@ data RcvMessage = RcvMessage
|
||||
forwardedByMember :: Maybe GroupMemberId
|
||||
}
|
||||
|
||||
data PendingGroupMessage = PendingGroupMessage
|
||||
{ msgId :: MessageId,
|
||||
cmEventTag :: ACMEventTag,
|
||||
msgBody :: MsgBody,
|
||||
introId_ :: Maybe Int64
|
||||
}
|
||||
|
||||
type MessageId = Int64
|
||||
|
||||
data ConnOrGroupId = ConnectionId Int64 | GroupId Int64
|
||||
|
||||
@@ -0,0 +1,18 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20240528_quota_err_counter where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
m20240528_quota_err_counter :: Query
|
||||
m20240528_quota_err_counter =
|
||||
[sql|
|
||||
ALTER TABLE connections ADD COLUMN quota_err_counter INTEGER NOT NULL DEFAULT 0;
|
||||
|]
|
||||
|
||||
down_m20240528_quota_err_counter :: Query
|
||||
down_m20240528_quota_err_counter =
|
||||
[sql|
|
||||
ALTER TABLE connections DROP COLUMN quota_err_counter;
|
||||
|]
|
||||
@@ -289,6 +289,7 @@ CREATE TABLE connections(
|
||||
pq_encryption INTEGER NOT NULL DEFAULT 0,
|
||||
pq_snd_enabled INTEGER,
|
||||
pq_rcv_enabled INTEGER,
|
||||
quota_err_counter INTEGER NOT NULL DEFAULT 0,
|
||||
FOREIGN KEY(snd_file_id, connection_id)
|
||||
REFERENCES snd_files(file_id, connection_id)
|
||||
ON DELETE CASCADE
|
||||
|
||||
@@ -14,6 +14,7 @@ module Simplex.Chat.Store.Connections
|
||||
getContactConnEntityByConnReqHash,
|
||||
getConnectionsToSubscribe,
|
||||
unsetConnectionToSubscribe,
|
||||
deleteConnectionRecord,
|
||||
)
|
||||
where
|
||||
|
||||
@@ -83,7 +84,7 @@ getConnectionEntity db vr user@User {userId, userContactId} agentConnId = do
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
||||
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter,
|
||||
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
|
||||
conn_chat_version, peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND agent_conn_id = ?
|
||||
@@ -220,3 +221,7 @@ getConnectionsToSubscribe db vr user@User {userId} = do
|
||||
|
||||
unsetConnectionToSubscribe :: DB.Connection -> User -> IO ()
|
||||
unsetConnectionToSubscribe db User {userId} = DB.execute db "UPDATE connections SET to_subscribe = 0 WHERE user_id = ? AND to_subscribe = 1" (Only userId)
|
||||
|
||||
deleteConnectionRecord :: DB.Connection -> User -> Int64 -> IO ()
|
||||
deleteConnectionRecord db User {userId} cId = do
|
||||
DB.execute db "DELETE FROM connections WHERE user_id = ? AND connection_id = ?" (userId, cId)
|
||||
|
||||
@@ -51,8 +51,10 @@ module Simplex.Chat.Store.Direct
|
||||
updateContactStatus,
|
||||
updateGroupUnreadChat,
|
||||
setConnectionVerified,
|
||||
incConnectionAuthErrCounter,
|
||||
setConnectionAuthErrCounter,
|
||||
incAuthErrCounter,
|
||||
setAuthErrCounter,
|
||||
incQuotaErrCounter,
|
||||
setQuotaErrCounter,
|
||||
getUserContacts,
|
||||
getUserContactConnIds,
|
||||
createOrUpdateContactRequest,
|
||||
@@ -131,11 +133,11 @@ deletePendingContactConnection db userId connId =
|
||||
|]
|
||||
(userId, connId, ConnContact)
|
||||
|
||||
createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO Contact
|
||||
createAddressContactConnection :: DB.Connection -> VersionRangeChat -> User -> Contact -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> SubscriptionMode -> VersionChat -> PQSupport -> ExceptT StoreError IO (Int64, Contact)
|
||||
createAddressContactConnection db vr user@User {userId} Contact {contactId} acId cReqHash xContactId incognitoProfile subMode chatV pqSup = do
|
||||
PendingContactConnection {pccConnId} <- liftIO $ createConnReqConnection db userId acId cReqHash xContactId incognitoProfile Nothing subMode chatV pqSup
|
||||
liftIO $ DB.execute db "UPDATE connections SET contact_id = ? WHERE connection_id = ?" (contactId, pccConnId)
|
||||
getContact db vr user contactId
|
||||
(pccConnId,) <$> getContact db vr user contactId
|
||||
|
||||
createConnReqConnection :: DB.Connection -> UserId -> ConnId -> ConnReqUriHash -> XContactId -> Maybe Profile -> Maybe GroupLinkId -> SubscriptionMode -> VersionChat -> PQSupport -> IO PendingContactConnection
|
||||
createConnReqConnection db userId acId cReqHash xContactId incognitoProfile groupLinkId subMode chatV pqSup = do
|
||||
@@ -184,7 +186,7 @@ getContactByConnReqHash db vr user@User {userId} cReqHash =
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -474,19 +476,32 @@ setConnectionVerified db User {userId} connId code = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE connections SET security_code = ?, security_code_verified_at = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (code, code $> updatedAt, updatedAt, userId, connId)
|
||||
|
||||
incConnectionAuthErrCounter :: DB.Connection -> User -> Connection -> IO Int
|
||||
incConnectionAuthErrCounter db User {userId} Connection {connId, authErrCounter} = do
|
||||
incAuthErrCounter :: DB.Connection -> User -> Connection -> IO Int
|
||||
incAuthErrCounter db User {userId} Connection {connId, authErrCounter} = do
|
||||
updatedAt <- getCurrentTime
|
||||
(counter_ :: Maybe Int) <- maybeFirstRow fromOnly $ DB.query db "SELECT auth_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (userId, connId)
|
||||
let counter' = fromMaybe authErrCounter counter_ + 1
|
||||
DB.execute db "UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter', updatedAt, userId, connId)
|
||||
pure counter'
|
||||
|
||||
setConnectionAuthErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
|
||||
setConnectionAuthErrCounter db User {userId} Connection {connId} counter = do
|
||||
setAuthErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
|
||||
setAuthErrCounter db User {userId} Connection {connId} counter = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE connections SET auth_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
|
||||
|
||||
incQuotaErrCounter :: DB.Connection -> User -> Connection -> IO Int
|
||||
incQuotaErrCounter db User {userId} Connection {connId, quotaErrCounter} = do
|
||||
updatedAt <- getCurrentTime
|
||||
(counter_ :: Maybe Int) <- maybeFirstRow fromOnly $ DB.query db "SELECT quota_err_counter FROM connections WHERE user_id = ? AND connection_id = ?" (userId, connId)
|
||||
let counter' = fromMaybe quotaErrCounter counter_ + 1
|
||||
DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter', updatedAt, userId, connId)
|
||||
pure counter'
|
||||
|
||||
setQuotaErrCounter :: DB.Connection -> User -> Connection -> Int -> IO ()
|
||||
setQuotaErrCounter db User {userId} Connection {connId} counter = do
|
||||
updatedAt <- getCurrentTime
|
||||
DB.execute db "UPDATE connections SET quota_err_counter = ?, updated_at = ? WHERE user_id = ? AND connection_id = ?" (counter, updatedAt, userId, connId)
|
||||
|
||||
updateContactProfile_ :: DB.Connection -> UserId -> ProfileId -> Profile -> IO ()
|
||||
updateContactProfile_ db userId profileId profile = do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -610,7 +625,7 @@ createOrUpdateContactRequest db vr user@User {userId} userContactLinkId invId (V
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -795,7 +810,7 @@ getContact_ db vr user@User {userId} contactId deleted =
|
||||
cp.preferences, ct.user_preferences, ct.created_at, ct.updated_at, ct.chat_ts, ct.contact_group_member_id, ct.contact_grp_inv_sent, ct.ui_themes, ct.chat_deleted, ct.custom_data,
|
||||
-- Connection
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id, c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM contacts ct
|
||||
JOIN contact_profiles cp ON ct.contact_profile_id = cp.contact_profile_id
|
||||
@@ -839,7 +854,7 @@ getContactConnections db vr userId Contact {contactId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN contacts ct ON ct.contact_id = c.contact_id
|
||||
@@ -884,7 +899,7 @@ getConnectionById db vr User {userId} connId = ExceptT $ do
|
||||
[sql|
|
||||
SELECT connection_id, agent_conn_id, conn_level, via_contact, via_user_contact_link, via_group_link, group_link_id, custom_user_profile_id,
|
||||
conn_status, conn_type, contact_conn_initiated, local_alias, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id,
|
||||
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter,
|
||||
created_at, security_code, security_code_verified_at, pq_support, pq_encryption, pq_snd_enabled, pq_rcv_enabled, auth_err_counter, quota_err_counter,
|
||||
conn_chat_version, peer_chat_min_version, peer_chat_max_version
|
||||
FROM connections
|
||||
WHERE user_id = ? AND connection_id = ?
|
||||
|
||||
@@ -202,7 +202,7 @@ getGroupLinkConnection db vr User {userId} groupInfo@GroupInfo {groupId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@@ -288,7 +288,7 @@ getGroupAndMember db User {userId, userContactId} groupMemberId vr =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@@ -714,7 +714,7 @@ groupMemberQuery =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id)
|
||||
@@ -973,10 +973,10 @@ getMemberInvitation db User {userId} groupMemberId =
|
||||
fmap join . maybeFirstRow fromOnly $
|
||||
DB.query db "SELECT sent_inv_queue_info FROM group_members WHERE group_member_id = ? AND user_id = ?" (groupMemberId, userId)
|
||||
|
||||
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO ()
|
||||
createMemberConnection :: DB.Connection -> UserId -> GroupMember -> ConnId -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO Connection
|
||||
createMemberConnection db userId GroupMember {groupMemberId} agentConnId chatV peerChatVRange subMode = do
|
||||
currentTs <- getCurrentTime
|
||||
void $ createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode
|
||||
createMemberConnection_ db userId groupMemberId agentConnId chatV peerChatVRange Nothing 0 currentTs subMode
|
||||
|
||||
createMemberConnectionAsync :: DB.Connection -> User -> GroupMemberId -> (CommandId, ConnId) -> VersionChat -> VersionRangeChat -> SubscriptionMode -> IO ()
|
||||
createMemberConnectionAsync db user@User {userId} groupMemberId (cmdId, agentConnId) chatV peerChatVRange subMode = do
|
||||
@@ -1119,20 +1119,33 @@ createIntroductions db chatV members toMember = do
|
||||
then pure []
|
||||
else do
|
||||
currentTs <- getCurrentTime
|
||||
mapM (insertIntro_ currentTs) reMembers
|
||||
catMaybes <$> mapM (createIntro_ currentTs) reMembers
|
||||
where
|
||||
insertIntro_ :: UTCTime -> GroupMember -> IO GroupMemberIntro
|
||||
insertIntro_ ts reMember = do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_member_intros
|
||||
(re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?)
|
||||
|]
|
||||
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts)
|
||||
introId <- insertedRowId db
|
||||
pure GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing}
|
||||
createIntro_ :: UTCTime -> GroupMember -> IO (Maybe GroupMemberIntro)
|
||||
createIntro_ ts reMember =
|
||||
-- when members connect concurrently, host would try to create introductions between them in both directions;
|
||||
-- this check avoids creating second (redundant) introduction
|
||||
checkInverseIntro >>= \case
|
||||
Just _ -> pure Nothing
|
||||
Nothing -> do
|
||||
DB.execute
|
||||
db
|
||||
[sql|
|
||||
INSERT INTO group_member_intros
|
||||
(re_group_member_id, to_group_member_id, intro_status, intro_chat_protocol_version, created_at, updated_at)
|
||||
VALUES (?,?,?,?,?,?)
|
||||
|]
|
||||
(groupMemberId' reMember, groupMemberId' toMember, GMIntroPending, chatV, ts, ts)
|
||||
introId <- insertedRowId db
|
||||
pure $ Just GroupMemberIntro {introId, reMember, toMember, introStatus = GMIntroPending, introInvitation = Nothing}
|
||||
where
|
||||
checkInverseIntro :: IO (Maybe Int64)
|
||||
checkInverseIntro =
|
||||
maybeFirstRow fromOnly $
|
||||
DB.query
|
||||
db
|
||||
"SELECT 1 FROM group_member_intros WHERE re_group_member_id = ? AND to_group_member_id = ? LIMIT 1"
|
||||
(groupMemberId' toMember, groupMemberId' reMember)
|
||||
|
||||
updateIntroStatus :: DB.Connection -> Int64 -> GroupMemberIntroStatus -> IO ()
|
||||
updateIntroStatus db introId introStatus = do
|
||||
@@ -1342,7 +1355,7 @@ getViaGroupMember db vr User {userId, userContactId} Contact {contactId} =
|
||||
m.invited_by, m.invited_by_group_member_id, m.local_display_name, m.contact_id, m.contact_profile_id, p.contact_profile_id, p.display_name, p.full_name, p.image, p.contact_link, p.local_alias, p.preferences,
|
||||
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM group_members m
|
||||
JOIN contacts ct ON ct.contact_id = m.contact_id
|
||||
@@ -1986,7 +1999,8 @@ createMemberContact
|
||||
pqEncryption = PQEncOff,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
authErrCounter = 0,
|
||||
quotaErrCounter = 0
|
||||
}
|
||||
mergedPreferences = contactUserPreferences user userPreferences preferences $ connIncognito ctConn
|
||||
pure Contact {contactId, localDisplayName, profile = memberProfile, activeConn = Just ctConn, viaGroup = Nothing, contactUsed = True, contactStatus = CSActive, chatSettings = defaultChatSettings, userPreferences, mergedPreferences, createdAt = currentTs, updatedAt = currentTs, chatTs = Just currentTs, contactGroupMemberId = Just groupMemberId, contactGrpInvSent = False, uiThemes = Nothing, chatDeleted = False, customData = Nothing}
|
||||
@@ -2119,7 +2133,8 @@ createMemberContactConn_
|
||||
pqEncryption = PQEncOff,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
authErrCounter = 0,
|
||||
quotaErrCounter = 0
|
||||
}
|
||||
|
||||
updateMemberProfile :: DB.Connection -> User -> GroupMember -> Profile -> ExceptT StoreError IO GroupMember
|
||||
|
||||
@@ -285,22 +285,22 @@ createPendingGroupMessage db groupMemberId messageId introId_ = do
|
||||
|]
|
||||
(groupMemberId, messageId, introId_, currentTs, currentTs)
|
||||
|
||||
getPendingGroupMessages :: DB.Connection -> Int64 -> IO [PendingGroupMessage]
|
||||
getPendingGroupMessages :: DB.Connection -> Int64 -> IO [(SndMessage, ACMEventTag, Maybe Int64)]
|
||||
getPendingGroupMessages db groupMemberId =
|
||||
map pendingGroupMessage
|
||||
<$> DB.query
|
||||
db
|
||||
[sql|
|
||||
SELECT pgm.message_id, m.chat_msg_event, m.msg_body, pgm.group_member_intro_id
|
||||
SELECT pgm.message_id, m.shared_msg_id, m.msg_body, m.chat_msg_event, pgm.group_member_intro_id
|
||||
FROM pending_group_messages pgm
|
||||
JOIN messages m USING (message_id)
|
||||
WHERE pgm.group_member_id = ?
|
||||
ORDER BY pgm.message_id ASC
|
||||
ORDER BY pgm.created_at ASC, pgm.message_id ASC
|
||||
|]
|
||||
(Only groupMemberId)
|
||||
where
|
||||
pendingGroupMessage (msgId, cmEventTag, msgBody, introId_) =
|
||||
PendingGroupMessage {msgId, cmEventTag, msgBody, introId_}
|
||||
pendingGroupMessage (msgId, sharedMsgId, msgBody, cmEventTag, introId_) =
|
||||
(SndMessage {msgId, sharedMsgId, msgBody}, cmEventTag, introId_)
|
||||
|
||||
deletePendingGroupMessage :: DB.Connection -> Int64 -> MessageId -> IO ()
|
||||
deletePendingGroupMessage db groupMemberId messageId =
|
||||
|
||||
@@ -109,6 +109,7 @@ import Simplex.Chat.Migrations.M20240430_ui_theme
|
||||
import Simplex.Chat.Migrations.M20240501_chat_deleted
|
||||
import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
|
||||
import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
|
||||
import Simplex.Chat.Migrations.M20240528_quota_err_counter
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
|
||||
schemaMigrations :: [(String, Query, Maybe Query)]
|
||||
@@ -217,7 +218,8 @@ schemaMigrations =
|
||||
("20240430_ui_theme", m20240430_ui_theme, Just down_m20240430_ui_theme),
|
||||
("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted),
|
||||
("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy),
|
||||
("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays)
|
||||
("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays),
|
||||
("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
|
||||
@@ -342,7 +342,7 @@ getUserAddressConnections db vr User {userId} = do
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version
|
||||
FROM connections c
|
||||
JOIN user_contact_links uc ON c.user_contact_link_id = uc.user_contact_link_id
|
||||
@@ -358,7 +358,7 @@ getUserContactLinks db vr User {userId} =
|
||||
[sql|
|
||||
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact, c.via_user_contact_link, c.via_group_link, c.group_link_id, c.custom_user_profile_id,
|
||||
c.conn_status, c.conn_type, c.contact_conn_initiated, c.local_alias, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter,
|
||||
c.created_at, c.security_code, c.security_code_verified_at, c.pq_support, c.pq_encryption, c.pq_snd_enabled, c.pq_rcv_enabled, c.auth_err_counter, c.quota_err_counter,
|
||||
c.conn_chat_version, c.peer_chat_min_version, c.peer_chat_max_version,
|
||||
uc.user_contact_link_id, uc.conn_req_contact, uc.group_id
|
||||
FROM connections c
|
||||
|
||||
@@ -163,12 +163,12 @@ toFileInfo (fileId, fileStatus, filePath) = CIFileInfo {fileId, fileStatus, file
|
||||
|
||||
type EntityIdsRow = (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64)
|
||||
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Maybe VersionChat, VersionChat, VersionChat)
|
||||
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, Maybe Int64, Bool, Maybe GroupLinkId, Maybe Int64, ConnStatus, ConnType, Bool, LocalAlias) :. EntityIdsRow :. (UTCTime, Maybe Text, Maybe UTCTime, PQSupport, PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Int, Int, Maybe VersionChat, VersionChat, VersionChat)
|
||||
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
|
||||
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe Int64, Maybe Bool, Maybe GroupLinkId, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Bool, Maybe LocalAlias) :. EntityIdsRow :. (Maybe UTCTime, Maybe Text, Maybe UTCTime, Maybe PQSupport, Maybe PQEncryption, Maybe PQEncryption, Maybe PQEncryption, Maybe Int, Maybe Int, Maybe VersionChat, Maybe VersionChat, Maybe VersionChat)
|
||||
|
||||
toConnection :: VersionRangeChat -> ConnectionRow -> Connection
|
||||
toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, chatV, minVer, maxVer)) =
|
||||
toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled, pqRcvEnabled, authErrCounter, quotaErrCounter, chatV, minVer, maxVer)) =
|
||||
Connection
|
||||
{ connId,
|
||||
agentConnId = AgentConnId acId,
|
||||
@@ -191,6 +191,7 @@ toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGr
|
||||
pqSndEnabled,
|
||||
pqRcvEnabled,
|
||||
authErrCounter,
|
||||
quotaErrCounter,
|
||||
createdAt
|
||||
}
|
||||
where
|
||||
@@ -203,8 +204,8 @@ toConnection vr ((connId, acId, connLevel, viaContact, viaUserContactLink, viaGr
|
||||
entityId_ ConnUserContact = userContactLinkId
|
||||
|
||||
toMaybeConnection :: VersionRangeChat -> MaybeConnectionRow -> Maybe Connection
|
||||
toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, connChatVersion, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, connChatVersion, minVer, maxVer))
|
||||
toMaybeConnection vr ((Just connId, Just agentConnId, Just connLevel, viaContact, viaUserContactLink, Just viaGroupLink, groupLinkId, customUserProfileId, Just connStatus, Just connType, Just contactConnInitiated, Just localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (Just createdAt, code_, verifiedAt_, Just pqSupport, Just pqEncryption, pqSndEnabled_, pqRcvEnabled_, Just authErrCounter, Just quotaErrCounter, connChatVersion, Just minVer, Just maxVer)) =
|
||||
Just $ toConnection vr ((connId, agentConnId, connLevel, viaContact, viaUserContactLink, viaGroupLink, groupLinkId, customUserProfileId, connStatus, connType, contactConnInitiated, localAlias) :. (contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId) :. (createdAt, code_, verifiedAt_, pqSupport, pqEncryption, pqSndEnabled_, pqRcvEnabled_, authErrCounter, quotaErrCounter, connChatVersion, minVer, maxVer))
|
||||
toMaybeConnection _ _ = Nothing
|
||||
|
||||
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> VersionChat -> VersionRangeChat -> Maybe ContactId -> Maybe Int64 -> Maybe ProfileId -> Int -> UTCTime -> SubscriptionMode -> PQSupport -> IO Connection
|
||||
@@ -249,7 +250,8 @@ createConnection_ db userId connType entityId acId connChatVersion peerChatVRang
|
||||
pqEncryption = CR.pqSupportToEnc pqSup,
|
||||
pqSndEnabled = Nothing,
|
||||
pqRcvEnabled = Nothing,
|
||||
authErrCounter = 0
|
||||
authErrCounter = 0,
|
||||
quotaErrCounter = 0
|
||||
}
|
||||
where
|
||||
ent ct = if connType == ct then entityId else Nothing
|
||||
|
||||
@@ -1303,6 +1303,7 @@ data Connection = Connection
|
||||
pqSndEnabled :: Maybe PQEncryption,
|
||||
pqRcvEnabled :: Maybe PQEncryption,
|
||||
authErrCounter :: Int,
|
||||
quotaErrCounter :: Int, -- if exceeds limit messages to group members are created as pending; sending to contacts is unaffected by this
|
||||
createdAt :: UTCTime
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@@ -1316,6 +1317,15 @@ authErrDisableCount = 10
|
||||
connDisabled :: Connection -> Bool
|
||||
connDisabled Connection {authErrCounter} = authErrCounter >= authErrDisableCount
|
||||
|
||||
quotaErrInactiveCount :: Int
|
||||
quotaErrInactiveCount = 5
|
||||
|
||||
quotaErrSetOnMERR :: Int
|
||||
quotaErrSetOnMERR = 999
|
||||
|
||||
connInactive :: Connection -> Bool
|
||||
connInactive Connection {quotaErrCounter} = quotaErrCounter >= quotaErrInactiveCount
|
||||
|
||||
data SecurityCode = SecurityCode {securityCode :: Text, verifiedAt :: UTCTime}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
@@ -128,13 +128,16 @@ data UIColors = UIColors
|
||||
background :: Maybe UIColor,
|
||||
menus :: Maybe UIColor,
|
||||
title :: Maybe UIColor,
|
||||
accentVariant2 :: Maybe UIColor,
|
||||
sentMessage :: Maybe UIColor,
|
||||
receivedMessage :: Maybe UIColor
|
||||
sentReply :: Maybe UIColor,
|
||||
receivedMessage :: Maybe UIColor,
|
||||
receivedReply :: Maybe UIColor
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
defaultUIColors :: UIColors
|
||||
defaultUIColors = UIColors Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
defaultUIColors = UIColors Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
newtype UIColor = UIColor String
|
||||
deriving (Eq, Show)
|
||||
|
||||
+21
-12
@@ -368,8 +368,13 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
plain . LB.unpack $ J.encode agentWorkersDetails -- this would be huge, but copypastable when has its own line
|
||||
]
|
||||
CRAgentMsgCounts {msgCounts} -> ["received messages (total, duplicates):", plain . LB.unpack $ J.encode msgCounts]
|
||||
CRAgentQueuesInfo {agentQueuesInfo} ->
|
||||
[ "agent queues info:",
|
||||
plain . LB.unpack $ J.encode agentQueuesInfo
|
||||
]
|
||||
CRContactDisabled u c -> ttyUser u ["[" <> ttyContact' c <> "] connection is disabled, to enable: " <> highlight ("/enable " <> viewContactName c) <> ", to delete: " <> highlight ("/d " <> viewContactName c)]
|
||||
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
|
||||
CRConnectionInactive entity inactive -> viewConnectionEntityInactive entity inactive
|
||||
CRAgentRcvQueueDeleted acId srv aqId err_ ->
|
||||
[ ("completed deleting rcv queue, agent connection id: " <> sShow acId)
|
||||
<> (", server: " <> sShow srv)
|
||||
@@ -380,9 +385,9 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
|
||||
CRAgentConnDeleted acId -> ["completed deleting connection, agent connection id: " <> sShow acId | logLevel <= CLLInfo]
|
||||
CRAgentUserDeleted auId -> ["completed deleting user" <> if logLevel <= CLLInfo then ", agent user id: " <> sShow auId else ""]
|
||||
CRMessageError u prefix err -> ttyUser u [plain prefix <> ": " <> plain err | prefix == "error" || logLevel <= CLLWarning]
|
||||
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError logLevel testView e
|
||||
CRChatError u e -> ttyUser' u $ viewChatError logLevel testView e
|
||||
CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError logLevel testView) errs
|
||||
CRChatCmdError u e -> ttyUserPrefix' u $ viewChatError True logLevel testView e
|
||||
CRChatError u e -> ttyUser' u $ viewChatError False logLevel testView e
|
||||
CRChatErrors u errs -> ttyUser' u $ concatMap (viewChatError False logLevel testView) errs
|
||||
CRArchiveImported archiveErrs -> if null archiveErrs then ["ok"] else ["archive import errors: " <> plain (show archiveErrs)]
|
||||
CRAppSettings as -> ["app settings: " <> plain (LB.unpack $ J.encode as)]
|
||||
CRTimedAction _ _ -> []
|
||||
@@ -1886,8 +1891,8 @@ viewRemoteCtrl CtrlAppInfo {deviceName, appVersionRange = AppVersionRange _ (App
|
||||
| otherwise = ""
|
||||
showCompatible = if compatible then "" else ", " <> bold' "not compatible"
|
||||
|
||||
viewChatError :: ChatLogLevel -> Bool -> ChatError -> [StyledString]
|
||||
viewChatError logLevel testView = \case
|
||||
viewChatError :: Bool -> ChatLogLevel -> Bool -> ChatError -> [StyledString]
|
||||
viewChatError isCmd logLevel testView = \case
|
||||
ChatError err -> case err of
|
||||
CENoActiveUser -> ["error: active user is required"]
|
||||
CENoConnectionUser agentConnId -> ["error: message user not found, conn id: " <> sShow agentConnId | logLevel <= CLLError]
|
||||
@@ -1945,7 +1950,6 @@ viewChatError logLevel testView = \case
|
||||
]
|
||||
CEGroupMemberUserRemoved -> ["you are no longer a member of the group"]
|
||||
CEGroupMemberNotFound -> ["group doesn't have this member"]
|
||||
CEGroupMemberIntroNotFound c -> ["group member intro not found for " <> ttyContact c]
|
||||
CEGroupCantResendInvitation g c -> viewCannotResendInvitation g c
|
||||
CEGroupInternal s -> ["chat group bug: " <> plain s]
|
||||
CEFileNotFound f -> ["file not found: " <> plain f]
|
||||
@@ -2026,14 +2030,14 @@ viewChatError logLevel testView = \case
|
||||
<> "error: connection authorization failed - this could happen if connection was deleted,\
|
||||
\ secured with different credentials, or due to a bug - please re-create the connection"
|
||||
]
|
||||
BROKER _ NETWORK -> []
|
||||
BROKER _ TIMEOUT -> []
|
||||
AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug]
|
||||
AGENT (A_PROHIBITED e) -> [withConnEntity <> "error: AGENT A_PROHIBITED, " <> plain e | logLevel <= CLLWarning]
|
||||
CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning]
|
||||
BROKER _ NETWORK | not isCmd -> []
|
||||
BROKER _ TIMEOUT | not isCmd -> []
|
||||
AGENT A_DUPLICATE -> [withConnEntity <> "error: AGENT A_DUPLICATE" | logLevel == CLLDebug || isCmd]
|
||||
AGENT (A_PROHIBITED e) -> [withConnEntity <> "error: AGENT A_PROHIBITED, " <> plain e | logLevel <= CLLWarning || isCmd]
|
||||
CONN NOT_FOUND -> [withConnEntity <> "error: CONN NOT_FOUND" | logLevel <= CLLWarning || isCmd]
|
||||
CRITICAL restart e -> [plain $ "critical error: " <> e] <> ["please restart the app" | restart]
|
||||
INTERNAL e -> [plain $ "internal error: " <> e]
|
||||
e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning]
|
||||
e -> [withConnEntity <> "smp agent error: " <> sShow e | logLevel <= CLLWarning || isCmd]
|
||||
where
|
||||
withConnEntity = case entity_ of
|
||||
Just entity@(RcvDirectMsgConnection conn contact_) -> case contact_ of
|
||||
@@ -2069,6 +2073,11 @@ viewConnectionEntityDisabled entity = case entity of
|
||||
where
|
||||
entityLabel = connEntityLabel entity
|
||||
|
||||
viewConnectionEntityInactive :: ConnectionEntity -> Bool -> [StyledString]
|
||||
viewConnectionEntityInactive entity inactive
|
||||
| inactive = ["[" <> connEntityLabel entity <> "] connection is marked as inactive"]
|
||||
| otherwise = ["[" <> connEntityLabel entity <> "] inactive connection is marked as active"]
|
||||
|
||||
connEntityLabel :: ConnectionEntity -> StyledString
|
||||
connEntityLabel = \case
|
||||
RcvDirectMsgConnection _ (Just Contact {localDisplayName = c}) -> plain c
|
||||
|
||||
Reference in New Issue
Block a user