diff --git a/simplexmq.cabal b/simplexmq.cabal index 588f65696..318dd8dc9 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -49,6 +49,7 @@ library Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2 + Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode Simplex.Messaging.Client Simplex.Messaging.Client.Agent Simplex.Messaging.Crypto diff --git a/src/Simplex/Messaging/Agent.hs b/src/Simplex/Messaging/Agent.hs index 99090613d..c6dd94ce5 100644 --- a/src/Simplex/Messaging/Agent.hs +++ b/src/Simplex/Messaging/Agent.hs @@ -58,7 +58,6 @@ module Simplex.Messaging.Agent enableNtfCron, checkNtfToken, deleteNtfToken, - setNtfMode, getNtfMode, deleteNtfSub, setAgentPhase, @@ -191,8 +190,8 @@ setNtfServers :: AgentErrorMonad m => AgentClient -> [NtfServer] -> m () setNtfServers c = withAgentEnv c . setNtfServers' c -- | Register device notifications token -registerNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m NtfTknStatus -registerNtfToken c = withAgentEnv c . registerNtfToken' c +registerNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m NtfTknStatus +registerNtfToken c = withAgentEnv c .: registerNtfToken' c -- | Verify device notifications token verifyNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> ByteString -> C.CbNonce -> m () @@ -208,10 +207,7 @@ checkNtfToken c = withAgentEnv c . checkNtfToken' c deleteNtfToken :: AgentErrorMonad m => AgentClient -> DeviceToken -> m () deleteNtfToken c = withAgentEnv c . deleteNtfToken' c -setNtfMode :: AgentErrorMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m () -setNtfMode c = withAgentEnv c .: setNtfMode' c - -getNtfMode :: AgentErrorMonad m => AgentClient -> m (NtfTknStatus, NotificationsMode) +getNtfMode :: AgentErrorMonad m => AgentClient -> m (DeviceToken, NtfTknStatus, NotificationsMode) getNtfMode c = withAgentEnv c $ getNtfMode' c -- | Delete notification subscription for connection @@ -640,10 +636,10 @@ setSMPServers' :: AgentMonad m => AgentClient -> NonEmpty SMPServer -> m () setSMPServers' c servers = do atomically $ writeTVar (smpServers c) servers -registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> m NtfTknStatus -registerNtfToken' c deviceToken = +registerNtfToken' :: forall m. AgentMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m NtfTknStatus +registerNtfToken' c deviceToken ntfMode = withStore' c (`getDeviceNtfToken` deviceToken) >>= \case - (Just tkn@NtfToken {ntfTokenId, ntfTknStatus, ntfTknAction}, prevTokens) -> do + (Just tkn@NtfToken {ntfTokenId, ntfTknStatus, ntfTknAction, ntfMode = _currentNtfMode}, prevTokens) -> do mapM_ (deleteToken_ c) prevTokens ns <- asks ntfSupervisor case (ntfTokenId, ntfTknAction) of @@ -655,7 +651,7 @@ registerNtfToken' c deviceToken = (Just tknId, Just (NTACron interval)) -> t tkn (cronSuccess interval) $ agentNtfEnableCron c tknId tkn interval (Just _tknId, Just NTACheck) -> do - if ntfTknStatus == NTActive + if ntfTknStatus == NTActive && ntfMode == NMInstant then initializeNtfSubQ c tkn else atomically $ nsUpdateToken ns tkn pure ntfTknStatus -- TODO @@ -673,7 +669,7 @@ registerNtfToken' c deviceToken = C.SignAlg a -> do tknKeys <- liftIO $ C.generateSignatureKeyPair a dhKeys <- liftIO C.generateKeyPair' - let tkn = newNtfToken deviceToken ntfServer tknKeys dhKeys + let tkn = newNtfToken deviceToken ntfServer tknKeys dhKeys ntfMode withStore' c (`createNtfToken` tkn) registerToken tkn pure NTRegistered @@ -724,10 +720,7 @@ deleteNtfToken' c deviceToken = (Just tkn, _) -> deleteToken_ c tkn _ -> throwError $ CMD PROHIBITED -setNtfMode' :: AgentMonad m => AgentClient -> DeviceToken -> NotificationsMode -> m () -setNtfMode' _c _deviceToken _ntfMode = throwError $ CMD PROHIBITED - -getNtfMode' :: AgentMonad m => AgentClient -> m (NtfTknStatus, NotificationsMode) +getNtfMode' :: AgentMonad m => AgentClient -> m (DeviceToken, NtfTknStatus, NotificationsMode) getNtfMode' _c = throwError $ CMD PROHIBITED -- | Delete notification subscription for connection, in Reader monad @@ -750,7 +743,7 @@ deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do atomically $ nsRemoveNtfToken ns withToken :: AgentMonad m => AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> m a -> m NtfTknStatus -withToken c tkn@NtfToken {deviceToken} from_ (toStatus, toAction_) f = do +withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f = do ns <- asks ntfSupervisor forM_ from_ $ \(status, action) -> do withStore' c $ \db -> updateNtfToken db tkn status (Just action) @@ -759,14 +752,14 @@ withToken c tkn@NtfToken {deviceToken} from_ (toStatus, toAction_) f = do Right _ -> do withStore' c $ \db -> updateNtfToken db tkn toStatus toAction_ let updatedToken = tkn {ntfTknStatus = toStatus, ntfTknAction = toAction_} - if toStatus == NTActive + if toStatus == NTActive && ntfMode == NMInstant then initializeNtfSubQ c updatedToken else atomically $ nsUpdateToken ns updatedToken pure toStatus Left e@(NTF AUTH) -> do withStore' c $ \db -> removeNtfToken db tkn atomically $ nsRemoveNtfToken ns - void $ registerNtfToken' c deviceToken + void $ registerNtfToken' c deviceToken ntfMode throwError e Left e -> throwError e @@ -780,7 +773,7 @@ initializeNtfSubQ c tkn = do -- TODO -- There should probably be another function to cancel all subscriptions that would flush the queue first, --- so that superwisor stops processing pending commands? +-- so that supervisor stops processing pending commands? -- It is an optimization, but I am thinking how it would behave if a user were to flip on/off quickly several times. setNtfServers' :: AgentMonad m => AgentClient -> [NtfServer] -> m () diff --git a/src/Simplex/Messaging/Agent/Protocol.hs b/src/Simplex/Messaging/Agent/Protocol.hs index 03077e020..9a54f044c 100644 --- a/src/Simplex/Messaging/Agent/Protocol.hs +++ b/src/Simplex/Messaging/Agent/Protocol.hs @@ -125,6 +125,8 @@ import Data.Time.Clock.System (SystemTime) import Data.Time.ISO8601 import Data.Type.Equality import Data.Typeable () +import Database.SQLite.Simple.FromField +import Database.SQLite.Simple.ToField import GHC.Generics (Generic) import Generic.Random (genericArbitraryU) import Simplex.Messaging.Agent.QueryString @@ -281,6 +283,10 @@ instance ToJSON NotificationsMode where toEncoding = strToJEncoding toJSON = strToJSON +instance ToField NotificationsMode where toField = toField . strEncode + +instance FromField NotificationsMode where fromField = blobFieldDecoder $ parseAll strP + data NotificationInfo = NotificationInfo { ntfConnId :: ConnId, ntfTs :: SystemTime, diff --git a/src/Simplex/Messaging/Agent/Store/SQLite.hs b/src/Simplex/Messaging/Agent/Store/SQLite.hs index cabb883c3..e7dbb257a 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite.hs @@ -69,6 +69,7 @@ module Simplex.Messaging.Agent.Store.SQLite getDeviceNtfToken, updateNtfTokenRegistration, updateNtfToken, + setNtfTokenNtfMode, removeNtfToken, -- Notification subscription persistence getNtfSubscription, @@ -623,15 +624,15 @@ updateRatchet db connId rc skipped = do DB.execute db "INSERT INTO skipped_messages (conn_id, header_key, msg_n, msg_key) VALUES (?, ?, ?, ?)" (connId, hk, msgN, mk) createNtfToken :: DB.Connection -> NtfToken -> IO () -createNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction} = do +createNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do upsertNtfServer_ db srv DB.execute db [sql| INSERT INTO ntf_tokens - (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_pub_key, tkn_priv_key, tkn_pub_dh_key, tkn_priv_dh_key, tkn_dh_secret, tkn_status, tkn_action) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) + (provider, device_token, ntf_host, ntf_port, tkn_id, tkn_pub_key, tkn_priv_key, tkn_pub_dh_key, tkn_priv_dh_key, tkn_dh_secret, tkn_status, tkn_action, ntf_mode) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?) |] - (provider, token, host, port, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction) + ((provider, token, host, port, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode)) getDeviceNtfToken :: DB.Connection -> DeviceToken -> IO (Maybe NtfToken, [NtfToken]) getDeviceNtfToken db t = do @@ -641,16 +642,18 @@ getDeviceNtfToken db t = do db [sql| SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash, - t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action + t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret, + t.tkn_status, t.tkn_action, t.ntf_mode FROM ntf_tokens t JOIN ntf_servers s USING (ntf_host, ntf_port) |] pure . first listToMaybe $ partition ((t ==) . deviceToken) tokens where - ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)) = + ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) = let ntfServer = ProtocolServer {host, port, keyHash} ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey) - in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction} + ntfMode = fromMaybe NMOff ntfMode_ + in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} updateNtfTokenRegistration :: DB.Connection -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> IO () updateNtfTokenRegistration db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do @@ -676,6 +679,18 @@ updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer |] (tknStatus, tknAction, updatedAt, provider, token, host, port) +setNtfTokenNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO () +setNtfTokenNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do + updatedAt <- getCurrentTime + DB.execute + db + [sql| + UPDATE ntf_tokens + SET ntf_mode = ?, updated_at = ? + WHERE provider = ? AND device_token = ? AND ntf_host = ? AND ntf_port = ? + |] + (ntfMode, updatedAt, provider, token, host, port) + removeNtfToken :: DB.Connection -> NtfToken -> IO () removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} = DB.execute @@ -846,17 +861,19 @@ getActiveNtfToken db = db [sql| SELECT s.ntf_host, s.ntf_port, s.ntf_key_hash, - t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret, t.tkn_status, t.tkn_action + t.provider, t.device_token, t.tkn_id, t.tkn_pub_key, t.tkn_priv_key, t.tkn_pub_dh_key, t.tkn_priv_dh_key, t.tkn_dh_secret, + t.tkn_status, t.tkn_action, t.ntf_mode FROM ntf_tokens t JOIN ntf_servers s USING (ntf_host, ntf_port) WHERE t.tkn_status = ? |] (Only NTActive) where - ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret, ntfTknStatus, ntfTknAction)) = + ntfToken ((host, port, keyHash) :. (provider, dt, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhPubKey, ntfDhPrivKey, ntfDhSecret) :. (ntfTknStatus, ntfTknAction, ntfMode_)) = let ntfServer = ProtocolServer {host, port, keyHash} ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey) - in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction} + ntfMode = fromMaybe NMOff ntfMode_ + in NtfToken {deviceToken = DeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, RcvNtfDhSecret)) getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} = diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs index 83a660edc..6b3061792 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs @@ -28,6 +28,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220101_initial import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220301_snd_queue_keys import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220322_notifications import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220608_v2 +import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode data Migration = Migration {name :: String, up :: Text} deriving (Show) @@ -37,7 +38,8 @@ schemaMigrations = [ ("20220101_initial", m20220101_initial), ("20220301_snd_queue_keys", m20220301_snd_queue_keys), ("20220322_notifications", m20220322_notifications), - ("20220607_v2", m20220608_v2) + ("20220607_v2", m20220608_v2), + ("m20220625_v2_ntf_mode", m20220625_v2_ntf_mode) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220625_v2_ntf_mode.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220625_v2_ntf_mode.hs new file mode 100644 index 000000000..1ba921be8 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20220625_v2_ntf_mode.hs @@ -0,0 +1,12 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20220625_v2_ntf_mode where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20220625_v2_ntf_mode :: Query +m20220625_v2_ntf_mode = + [sql| +ALTER TABLE ntf_tokens ADD COLUMN ntf_mode TEXT NULL; +|] diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql index 5a4436e8b..daf7cd724 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql @@ -164,7 +164,8 @@ tkn_dh_secret BLOB, -- DH secret for e2e encryption of notifications tkn_status TEXT NOT NULL, tkn_action BLOB, created_at TEXT NOT NULL DEFAULT(datetime('now')), - updated_at TEXT NOT NULL DEFAULT(datetime('now')), -- this is to check token status periodically to know when it was last checked + updated_at TEXT NOT NULL DEFAULT(datetime('now')), + ntf_mode TEXT NULL, -- this is to check token status periodically to know when it was last checked PRIMARY KEY(provider, device_token, ntf_host, ntf_port), FOREIGN KEY(ntf_host, ntf_port) REFERENCES ntf_servers ON DELETE RESTRICT ON UPDATE CASCADE diff --git a/src/Simplex/Messaging/Notifications/Client.hs b/src/Simplex/Messaging/Notifications/Client.hs index 1ac72f590..d73abdfb1 100644 --- a/src/Simplex/Messaging/Notifications/Client.hs +++ b/src/Simplex/Messaging/Notifications/Client.hs @@ -15,7 +15,7 @@ import Data.Time (UTCTime) import Data.Word (Word16) import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) -import Simplex.Messaging.Agent.Protocol (ConnId) +import Simplex.Messaging.Agent.Protocol (ConnId, NotificationsMode (..)) import Simplex.Messaging.Client import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding @@ -119,12 +119,13 @@ data NtfToken = NtfToken -- | token status ntfTknStatus :: NtfTknStatus, -- | pending token action and the earliest time - ntfTknAction :: Maybe NtfTknAction + ntfTknAction :: Maybe NtfTknAction, + ntfMode :: NotificationsMode } deriving (Show) -newNtfToken :: DeviceToken -> NtfServer -> C.ASignatureKeyPair -> C.KeyPair 'C.X25519 -> NtfToken -newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys = +newNtfToken :: DeviceToken -> NtfServer -> C.ASignatureKeyPair -> C.KeyPair 'C.X25519 -> NotificationsMode -> NtfToken +newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys ntfMode = NtfToken { deviceToken, ntfServer, @@ -134,7 +135,8 @@ newNtfToken deviceToken ntfServer (ntfPubKey, ntfPrivKey) ntfDhKeys = ntfDhKeys, ntfDhSecret = Nothing, ntfTknStatus = NTNew, - ntfTknAction = Just NTARegister + ntfTknAction = Just NTARegister, + ntfMode } data NtfSubOrSMPAction = NtfSubAction NtfSubAction | NtfSubSMPAction NtfSubSMPAction diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index f138b1308..99ca7d8e5 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -66,7 +66,7 @@ testNotificationToken APNSMockServer {apnsQ} = do a <- getSMPAgentClient agentCfg initAgentServers Right () <- runExceptT $ do let tkn = DeviceToken PPApns "abcd" - NTRegistered <- registerNtfToken a tkn + NTRegistered <- registerNtfToken a tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ verification <- ntfData .-> "verification" @@ -96,13 +96,13 @@ testNtfTokenRepeatRegistration APNSMockServer {apnsQ} = do a <- getSMPAgentClient agentCfg initAgentServers Right () <- runExceptT $ do let tkn = DeviceToken PPApns "abcd" - NTRegistered <- registerNtfToken a tkn + NTRegistered <- registerNtfToken a tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ verification <- ntfData .-> "verification" nonce <- C.cbNonce <$> ntfData .-> "nonce" liftIO $ sendApnsResponse APNSRespOk - NTRegistered <- registerNtfToken a tkn + NTRegistered <- registerNtfToken a tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <- atomically $ readTBQueue apnsQ _ <- ntfData' .-> "verification" @@ -123,7 +123,7 @@ testNtfTokenSecondRegistration APNSMockServer {apnsQ} = do a' <- getSMPAgentClient agentCfg {dbFile = testDB2} initAgentServers Right () <- runExceptT $ do let tkn = DeviceToken PPApns "abcd" - NTRegistered <- registerNtfToken a tkn + NTRegistered <- registerNtfToken a tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ verification <- ntfData .-> "verification" @@ -131,7 +131,7 @@ testNtfTokenSecondRegistration APNSMockServer {apnsQ} = do liftIO $ sendApnsResponse APNSRespOk verifyNtfToken a tkn verification nonce - NTRegistered <- registerNtfToken a' tkn + NTRegistered <- registerNtfToken a' tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <- atomically $ readTBQueue apnsQ verification' <- ntfData' .-> "verification" @@ -158,7 +158,7 @@ testNtfTokenServerRestart t APNSMockServer {apnsQ} = do a <- getSMPAgentClient agentCfg initAgentServers let tkn = DeviceToken PPApns "abcd" Right ntfData <- withNtfServer t . runExceptT $ do - NTRegistered <- registerNtfToken a tkn + NTRegistered <- registerNtfToken a tkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ liftIO $ sendApnsResponse APNSRespOk @@ -198,7 +198,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} = do get bob ##> ("", aliceId, CON) -- register notification token let tkn = DeviceToken PPApns "abcd" - NTRegistered <- registerNtfToken alice tkn + NTRegistered <- registerNtfToken alice tkn NMInstant APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ verification <- ntfData .-> "verification" @@ -248,7 +248,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} = do Right () <- runExceptT $ do -- alice registers notification token let aliceTkn = DeviceToken PPApns "abcd" - NTRegistered <- registerNtfToken alice aliceTkn + NTRegistered <- registerNtfToken alice aliceTkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}, sendApnsResponse} <- atomically $ readTBQueue apnsQ verification <- ntfData .-> "verification" @@ -258,7 +258,7 @@ testNotificationSubscriptionNewConnection APNSMockServer {apnsQ} = do NTActive <- checkNtfToken alice aliceTkn -- bob registers notification token let bobTkn = DeviceToken PPApns "bcde" - NTRegistered <- registerNtfToken bob bobTkn + NTRegistered <- registerNtfToken bob bobTkn NMPeriodic APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}, sendApnsResponse = sendApnsResponse'} <- atomically $ readTBQueue apnsQ verification' <- ntfData' .-> "verification"