mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-09-17 05:55:04 +00:00
messaging services (#1667)
* smp server: messaging services (#1565)
* 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
* servers: maintain xor-hash of all associated queue IDs in PostgreSQL (#1668)
* servers: maintain xor-hash of all associated queue IDs in PostgreSQL (#1615)
* ntf server: maintain xor-hash of all associated queue IDs via PostgreSQL triggers
* smp server: xor hash with triggers
* fix sql and using pgcrypto extension in tests
* track counts and hashes in smp/ntf servers via triggers, smp server stats for service subscription, update SMP protocol to pass expected count and hash in SSUB/NSSUB commands
* agent migrations with functions/triggers
* remove agent triggers
* try tracking service subs in the agent (WIP, does not compile)
* Revert "try tracking service subs in the agent (WIP, does not compile)"
This reverts commit 59e908100d.
* comment
* agent database triggers
* service subscriptions in the client
* test / fix client services
* update schema
* fix postgres migration
* update schema
* move schema test to the end
* use static function with SQLite to avoid dynamic wrapper
* agent: fail when per-connection transport isolation is used with services (#1670)
* agent: service subscription events (#1671)
* agent: use server keyhash when loading service record
* agent: process queue/service associations with delayed subscription results
* agent: service subscription events
* agent: finalize initial service subscriptions, remove associations on service ID changes (#1672)
* agent: remove service/queue associations when service ID changes
* agent: check that service ID in NEW response matches session ID in transport session
* agent subscription WIP
* test
* comment
* enable tests
* update queries
* agent: option to add SQLite aggregates to DB connection (#1673)
* agent: add build_relations_vector function to sqlite
* update aggregate
* use static aggregate
* remove relations
---------
Co-authored-by: Evgeny Poberezkin <evgeny@poberezkin.com>
* add test, treat BAD_SERVICE as temp error, only remove queue associations on service errors
* add packZipWith for backward compatibility with GHC 8.10.7
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
* servers: service stats and logging, allow services without option (removed), report errors during service message delivery, remove threads when service subscription ended (#1676)
* smp server: always allow services without option
* smp server: maintain IDs hash in session subscription states
* smp server: service message delivery error handling
* ntf server: log subscription count and hash differences
* smp server: remove delivery threads when service subscription ended/client disconnected
* agent: remove service queue association when service ID changed, process ENDS event, test migrating to/from service (#1677)
* agent: remove service queue association when service ID changed
* agent: process ENDS event
* agent: send service subscription error event
* agent: test migrating to/from service subscriptions, fixes
* agent: always remove service when disabled, fix service subscriptions
* ntf server: use different client certs for each SMP server, remove support for store log (#1681)
* ntf server: remove support for store log
* ntf server: use different client certificates for each SMP server
* smp protocol: fix encoding for SOKS/ENDS responses (#1683)
* agent: create user with option to enable client service (#1684)
* agent: create user with option to enable client service
* handle HTTP2 errors
* do not catch async exceptions
* agent: minor fixes
* docs: update protocol (#1705)
* docs: agent threat model
* update protocol docs
* update RFCs (#1730)
* update RFCs
* update
* update overview
* update terminology
* original language in threat model
---------
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
* docs: fix minor issues in protocols
* docs: add e2e encrypted message wire encoding to PQDR spec
* docs: add missing encodings and other protocol corrections
* docs: move implemented rfcs
* smp: service fixes (#1737)
* smp: deliver service subscription to correct client
* tests: more resilient to concurrency
* optimize PostgreSQL query
* fix service re-association after server "downgrade"
* correctly handle service removed from server (and ID changed)
* remove unused
---------
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
* prometheus: fix metrics names (#1747)
* test: rcv service re-association on restart (#1746)
* agent: correct log message
* docs: update whitepaper
* smp: fix messaging client service issues (#1751)
* services: fix minor issues
* fix accounting for subscribed service queues, add prometheus stats
* fix uncorrelated subquery
* fix potential race condition when inserting service defensively, as it is also prevented by how client is created
---------
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
* agent: refactor cleanup if no pending subs (#1757)
* smp server: batch processing of subscription messages (#1753)
* smp server: batch processing of subscription messages
* refactor
* empty line
* fix
---------
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
* smp: batch queue association updates on subscriptions (#1760)
* smp: batch queue association updates on subscriptions
* refactor to fused batching
* simpler
* batch assoc functions
* clean up
* fix
---------
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
* agent: use primary key index in setRcvServiceAssocs (#1783)
* agent: use primary key index in setRcvServiceAssocs
Previous WHERE rcv_id = ? did not match the (host, port, rcv_id)
primary key prefix and fell back to a table scan via
idx_rcv_queues_client_notice_id. With ~390k rows per queue, each
update in a 1350-row batch scanned the whole table, yielding ~290s
per batch and a multi-hour rcv-services migration.
* agent: pass SMPServer explicitly to setRcvServiceAssocs
Avoid extracting host/port from the first queue inside setRcvServiceAssocs.
The caller already has SMPServer in scope (from tSess) and the call chain
is short, so threading it through is simpler than inspecting the list.
Removes the empty-list guard from setRcvServiceAssocs (it remains in
processRcvServiceAssocs).
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
Co-authored-by: sh <37271604+shumvgolove@users.noreply.github.com>
This commit is contained in:
co-authored by
spaced4ndy
Evgeny @ SimpleX Chat
sh
parent
f03cec7a58
commit
f0b7a4be73
@@ -24,9 +24,11 @@ module Simplex.Messaging.Server.QueueStore.Postgres
|
||||
batchInsertServices,
|
||||
batchInsertQueues,
|
||||
foldServiceRecs,
|
||||
foldRcvServiceQueueRecs,
|
||||
foldQueueRecs,
|
||||
foldRecentQueueRecs,
|
||||
handleDuplicate,
|
||||
rowToQueueRec,
|
||||
withLog_,
|
||||
withDB,
|
||||
withDB',
|
||||
@@ -89,7 +91,7 @@ import Simplex.Messaging.SystemTime
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (SMPServiceRole (..))
|
||||
import Simplex.Messaging.Util (eitherToMaybe, firstRow, ifM, maybeFirstRow, maybeFirstRow', tshow, (<$$>))
|
||||
import Simplex.Messaging.Util (eitherToMaybe, firstRow, ifM, maybeFirstRow, maybeFirstRow', tshow, (<$$>), ($>>=))
|
||||
import System.Exit (exitFailure)
|
||||
import System.IO (IOMode (..), hFlush, stdout)
|
||||
import UnliftIO.STM
|
||||
@@ -502,6 +504,32 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
|
||||
atomically $ writeTVar (queueRec sq) $ Just q'
|
||||
withLog "setQueueService" st $ \sl -> logQueueService sl rId party serviceId
|
||||
|
||||
setQueueServices :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> SParty p -> Maybe ServiceId -> [q] -> IO (Either ErrorType (M.Map RecipientId (Either ErrorType ())))
|
||||
setQueueServices _ _ _ [] = pure $ Right M.empty
|
||||
setQueueServices st party serviceId qs = E.uninterruptibleMask_ $ runExceptT $ do
|
||||
updated <- S.fromList <$> withDB' "setQueueServices" st (\db ->
|
||||
map fromOnly <$> DB.query db updateQuery (serviceId, In (map recipientId qs)))
|
||||
results <- liftIO $ forM qs $ \sq -> do
|
||||
let rId = recipientId sq
|
||||
(rId,) <$> if S.member rId updated
|
||||
then readQueueRecIO (queueRec sq) $>>= \q -> do
|
||||
atomically $ writeTVar (queueRec sq) $ Just $ updateRec q
|
||||
withLog "setQueueServices" st $ \sl -> logQueueService sl rId party serviceId
|
||||
pure $ Right ()
|
||||
else pure $ Left AUTH
|
||||
pure $ M.fromList results
|
||||
where
|
||||
updateQuery = case party of
|
||||
SRecipientService ->
|
||||
"UPDATE msg_queues SET rcv_service_id = ? WHERE recipient_id IN ? AND deleted_at IS NULL RETURNING recipient_id"
|
||||
SNotifierService ->
|
||||
"UPDATE msg_queues SET ntf_service_id = ? WHERE recipient_id IN ? AND notifier_id IS NOT NULL AND deleted_at IS NULL RETURNING recipient_id"
|
||||
updateRec q = case party of
|
||||
SRecipientService -> q {rcvServiceId = serviceId}
|
||||
SNotifierService -> case notifier q of
|
||||
Just nc -> q {notifier = Just nc {ntfServiceId = serviceId}}
|
||||
Nothing -> q
|
||||
|
||||
getQueueNtfServices :: PostgresQueueStore q -> [(NotifierId, a)] -> IO (Either ErrorType ([(Maybe ServiceId, [(NotifierId, a)])], [(NotifierId, a)]))
|
||||
getQueueNtfServices st ntfs = E.uninterruptibleMask_ $ runExceptT $ do
|
||||
snIds <-
|
||||
@@ -522,15 +550,11 @@ instance StoreQueueClass q => QueueStoreClass q (PostgresQueueStore q) where
|
||||
let (sNtfs, restNtfs) = partition (\(nId, _) -> S.member nId snIds) ntfs'
|
||||
in ((serviceId, sNtfs) : ssNtfs, restNtfs)
|
||||
|
||||
getServiceQueueCount :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
|
||||
getServiceQueueCount st party serviceId =
|
||||
E.uninterruptibleMask_ $ runExceptT $ withDB' "getServiceQueueCount" st $ \db ->
|
||||
maybeFirstRow' 0 fromOnly $
|
||||
DB.query db query (Only serviceId)
|
||||
where
|
||||
query = case party of
|
||||
SRecipientService -> "SELECT count(1) FROM msg_queues WHERE rcv_service_id = ? AND deleted_at IS NULL"
|
||||
SNotifierService -> "SELECT count(1) FROM msg_queues WHERE ntf_service_id = ? AND deleted_at IS NULL"
|
||||
getServiceQueueCountHash :: (PartyI p, ServiceParty p) => PostgresQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType (Int64, IdsHash))
|
||||
getServiceQueueCountHash st party serviceId =
|
||||
E.uninterruptibleMask_ $ runExceptT $ withDB' "getServiceQueueCountHash" st $ \db ->
|
||||
maybeFirstRow' (0, mempty) id $
|
||||
DB.query db ("SELECT queue_count, queue_ids_hash FROM services WHERE service_id = ? AND service_role = ?") (serviceId, partyServiceRole party)
|
||||
|
||||
batchInsertServices :: [STMService] -> PostgresQueueStore q -> IO Int64
|
||||
batchInsertServices services' toStore =
|
||||
@@ -577,12 +601,17 @@ insertServiceQuery =
|
||||
VALUES (?,?,?,?,?)
|
||||
|]
|
||||
|
||||
foldServiceRecs :: forall a q. Monoid a => PostgresQueueStore q -> (ServiceRec -> IO a) -> IO a
|
||||
foldServiceRecs :: Monoid a => PostgresQueueStore q -> (ServiceRec -> IO a) -> IO a
|
||||
foldServiceRecs st f =
|
||||
withTransaction (dbStore st) $ \db ->
|
||||
DB.fold_ db "SELECT service_id, service_role, service_cert, service_cert_hash, created_at FROM services" mempty $
|
||||
\ !acc -> fmap (acc <>) . f . rowToServiceRec
|
||||
|
||||
foldRcvServiceQueueRecs :: PostgresQueueStore q -> ServiceId -> (a -> (RecipientId, QueueRec) -> IO a) -> a -> IO (Either ErrorType a)
|
||||
foldRcvServiceQueueRecs st serviceId f acc =
|
||||
runExceptT $ withDB' "foldRcvServiceQueueRecs" st $ \db ->
|
||||
DB.fold db (queueRecQuery <> " WHERE rcv_service_id = ? AND deleted_at IS NULL") (Only serviceId) acc $ \a -> f a . rowToQueueRec
|
||||
|
||||
foldQueueRecs :: Monoid a => Bool -> Bool -> PostgresQueueStore q -> ((RecipientId, QueueRec) -> IO a) -> IO a
|
||||
foldQueueRecs withData = foldQueueRecs_ foldRecs
|
||||
where
|
||||
@@ -769,10 +798,6 @@ instance ToField SMPServiceRole where toField = toField . decodeLatin1 . smpEnco
|
||||
|
||||
instance FromField SMPServiceRole where fromField = fromTextField_ $ eitherToMaybe . smpDecode . encodeUtf8
|
||||
|
||||
instance ToField X.CertificateChain where toField = toField . Binary . smpEncode . C.encodeCertChain
|
||||
|
||||
instance FromField X.CertificateChain where fromField = blobFieldDecoder (parseAll C.certChainP)
|
||||
|
||||
#if !defined(dbPostgres)
|
||||
instance ToField EntityId where toField (EntityId s) = toField $ Binary s
|
||||
|
||||
@@ -790,6 +815,10 @@ instance ToField C.APublicAuthKey where toField = toField . Binary . C.encodePub
|
||||
|
||||
instance FromField C.APublicAuthKey where fromField = blobFieldDecoder C.decodePubKey
|
||||
|
||||
instance ToField IdsHash where toField (IdsHash s) = toField (Binary s)
|
||||
|
||||
deriving newtype instance FromField IdsHash
|
||||
|
||||
instance ToField EncDataBytes where toField (EncDataBytes s) = toField (Binary s)
|
||||
|
||||
deriving newtype instance FromField EncDataBytes
|
||||
@@ -797,4 +826,8 @@ deriving newtype instance FromField EncDataBytes
|
||||
deriving newtype instance ToField (RoundedSystemTime t)
|
||||
|
||||
deriving newtype instance FromField (RoundedSystemTime t)
|
||||
|
||||
instance ToField X.CertificateChain where toField = toField . Binary . smpEncode . C.encodeCertChain
|
||||
|
||||
instance FromField X.CertificateChain where fromField = blobFieldDecoder (parseAll C.certChainP)
|
||||
#endif
|
||||
|
||||
@@ -10,6 +10,7 @@ where
|
||||
import Data.List (sortOn)
|
||||
import Data.Text (Text)
|
||||
import Simplex.Messaging.Agent.Store.Shared
|
||||
import Simplex.Messaging.Agent.Store.Postgres.Migrations.Util
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
serverSchemaMigrations :: [(String, Text, Maybe Text)]
|
||||
@@ -18,7 +19,8 @@ serverSchemaMigrations =
|
||||
("20250319_updated_index", m20250319_updated_index, Just down_m20250319_updated_index),
|
||||
("20250320_short_links", m20250320_short_links, Just down_m20250320_short_links),
|
||||
("20250514_service_certs", m20250514_service_certs, Just down_m20250514_service_certs),
|
||||
("20250903_store_messages", m20250903_store_messages, Just down_m20250903_store_messages)
|
||||
("20250903_store_messages", m20250903_store_messages, Just down_m20250903_store_messages),
|
||||
("20250915_queue_ids_hash", m20250915_queue_ids_hash, Just down_m20250915_queue_ids_hash)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -450,3 +452,139 @@ ALTER TABLE msg_queues
|
||||
|
||||
DROP TABLE messages;
|
||||
|]
|
||||
|
||||
m20250915_queue_ids_hash :: Text
|
||||
m20250915_queue_ids_hash =
|
||||
createXorHashFuncs
|
||||
<> [r|
|
||||
ALTER TABLE services
|
||||
ADD COLUMN queue_count BIGINT NOT NULL DEFAULT 0,
|
||||
ADD COLUMN queue_ids_hash BYTEA NOT NULL DEFAULT '\x00000000000000000000000000000000';
|
||||
|
||||
CREATE FUNCTION update_all_aggregates() RETURNS VOID
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
WITH acc AS (
|
||||
SELECT
|
||||
s.service_id,
|
||||
count(1) as q_count,
|
||||
xor_aggregate(public.digest(CASE WHEN s.service_role = 'M' THEN q.recipient_id ELSE COALESCE(q.notifier_id, '\x00000000000000000000000000000000') END, 'md5')) AS q_ids_hash
|
||||
FROM services s
|
||||
JOIN msg_queues q ON (s.service_id = q.rcv_service_id AND s.service_role = 'M') OR (s.service_id = q.ntf_service_id AND s.service_role = 'N')
|
||||
WHERE q.deleted_at IS NULL
|
||||
GROUP BY s.service_id
|
||||
)
|
||||
UPDATE services s
|
||||
SET queue_count = COALESCE(acc.q_count, 0),
|
||||
queue_ids_hash = COALESCE(acc.q_ids_hash, '\x00000000000000000000000000000000')
|
||||
FROM acc
|
||||
WHERE s.service_id = acc.service_id;
|
||||
END;
|
||||
$$;
|
||||
|
||||
SELECT update_all_aggregates();
|
||||
|
||||
CREATE FUNCTION update_aggregates(p_service_id BYTEA, p_role TEXT, p_queue_id BYTEA, p_change BIGINT) RETURNS VOID
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
UPDATE services
|
||||
SET queue_count = queue_count + p_change,
|
||||
queue_ids_hash = xor_combine(queue_ids_hash, public.digest(p_queue_id, 'md5'))
|
||||
WHERE service_id = p_service_id AND service_role = p_role;
|
||||
END;
|
||||
$$;
|
||||
|
||||
CREATE FUNCTION on_queue_insert() RETURNS TRIGGER
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF NEW.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
IF NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
RETURN NEW;
|
||||
END;
|
||||
$$;
|
||||
|
||||
CREATE FUNCTION on_queue_delete() RETURNS TRIGGER
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF OLD.deleted_at IS NULL THEN
|
||||
IF OLD.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
END IF;
|
||||
IF OLD.ntf_service_id IS NOT NULL AND OLD.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
END IF;
|
||||
END IF;
|
||||
RETURN OLD;
|
||||
END;
|
||||
$$;
|
||||
|
||||
CREATE FUNCTION on_queue_update() RETURNS TRIGGER
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF OLD.deleted_at IS NULL AND OLD.rcv_service_id IS NOT NULL THEN
|
||||
IF NOT (NEW.deleted_at IS NULL AND NEW.rcv_service_id IS NOT NULL) THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
ELSIF OLD.rcv_service_id IS DISTINCT FROM NEW.rcv_service_id THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
ELSIF NEW.deleted_at IS NULL AND NEW.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
|
||||
IF OLD.deleted_at IS NULL AND OLD.ntf_service_id IS NOT NULL AND OLD.notifier_id IS NOT NULL THEN
|
||||
IF NOT (NEW.deleted_at IS NULL AND NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL) THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
ELSIF OLD.ntf_service_id IS DISTINCT FROM NEW.ntf_service_id OR OLD.notifier_id IS DISTINCT FROM NEW.notifier_id THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
ELSIF NEW.deleted_at IS NULL AND NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
RETURN NEW;
|
||||
END;
|
||||
$$;
|
||||
|
||||
CREATE TRIGGER tr_queue_insert
|
||||
AFTER INSERT ON msg_queues
|
||||
FOR EACH ROW EXECUTE PROCEDURE on_queue_insert();
|
||||
|
||||
CREATE TRIGGER tr_queue_delete
|
||||
AFTER DELETE ON msg_queues
|
||||
FOR EACH ROW EXECUTE PROCEDURE on_queue_delete();
|
||||
|
||||
CREATE TRIGGER tr_queue_update
|
||||
AFTER UPDATE ON msg_queues
|
||||
FOR EACH ROW EXECUTE PROCEDURE on_queue_update();
|
||||
|]
|
||||
|
||||
down_m20250915_queue_ids_hash :: Text
|
||||
down_m20250915_queue_ids_hash =
|
||||
[r|
|
||||
DROP TRIGGER tr_queue_insert ON msg_queues;
|
||||
DROP TRIGGER tr_queue_delete ON msg_queues;
|
||||
DROP TRIGGER tr_queue_update ON msg_queues;
|
||||
|
||||
DROP FUNCTION on_queue_insert;
|
||||
DROP FUNCTION on_queue_delete;
|
||||
DROP FUNCTION on_queue_update;
|
||||
|
||||
DROP FUNCTION update_aggregates;
|
||||
|
||||
DROP FUNCTION update_all_aggregates;
|
||||
|
||||
ALTER TABLE services
|
||||
DROP COLUMN queue_count,
|
||||
DROP COLUMN queue_ids_hash;
|
||||
|]
|
||||
<> dropXorHashFuncs
|
||||
|
||||
@@ -104,6 +104,71 @@ $$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.on_queue_delete() RETURNS trigger
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF OLD.deleted_at IS NULL THEN
|
||||
IF OLD.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
END IF;
|
||||
IF OLD.ntf_service_id IS NOT NULL AND OLD.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
END IF;
|
||||
END IF;
|
||||
RETURN OLD;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.on_queue_insert() RETURNS trigger
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF NEW.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
IF NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
RETURN NEW;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.on_queue_update() RETURNS trigger
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
IF OLD.deleted_at IS NULL AND OLD.rcv_service_id IS NOT NULL THEN
|
||||
IF NOT (NEW.deleted_at IS NULL AND NEW.rcv_service_id IS NOT NULL) THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
ELSIF OLD.rcv_service_id IS DISTINCT FROM NEW.rcv_service_id THEN
|
||||
PERFORM update_aggregates(OLD.rcv_service_id, 'M', OLD.recipient_id, -1);
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
ELSIF NEW.deleted_at IS NULL AND NEW.rcv_service_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.rcv_service_id, 'M', NEW.recipient_id, 1);
|
||||
END IF;
|
||||
|
||||
IF OLD.deleted_at IS NULL AND OLD.ntf_service_id IS NOT NULL AND OLD.notifier_id IS NOT NULL THEN
|
||||
IF NOT (NEW.deleted_at IS NULL AND NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL) THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
ELSIF OLD.ntf_service_id IS DISTINCT FROM NEW.ntf_service_id OR OLD.notifier_id IS DISTINCT FROM NEW.notifier_id THEN
|
||||
PERFORM update_aggregates(OLD.ntf_service_id, 'N', OLD.notifier_id, -1);
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
ELSIF NEW.deleted_at IS NULL AND NEW.ntf_service_id IS NOT NULL AND NEW.notifier_id IS NOT NULL THEN
|
||||
PERFORM update_aggregates(NEW.ntf_service_id, 'N', NEW.notifier_id, 1);
|
||||
END IF;
|
||||
RETURN NEW;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.try_del_msg(p_recipient_id bytea, p_msg_id bytea) RETURNS TABLE(r_msg_id bytea, r_msg_ts bigint, r_msg_quota boolean, r_msg_ntf_flag boolean, r_msg_body bytea)
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
@@ -225,6 +290,43 @@ $$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.update_aggregates(p_service_id bytea, p_role text, p_queue_id bytea, p_change bigint) RETURNS void
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
UPDATE services
|
||||
SET queue_count = queue_count + p_change,
|
||||
queue_ids_hash = xor_combine(queue_ids_hash, public.digest(p_queue_id, 'md5'))
|
||||
WHERE service_id = p_service_id AND service_role = p_role;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.update_all_aggregates() RETURNS void
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
BEGIN
|
||||
WITH acc AS (
|
||||
SELECT
|
||||
s.service_id,
|
||||
count(1) as q_count,
|
||||
xor_aggregate(public.digest(CASE WHEN s.service_role = 'M' THEN q.recipient_id ELSE COALESCE(q.notifier_id, '\x00000000000000000000000000000000') END, 'md5')) AS q_ids_hash
|
||||
FROM services s
|
||||
JOIN msg_queues q ON (s.service_id = q.rcv_service_id AND s.service_role = 'M') OR (s.service_id = q.ntf_service_id AND s.service_role = 'N')
|
||||
WHERE q.deleted_at IS NULL
|
||||
GROUP BY s.service_id
|
||||
)
|
||||
UPDATE services s
|
||||
SET queue_count = COALESCE(acc.q_count, 0),
|
||||
queue_ids_hash = COALESCE(acc.q_ids_hash, '\x00000000000000000000000000000000')
|
||||
FROM acc
|
||||
WHERE s.service_id = acc.service_id;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.write_message(p_recipient_id bytea, p_msg_id bytea, p_msg_ts bigint, p_msg_quota boolean, p_msg_ntf_flag boolean, p_msg_body bytea, p_quota integer) RETURNS TABLE(quota_written boolean, was_empty boolean)
|
||||
LANGUAGE plpgsql
|
||||
AS $$
|
||||
@@ -256,6 +358,34 @@ END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE FUNCTION smp_server.xor_combine(state bytea, value bytea) RETURNS bytea
|
||||
LANGUAGE plpgsql IMMUTABLE STRICT
|
||||
AS $$
|
||||
DECLARE
|
||||
result BYTEA := state;
|
||||
i INTEGER;
|
||||
len INTEGER := octet_length(value);
|
||||
BEGIN
|
||||
IF octet_length(state) != len THEN
|
||||
RAISE EXCEPTION 'Inputs must be equal length (% != %)', octet_length(state), len;
|
||||
END IF;
|
||||
FOR i IN 0..len-1 LOOP
|
||||
result := set_byte(result, i, get_byte(state, i) # get_byte(value, i));
|
||||
END LOOP;
|
||||
RETURN result;
|
||||
END;
|
||||
$$;
|
||||
|
||||
|
||||
|
||||
CREATE AGGREGATE smp_server.xor_aggregate(bytea) (
|
||||
SFUNC = smp_server.xor_combine,
|
||||
STYPE = bytea,
|
||||
INITCOND = '\x00000000000000000000000000000000'
|
||||
);
|
||||
|
||||
|
||||
SET default_table_access_method = heap;
|
||||
|
||||
|
||||
@@ -320,7 +450,9 @@ CREATE TABLE smp_server.services (
|
||||
service_role text NOT NULL,
|
||||
service_cert bytea NOT NULL,
|
||||
service_cert_hash bytea NOT NULL,
|
||||
created_at bigint NOT NULL
|
||||
created_at bigint NOT NULL,
|
||||
queue_count bigint DEFAULT 0 NOT NULL,
|
||||
queue_ids_hash bytea DEFAULT '\x00000000000000000000000000000000'::bytea NOT NULL
|
||||
);
|
||||
|
||||
|
||||
@@ -390,6 +522,18 @@ CREATE INDEX idx_services_service_role ON smp_server.services USING btree (servi
|
||||
|
||||
|
||||
|
||||
CREATE TRIGGER tr_queue_delete AFTER DELETE ON smp_server.msg_queues FOR EACH ROW EXECUTE FUNCTION smp_server.on_queue_delete();
|
||||
|
||||
|
||||
|
||||
CREATE TRIGGER tr_queue_insert AFTER INSERT ON smp_server.msg_queues FOR EACH ROW EXECUTE FUNCTION smp_server.on_queue_insert();
|
||||
|
||||
|
||||
|
||||
CREATE TRIGGER tr_queue_update AFTER UPDATE ON smp_server.msg_queues FOR EACH ROW EXECUTE FUNCTION smp_server.on_queue_update();
|
||||
|
||||
|
||||
|
||||
ALTER TABLE ONLY smp_server.messages
|
||||
ADD CONSTRAINT messages_recipient_id_fkey FOREIGN KEY (recipient_id) REFERENCES smp_server.msg_queues(recipient_id) ON UPDATE RESTRICT ON DELETE CASCADE;
|
||||
|
||||
|
||||
@@ -17,6 +17,7 @@
|
||||
module Simplex.Messaging.Server.QueueStore.STM
|
||||
( STMQueueStore (..),
|
||||
STMService (..),
|
||||
foldRcvServiceQueues,
|
||||
setStoreLog,
|
||||
withLog',
|
||||
readQueueRecIO,
|
||||
@@ -27,6 +28,7 @@ where
|
||||
import qualified Control.Exception as E
|
||||
import Control.Logger.Simple
|
||||
import Control.Monad
|
||||
import Data.Bifunctor (first)
|
||||
import Data.Bitraversable (bimapM)
|
||||
import Data.Functor (($>))
|
||||
import Data.Int (Int64)
|
||||
@@ -45,7 +47,7 @@ import Simplex.Messaging.SystemTime
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport (SMPServiceRole (..))
|
||||
import Simplex.Messaging.Util (anyM, ifM, tshow, ($>>), ($>>=), (<$$))
|
||||
import Simplex.Messaging.Util (anyM, ifM, tshow, ($>>), ($>>=), (<$$), (<$$>))
|
||||
import System.IO
|
||||
import UnliftIO.STM
|
||||
|
||||
@@ -61,8 +63,8 @@ data STMQueueStore q = STMQueueStore
|
||||
|
||||
data STMService = STMService
|
||||
{ serviceRec :: ServiceRec,
|
||||
serviceRcvQueues :: TVar (Set RecipientId),
|
||||
serviceNtfQueues :: TVar (Set NotifierId)
|
||||
serviceRcvQueues :: TVar (Set RecipientId, IdsHash),
|
||||
serviceNtfQueues :: TVar (Set NotifierId, IdsHash)
|
||||
}
|
||||
|
||||
setStoreLog :: STMQueueStore q -> StoreLog 'WriteMode -> IO ()
|
||||
@@ -112,7 +114,7 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
|
||||
}
|
||||
where
|
||||
serviceCount role = M.foldl' (\ !n s -> if serviceRole (serviceRec s) == role then n + 1 else n) 0
|
||||
serviceQueuesCount serviceSel = foldM (\n s -> (n +) . S.size <$> readTVarIO (serviceSel s)) 0
|
||||
serviceQueuesCount serviceSel = foldM (\n s -> (n +) . S.size . fst <$> readTVarIO (serviceSel s)) 0
|
||||
|
||||
addQueue_ :: STMQueueStore q -> (RecipientId -> QueueRec -> IO q) -> RecipientId -> QueueRec -> IO (Either ErrorType q)
|
||||
addQueue_ st mkQ rId qr@QueueRec {senderId = sId, notifier, queueData, rcvServiceId} = do
|
||||
@@ -303,8 +305,8 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
|
||||
TM.insert fp newSrvId serviceCerts
|
||||
pure $ Right (newSrvId, True)
|
||||
newSTMService = do
|
||||
serviceRcvQueues <- newTVar S.empty
|
||||
serviceNtfQueues <- newTVar S.empty
|
||||
serviceRcvQueues <- newTVar (S.empty, mempty)
|
||||
serviceNtfQueues <- newTVar (S.empty, mempty)
|
||||
pure STMService {serviceRec = sr, serviceRcvQueues, serviceNtfQueues}
|
||||
|
||||
setQueueService :: (PartyI p, ServiceParty p) => STMQueueStore q -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
|
||||
@@ -330,11 +332,15 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
|
||||
let !q' = Just q {notifier = Just nc {ntfServiceId = serviceId}}
|
||||
updateServiceQueues serviceNtfQueues nId prevNtfSrvId
|
||||
writeTVar qr q' $> Right ()
|
||||
updateServiceQueues :: (STMService -> TVar (Set QueueId)) -> QueueId -> Maybe ServiceId -> STM ()
|
||||
updateServiceQueues :: (STMService -> TVar (Set QueueId, IdsHash)) -> QueueId -> Maybe ServiceId -> STM ()
|
||||
updateServiceQueues serviceSel qId prevSrvId = do
|
||||
mapM_ (removeServiceQueue st serviceSel qId) prevSrvId
|
||||
mapM_ (addServiceQueue st serviceSel qId) serviceId
|
||||
|
||||
setQueueServices st party serviceId qs = Right . M.fromList <$> mapM setQueue qs
|
||||
where
|
||||
setQueue sq = (recipientId sq,) <$> setQueueService st sq party serviceId
|
||||
|
||||
getQueueNtfServices :: STMQueueStore q -> [(NotifierId, a)] -> IO (Either ErrorType ([(Maybe ServiceId, [(NotifierId, a)])], [(NotifierId, a)]))
|
||||
getQueueNtfServices st ntfs = do
|
||||
ss <- readTVarIO (services st)
|
||||
@@ -345,20 +351,30 @@ instance StoreQueueClass q => QueueStoreClass q (STMQueueStore q) where
|
||||
pure $ Right (ssNtfs', deleteNtfs)
|
||||
where
|
||||
addService (ssNtfs, ntfs') (serviceId, s) = do
|
||||
snIds <- readTVarIO $ serviceNtfQueues s
|
||||
(snIds, _) <- readTVarIO $ serviceNtfQueues s
|
||||
let (sNtfs, restNtfs) = partition (\(nId, _) -> S.member nId snIds) ntfs'
|
||||
pure ((Just serviceId, sNtfs) : ssNtfs, restNtfs)
|
||||
|
||||
getServiceQueueCount :: (PartyI p, ServiceParty p) => STMQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
|
||||
getServiceQueueCount st party serviceId =
|
||||
getServiceQueueCountHash :: (PartyI p, ServiceParty p) => STMQueueStore q -> SParty p -> ServiceId -> IO (Either ErrorType (Int64, IdsHash))
|
||||
getServiceQueueCountHash st party serviceId =
|
||||
TM.lookupIO serviceId (services st) >>=
|
||||
maybe (pure $ Left AUTH) (fmap (Right . fromIntegral . S.size) . readTVarIO . serviceSel)
|
||||
maybe (pure $ Left AUTH) (fmap (Right . first (fromIntegral . S.size)) . readTVarIO . serviceSel)
|
||||
where
|
||||
serviceSel :: STMService -> TVar (Set QueueId)
|
||||
serviceSel :: STMService -> TVar (Set QueueId, IdsHash)
|
||||
serviceSel = case party of
|
||||
SRecipientService -> serviceRcvQueues
|
||||
SNotifierService -> serviceNtfQueues
|
||||
|
||||
foldRcvServiceQueues :: StoreQueueClass q => STMQueueStore q -> ServiceId -> (a -> (q, QueueRec) -> IO a) -> a -> IO a
|
||||
foldRcvServiceQueues st serviceId f acc =
|
||||
TM.lookupIO serviceId (services st) >>= \case
|
||||
Nothing -> pure acc
|
||||
Just s ->
|
||||
readTVarIO (serviceRcvQueues s)
|
||||
>>= foldM (\a -> get >=> maybe (pure a) (f a)) acc . fst
|
||||
where
|
||||
get rId = TM.lookupIO rId (queues st) $>>= \q -> (q,) <$$> readTVarIO (queueRec q)
|
||||
|
||||
withQueueRec :: TVar (Maybe QueueRec) -> (QueueRec -> STM a) -> IO (Either ErrorType a)
|
||||
withQueueRec qr a = atomically $ readQueueRec qr >>= mapM a
|
||||
|
||||
@@ -368,16 +384,23 @@ setStatus qr status =
|
||||
Just q -> (Right (), Just q {status})
|
||||
Nothing -> (Left AUTH, Nothing)
|
||||
|
||||
addServiceQueue :: STMQueueStore q -> (STMService -> TVar (Set QueueId)) -> QueueId -> ServiceId -> STM ()
|
||||
addServiceQueue st serviceSel qId serviceId =
|
||||
TM.lookup serviceId (services st) >>= mapM_ (\s -> modifyTVar' (serviceSel s) (S.insert qId))
|
||||
addServiceQueue :: STMQueueStore q -> (STMService -> TVar (Set QueueId, IdsHash)) -> QueueId -> ServiceId -> STM ()
|
||||
addServiceQueue = setServiceQueues_ S.insert
|
||||
{-# INLINE addServiceQueue #-}
|
||||
|
||||
removeServiceQueue :: STMQueueStore q -> (STMService -> TVar (Set QueueId)) -> QueueId -> ServiceId -> STM ()
|
||||
removeServiceQueue st serviceSel qId serviceId =
|
||||
TM.lookup serviceId (services st) >>= mapM_ (\s -> modifyTVar' (serviceSel s) (S.delete qId))
|
||||
removeServiceQueue :: STMQueueStore q -> (STMService -> TVar (Set QueueId, IdsHash)) -> QueueId -> ServiceId -> STM ()
|
||||
removeServiceQueue = setServiceQueues_ S.delete
|
||||
{-# INLINE removeServiceQueue #-}
|
||||
|
||||
setServiceQueues_ :: (QueueId -> Set QueueId -> Set QueueId) -> STMQueueStore q -> (STMService -> TVar (Set QueueId, IdsHash)) -> QueueId -> ServiceId -> STM ()
|
||||
setServiceQueues_ updateSet st serviceSel qId serviceId =
|
||||
TM.lookup serviceId (services st) >>= mapM_ (\v -> modifyTVar' (serviceSel v) update)
|
||||
where
|
||||
update (s, idsHash) =
|
||||
let !s' = updateSet qId s
|
||||
!idsHash' = queueIdHash qId <> idsHash
|
||||
in (s', idsHash')
|
||||
|
||||
removeNotifier :: STMQueueStore q -> NtfCreds -> STM ()
|
||||
removeNotifier st NtfCreds {notifierId = nId, ntfServiceId} = do
|
||||
TM.delete nId $ notifiers st
|
||||
|
||||
@@ -16,6 +16,7 @@ import Control.Concurrent.STM
|
||||
import Control.Monad
|
||||
import Data.Int (Int64)
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import Data.Map.Strict (Map)
|
||||
import Data.Text (Text)
|
||||
import Simplex.Messaging.Protocol
|
||||
import Simplex.Messaging.Server.QueueStore
|
||||
@@ -51,8 +52,9 @@ class StoreQueueClass q => QueueStoreClass q s where
|
||||
deleteStoreQueue :: s -> q -> IO (Either ErrorType QueueRec)
|
||||
getCreateService :: s -> ServiceRec -> IO (Either ErrorType ServiceId)
|
||||
setQueueService :: (PartyI p, ServiceParty p) => s -> q -> SParty p -> Maybe ServiceId -> IO (Either ErrorType ())
|
||||
setQueueServices :: (PartyI p, ServiceParty p) => s -> SParty p -> Maybe ServiceId -> [q] -> IO (Either ErrorType (Map RecipientId (Either ErrorType ())))
|
||||
getQueueNtfServices :: s -> [(NotifierId, a)] -> IO (Either ErrorType ([(Maybe ServiceId, [(NotifierId, a)])], [(NotifierId, a)]))
|
||||
getServiceQueueCount :: (PartyI p, ServiceParty p) => s -> SParty p -> ServiceId -> IO (Either ErrorType Int64)
|
||||
getServiceQueueCountHash :: (PartyI p, ServiceParty p) => s -> SParty p -> ServiceId -> IO (Either ErrorType (Int64, IdsHash))
|
||||
|
||||
data EntityCounts = EntityCounts
|
||||
{ queueCount :: Int,
|
||||
|
||||
Reference in New Issue
Block a user