mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-06-04 10:51:27 +00:00
agent: aggregate multiple expired subscription responses into a single UP event (#1160)
* agent: aggregate multiple expired subscription responses into a single UP event * clean up * refactor processing of expired responses * refactor * refactor 2 * refactor unexpectedResponse
This commit is contained in:
committed by
GitHub
parent
7a15ea59c9
commit
8b21f7ef2a
@@ -12,7 +12,6 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Notifications.Protocol
|
||||
import Simplex.Messaging.Notifications.Transport (NTFVersion, supportedClientNTFVRange, supportedNTFHandshakes)
|
||||
import Simplex.Messaging.Protocol (ErrorType)
|
||||
import Simplex.Messaging.Util (bshow)
|
||||
|
||||
type NtfClient = ProtocolClient NTFVersion ErrorType NtfResponse
|
||||
|
||||
@@ -25,7 +24,7 @@ ntfRegisterToken :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Token -> Exc
|
||||
ntfRegisterToken c pKey newTkn =
|
||||
sendNtfCommand c (Just pKey) "" (TNEW newTkn) >>= \case
|
||||
NRTknId tknId dhKey -> pure (tknId, dhKey)
|
||||
r -> throwE . PCEUnexpectedResponse $ bshow r
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
ntfVerifyToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> NtfRegCode -> ExceptT NtfClientError IO ()
|
||||
ntfVerifyToken c pKey tknId code = okNtfCommand (TVFY code) c pKey tknId
|
||||
@@ -34,7 +33,7 @@ ntfCheckToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> ExceptT NtfClie
|
||||
ntfCheckToken c pKey tknId =
|
||||
sendNtfCommand c (Just pKey) tknId TCHK >>= \case
|
||||
NRTkn stat -> pure stat
|
||||
r -> throwE . PCEUnexpectedResponse $ bshow r
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
ntfReplaceToken :: NtfClient -> C.APrivateAuthKey -> NtfTokenId -> DeviceToken -> ExceptT NtfClientError IO ()
|
||||
ntfReplaceToken c pKey tknId token = okNtfCommand (TRPL token) c pKey tknId
|
||||
@@ -49,13 +48,13 @@ ntfCreateSubscription :: NtfClient -> C.APrivateAuthKey -> NewNtfEntity 'Subscri
|
||||
ntfCreateSubscription c pKey newSub =
|
||||
sendNtfCommand c (Just pKey) "" (SNEW newSub) >>= \case
|
||||
NRSubId subId -> pure subId
|
||||
r -> throwE . PCEUnexpectedResponse $ bshow r
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
ntfCheckSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO NtfSubStatus
|
||||
ntfCheckSubscription c pKey subId =
|
||||
sendNtfCommand c (Just pKey) subId SCHK >>= \case
|
||||
NRSub stat -> pure stat
|
||||
r -> throwE . PCEUnexpectedResponse $ bshow r
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
ntfDeleteSubscription :: NtfClient -> C.APrivateAuthKey -> NtfSubscriptionId -> ExceptT NtfClientError IO ()
|
||||
ntfDeleteSubscription = okNtfCommand SDEL
|
||||
@@ -68,4 +67,4 @@ okNtfCommand :: NtfEntityI e => NtfCommand e -> NtfClient -> C.APrivateAuthKey -
|
||||
okNtfCommand cmd c pKey entId =
|
||||
sendNtfCommand c (Just pKey) entId cmd >>= \case
|
||||
NROk -> return ()
|
||||
r -> throwE . PCEUnexpectedResponse $ bshow r
|
||||
r -> throwE $ unexpectedResponse r
|
||||
|
||||
@@ -31,7 +31,7 @@ import Data.Time.Clock (UTCTime (..), diffTimeToPicoseconds, getCurrentTime)
|
||||
import Data.Time.Clock.System (getSystemTime)
|
||||
import Data.Time.Format.ISO8601 (iso8601Show)
|
||||
import Network.Socket (ServiceName)
|
||||
import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError)
|
||||
import Simplex.Messaging.Client (ProtocolClientError (..), SMPClientError, ServerTransmission (..))
|
||||
import Simplex.Messaging.Client.Agent
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding.String
|
||||
@@ -220,23 +220,27 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
|
||||
|
||||
receiveSMP :: M ()
|
||||
receiveSMP = forever $ do
|
||||
((_, srv, _), _, _, _tType, ntfId, msgOrErr) <- atomically $ readTBQueue msgQ
|
||||
let smpQueue = SMPQueueNtf srv ntfId
|
||||
case msgOrErr of
|
||||
Right (SMP.NMSG nmsgNonce encNMsgMeta) -> do
|
||||
ntfTs <- liftIO getSystemTime
|
||||
st <- asks store
|
||||
NtfPushServer {pushQ} <- asks pushServer
|
||||
stats <- asks serverStats
|
||||
atomically $ updatePeriodStats (activeSubs stats) ntfId
|
||||
atomically $
|
||||
findNtfSubscriptionToken st smpQueue
|
||||
>>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
|
||||
incNtfStat ntfReceived
|
||||
Right SMP.END -> updateSubStatus smpQueue NSEnd
|
||||
Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
|
||||
Right _ -> logError $ "SMP server unexpected response"
|
||||
Left e -> logError $ "SMP client error: " <> tshow e
|
||||
((_, srv, _), _, _, ts) <- atomically $ readTBQueue msgQ
|
||||
forM ts $ \(ntfId, t) -> case t of
|
||||
STUnexpectedError e -> logError $ "SMP client unexpected error: " <> tshow e -- uncorrelated response, should not happen
|
||||
STResponse {} -> pure () -- it was already reported as timeout error
|
||||
STEvent msgOrErr -> do
|
||||
let smpQueue = SMPQueueNtf srv ntfId
|
||||
case msgOrErr of
|
||||
Right (SMP.NMSG nmsgNonce encNMsgMeta) -> do
|
||||
ntfTs <- liftIO getSystemTime
|
||||
st <- asks store
|
||||
NtfPushServer {pushQ} <- asks pushServer
|
||||
stats <- asks serverStats
|
||||
atomically $ updatePeriodStats (activeSubs stats) ntfId
|
||||
atomically $
|
||||
findNtfSubscriptionToken st smpQueue
|
||||
>>= mapM_ (\tkn -> writeTBQueue pushQ (tkn, PNMessage PNMessageData {smpQueue, ntfTs, nmsgNonce, encNMsgMeta}))
|
||||
incNtfStat ntfReceived
|
||||
Right SMP.END -> updateSubStatus smpQueue NSEnd
|
||||
Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
|
||||
Right _ -> logError $ "SMP server unexpected response"
|
||||
Left e -> logError $ "SMP client error: " <> tshow e
|
||||
|
||||
receiveAgent =
|
||||
forever $
|
||||
@@ -248,7 +252,6 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
|
||||
forM_ subs $ \(_, ntfId) -> do
|
||||
let smpQueue = SMPQueueNtf srv ntfId
|
||||
updateSubStatus smpQueue NSInactive
|
||||
|
||||
CAResubscribed srv subs -> do
|
||||
forM_ subs $ \(_, ntfId) -> updateSubStatus (SMPQueueNtf srv ntfId) NSActive
|
||||
logSubStatus srv "resubscribed" $ length subs
|
||||
|
||||
Reference in New Issue
Block a user