From 14122174c9a5edd02441bf63ec9aa1751399a88c Mon Sep 17 00:00:00 2001 From: "Evgeny @ SimpleX Chat" <259188159+evgeny-simplex@users.noreply.github.com> Date: Sun, 25 Oct 2026 09:10:45 +0000 Subject: [PATCH] smp server: keep queues blocked with notice after restart and import (#1971) --- simplexmq.cabal | 1 + src/Simplex/Messaging/Protocol.hs | 4 +++- src/Simplex/Messaging/Server/QueueStore/Postgres.hs | 10 +++++++++- tests/CoreTests/StoreLogTests.hs | 8 ++++++++ 4 files changed, 21 insertions(+), 2 deletions(-) diff --git a/simplexmq.cabal b/simplexmq.cabal index 349ce52aa..8a96732fe 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -361,6 +361,7 @@ library , asn1-types ==0.3.* , async ==2.2.* , attoparsec ==0.14.* + , attoparsec-aeson ==2.2.* , base >=4.14 && <5 , base64-bytestring >=1.0 && <1.3 , composition ==1.0.* diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index faeb214bc..8ff1bfcc0 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -242,7 +242,9 @@ import Control.Monad.Except import Crypto.Random (ChaChaDRG) import Data.Aeson (FromJSON (..), ToJSON (..)) import qualified Data.Aeson as J +import qualified Data.Aeson.Parser as J import qualified Data.Aeson.TH as J +import qualified Data.Aeson.Types as JT import Data.Attoparsec.ByteString.Char8 (Parser, ()) import qualified Data.Attoparsec.ByteString.Char8 as A import Data.Bifunctor (bimap, first) @@ -1780,7 +1782,7 @@ instance StrEncoding BlockingInfo where "reason=" <> strEncode reason <> maybe "" ((",notice=" <>) . LB.toStrict . J.encode) notice strP = do reason <- "reason=" *> strP - notice <- optional $ ",notice=" *> (J.eitherDecodeStrict <$?> A.takeByteString) + notice <- optional $ ",notice=" *> (JT.parseEither parseJSON <$?> J.json') pure BlockingInfo {reason, notice} instance Encoding BlockingInfo where diff --git a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs index 23b90b100..66e9a91f3 100644 --- a/src/Simplex/Messaging/Server/QueueStore/Postgres.hs +++ b/src/Simplex/Messaging/Server/QueueStore/Postgres.hs @@ -44,6 +44,7 @@ import Control.Monad.Trans.Except import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as BB import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy as LB import Data.Bitraversable (bimapM) import Data.Either (fromRight) @@ -558,7 +559,7 @@ queueRecToText (rId, QueueRec {recipientKeys, rcvDhSecret, senderId, senderKey, nullable (notifierKey <$> n), nullable (rcvNtfDhSecret <$> n), nullable (ntfServiceId =<< n), - BB.char7 '"' <> renderField (toField status) <> BB.char7 '"', + quotedField (toField status), nullable updatedAt, nullable linkId_, nullable rcvServiceId, @@ -577,6 +578,13 @@ renderField = \case EscapeIdentifier s -> BB.byteString s -- Not used in COPY data Many as -> mconcat (map renderField as) +quotedField :: Action -> Builder +quotedField a = BB.char7 '"' <> escapeQuotes (renderField a) <> BB.char7 '"' + where + escapeQuotes bld = + let bs = LB.toStrict $ BB.toLazyByteString bld + in BB.byteString $ B.concatMap (\c -> if c == '"' then "\"\"" else B.singleton c) bs + queueDataColumns :: Maybe (LinkId, QueueLinkData) -> (Maybe LinkId, Maybe QueueLinkData) queueDataColumns = \case Just (linkId, linkData) -> (Just linkId, Just linkData) diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs index d34755d1e..45116d4a5 100644 --- a/tests/CoreTests/StoreLogTests.hs +++ b/tests/CoreTests/StoreLogTests.hs @@ -72,6 +72,8 @@ storeLogTests = q <- testNewQueueRecData g qm (Just (lnkId, qd)) pure (q, lnkId, qd) let pubKey = fst <$> atomically (C.generateAuthKeyPair C.SEd25519 g) + rcvSr = sr {serviceRole = SRMessaging} + blockedWithNotice = BlockingInfo {reason = BRContent, notice = Just ClientNotice {ttl = Just 86400}} newKeys <- runIO $ L.fromList <$> sequence [pubKey, pubKey] testSMPStoreLog ("SMP server store log, queueMode = " <> show qm) @@ -123,6 +125,12 @@ storeLogTests = compacted = [NewService sr, CreateQueue rId qr {notifier = Just ntfCreds {ntfServiceId = Just serviceId}}], state = M.fromList [(rId, qr {notifier = Just ntfCreds {ntfServiceId = Just serviceId}})] }, + SLTC + { name = "create queue, register and associate messaging service, block queue with notice", + saved = [CreateQueue rId qr, NewService rcvSr, QueueService rId (ASP SRecipientService) (Just serviceId), BlockQueue rId blockedWithNotice], + compacted = [NewService rcvSr, CreateQueue rId qr {rcvServiceId = Just serviceId, status = EntityBlocked blockedWithNotice}], + state = M.fromList [(rId, qr {rcvServiceId = Just serviceId, status = EntityBlocked blockedWithNotice})] + }, SLTC { name = "delete notifier", saved = [CreateQueue rId qr, AddNotifier rId ntfCreds, DeleteNotifier rId],