ntf: remove notification subscription (#417)

src/Simplex/Messaging/Notifications/Server/Store.hs

@@ -24,6 +24,7 @@ import Simplex.Messaging.Util (whenM, ($>>=))
 
 data NtfStore = NtfStore
   { tokens :: TMap NtfTokenId NtfTknData,
+    -- multiple registrations exist to protect from malicious registrations if token is compromised
     tokenRegistrations :: TMap DeviceToken (TMap ByteString NtfTokenId),
     subscriptions :: TMap NtfSubscriptionId NtfSubData,
     tokenSubscriptions :: TMap NtfTokenId (TVar (Set NtfSubscriptionId)),

src/Simplex/Messaging/Protocol.hs

@@ -221,6 +221,7 @@ data Command (p :: Party) where
   SUB :: Command Recipient
   KEY :: SndPublicVerifyKey -> Command Recipient
   NKEY :: NtfPublicVerifyKey -> RcvNtfPublicDhKey -> Command Recipient
+  NDEL :: Command Recipient
   GET :: Command Recipient
   -- ACK v1 has to be supported for encoding/decoding
   -- ACK :: Command Recipient
@@ -303,6 +304,7 @@ data CommandTag (p :: Party) where
   SUB_ :: CommandTag Recipient
   KEY_ :: CommandTag Recipient
   NKEY_ :: CommandTag Recipient
+  NDEL_ :: CommandTag Recipient
   GET_ :: CommandTag Recipient
   ACK_ :: CommandTag Recipient
   OFF_ :: CommandTag Recipient
@@ -342,6 +344,7 @@ instance PartyI p => Encoding (CommandTag p) where
     SUB_ -> "SUB"
     KEY_ -> "KEY"
     NKEY_ -> "NKEY"
+    NDEL_ -> "NDEL"
     GET_ -> "GET"
     ACK_ -> "ACK"
     OFF_ -> "OFF"
@@ -357,6 +360,7 @@ instance ProtocolMsgTag CmdTag where
     "SUB" -> Just $ CT SRecipient SUB_
     "KEY" -> Just $ CT SRecipient KEY_
     "NKEY" -> Just $ CT SRecipient NKEY_
+    "NDEL" -> Just $ CT SRecipient NDEL_
     "GET" -> Just $ CT SRecipient GET_
     "ACK" -> Just $ CT SRecipient ACK_
     "OFF" -> Just $ CT SRecipient OFF_
@@ -651,6 +655,7 @@ instance PartyI p => ProtocolEncoding (Command p) where
     SUB -> e SUB_
     KEY k -> e (KEY_, ' ', k)
     NKEY k dhKey -> e (NKEY_, ' ', k, dhKey)
+    NDEL -> e NDEL_
     GET -> e GET_
     ACK msgId
       | v == 1 -> e ACK_
@@ -698,6 +703,7 @@ instance ProtocolEncoding Cmd where
         SUB_ -> pure SUB
         KEY_ -> KEY <$> _smpP
         NKEY_ -> NKEY <$> _smpP <*> smpP
+        NDEL_ -> pure NDEL
         GET_ -> pure GET
         ACK_
           | v == 1 -> pure $ ACK ""

src/Simplex/Messaging/Server.hs

@@ -334,6 +334,7 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
             ACK msgId -> acknowledgeMsg msgId
             KEY sKey -> secureQueue_ st sKey
             NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
+            NDEL -> deleteQueueNotifier_ st
             OFF -> suspendQueue_ st
             DEL -> delQueueAndMsgs st
       where
@@ -405,6 +406,11 @@ client clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ} Server {subscri
                   withLog $ \s -> logAddNotifier s queueId ntfCreds
                   pure $ NID notifierId rcvPublicDhKey
 
+        deleteQueueNotifier_ :: QueueStore -> m (Transmission BrokerMsg)
+        deleteQueueNotifier_ st = do
+          withLog (`logDeleteNotifier` queueId)
+          okResp <$> atomically (deleteQueueNotifier st queueId)
+
         suspendQueue_ :: QueueStore -> m (Transmission BrokerMsg)
         suspendQueue_ st = do
           withLog (`logDeleteQueue` queueId)

src/Simplex/Messaging/Server/QueueStore.hs

@@ -39,5 +39,6 @@ class MonadQueueStore s m where
   getQueue :: s -> SParty p -> QueueId -> m (Either ErrorType QueueRec)
   secureQueue :: s -> RecipientId -> SndPublicVerifyKey -> m (Either ErrorType QueueRec)
   addQueueNotifier :: s -> RecipientId -> NtfCreds -> m (Either ErrorType QueueRec)
+  deleteQueueNotifier :: s -> RecipientId -> m (Either ErrorType ())
   suspendQueue :: s -> RecipientId -> m (Either ErrorType ())
   deleteQueue :: s -> RecipientId -> m (Either ErrorType ())

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

@@ -71,6 +71,14 @@ instance MonadQueueStore QueueStore STM where
         TM.insert nId rId notifiers
         pure $ Just q
 
+  deleteQueueNotifier :: QueueStore -> RecipientId -> STM (Either ErrorType ())
+  deleteQueueNotifier QueueStore {queues, notifiers} rId =
+    withQueue rId queues $ \qVar -> do
+      q <- readTVar qVar
+      forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
+      writeTVar qVar q {notifier = Nothing}
+      pure $ Just ()
+
   suspendQueue :: QueueStore -> RecipientId -> STM (Either ErrorType ())
   suspendQueue QueueStore {queues} rId =
     withQueue rId queues $ \qVar -> modifyTVar' qVar (\q -> q {status = QueueOff}) $> Just ()

src/Simplex/Messaging/Server/StoreLog.hs

@@ -17,6 +17,7 @@ module Simplex.Messaging.Server.StoreLog
     logSecureQueue,
     logAddNotifier,
     logDeleteQueue,
+    logDeleteNotifier,
     readWriteStoreLog,
   )
 where
@@ -50,6 +51,7 @@ data StoreLogRecord
   | SecureQueue QueueId SndPublicVerifyKey
   | AddNotifier QueueId NtfCreds
   | DeleteQueue QueueId
+  | DeleteNotifier QueueId
 
 instance StrEncoding QueueRec where
   strEncode QueueRec {recipientId, recipientKey, rcvDhSecret, senderId, senderKey, notifier} =
@@ -79,12 +81,14 @@ instance StrEncoding StoreLogRecord where
     SecureQueue rId sKey -> strEncode (Str "SECURE", rId, sKey)
     AddNotifier rId ntfCreds -> strEncode (Str "NOTIFIER", rId, ntfCreds)
     DeleteQueue rId -> strEncode (Str "DELETE", rId)
+    DeleteNotifier rId -> strEncode (Str "NDELETE", rId)
 
   strP =
     "CREATE " *> (CreateQueue <$> strP)
       <|> "SECURE " *> (SecureQueue <$> strP_ <*> strP)
       <|> "NOTIFIER " *> (AddNotifier <$> strP_ <*> strP)
       <|> "DELETE " *> (DeleteQueue <$> strP)
+      <|> "NDELETE" *> (DeleteNotifier <$> strP)
 
 openWriteStoreLog :: FilePath -> IO (StoreLog 'WriteMode)
 openWriteStoreLog f = WriteStoreLog f <$> openFile f WriteMode
@@ -121,6 +125,9 @@ logAddNotifier s qId ntfCreds = writeStoreLogRecord s $ AddNotifier qId ntfCreds
 logDeleteQueue :: StoreLog 'WriteMode -> QueueId -> IO ()
 logDeleteQueue s = writeStoreLogRecord s . DeleteQueue
 
+logDeleteNotifier :: StoreLog 'WriteMode -> QueueId -> IO ()
+logDeleteNotifier s = writeStoreLogRecord s . DeleteNotifier
+
 readWriteStoreLog :: StoreLog 'ReadMode -> IO (Map RecipientId QueueRec, StoreLog 'WriteMode)
 readWriteStoreLog s@(ReadStoreLog f _) = do
   qs <- readQueues s
@@ -151,5 +158,6 @@ readQueues (ReadStoreLog _ h) = LB.hGetContents h >>= returnResult . procStoreLo
       SecureQueue qId sKey -> M.adjust (\q -> q {senderKey = Just sKey}) qId m
       AddNotifier qId ntfCreds -> M.adjust (\q -> q {notifier = Just ntfCreds}) qId m
       DeleteQueue qId -> M.delete qId m
+      DeleteNotifier qId -> M.adjust (\q -> q {notifier = Nothing}) qId m
     printError :: LogParsingError -> IO ()
     printError (e, s) = B.putStrLn $ "Error parsing log: " <> B.pack e <> " - " <> s