mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-28 05:04:40 +00:00
ntf: register token with NotificationsMode (#429)
This commit is contained in:
JRoberts
@@ -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
|
||||
|
||||
@@ -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 ()
|
||||
|
||||
@@ -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,
|
||||
|
||||
@@ -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} =
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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;
|
||||
|]
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user