ntf server: fix repeat token registration when it became invalid (regression) (#1539)

Author: epoberezkin

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -536,6 +536,15 @@ data NtfTknStatus
     NTExpired
   deriving (Eq, Show)
 
+allowTokenVerification :: NtfTknStatus -> Bool
+allowTokenVerification = \case
+  NTNew -> False
+  NTRegistered -> True
+  NTInvalid _ -> False
+  NTConfirmed -> True
+  NTActive -> True
+  NTExpired -> False
+
 allowNtfSubCommands :: NtfTknStatus -> Bool
 allowNtfSubCommands = \case
   NTNew -> False

src/Simplex/Messaging/Notifications/Server.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -729,14 +730,17 @@ client NtfServerClient {rcvQ, sndQ} NtfSubscriber {newSubQ, smpAgent = ca} NtfPu
             logDebug "TNEW - registered token"
             let dhSecret = C.dh' dhPubKey tknDhPrivKey
             -- it is required that DH secret is the same, to avoid failed verifications if notification is delaying
-            if tknDhSecret == dhSecret
-              then do
+            if
+              | tknDhSecret /= dhSecret -> pure $ NRErr AUTH
+              | allowTokenVerification tknStatus -> sendVerification
+              | otherwise -> withNtfStore (\st -> updateTknStatus st tkn NTRegistered) $ \_ -> sendVerification
+            where
+              sendVerification = do
                 atomically $ writeTBQueue pushQ (tkn, PNVerification tknRegCode)
                 incNtfStatT token ntfVrfQueued
                 pure $ NRTknId ntfTknId $ C.publicKey tknDhPrivKey
-              else pure $ NRErr AUTH
           TVFY code -- this allows repeated verification for cases when client connection dropped before server response
-            | (tknStatus == NTRegistered || tknStatus == NTConfirmed || tknStatus == NTActive) && tknRegCode == code -> do
+            | allowTokenVerification tknStatus && tknRegCode == code -> do
                 logDebug "TVFY - token verified"
                 withNtfStore (`setTokenActive` tkn) $ \_ -> NROk <$ incNtfStatT token tknVerified
             | otherwise -> do

tests/AgentTests/NotificationTests.hs

@@ -58,6 +58,7 @@ import qualified Data.Text as T
 import Data.Text.Encoding (encodeUtf8)
 import qualified Data.Text.IO as TIO
 import Data.Time.Clock.System (systemToUTCTime)
+import qualified Database.PostgreSQL.Simple as PSQL
 import NtfClient
 import SMPAgentClient (agentCfg, initAgentServers, initAgentServers2, testDB, testDB2, testNtfServer, testNtfServer2)
 import SMPClient (cfgMS, cfgJ2QS, cfgVPrev, ntfTestPort, ntfTestPort2, serverStoreConfig, testPort, testPort2, withSmpServer, withSmpServerConfigOn, withSmpServerStoreLogOn, withSmpServerStoreMsgLogOn, xit'')
@@ -74,6 +75,7 @@ import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Notifications.Protocol
 import Simplex.Messaging.Notifications.Server.Env (NtfServerConfig (..))
 import Simplex.Messaging.Notifications.Server.Push.APNS
+import Simplex.Messaging.Notifications.Server.Store.Postgres (closeNtfDbStore, newNtfDbStore, withDB')
 import Simplex.Messaging.Notifications.Types (NtfTknAction (..), NtfToken (..))
 import Simplex.Messaging.Parsers (parseAll)
 import Simplex.Messaging.Protocol (ErrorType (AUTH), MsgFlags (MsgFlags), NMsgMeta (..), NtfServer, ProtocolServer (..), SMPMsgMeta (..), SubscriptionMode (..))
@@ -122,12 +124,10 @@ notificationTests ps@(t, _) = do
     it "should keep working with active token until replaced" $
       withAPNSMockServer $ \apns ->
         testNtfTokenChangeServers t apns
-    -- TODO [ntfdb] modify database in the test
-    xit "should re-register token in NTInvalid status after register attempt" $
+    it "should re-register token in NTInvalid status after register attempt" $
       withAPNSMockServer $ \apns ->
         testNtfTokenReRegisterInvalid t apns
-    -- TODO [ntfdb] modify database in the test
-    xit "should re-register token in NTInvalid status after checking token" $
+    it "should re-register token in NTInvalid status after checking token" $
       withAPNSMockServer $ \apns ->
         testNtfTokenReRegisterInvalidOnCheck t apns
   describe "notification server tests" $ do
@@ -489,7 +489,9 @@ testNtfTokenReRegisterInvalid t apns = do
   withNtfServer t $ pure ()
 
   threadDelay 250000
-  replaceSubstringInFile ntfTestStoreLogFile "tokenStatus=ACTIVE" "tokenStatus=INVALID"
+  st <- newNtfDbStore ntfTestDBCfg
+  Right 1 <- withDB' "test" st $ \db -> PSQL.execute db "UPDATE tokens SET status = ? WHERE status = ?" (NTInvalid Nothing, NTActive)
+  closeNtfDbStore st
 
   threadDelay 250000
   withNtfServer t $ do
@@ -518,7 +520,9 @@ testNtfTokenReRegisterInvalidOnCheck t apns = do
   withNtfServer t $ pure ()
 
   threadDelay 250000
-  replaceSubstringInFile ntfTestStoreLogFile "tokenStatus=ACTIVE" "tokenStatus=INVALID"
+  st <- newNtfDbStore ntfTestDBCfg
+  Right 1 <- withDB' "test" st $ \db -> PSQL.execute db "UPDATE tokens SET status = ? WHERE status = ?" (NTInvalid Nothing, NTActive)
+  closeNtfDbStore st
 
   threadDelay 250000
   withNtfServer t $ do