smp server: keep queues blocked with notice after restart and import (#1971)

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.*

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

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)

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],