ntf: IDSUB response, check notifierKey and return subId on repeat SNEW (#383)

src/Simplex/Messaging/Notifications/Client.hs

@@ -27,7 +27,7 @@ type NtfClient = ProtocolClient NtfResponse
 ntfRegisterToken :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Token -> ExceptT ProtocolClientError IO (NtfTokenId, C.PublicKeyX25519)
 ntfRegisterToken c pKey newTkn =
   sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
-    NRId tknId dhKey -> pure (tknId, dhKey)
+    NRTknId tknId dhKey -> pure (tknId, dhKey)
     _ -> throwE PCEUnexpectedResponse
 
 ntfVerifyToken :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> NtfRegCode -> ExceptT ProtocolClientError IO ()
@@ -45,10 +45,10 @@ ntfDeleteToken = okNtfCommand TDEL
 ntfEnableCron :: NtfClient -> C.APrivateSignKey -> NtfTokenId -> Word16 -> ExceptT ProtocolClientError IO ()
 ntfEnableCron c pKey tknId int = okNtfCommand (TCRN int) c pKey tknId
 
-ntfCreateSubsciption :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO (NtfSubscriptionId, C.PublicKeyX25519)
-ntfCreateSubsciption c pKey newSub =
+ntfCreateSubscription :: NtfClient -> C.APrivateSignKey -> NewNtfEntity 'Subscription -> ExceptT ProtocolClientError IO NtfSubscriptionId
+ntfCreateSubscription c pKey newSub =
   sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
-    NRId subId dhKey -> pure (subId, dhKey)
+    NRSubId subId -> pure subId
     _ -> throwE PCEUnexpectedResponse
 
 ntfCheckSubscription :: NtfClient -> C.APrivateSignKey -> NtfSubscriptionId -> ExceptT ProtocolClientError IO NtfSubStatus

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -231,7 +231,8 @@ instance ProtocolEncoding NtfCmd where
   checkCredentials t (NtfCmd e c) = NtfCmd e <$> checkCredentials t c
 
 data NtfResponseTag
-  = NRId_
+  = NRTknId_
+  | NRSubId_
   | NROk_
   | NRErr_
   | NRTkn_
@@ -241,7 +242,8 @@ data NtfResponseTag
 
 instance Encoding NtfResponseTag where
   smpEncode = \case
-    NRId_ -> "ID"
+    NRTknId_ -> "IDTKN"
+    NRSubId_ -> "IDSUB"
     NROk_ -> "OK"
     NRErr_ -> "ERR"
     NRTkn_ -> "TKN"
@@ -251,7 +253,8 @@ instance Encoding NtfResponseTag where
 
 instance ProtocolMsgTag NtfResponseTag where
   decodeTag = \case
-    "ID" -> Just NRId_
+    "IDTKN" -> Just NRTknId_
+    "IDSUB" -> Just NRSubId_
     "OK" -> Just NROk_
     "ERR" -> Just NRErr_
     "TKN" -> Just NRTkn_
@@ -260,7 +263,8 @@ instance ProtocolMsgTag NtfResponseTag where
     _ -> Nothing
 
 data NtfResponse
-  = NRId NtfEntityId C.PublicKeyX25519
+  = NRTknId NtfEntityId C.PublicKeyX25519
+  | NRSubId NtfEntityId
   | NROk
   | NRErr ErrorType
   | NRTkn NtfTknStatus
@@ -271,7 +275,8 @@ data NtfResponse
 instance ProtocolEncoding NtfResponse where
   type Tag NtfResponse = NtfResponseTag
   encodeProtocol = \case
-    NRId entId dhKey -> e (NRId_, ' ', entId, dhKey)
+    NRTknId entId dhKey -> e (NRTknId_, ' ', entId, dhKey)
+    NRSubId entId -> e (NRSubId_, ' ', entId)
     NROk -> e NROk_
     NRErr err -> e (NRErr_, ' ', err)
     NRTkn stat -> e (NRTkn_, ' ', stat)
@@ -282,7 +287,8 @@ instance ProtocolEncoding NtfResponse where
       e = smpEncode
 
   protocolP = \case
-    NRId_ -> NRId <$> _smpP <*> smpP
+    NRTknId_ -> NRTknId <$> _smpP <*> smpP
+    NRSubId_ -> NRSubId <$> _smpP
     NROk_ -> pure NROk
     NRErr_ -> NRErr <$> _smpP
     NRTkn_ -> NRTkn <$> _smpP
@@ -290,8 +296,10 @@ instance ProtocolEncoding NtfResponse where
     NRPong_ -> pure NRPong
 
   checkCredentials (_, _, entId, _) cmd = case cmd of
-    -- ID response must not have queue ID
-    NRId {} -> noEntity
+    -- IDTKN response must not have queue ID
+    NRTknId {} -> noEntity
+    -- IDSUB response must not have queue ID
+    NRSubId {} -> noEntity
     -- ERR response does not always have entity ID
     NRErr _ -> Right cmd
     -- PONG response must not have queue ID

src/Simplex/Messaging/Notifications/Server.hs

@@ -208,7 +208,6 @@ verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
             _ -> VRVerified (NtfReqNew corrId (ANE SToken tkn))
           else VRFailed
     NtfCmd SToken c -> do
-      -- TODO move active token check here to differentiate error
       t_ <- atomically $ getNtfToken st entId
       pure $ case t_ of
         Just t@NtfTknData {tknVerifyKey}
@@ -229,6 +228,7 @@ verifyNtfTransmission (sig_, signed, (corrId, entId, _)) cmd = do
             else VRFailed
         _ -> maybe False (dummyVerifyCmd signed) sig_ `seq` VRFailed
     NtfCmd SSubscription c -> do
+      -- TODO move active token check here to differentiate error
       r_ <- atomically $ getNtfSubscription st entId
       pure $ case r_ of
         Just (s, NtfTknData {tknVerifyKey})
@@ -259,7 +259,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ
           tkn <- mkNtfTknData tknId newTkn ks dhSecret regCode
           addNtfToken st tknId tkn
           writeTBQueue pushQ (tkn, PNVerification regCode)
-        pure (corrId, "", NRId tknId srvDhPubKey)
+        pure (corrId, "", NRTknId tknId srvDhPubKey)
       NtfReqCmd SToken (NtfTkn tkn@NtfTknData {ntfTknId, tknStatus, tknRegCode, tknDhSecret, tknDhKeys = (srvDhPubKey, srvDhPrivKey)}) (corrId, tknId, cmd) -> do
         status <- readTVarIO tknStatus
         (corrId,tknId,) <$> case cmd of
@@ -270,7 +270,7 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ
             if tknDhSecret == dhSecret
               then do
                 atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
-                pure $ NRId ntfTknId srvDhPubKey
+                pure $ NRTknId ntfTknId srvDhPubKey
               else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
             | (status == NTRegistered || status == NTConfirmed || status == NTActive) && tknRegCode == code -> do
@@ -315,24 +315,25 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ} NtfPushServer {pushQ
                     threadDelay delay
                     atomically $ writeTBQueue pushQ (tkn, PNCheckMessages)
       NtfReqNew corrId (ANE SSubscription newSub) -> do
+        logDebug "SNEW - new subscription"
         st <- asks store
         subId <- getId
         atomically $ do
           sub <- mkNtfSubData newSub
           (corrId,"",)
             <$> ( addNtfSubscription st subId sub >>= \case
-                    -- TODO response ID
-                    Just _ -> writeTBQueue newSubQ (NtfSub sub) $> NROk
+                    Just _ -> writeTBQueue newSubQ (NtfSub sub) $> NRSubId subId
                     _ -> pure $ NRErr AUTH
                 )
-      NtfReqCmd SSubscription _sub (corrId, subId, cmd) ->
+      NtfReqCmd SSubscription (NtfSub NtfSubData {notifierKey = registeredNKey}) (corrId, subId, cmd) ->
         (corrId,subId,) <$> case cmd of
-          SNEW _newSub -> do
-            logDebug "SNEW - registered subscription"
-            -- st <- asks store
-            -- TODO check NKEY?
-            -- TODO response ID
-            pure NROk
+          SNEW (NewNtfSub _ _ notifierKey) -> do
+            logDebug "SNEW - existing subscription"
+            -- TODO retry if subscription failed, if pending or AUTH do nothing
+            pure $
+              if notifierKey == registeredNKey
+                then NRSubId subId
+                else NRErr AUTH
           SCHK -> pure NROk
           SDEL -> pure NROk
           PING -> pure NRPong