add msgId to ACK to avoid the risks of losing messages with concurrent delivery (in app/NSE) (#387)

* add msgId to ACK to avoid the risks of losing messages with concurrent delivery (in app/NSE)

* update ACK to only remove message and update stats if msgId matches

* add tests, fix

* rename sameMsgId/msgDeleted

src/Simplex/Messaging/Server/Env/STM.hs

@@ -94,7 +94,7 @@ data Server = Server
   }
 
 data Client = Client
-  { subscriptions :: TMap RecipientId Sub,
+  { subscriptions :: TMap RecipientId (TVar Sub),
     ntfSubscriptions :: TMap NotifierId (),
     rcvQ :: TBQueue (Transmission Cmd),
     sndQ :: TBQueue (Transmission BrokerMsg),
@@ -117,7 +117,7 @@ data SubscriptionThread = NoSub | SubPending | SubThread ThreadId | ProhibitSub
 
 data Sub = Sub
   { subThread :: SubscriptionThread,
-    delivered :: TMVar ()
+    delivered :: TMVar MsgId
   }
 
 newServer :: Natural -> STM Server
@@ -149,14 +149,8 @@ newServerStats ts = do
   fromTime <- newTVar ts
   pure ServerStats {qCreated, qSecured, qDeleted, msgSent, msgRecv, msgQueues, fromTime}
 
-newSubscription :: STM Sub
-newSubscription = newSubscription_ NoSub
-
-prohibitedSubscription :: STM Sub
-prohibitedSubscription = newSubscription_ ProhibitSub
-
-newSubscription_ :: SubscriptionThread -> STM Sub
-newSubscription_ subThread = do
+newSubscription :: SubscriptionThread -> STM Sub
+newSubscription subThread = do
   delivered <- newEmptyTMVar
   return Sub {subThread, delivered}
 

src/Simplex/Messaging/Server/MsgStore.hs

@@ -23,6 +23,6 @@ class MonadMsgQueue q m where
   writeMsg :: q -> Message -> m () -- non blocking
   tryPeekMsg :: q -> m (Maybe Message) -- non blocking
   peekMsg :: q -> m Message -- blocking
-  tryDelMsg :: q -> m () -- non blocking
-  tryDelPeekMsg :: q -> m (Maybe Message) -- atomic delete (== read) last and peek next message, if available
+  tryDelMsg :: q -> MsgId -> m Bool -- non blocking
+  tryDelPeekMsg :: q -> MsgId -> m (Bool, Maybe Message) -- atomic delete (== read) last and peek next message, if available
   deleteExpiredMsgs :: q -> Int64 -> m ()

src/Simplex/Messaging/Server/MsgStore/STM.hs

@@ -2,16 +2,19 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TupleSections #-}
 
 module Simplex.Messaging.Server.MsgStore.STM where
 
-import Control.Monad (void, when)
+import Control.Monad (when)
+import Data.Functor (($>))
 import Data.Int (Int64)
 import Data.Time.Clock.System (SystemTime (systemSeconds))
 import Numeric.Natural
-import Simplex.Messaging.Protocol (RecipientId)
+import Simplex.Messaging.Protocol (MsgId, RecipientId)
 import Simplex.Messaging.Server.MsgStore
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
@@ -49,12 +52,22 @@ instance MonadMsgQueue MsgQueue STM where
   peekMsg :: MsgQueue -> STM Message
   peekMsg = peekTBQueue . msgQueue
 
-  tryDelMsg :: MsgQueue -> STM ()
-  tryDelMsg = void . tryReadTBQueue . msgQueue
+  tryDelMsg :: MsgQueue -> MsgId -> STM Bool
+  tryDelMsg (MsgQueue q) msgId' =
+    tryPeekTBQueue q >>= \case
+      Just Message {msgId}
+        | msgId == msgId' -> tryReadTBQueue q $> True
+        | otherwise -> pure False
+      _ -> pure False
 
   -- atomic delete (== read) last and peek next message if available
-  tryDelPeekMsg :: MsgQueue -> STM (Maybe Message)
-  tryDelPeekMsg (MsgQueue q) = tryReadTBQueue q >> tryPeekTBQueue q
+  tryDelPeekMsg :: MsgQueue -> MsgId -> STM (Bool, Maybe Message)
+  tryDelPeekMsg (MsgQueue q) msgId' =
+    tryPeekTBQueue q >>= \case
+      msg_@(Just Message {msgId})
+        | msgId == msgId' -> (True,) <$> (tryReadTBQueue q >> tryPeekTBQueue q)
+        | otherwise -> pure (False, msg_)
+      _ -> pure (False, Nothing)
 
   deleteExpiredMsgs :: MsgQueue -> Int64 -> STM ()
   deleteExpiredMsgs (MsgQueue q) old = loop