blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: differentiate inactive and forwarded group snd statuses (#4420)

Browse Source 
* core: GroupSndStatus

* rfc

* encoding, db apis

* pending, forwarded statuses

* encoding
This commit is contained in:
spaced4ndy
2024-07-09 21:29:36 +04:00
committed by GitHub
parent 3e623684bc
commit a9d2535292
4 changed files with 146 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat/Messages.hs
+52 -5
View File
@@ -873,7 +873,7 @@ ciCreateStatus content = case msgDirection @d of
SMDSnd -> ciStatusNew
SMDRcv -> if ciRequiresAttention content then ciStatusNew else CISRcvRead
membersGroupItemStatus :: [(CIStatus 'MDSnd, Int)] -> CIStatus 'MDSnd
membersGroupItemStatus :: [(GroupSndStatus, Int)] -> CIStatus 'MDSnd
membersGroupItemStatus memStatusCounts
| rcvdOk == total = CISSndRcvd MROk SSPComplete
| rcvdOk + rcvdBad == total = CISSndRcvd MRBadMsgHash SSPComplete
@@ -884,9 +884,9 @@ membersGroupItemStatus memStatusCounts
| otherwise = CISSndNew
where
total = sum $ map snd memStatusCounts
rcvdOk = fromMaybe 0 $ lookup (CISSndRcvd MROk SSPComplete) memStatusCounts
rcvdBad = fromMaybe 0 $ lookup (CISSndRcvd MRBadMsgHash SSPComplete) memStatusCounts
sent = fromMaybe 0 $ lookup (CISSndSent SSPComplete) memStatusCounts
rcvdOk = fromMaybe 0 $ lookup (GSSRcvd MROk) memStatusCounts
rcvdBad = fromMaybe 0 $ lookup (GSSRcvd MRBadMsgHash) memStatusCounts
sent = fromMaybe 0 $ lookup GSSSent memStatusCounts
data SndCIStatusProgress
= SSPPartial
@@ -903,6 +903,47 @@ instance StrEncoding SndCIStatusProgress where
"complete" -> pure SSPComplete
_ -> fail "bad SndCIStatusProgress"
data GroupSndStatus
= GSSNew
| GSSForwarded
| GSSInactive
| GSSSent
| GSSRcvd {msgRcptStatus :: MsgReceiptStatus}
| GSSError {agentError :: SndError}
| GSSWarning {agentError :: SndError}
| GSSInvalid {text :: Text}
deriving instance Eq GroupSndStatus
deriving instance Show GroupSndStatus
-- Preserve CIStatus encoding for backwards compatibility
instance StrEncoding GroupSndStatus where
strEncode = \case
GSSNew -> "snd_new"
GSSForwarded -> "snd_forwarded"
GSSInactive -> "snd_inactive"
GSSSent -> "snd_sent complete"
GSSRcvd msgRcptStatus -> "snd_rcvd " <> strEncode msgRcptStatus <> " complete"
GSSError sndErr -> "snd_error " <> strEncode sndErr
GSSWarning sndErr -> "snd_warning " <> strEncode sndErr
GSSInvalid {} -> "invalid"
strP =
(statusP <* A.endOfInput) -- see ACIStatus decoding
<|> (GSSInvalid . safeDecodeUtf8 <$> A.takeByteString)
where
statusP =
A.takeTill (== ' ') >>= \case
"snd_new" -> pure GSSNew
"snd_forwarded" -> pure GSSForwarded
"snd_inactive" -> pure GSSInactive
"snd_sent" -> GSSSent <$ " complete"
"snd_rcvd" -> GSSRcvd <$> (_strP <* " complete")
"snd_error_auth" -> pure $ GSSError SndErrAuth
"snd_error" -> GSSError <$> (A.space *> strP)
"snd_warning" -> GSSWarning <$> (A.space *> strP)
_ -> fail "bad status"
type ChatItemId = Int64
type ChatItemTs = UTCTime
@@ -1176,7 +1217,7 @@ mkItemVersion ChatItem {content, meta} = version <$> ciMsgContent content
data MemberDeliveryStatus = MemberDeliveryStatus
{ groupMemberId :: GroupMemberId,
memberDeliveryStatus :: CIStatus 'MDSnd,
memberDeliveryStatus :: GroupSndStatus,
sentViaProxy :: Maybe Bool
}
deriving (Eq, Show)
@@ -1234,6 +1275,12 @@ instance (Typeable d, MsgDirectionI d) => FromField (CIStatus d) where fromField
instance FromField ACIStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
$(JQ.deriveJSON (sumTypeJSON $ dropPrefix "GSS") ''GroupSndStatus)
instance ToField GroupSndStatus where toField = toField . decodeLatin1 . strEncode
instance FromField GroupSndStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8
$(JQ.deriveJSON defaultJSON ''MemberDeliveryStatus)
$(JQ.deriveJSON defaultJSON ''ChatItemVersion)
src/Simplex/Chat/Store/Messages.hs
+4 -4
View File
@@ -2531,14 +2531,14 @@ deleteCIModeration db GroupInfo {groupId} itemMemberId (Just sharedMsgId) =
"DELETE FROM chat_item_moderations WHERE group_id = ? AND item_member_id = ? AND shared_msg_id = ?"
(groupId, itemMemberId, sharedMsgId)
createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
createGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO ()
createGroupSndStatus db itemId memberId status =
DB.execute
db
"INSERT INTO group_snd_item_statuses (chat_item_id, group_member_id, group_snd_item_status) VALUES (?,?,?)"
(itemId, memberId, status)
getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO (CIStatus 'MDSnd)
getGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> ExceptT StoreError IO GroupSndStatus
getGroupSndStatus db itemId memberId =
ExceptT . firstRow fromOnly (SENoGroupSndStatus itemId memberId) $
DB.query
@@ -2551,7 +2551,7 @@ getGroupSndStatus db itemId memberId =
|]
(itemId, memberId)
updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> CIStatus 'MDSnd -> IO ()
updateGroupSndStatus :: DB.Connection -> ChatItemId -> GroupMemberId -> GroupSndStatus -> IO ()
updateGroupSndStatus db itemId memberId status = do
currentTs <- liftIO getCurrentTime
DB.execute
@@ -2589,7 +2589,7 @@ getGroupSndStatuses db itemId =
memStatus (groupMemberId, memberDeliveryStatus, sentViaProxy) =
MemberDeliveryStatus {groupMemberId, memberDeliveryStatus, sentViaProxy}
getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(CIStatus 'MDSnd, Int)]
getGroupSndStatusCounts :: DB.Connection -> ChatItemId -> IO [(GroupSndStatus, Int)]
getGroupSndStatusCounts db itemId =
DB.query
db