dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-06-06 08:21:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

smp server: messaging services (#1565)

Browse Source 
* smp server: refactor message delivery to always respond SOK to subscriptions

* refactor ntf subscribe

* cancel subscription thread and reduce service subscription count when queue is deleted

* subscribe rcv service, deliver sent messages to subscribed service

* subscribe rcv service to messages (TODO delivery on subscription)

* WIP

* efficient initial delivery of messages to subscribed service

* test: delivery to client with service certificate

* test: upgrade/downgrade to/from service subscriptions

* remove service association from agent API, add per-user flag to use the service

* agent client (WIP)

* service certificates in the client

* rfc about drift detection, and SALL to mark end of message delivery

* fix test

* fix test

* add function for postgresql message storage

* update migration
This commit is contained in:
Evgeny
2025-11-07 21:36:28 +00:00
committed by GitHub
parent 3016b929b4
commit 1ca4677b28
31 changed files with 969 additions and 305 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Server/MsgStore/Postgres.hs
+33
View File
@@ -119,6 +119,34 @@ instance MsgStoreClass PostgresMsgStore where
toMessageStats (expiredMsgsCount, storedMsgsCount, storedQueues) =
MessageStats {expiredMsgsCount, storedMsgsCount, storedQueues}
foldRcvServiceMessages :: PostgresMsgStore -> ServiceId -> (a -> RecipientId -> Either ErrorType (Maybe (QueueRec, Message)) -> IO a) -> a -> IO a
foldRcvServiceMessages ms serviceId f acc =
withTransaction (dbStore $ queueStore_ ms) $ \db ->
DB.fold
db
[sql|
SELECT q.recipient_id, q.recipient_keys, q.rcv_dh_secret,
q.sender_id, q.sender_key, q.queue_mode,
q.notifier_id, q.notifier_key, q.rcv_ntf_dh_secret, q.ntf_service_id,
q.status, q.updated_at, q.link_id, q.rcv_service_id,
m.msg_id, m.msg_ts, m.msg_quota, m.msg_ntf_flag, m.msg_body
FROM msg_queues q
LEFT JOIN (
SELECT recipient_id, msg_id, msg_ts, msg_quota, msg_ntf_flag, msg_body,
ROW_NUMBER() OVER (PARTITION BY recipient_id ORDER BY message_id ASC) AS row_num
FROM messages
) m ON q.recipient_id = m.recipient_id AND m.row_num = 1
WHERE q.rcv_service_id = ? AND q.deleted_at IS NULL;
|]
(Only serviceId)
acc
f'
where
f' a (qRow :. mRow) =
let (rId, qr) = rowToQueueRec qRow
msg_ = toMaybeMessage mRow
in f a rId $ Right ((qr,) <$> msg_)
logQueueStates _ = error "logQueueStates not used"
logQueueState _ = error "logQueueState not used"
@@ -247,6 +275,11 @@ uninterruptibleMask_ :: ExceptT ErrorType IO a -> ExceptT ErrorType IO a
uninterruptibleMask_ = ExceptT . E.uninterruptibleMask_ . runExceptT
{-# INLINE uninterruptibleMask_ #-}
toMaybeMessage :: (Maybe (Binary MsgId), Maybe Int64, Maybe Bool, Maybe Bool, Maybe (Binary MsgBody)) -> Maybe Message
toMaybeMessage = \case
(Just msgId, Just ts, Just msgQuota, Just ntf, Just body) -> Just $ toMessage (msgId, ts, msgQuota, ntf, body)
_ -> Nothing
toMessage :: (Binary MsgId, Int64, Bool, Bool, Binary MsgBody) -> Message
toMessage (Binary msgId, ts, msgQuota, ntf, Binary body)
| msgQuota = MessageQuota {msgId, msgTs}