From 6850037e214b5a8eb4d46a3671b452a03349d674 Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Thu, 30 Jul 2026 12:27:47 +0000 Subject: [PATCH] limit attempts for key sending --- plans/2026-07-26-p2p-member-keys.md | 97 ++++++++++++++++--- src/Simplex/Chat/Library/Internal.hs | 91 +++++++++++------ src/Simplex/Chat/Library/Subscriber.hs | 2 +- src/Simplex/Chat/Store/Connections.hs | 4 +- src/Simplex/Chat/Store/Groups.hs | 48 ++++++--- src/Simplex/Chat/Store/Messages.hs | 8 +- .../Migrations/M20260727_member_key_sent.hs | 6 +- .../Store/Postgres/Migrations/chat_schema.sql | 3 +- .../Migrations/M20260727_member_key_sent.hs | 6 +- .../Store/SQLite/Migrations/chat_schema.sql | 3 +- src/Simplex/Chat/Store/Shared.hs | 25 ++++- src/Simplex/Chat/Types.hs | 7 +- 12 files changed, 231 insertions(+), 69 deletions(-) diff --git a/plans/2026-07-26-p2p-member-keys.md b/plans/2026-07-26-p2p-member-keys.md index 5f5da8c597..6bad3829e4 100644 --- a/plans/2026-07-26-p2p-member-keys.md +++ b/plans/2026-07-26-p2p-member-keys.md @@ -95,20 +95,95 @@ A binary-capable member below `groupMemberKeyVersion` (18-19) receives the signe Three mode sites to update: `prepareMsgReqs` (`:2549`, main group send), `sendGroupMemberMessages` (`:2232`, member-to-member / introductions), and `:2676`. -## Implementation status (2026-07-27) +## Revision (2026-07-30): consolidate the send decision, classify delivery -All seven items implemented: +Items 2, 4, 7 above are the first-cut design - a boolean `user_member_key_sent`, set true on delivery, with the binary/JSON split re-derived in `prepareMsgReqs`. That shipped (commit `261d09ba4` onward) and is the current code. This revision replaces it. Two problems drove it: -1. Version - `groupMemberKeyVersion = 20`, `currentChatVersion = 20`, `XGrpLinkMem` in `requiresSignature`, `XGrpLinkMem`/`XInfo`/`XContact` carry `Maybe MemberKey`. -2. Schema/type/rows - `user_member_key_sent` column (both backends, migration `M20260727_member_key_sent`), `userMemberKeySent :: Bool` on `GroupMember`, all `GroupMemberRow`/`MaybeGroupMemberRow` SELECTs and parses. -3. Generation - `setUserMemberKey`, `ensureUserMemberKey`, `groupMemberKey`; keyed at `APINewGroup` (create), `joinContact` (contact-link join), `sendXGrpLinkMem` and `XGrpLinkInv` handshake (prepared-group join), and lazily at the send entries. -4. `sendGroupProfileUpdate` - one `XInfo profile (Just ownKey)` to `profileMembers ∪ keyMembers` via `sendGroupMessages_`, marks `setMembersMemberKeySent` for delivered v20+ recipients (`sentTo` Right / `pending` / `forwarded`), `updateUserMemberProfileSentAt` only when the profile changed. -5. Distribution - `XContact` (joiner->host, TOFU) threaded through `profileContactRequest` to `acceptGroupJoinRequestAsync`; `XGrpLinkMem` (host->joiner) signed via `sendGroupMemberMessages`; `XInfo` allow-reply (joiner->host) signed via `encodeSignedGroupConnInfo` + `allowAgentConnectionInfo`, gated on `not (useRelays' gInfo) && maxVersion chatVRange >= relayWebCapVersion`. -6. Receive - `storeMemberKey` (pin-or-reject, self-certified by `verifyGroupSig`) at `xInfoMember`, `xGrpLinkMem`, and the `INFO`/`XInfo` allow-reply (switched to `parseChatMessage'`). -7. Signed send - `prepareMsgReqs` partitions recipients by `relayWebCapVersion` (binary-signed to v18+, sig-stripped JSON below); `memberBatch` does the single-connection equivalent for `sendGroupMemberMessages` and `sendPendingGroupMessages`. +1. **`prepareMsgReqs` re-derives the send mode.** `memberSendAction` (`Internal.hs:2606`) already walks every member - with `useRelays'` and version in hand - to choose `MSASend`; `prepareMsgReqs` then walks the resulting `toSend` again - `partition useBinary` where `useBinary (m,_) = useRelays' gInfo || m supportsVersion relayWebCapVersion` (`:2564`) - recomputing the same decision. One decision, two owners. +2. **The boolean models only the happy path.** A `sentTo` `Left` is never marked, so an errored member is re-selected every send forever, uncounted; a disabled member (a `memberSendAction` skip) likewise. No permanent/transient split, no give-up. + +### A. `MemberSendAction` - total, records mode and skip reason + +```haskell +data SkipReason = SRUnsendable | SRNotApplicable + -- SRUnsendable: disabled / ConnDeleted / failed / GSMemRejected (memberSendAction :2619) + -- SRNotApplicable: relay non-target (:2615), self GCUserMember (:2625), forward with no path (:2633) +data MemberSendAction = MSASend BatchMode Connection | MSAPending | MSAForwarded | MSASkip SkipReason +memberSendAction :: ... -> MemberSendAction -- total, no Maybe +``` + +- Every current `Nothing` becomes `MSASkip r` with the reason from the branch it came from. For a key recipient (a real, non-self member receiving `XInfo`, not `XGrpMsgForward`), only `:2619` → `SRUnsendable` is reachable. +- `MSASend` records the `BatchMode` (`BMBinary` for `useRelays' gInfo || m supportsVersion relayWebCapVersion`, else `BMJson`) - computed where `memberSendAction` already branches on exactly that predicate. +- `addMember` (`:2550`) sorts `MSASend BMBinary` / `MSASend BMJson` into pre-partitioned `toSendBin` / `toSendJson`; `prepareMsgReqs` consumes those and drops its own `partition useBinary`. Problem 1 gone. +- `GroupSndResult` gains `skipped :: [(GroupMember, SkipReason)]` so the key-marking sees skips. The other consumer, `createMemberSndStatuses` (`Commands.hs:4822`), ignores `skipped` and the mode - unchanged. + +### B. Two columns + `KeySendStatus` sum type + +Replace the boolean with two columns (edit the unreleased `M20260727` migration + both `chat_schema.sql`; no new migration): +- `user_member_key_status TEXT` - `NULL` = attempting; `"sent"` = delivered; any other text = terminal error reason. +- `user_member_key_attempts INTEGER NOT NULL DEFAULT 0` - retriable-failure count. + +`GroupMember` field `userMemberKeyStatus :: KeySendStatus` (was `userMemberKeySent :: Bool`), a sum type constructed from the two columns: + +```haskell +data KeySendStatus = KSSent | KSError Text | KSAttempts Int +-- from (status :: Maybe Text, attempts :: Int): +-- (Just "sent", _) -> KSSent +-- (Just reason, _) -> KSError reason -- any non-null, non-"sent" text ("sent" reserved) +-- (Nothing, n) -> KSAttempts n -- still attempting, n prior retriable failures +``` + +Two columns, not one text field, so each marking outcome is one uniform bulk write (C): success touches only `status`, a retry touches only `attempts` (`attempts = attempts + 1`, no per-row value), an error groups by reason. Member creation default `KSAttempts 0` = (`NULL`, `0`). + +Selection: `memberNeedsKey m = m supportsVersion groupMemberKeyVersion && case userMemberKeyStatus m of { KSAttempts n -> n < maxKeySendAttempts; _ -> False }`. Comparing the count to config (E) means no separate "abandoned" state; raising the cap re-includes maxed-out members. + +### C. Marking - classify once, from `GroupSndResult` + +Per key-recipient, one outcome, written as partitioned bulk updates: +- **Delivered** (`sentTo` enqueue `Right`, or `pending`, or `forwarded`) → `status = "sent"`. +- **Skipped** (`skipped`): `SRUnsendable` → `status = ` terminal (a disabled connection is terminal in practice - `APIEnableGroupMember` is effectively never called - so stop re-selecting it); `SRNotApplicable` → untouched. +- **Errored** (`sentTo` `Left`): `terminalKeySend e` → `status = ` (grouped by reason); else → `attempts = attempts + 1`. + +The send is async: this classifies only the synchronous **enqueue** result. `submitPendingMsg` (`Agent.hs:2068`) hands the message to the SND worker, which does the network send and emits `SENT` / `MERR` (`Agent.hs:2196,2274`) - so AUTH / QUOTA / NETWORK / BROKER never reach this point; the agent retries them itself. `temporaryOrHostError` is therefore the wrong classifier here - it triages the async errors that cannot occur, and misjudges the few that can. + +### D. `terminalKeySend` - closed terminal set, default retriable + +```haskell +terminalKeySend :: ChatError -> Bool +terminalKeySend = \case + ChatErrorAgent {agentError} -> case agentError of + CONN SIMPLEX _ -> True -- connection has no send queue (prepareConn :1821) + CONN NOT_FOUND _ -> True -- connection / ratchet gone (getConn :1812) + NO_USER -> True -- user deleted + _ -> False + _ -> False +``` + +Everything else is retriable, bounded by the cap: `CMD PROHIBITED` (ratchet resync, `Agent.hs:1826`), `CRITICAL True` (agent DB lock, `SEDatabaseBusy`), `INACTIVE` (agent suspended), `ChatErrorStore` (chat DB contention), `INTERNAL` (catch-all - ambiguous, so retriable), and oversize (`CMD LARGE` / batch `CEInternalError "large message"` / `CEException "large compressed message"` - rare, a global profile-size problem, self-limiting under the cap; a dedicated `ChatErrorType` constructor for the batch case is a separate cleanup, out of this branch). Inverting to a terminal whitelist is deliberate: at the enqueue phase, mislabeling a transient error permanent abandons a member whose next send would succeed, while mislabeling a permanent error retriable costs only a few capped sends. + +Exhaustive reachability (why the terminal set is these three): the only synchronous producers are `getConn_` (`Agent.hs:1806`), `prepareConn` (`:1814`), and `enqueueMessageB`/`storeSentMsg` (`:2062`). All network/server errors (`SMP`/`BROKER`/`PROXY`/`NTF`/`XFTP`, and `AUTH`/`QUOTA`) are async (MERR) and unreachable here; `AGENT (A_*)` are receive/queue-op side; `CONN DUPLICATE`/`NOT_ACCEPTED`/`NOT_AVAILABLE`, `CMD SYNTAX`/`NO_CONN`/`SIZE`, `NTF`/`XFTP`/`FILE`/`RCP`/`NOTICE`/`CRITICAL False` are other paths. + +### E. Config + +`maxKeySendAttempts :: Int` in the chat config (value immaterial - a small cap like 5; over-retrying a rare ambiguous error is cheap). + +## Implementation status (2026-07-30) + +- Items 1, 3, 5, 6 - implemented as described: versions, key generation, distribution (`XContact` / `XGrpLinkMem` / `XInfo`), receive pin-or-reject. +- Items 2, 4, 7 - the boolean baseline is **replaced by the Revision (A-E)**, which is now implemented and compiles (`cabal build lib:simplex-chat`, both backends' schema + migration updated): + - A - `MemberSendAction` total, records `BatchMode` and `SkipReason`; `sendBatchMode` is the single owner of the binary/JSON decision; `sendGroupSignedMessages_` dedups then classifies with list comprehensions into pre-partitioned `toSendBin`/`toSendJson`; `prepareMsgReqs` reads them (no re-derivation); `GroupSndResult` gains `skipped`. + - B - two columns `user_member_key_status TEXT` / `user_member_key_attempts` (migration `M20260727` + both `chat_schema.sql`), field `userMemberKeyStatus :: KeySendStatus` built by `toKeySendStatus`, store fns `setMembersKeyStatus` / `incMembersKeyAttempts`. + - C - `markKeySends` classifies each key-recipient once from `GroupSndResult` and writes partitioned bulk updates; `memberNeedsKey` selects `KSAttempts n < maxKeySendAttempts`. + - D - `terminalKeySend` = {`CONN SIMPLEX`, `CONN NOT_FOUND`, `NO_USER`}; everything else retriable. + - E - `maxKeySendAttempts = 5`. + +Remaining work: +- Regenerate the client-type mirrors: `userMemberKeyStatus` still shows as `userMemberKeySent: boolean` in the generated `types.ts`, `_types.py`, and `bots/api/TYPES.md` (generated by `bots/src/API/Docs/Generate*.hs`). +- Tests: the branch adds none beyond `ProtocolTests` field plumbing - no coverage of distribution, pin-or-reject, signed send/verify, or the classification. ## Open decisions -None outstanding. +- Names, to confirm or adjust: columns `user_member_key_status` / `user_member_key_attempts`, field `userMemberKeyStatus :: KeySendStatus`, constructors `KeySendStatus`/`KS*` and `SkipReason`/`SR*`, config `maxKeySendAttempts`. +- Whether a `SRUnsendable` skip is recorded as a terminal `error` (proposed: yes - a disabled connection is terminal in practice). -Resolved: names finalized during implementation. Both key writes required (`groups.member_priv_key` and own-row `member_pub_key`). `XContact` includes the unsigned key at member creation and the signed allow-reply confirms it. Reuse `relayWebCapVersion` (18) as the binary floor. `user_member_key_sent` is a boolean, set `True` for key recipients in `sentTo`/`pending`/`forwarded`; no cap or error classification - `memberSendAction` skips dead connections (`Internal.hs:2608`), so they are re-filtered, not re-sent, until ready. Key change on receipt - reject any change, immutable. Signed send (item 7) - partition by binary capability. Key distribution runs in all p2p groups including incognito. First send after generation is signed. Sign criteria unchanged. Handshake allow-reply signed, confirms the key at join. +Resolved: both key writes required (`groups.member_priv_key` and own-row `member_pub_key`). `XContact` includes the unsigned key at member creation and the signed allow-reply confirms it. Reuse `relayWebCapVersion` (18) as the binary floor. Key change on receipt - reject any change, immutable. Signed send (item 7) - partition by binary capability, and (Revision A) the mode is decided once in `memberSendAction`, not re-derived. Key distribution runs in all p2p groups including incognito. First send after generation is signed. Sign criteria unchanged. Handshake allow-reply signed, confirms the key at join. Status is a two-column `KeySendStatus` sum type (not a boolean); delivery is classified terminal-vs-retriable with a capped attempt counter, terminal set closed (D). diff --git a/src/Simplex/Chat/Library/Internal.hs b/src/Simplex/Chat/Library/Internal.hs index ae7c38d654..9acdc63a06 100644 --- a/src/Simplex/Chat/Library/Internal.hs +++ b/src/Simplex/Chat/Library/Internal.hs @@ -2492,25 +2492,55 @@ sendGroupProfileUpdate user gInfo scope asGroup members sendProfile_ members' = do let incognitoProfile = incognitoMembershipProfile gInfo profile <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo (fromLocalProfile <$> incognitoProfile) - (_, GroupSndResult {sentTo, pending, forwarded}) <- sendGroupMessages_ user gInfo members' False [XInfo profile (groupMemberKey gInfo)] - pure $ [mId | (mId, _, Right _) <- sentTo] <> map (\(mId, _, _) -> mId) pending <> map groupMemberId' forwarded + snd <$> sendGroupMessages_ user gInfo members' False [XInfo profile (groupMemberKey gInfo)] sendProfileUpdate = unless (null members) $ do - delivered <- sendProfile_ members + gsr <- sendProfile_ members currentTs <- liftIO getCurrentTime - withStore' $ \db -> do - updateUserMemberProfileSentAt db user gInfo currentTs - let keyIds = S.fromList [groupMemberId' m | m <- members, memberNeedsKey m] - delivered' = filter (`S.member` keyIds) delivered - unless (useRelays' gInfo || null delivered') $ setMembersMemberKeySent db delivered' + withStore' $ \db -> updateUserMemberProfileSentAt db user gInfo currentTs + unless (useRelays' gInfo) $ markKeySends (keyIds members) gsr sendProfileAndKey members' = unless (null members') $ do - delivered <- sendProfile_ members' - unless (null delivered) $ withStore' (`setMembersMemberKeySent` delivered) - memberNeedsKey m = m `supportsVersion` groupMemberKeyVersion && not (userMemberKeySent m) + gsr <- sendProfile_ members' + markKeySends (keyIds members') gsr + keyIds ms = S.fromList [groupMemberId' m | m <- ms, memberNeedsKey m] + memberNeedsKey m = m `supportsVersion` groupMemberKeyVersion && case userMemberKeyStatus m of + KSAttempts n -> n < maxKeySendAttempts + _ -> False + maxKeySendAttempts :: Int + maxKeySendAttempts = 5 + terminalKeySend = \case + ChatErrorAgent {agentError} -> case agentError of + CONN SIMPLEX _ -> True + CONN NOT_FOUND _ -> True + NO_USER -> True + _ -> False + _ -> False + markKeySends kIds GroupSndResult {sentTo, pending, forwarded, failed} = + withStore' $ \db -> do + unless (null sentIds) $ setMembersKeyStatus db KSSent sentIds + unless (null failedIds) $ setMembersKeyStatus db KSFailed failedIds + unless (null retriable) $ incMembersKeyAttempts db retriable + forM_ (M.toList terminalErrs) $ \(reason, mIds) -> setMembersKeyStatus db (KSError reason) mIds + where + keyMember mId = mId `S.member` kIds + keyIdsOf ms = [gmId | m <- ms, let gmId = groupMemberId' m, keyMember gmId] + (delivered, errored) = foldr part (foldr part ([], []) pending) sentTo + part :: (GroupMemberId, a, Either ChatError b) -> ([GroupMemberId], [(GroupMemberId, ChatError)]) -> ([GroupMemberId], [(GroupMemberId, ChatError)]) + part (mId, _, r) acc@(d, e) + | not (keyMember mId) = acc + | Left err <- r = (d, (mId, err) : e) + | otherwise = (mId : d, e) + (retriable, terminalErrs) = foldr splitErr ([], M.empty) errored + splitErr (mId, e) (ret, terr) + | terminalKeySend e = (ret, M.insertWith (<>) (tshow e) [mId] terr) + | otherwise = (mId : ret, terr) + sentIds = delivered <> keyIdsOf forwarded + failedIds = keyIdsOf failed data GroupSndResult = GroupSndResult { sentTo :: [(GroupMemberId, Either ChatError [MessageId], Either ChatError ([Int64], PQEncryption))], pending :: [(GroupMemberId, Either ChatError MessageId, Either ChatError ())], - forwarded :: [GroupMember] + forwarded :: [GroupMember], + failed :: [GroupMember] } sendGroupMessages_ :: MsgEncodingI e => User -> GroupInfo -> [GroupMember] -> Bool -> NonEmpty (ChatMsgEvent e) -> CM (NonEmpty (Either ChatError SndMessage), GroupSndResult) @@ -2522,8 +2552,8 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents sndMsgs_ <- lift $ createSndMessages idsEvts recipientMembers' <- liftIO $ shuffleMembers recipientMembers let msgFlags = MsgFlags {notification = any (hasNotification . toCMEventTag) events} - (toSend, toPending, forwarded, _, dups) = - foldr' (addMember recipientMembers') ([], [], [], S.empty, 0 :: Int) recipientMembers' + (toSend, toPending, forwarded, failed, _, dups) = + foldr' (addMember recipientMembers') (([], []), [], [], [], S.empty, 0 :: Int) recipientMembers' when (dups /= 0) $ logError $ "sendGroupMessages_: " <> tshow dups <> " duplicate members" -- TODO PQ either somehow ensure that group members connections cannot have pqSupport/pqEncryption or pass Off's here -- Deliver to toSend members @@ -2537,7 +2567,7 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents -- Zip for easier access to results let sentTo = zipWith3 (\mId mReq r -> (mId, fmap (\(_, _, (_, msgIds)) -> msgIds) mReq, r)) sendToMemIds msgReqs delivered pending = zipWith3 (\mId pReq r -> (mId, fmap snd pReq, r)) pendingMemIds pendingReqs stored - pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded}) + pure (sndMsgs_, GroupSndResult {sentTo, pending, forwarded, failed}) where events = L.map snd signedEvents idsEvts = L.map (\(signing, evt) -> (GroupId groupId, signing, evt)) signedEvents @@ -2547,23 +2577,29 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents liftM2 (<>) (shuffle adminMs) (shuffle otherMs) where isAdmin GroupMember {memberRole} = memberRole >= GRAdmin - addMember members m acc@(toSend, pending, forwarded, !mIds, !dups) = + batchMode m + | useRelays' gInfo || m `supportsVersion` relayWebCapVersion = BMBinary + | otherwise = BMJson + addMember members m acc@(toSend@(toSendBin, toSendJson), pending, forwarded, failed, !mIds, !dups) = case memberSendAction gInfo events members m of Just a - | mId `S.member` mIds -> (toSend, pending, forwarded, mIds, dups + 1) + | mId `S.member` mIds -> (toSend, pending, forwarded, failed, mIds, dups + 1) | otherwise -> case a of - MSASend conn -> ((m, conn) : toSend, pending, forwarded, mIds', dups) - MSAPending -> (toSend, m : pending, forwarded, mIds', dups) - MSAForwarded -> (toSend, pending, m : forwarded, mIds', dups) + MSASend conn -> + let toSend' = case batchMode m of + BMBinary -> ((m, conn) : toSendBin, toSendJson) + BMJson -> (toSendBin, (m, conn) : toSendJson) + in (toSend', pending, forwarded, failed, mIds', dups) + MSAPending -> (toSend, m : pending, forwarded, failed, mIds', dups) + MSAForwarded -> (toSend, pending, m : forwarded, failed, mIds', dups) + MSAFail -> (toSend, pending, forwarded, m : failed, mIds', dups) Nothing -> acc where mId = groupMemberId' m mIds' = S.insert mId mIds - prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> [(GroupMember, Connection)] -> ([GroupMemberId], [Either ChatError ChatMsgReq]) - prepareMsgReqs msgFlags msgs toSend = - let (toSendBin, toSendJson) = partition useBinary toSend - useBinary (m, _) = useRelays' gInfo || m `supportsVersion` relayWebCapVersion - in batchReqs BMBinary msgs toSendBin <> batchReqs BMJson msgs toSendJson + prepareMsgReqs :: MsgFlags -> NonEmpty (Either ChatError SndMessage) -> ([(GroupMember, Connection)], [(GroupMember, Connection)]) -> ([GroupMemberId], [Either ChatError ChatMsgReq]) + prepareMsgReqs msgFlags msgs (toSendBin, toSendJson) = + batchReqs BMBinary msgs toSendBin <> batchReqs BMJson msgs toSendJson where batchReqs _ [] [] = ([], []) batchReqs mode msgs' toSend' = case L.nonEmpty (batchSndMessagesJSON mode msgs') of @@ -2601,7 +2637,7 @@ sendGroupSignedMessages_ gInfo@GroupInfo {groupId} recipientMembers signedEvents createPendingMsg db (groupMemberId, msgId) = createPendingGroupMessage db groupMemberId msgId $> Right () -data MemberSendAction = MSASend Connection | MSAPending | MSAForwarded +data MemberSendAction = MSASend Connection | MSAPending | MSAForwarded | MSAFail memberSendAction :: GroupInfo -> NonEmpty (ChatMsgEvent e) -> [GroupMember] -> GroupMember -> Maybe MemberSendAction memberSendAction gInfo@GroupInfo {membership} events members m@GroupMember {memberStatus} @@ -2616,7 +2652,7 @@ memberSendAction gInfo@GroupInfo {membership} events members m@GroupMember {memb | otherwise = case memberConn m of Nothing -> pendingOrForwarded Just conn@Connection {connStatus} - | connDisabled conn || connStatus == ConnDeleted || isConnFailed connStatus || memberStatus == GSMemRejected -> Nothing + | connDisabled conn || connStatus == ConnDeleted || isConnFailed connStatus || memberStatus == GSMemRejected -> Just MSAFail | connInactive conn -> Just MSAPending | connStatus == ConnSndReady || connStatus == ConnReady -> Just (MSASend conn) | otherwise -> pendingOrForwarded @@ -2663,6 +2699,7 @@ sendGroupMemberMessage gInfo@GroupInfo {groupId} m@GroupMember {groupMemberId} c MSASend conn -> void $ deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId MSAPending -> withStore' $ \db -> createPendingGroupMessage db groupMemberId msgId MSAForwarded -> pure () + MSAFail -> pure () -- Send pre-encoded forwarded message preserving original signature sendFwdMemberMessage :: GroupMember -> GrpMsgForward -> VerifiedMsg 'Json -> CM () diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index f2295084a5..596b25ce08 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -932,7 +932,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = let incognitoProfile = ExistingIncognito <$> incognitoMembershipProfile gInfo'' profileToSend <- presentUserBadge user incognitoProfile $ userProfileInGroup user gInfo'' (fromIncognitoProfile <$> incognitoProfile) sendGroupMemberMessages user gInfo'' conn [XGrpLinkMem profileToSend (groupMemberKey gInfo'')] - withStore' $ \db -> setMembersMemberKeySent db [groupMemberId' m'] + when (m' `supportsVersion` groupMemberKeyVersion) $ withStore' (`setMemberKeySent` groupMemberId' m') _ -> do unless (memberPending m) $ withStore' $ \db -> updateGroupMemberStatus db userId m GSMemConnected notifyMemberConnected gInfo m Nothing diff --git a/src/Simplex/Chat/Store/Connections.hs b/src/Simplex/Chat/Store/Connections.hs index d3c4e79c4e..f23176ca85 100644 --- a/src/Simplex/Chat/Store/Connections.hs +++ b/src/Simplex/Chat/Store/Connections.hs @@ -159,13 +159,13 @@ getConnectionEntity db cxt user@User {userId, userContactId} agentConnId = do pu.display_name, pu.full_name, pu.short_descr, pu.description, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences, pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_proof, pu.contact_domain_verified, mu.created_at, mu.updated_at, - mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.user_member_key_sent, mu.relay_link, mu.member_security_code, mu.member_security_code_verified_at, + mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.user_member_key_status, mu.user_member_key_attempts, mu.relay_link, mu.member_security_code, mu.member_security_code_verified_at, -- from GroupMember m.group_member_id, m.group_id, m.index_in_group, m.member_id, m.peer_chat_min_version, m.peer_chat_max_version, m.member_role, m.member_category, m.member_status, m.show_messages, m.member_restriction, 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.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_sent, m.relay_link, m.member_security_code, m.member_security_code_verified_at + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_status, m.user_member_key_attempts, m.relay_link, m.member_security_code, m.member_security_code_verified_at FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) JOIN groups g ON g.group_id = m.group_id diff --git a/src/Simplex/Chat/Store/Groups.hs b/src/Simplex/Chat/Store/Groups.hs index c716a4c826..c73604959b 100644 --- a/src/Simplex/Chat/Store/Groups.hs +++ b/src/Simplex/Chat/Store/Groups.hs @@ -108,7 +108,9 @@ module Simplex.Chat.Store.Groups setGroupMemberKeyRole, setUserMemberKey, setMemberPubKey, - setMembersMemberKeySent, + setMemberKeySent, + setMembersKeyStatus, + incMembersKeyAttempts, setGroupMemberVerified, createRelayForOwner, getCreateRelayForMember, @@ -260,11 +262,11 @@ import Database.SQLite.Simple (Only (..), Query, (:.) (..)) import Database.SQLite.Simple.QQ (sql) #endif -type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe BoolInt, Maybe ShortLinkContact, Maybe Text, Maybe UTCTime) +type MaybeGroupMemberRow = (Maybe GroupMemberId, Maybe GroupId, Maybe Int64, Maybe MemberId, Maybe VersionChat, Maybe VersionChat, Maybe GroupMemberRole, Maybe GroupMemberCategory, Maybe GroupMemberStatus, Maybe BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, Maybe ContactName, Maybe ContactId, Maybe ProfileId) :. ((Maybe ProfileId, Maybe ContactName, Maybe Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, Maybe LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow) :. (Maybe UTCTime, Maybe UTCTime) :. (Maybe UTCTime, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe Text, Maybe Int64, Maybe ShortLinkContact, Maybe Text, Maybe UTCTime) toMaybeGroupMember :: UTCTime -> Int64 -> MaybeGroupMemberRow -> Maybe GroupMember -toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, description, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. domainRow) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, Just userMemberKeySent, relayLink, memberCode_, memberCodeVerifiedAt_)) = - Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. domainRow) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, userMemberKeySent, relayLink, memberCode_, memberCodeVerifiedAt_)) +toMaybeGroupMember now userContactId ((Just groupMemberId, Just groupId, Just indexInGroup, Just memberId, Just minVer, Just maxVer, Just memberRole, Just memberCategory, Just memberStatus, Just showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, Just localDisplayName, memberContactId, Just memberContactProfileId) :. ((Just profileId, Just displayName, Just fullName, shortDescr, description, image, contactLink, peerType, Just localAlias, contactPreferences) :. badgeRow :. domainRow) :. (Just createdAt, Just updatedAt) :. (supportChatTs, Just supportChatUnread, Just supportChatUnanswered, Just supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, keyStatus_, Just keyAttempts, relayLink, memberCode_, memberCodeVerifiedAt_)) = + Just $ toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, showMessages, memberBlocked') :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. ((profileId, displayName, fullName, shortDescr, description, image, contactLink, peerType, localAlias, contactPreferences) :. badgeRow :. domainRow) :. (createdAt, updatedAt) :. (supportChatTs, supportChatUnread, supportChatUnanswered, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, keyStatus_, keyAttempts, relayLink, memberCode_, memberCodeVerifiedAt_)) toMaybeGroupMember _ _ _ = Nothing createGroupLink :: DB.Connection -> TVar ChaChaDRG -> User -> GroupInfo -> ConnId -> CreatedLinkContact -> GroupLinkId -> GroupMemberRole -> SubscriptionMode -> ExceptT StoreError IO GroupLink @@ -596,7 +598,7 @@ createContactMemberInv_ db User {userId, userContactId} groupId invitedByGroupMe updatedAt = createdAt, supportChat = Nothing, memberPubKey, - userMemberKeySent = False, + userMemberKeyStatus = KSAttempts 0, relayLink = Nothing, memberVerifiedCode = Nothing } @@ -1401,7 +1403,7 @@ createNewContactMember db gVar User {userId, userContactId} GroupInfo {groupId, updatedAt = createdAt, supportChat = Nothing, memberPubKey = Nothing, - userMemberKeySent = False, + userMemberKeyStatus = KSAttempts 0, relayLink = Nothing, memberVerifiedCode = Nothing } @@ -1698,19 +1700,39 @@ setMemberPubKey db groupMemberId pubKey = do currentTs <- getCurrentTime DB.execute db "UPDATE group_members SET member_pub_key = ?, updated_at = ? WHERE group_member_id = ?" (pubKey, currentTs, groupMemberId) -setMembersMemberKeySent :: DB.Connection -> [GroupMemberId] -> IO () -setMembersMemberKeySent db memberIds = do +setMemberKeySent :: DB.Connection -> GroupMemberId -> IO () +setMemberKeySent db groupMemberId = do + currentTs <- getCurrentTime + DB.execute db "UPDATE group_members SET user_member_key_status = ?, updated_at = ? WHERE group_member_id = ?" (keySendStatusText KSSent, currentTs, groupMemberId) + +setMembersKeyStatus :: DB.Connection -> KeySendStatus -> [GroupMemberId] -> IO () +setMembersKeyStatus db status memberIds = do currentTs <- getCurrentTime #if defined(dbPostgres) DB.execute db - "UPDATE group_members SET user_member_key_sent = ?, updated_at = ? WHERE group_member_id IN ?" - (BI True, currentTs, In memberIds) + "UPDATE group_members SET user_member_key_status = ?, updated_at = ? WHERE group_member_id IN ?" + (keySendStatusText status, currentTs, In memberIds) #else DB.executeMany db - "UPDATE group_members SET user_member_key_sent = ?, updated_at = ? WHERE group_member_id = ?" - (map (BI True,currentTs,) memberIds) + "UPDATE group_members SET user_member_key_status = ?, updated_at = ? WHERE group_member_id = ?" + (map (keySendStatusText status,currentTs,) memberIds) +#endif + +incMembersKeyAttempts :: DB.Connection -> [GroupMemberId] -> IO () +incMembersKeyAttempts db memberIds = do + currentTs <- getCurrentTime +#if defined(dbPostgres) + DB.execute + db + "UPDATE group_members SET user_member_key_attempts = user_member_key_attempts + 1, updated_at = ? WHERE group_member_id IN ?" + (currentTs, In memberIds) +#else + DB.executeMany + db + "UPDATE group_members SET user_member_key_attempts = user_member_key_attempts + 1, updated_at = ? WHERE group_member_id = ?" + (map (currentTs,) memberIds) #endif setGroupMemberVerified :: DB.Connection -> User -> GroupMemberId -> Maybe Text -> IO () @@ -2520,7 +2542,7 @@ createNewMember_ updatedAt = createdAt, supportChat = Nothing, memberPubKey, - userMemberKeySent = False, + userMemberKeyStatus = KSAttempts 0, relayLink = Nothing, memberVerifiedCode = Nothing } diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index feeeb9a57d..368c1a703a 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -724,7 +724,7 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_sent, m.relay_link, m.member_security_code, m.member_security_code_verified_at + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_status, m.user_member_key_attempts, m.relay_link, m.member_security_code, m.member_security_code_verified_at FROM group_members m JOIN contact_profiles p ON p.contact_profile_id = COALESCE(m.member_profile_id, m.contact_profile_id) LEFT JOIN contacts c ON m.contact_id = c.contact_id @@ -3094,7 +3094,7 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do p.display_name, p.full_name, p.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_sent, m.relay_link, m.member_security_code, m.member_security_code_verified_at, + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_status, m.user_member_key_attempts, m.relay_link, m.member_security_code, m.member_security_code_verified_at, -- quoted ChatItem ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent, -- quoted GroupMember @@ -3103,14 +3103,14 @@ getGroupChatItem db User {userId, userContactId} groupId itemId = ExceptT $ do rp.display_name, rp.full_name, rp.short_descr, rp.description, rp.image, rp.contact_link, rp.chat_peer_type, rp.local_alias, rp.preferences, rp.badge_proof, rp.badge_pres_header, rp.badge_expiry, rp.badge_type, rp.badge_verified, rp.badge_extra, rp.badge_master_key, rp.badge_signature, rp.badge_key_idx, rp.contact_domain, rp.contact_domain_proof, rp.contact_domain_verified, rm.created_at, rm.updated_at, - rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, rm.member_pub_key, rm.user_member_key_sent, rm.relay_link, rm.member_security_code, rm.member_security_code_verified_at, + rm.support_chat_ts, rm.support_chat_items_unread, rm.support_chat_items_member_attention, rm.support_chat_items_mentions, rm.support_chat_last_msg_from_member_ts, rm.member_pub_key, rm.user_member_key_status, rm.user_member_key_attempts, rm.relay_link, rm.member_security_code, rm.member_security_code_verified_at, -- deleted by GroupMember dbm.group_member_id, dbm.group_id, dbm.index_in_group, dbm.member_id, dbm.peer_chat_min_version, dbm.peer_chat_max_version, dbm.member_role, dbm.member_category, dbm.member_status, dbm.show_messages, dbm.member_restriction, dbm.invited_by, dbm.invited_by_group_member_id, dbm.local_display_name, dbm.contact_id, dbm.contact_profile_id, dbp.contact_profile_id, dbp.display_name, dbp.full_name, dbp.short_descr, dbp.description, dbp.image, dbp.contact_link, dbp.chat_peer_type, dbp.local_alias, dbp.preferences, dbp.badge_proof, dbp.badge_pres_header, dbp.badge_expiry, dbp.badge_type, dbp.badge_verified, dbp.badge_extra, dbp.badge_master_key, dbp.badge_signature, dbp.badge_key_idx, dbp.contact_domain, dbp.contact_domain_proof, dbp.contact_domain_verified, dbm.created_at, dbm.updated_at, - dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts, dbm.member_pub_key, dbm.user_member_key_sent, dbm.relay_link, dbm.member_security_code, dbm.member_security_code_verified_at + dbm.support_chat_ts, dbm.support_chat_items_unread, dbm.support_chat_items_member_attention, dbm.support_chat_items_mentions, dbm.support_chat_last_msg_from_member_ts, dbm.member_pub_key, dbm.user_member_key_status, dbm.user_member_key_attempts, dbm.relay_link, dbm.member_security_code, dbm.member_security_code_verified_at FROM chat_items i LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN group_members m ON m.group_member_id = i.group_member_id diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/M20260727_member_key_sent.hs b/src/Simplex/Chat/Store/Postgres/Migrations/M20260727_member_key_sent.hs index 305b09bda1..ea5b99fefc 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/M20260727_member_key_sent.hs +++ b/src/Simplex/Chat/Store/Postgres/Migrations/M20260727_member_key_sent.hs @@ -9,11 +9,13 @@ import Text.RawString.QQ (r) m20260727_member_key_sent :: Text m20260727_member_key_sent = [r| -ALTER TABLE group_members ADD COLUMN user_member_key_sent SMALLINT NOT NULL DEFAULT 0; +ALTER TABLE group_members ADD COLUMN user_member_key_status TEXT; +ALTER TABLE group_members ADD COLUMN user_member_key_attempts BIGINT NOT NULL DEFAULT 0; |] down_m20260727_member_key_sent :: Text down_m20260727_member_key_sent = [r| -ALTER TABLE group_members DROP COLUMN user_member_key_sent; +ALTER TABLE group_members DROP COLUMN user_member_key_status; +ALTER TABLE group_members DROP COLUMN user_member_key_attempts; |] diff --git a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql index 2bfc8a5a33..a0ea9b5385 100644 --- a/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/Postgres/Migrations/chat_schema.sql @@ -844,7 +844,8 @@ CREATE TABLE test_chat_schema.group_members ( roster_served_version bigint, member_security_code text, member_security_code_verified_at timestamp with time zone, - user_member_key_sent smallint DEFAULT 0 NOT NULL + user_member_key_status text, + user_member_key_attempts bigint DEFAULT 0 NOT NULL ); diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/M20260727_member_key_sent.hs b/src/Simplex/Chat/Store/SQLite/Migrations/M20260727_member_key_sent.hs index 2391c55a99..a7fb1fdd8e 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/M20260727_member_key_sent.hs +++ b/src/Simplex/Chat/Store/SQLite/Migrations/M20260727_member_key_sent.hs @@ -8,11 +8,13 @@ import Database.SQLite.Simple.QQ (sql) m20260727_member_key_sent :: Query m20260727_member_key_sent = [sql| -ALTER TABLE group_members ADD COLUMN user_member_key_sent INTEGER NOT NULL DEFAULT 0; +ALTER TABLE group_members ADD COLUMN user_member_key_status TEXT; +ALTER TABLE group_members ADD COLUMN user_member_key_attempts INTEGER NOT NULL DEFAULT 0; |] down_m20260727_member_key_sent :: Query down_m20260727_member_key_sent = [sql| -ALTER TABLE group_members DROP COLUMN user_member_key_sent; +ALTER TABLE group_members DROP COLUMN user_member_key_status; +ALTER TABLE group_members DROP COLUMN user_member_key_attempts; |] diff --git a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql index 3d9a9117a3..3c5fe7abe5 100644 --- a/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Store/SQLite/Migrations/chat_schema.sql @@ -255,7 +255,8 @@ CREATE TABLE group_members( roster_served_version INTEGER, member_security_code TEXT, member_security_code_verified_at TEXT, - user_member_key_sent INTEGER NOT NULL DEFAULT 0, + user_member_key_status TEXT, + user_member_key_attempts INTEGER NOT NULL DEFAULT 0, FOREIGN KEY(user_id, local_display_name) REFERENCES display_names(user_id, local_display_name) ON DELETE CASCADE diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index 07418adb41..0ef64d1d63 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -687,7 +687,7 @@ type GroupInfoRow = (Int64, GroupName, GroupName, Text, Maybe Text, Text, Maybe type PublicGroupAccessRow = (Maybe Text, Maybe SimplexDomain, Maybe BoolInt, Maybe BoolInt, Maybe SimplexDomainProof) -type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, BoolInt, Maybe ShortLinkContact, Maybe Text, Maybe UTCTime) +type GroupMemberRow = (GroupMemberId, GroupId, Int64, MemberId, VersionChat, VersionChat, GroupMemberRole, GroupMemberCategory, GroupMemberStatus, BoolInt, Maybe MemberRestrictionStatus) :. (Maybe Int64, Maybe GroupMemberId, ContactName, Maybe ContactId, ProfileId) :. ProfileRow :. (UTCTime, UTCTime) :. (Maybe UTCTime, Int64, Int64, Int64, Maybe UTCTime, Maybe C.PublicKeyEd25519, Maybe Text, Int64, Maybe ShortLinkContact, Maybe Text, Maybe UTCTime) type ProfileRow = (ProfileId, ContactName, Text, Maybe Text, Maybe Text, Maybe ImageData, Maybe ConnLinkContact, Maybe ChatPeerType, LocalAlias, Maybe Preferences) :. BadgeRow :. ContactDomainRow @@ -738,13 +738,30 @@ toGroupKeys publicGroupId_ (rootPrivKey, rootPubKey, memberPrivKey) = _ -> Nothing -- invalid state, in which case messages won't be signed even if memberPrivKey is present in GroupKeys <$> publicGroupKeys <*> memberPrivKey +keySendStatusText :: KeySendStatus -> Maybe Text +keySendStatusText = \case + KSSent -> Just "sent" + KSFailed -> Just "failed" + KSError e -> Just $ "error " <> e + KSAttempts _ -> Nothing + +toKeySendStatus :: Maybe Text -> Int64 -> KeySendStatus +toKeySendStatus status attempts = case status of + Nothing -> KSAttempts $ fromIntegral attempts + Just "sent" -> KSSent + Just "failed" -> KSFailed + Just s -> case T.stripPrefix "error " s of + Just e -> KSError e + Nothing -> KSError s + toGroupMember :: UTCTime -> Int64 -> GroupMemberRow -> GroupMember -toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, BI userMemberKeySent, relayLink, memberCode_, memberCodeVerifiedAt_)) = +toGroupMember now userContactId ((groupMemberId, groupId, indexInGroup, memberId, minVer, maxVer, memberRole, memberCategory, memberStatus, BI showMessages, memberRestriction_) :. (invitedById, invitedByGroupMemberId, localDisplayName, memberContactId, memberContactProfileId) :. profileRow :. (createdAt, updatedAt) :. (supportChatTs_, supportChatUnread, supportChatMemberAttention, supportChatMentions, supportChatLastMsgFromMemberTs, memberPubKey, keyStatus_, keyAttempts, relayLink, memberCode_, memberCodeVerifiedAt_)) = let memberProfile = rowToLocalProfile now profileRow memberSettings = GroupMemberSettings {showMessages} blockedByAdmin = maybe False mrsBlocked memberRestriction_ invitedBy = toInvitedBy userContactId invitedById activeConn = Nothing + userMemberKeyStatus = toKeySendStatus keyStatus_ keyAttempts memberVerifiedCode = SecurityCode <$> memberCode_ <*> memberCodeVerifiedAt_ memberChatVRange = fromMaybe (versionToRange maxVer) $ safeVersionRange minVer maxVer supportChat = case supportChatTs_ of @@ -768,7 +785,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.short_descr, p.description, p.image, p.contact_link, p.chat_peer_type, p.local_alias, p.preferences, p.badge_proof, p.badge_pres_header, p.badge_expiry, p.badge_type, p.badge_verified, p.badge_extra, p.badge_master_key, p.badge_signature, p.badge_key_idx, p.contact_domain, p.contact_domain_proof, p.contact_domain_verified, m.created_at, m.updated_at, - m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_sent, m.relay_link, m.member_security_code, m.member_security_code_verified_at, + m.support_chat_ts, m.support_chat_items_unread, m.support_chat_items_member_attention, m.support_chat_items_mentions, m.support_chat_last_msg_from_member_ts, m.member_pub_key, m.user_member_key_status, m.user_member_key_attempts, m.relay_link, m.member_security_code, m.member_security_code_verified_at, 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.xcontact_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.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, @@ -813,7 +830,7 @@ groupInfoQueryFields = pu.display_name, pu.full_name, pu.short_descr, pu.description, pu.image, pu.contact_link, pu.chat_peer_type, pu.local_alias, pu.preferences, pu.badge_proof, pu.badge_pres_header, pu.badge_expiry, pu.badge_type, pu.badge_verified, pu.badge_extra, pu.badge_master_key, pu.badge_signature, pu.badge_key_idx, pu.contact_domain, pu.contact_domain_proof, pu.contact_domain_verified, mu.created_at, mu.updated_at, - mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.user_member_key_sent, mu.relay_link, mu.member_security_code, mu.member_security_code_verified_at + mu.support_chat_ts, mu.support_chat_items_unread, mu.support_chat_items_member_attention, mu.support_chat_items_mentions, mu.support_chat_last_msg_from_member_ts, mu.member_pub_key, mu.user_member_key_status, mu.user_member_key_attempts, mu.relay_link, mu.member_security_code, mu.member_security_code_verified_at |] groupInfoQueryFrom :: Query diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 71d99d0e21..1834f9c112 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1116,6 +1116,9 @@ type GroupMemberId = Int64 -- memberProfile's profileId is COALESCE(member_profile_id, contact_profile_id), member_profile_id is non null -- if incognito profile was saved for member (used for hosts and invitees in incognito groups) +data KeySendStatus = KSSent | KSFailed | KSError Text | KSAttempts Int + deriving (Eq, Show) + data GroupMember = GroupMember { groupMemberId :: GroupMemberId, groupId :: GroupId, @@ -1146,7 +1149,7 @@ data GroupMember = GroupMember updatedAt :: UTCTime, supportChat :: Maybe GroupSupportChat, memberPubKey :: Maybe C.PublicKeyEd25519, - userMemberKeySent :: Bool, + userMemberKeyStatus :: KeySendStatus, relayLink :: Maybe ShortLinkContact, -- out-of-band verified security code for connectionless (channel) members; -- regular members carry it in activeConn instead (see memberSecurityCode) @@ -2268,6 +2271,8 @@ $(JQ.deriveJSON defaultJSON ''GroupMemberSettings) $(JQ.deriveJSON defaultJSON ''SecurityCode) +$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "KS") ''KeySendStatus) + $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "Conn") ''ConnStatus) $(JQ.deriveJSON defaultJSON ''Connection)