mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-31 05:25:49 +00:00
WIP: add test to check webpush requests from ntf server
This commit is contained in:
sim
@@ -217,11 +217,11 @@ runNtfTestCfg (t, msType) baseId smpCfg ntfCfg' aCfg bCfg runTest = do
|
||||
threadDelay 100000
|
||||
|
||||
testNotificationToken :: APNSMockServer -> IO ()
|
||||
testNotificationToken apns = do
|
||||
testNotificationToken (APNSMockServer apns) = do
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -241,16 +241,16 @@ v .-> key = do
|
||||
-- logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
|
||||
|
||||
testNtfTokenRepeatRegistration :: APNSMockServer -> IO ()
|
||||
testNtfTokenRepeatRegistration apns = do
|
||||
testNtfTokenRepeatRegistration (APNSMockServer apns) = do
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a -> runRight_ $ do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
getMockNotification apns tkn
|
||||
_ <- ntfData' .-> "verification"
|
||||
_ <- C.cbNonce <$> ntfData' .-> "nonce"
|
||||
@@ -260,18 +260,18 @@ testNtfTokenRepeatRegistration apns = do
|
||||
pure ()
|
||||
|
||||
testNtfTokenSecondRegistration :: APNSMockServer -> IO ()
|
||||
testNtfTokenSecondRegistration apns =
|
||||
testNtfTokenSecondRegistration (APNSMockServer apns) =
|
||||
withAgentClients2 $ \a a' -> runRight_ $ do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
verifyNtfToken a tkn nonce verification
|
||||
|
||||
NTRegistered <- registerNtfToken a' tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
getMockNotification apns tkn
|
||||
verification' <- ntfData' .-> "verification"
|
||||
nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
|
||||
@@ -290,12 +290,12 @@ testNtfTokenSecondRegistration apns =
|
||||
pure ()
|
||||
|
||||
testNtfTokenServerRestart :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenServerRestart t apns = do
|
||||
testNtfTokenServerRestart t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
ntfData <- withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
withNtfServer t $ runRight $ do
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
pure ntfData
|
||||
-- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
|
||||
@@ -311,12 +311,12 @@ testNtfTokenServerRestart t apns = do
|
||||
pure ()
|
||||
|
||||
testNtfTokenServerRestartReverify :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenServerRestartReverify t apns = do
|
||||
testNtfTokenServerRestartReverify t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a -> do
|
||||
ntfData <- withNtfServer t $ runRight $ do
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
pure ntfData
|
||||
runRight_ $ do
|
||||
@@ -334,12 +334,12 @@ testNtfTokenServerRestartReverify t apns = do
|
||||
pure ()
|
||||
|
||||
testNtfTokenServerRestartReverifyTimeout :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenServerRestartReverifyTimeout t apns = do
|
||||
testNtfTokenServerRestartReverifyTimeout t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
|
||||
(nonce, verification) <- withNtfServer t $ runRight $ do
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -369,12 +369,12 @@ testNtfTokenServerRestartReverifyTimeout t apns = do
|
||||
pure ()
|
||||
|
||||
testNtfTokenServerRestartReregister :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenServerRestartReregister t apns = do
|
||||
testNtfTokenServerRestartReregister t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a ->
|
||||
withNtfServer t $ runRight $ do
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
|
||||
getMockNotification apns tkn
|
||||
pure ()
|
||||
-- the new agent is created as otherwise when running the tests in CI the old agent was keeping the connection to the server
|
||||
@@ -384,7 +384,7 @@ testNtfTokenServerRestartReregister t apns = do
|
||||
-- so that repeat registration happens when client is restarted.
|
||||
withNtfServer t $ runRight_ $ do
|
||||
NTRegistered <- registerNtfToken a' tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -393,12 +393,12 @@ testNtfTokenServerRestartReregister t apns = do
|
||||
pure ()
|
||||
|
||||
testNtfTokenServerRestartReregisterTimeout :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenServerRestartReregisterTimeout t apns = do
|
||||
testNtfTokenServerRestartReregisterTimeout t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAgent 1 agentCfg initAgentServers testDB $ \a@AgentClient {agentEnv = Env {store}} -> do
|
||||
withNtfServer t $ runRight $ do
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just _}} <-
|
||||
getMockNotification apns tkn
|
||||
pure ()
|
||||
-- this emulates the situation when server registered token but the client did not receive the response
|
||||
@@ -419,7 +419,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do
|
||||
-- so that repeat registration happens when client is restarted.
|
||||
withNtfServer t $ runRight_ $ do
|
||||
NTRegistered <- registerNtfToken a' tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -434,14 +434,14 @@ getTestNtfTokenPort a =
|
||||
Nothing -> error "no active NtfToken"
|
||||
|
||||
testNtfTokenMultipleServers :: ASrvTransport -> APNSMockServer -> IO ()
|
||||
testNtfTokenMultipleServers t apns = do
|
||||
testNtfTokenMultipleServers t (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAgent 1 agentCfg initAgentServers2 testDB $ \a ->
|
||||
withNtfServerThreadOn t ntfTestPort ntfTestDBCfg $ \ntf ->
|
||||
withNtfServerThreadOn t ntfTestPort2 ntfTestDBCfg2 $ \ntf2 -> runRight_ $ do
|
||||
-- register a new token, the agent picks a server and stores its choice
|
||||
NTRegistered <- registerNtfToken a tkn NMPeriodic
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -544,7 +544,7 @@ testRunNTFServerTests t srv =
|
||||
testProtocolServer a NRMInteractive 1 $ ProtoServerWithAuth srv Nothing
|
||||
|
||||
testNotificationSubscriptionExistingConnection :: APNSMockServer -> AgentMsgId -> AgentClient -> AgentClient -> IO ()
|
||||
testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
|
||||
testNotificationSubscriptionExistingConnection (APNSMockServer apns) baseId alice@AgentClient {agentEnv = Env {config = aliceCfg, store}} bob = do
|
||||
(bobId, aliceId, nonce, message) <- runRight $ do
|
||||
-- establish connection
|
||||
(bobId, qInfo) <- createConnection alice 1 True SCMInvitation Nothing SMSubscribe
|
||||
@@ -557,7 +557,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
|
||||
-- register notification token
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
NTRegistered <- registerNtfToken alice tkn NMInstant
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
verification <- ntfData .-> "verification"
|
||||
vNonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
@@ -567,7 +567,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
|
||||
1 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello"
|
||||
get bob ##> ("", aliceId, SENT $ baseId + 1)
|
||||
-- notification
|
||||
(nonce, message) <- messageNotification apns tkn
|
||||
(nonce, message) <- messageNotification (APNSMockServer apns) tkn
|
||||
pure (bobId, aliceId, nonce, message)
|
||||
|
||||
Right [NotificationInfo {ntfConnId = cId, ntfMsgMeta = Just NMsgMeta {msgTs}}] <- runExceptT $ getNotificationConns alice nonce message
|
||||
@@ -600,7 +600,7 @@ testNotificationSubscriptionExistingConnection apns baseId alice@AgentClient {ag
|
||||
2 <- msgId <$> sendMessage bob aliceId (SMP.MsgFlags True) "hello again"
|
||||
get bob ##> ("", aliceId, SENT $ baseId + 2)
|
||||
-- no notifications should follow
|
||||
noNotification alice apns
|
||||
noNotification alice $ APNSMockServer apns
|
||||
where
|
||||
msgId = subtract baseId
|
||||
|
||||
@@ -645,10 +645,10 @@ testNotificationSubscriptionNewConnection apns baseId alice bob =
|
||||
msgId = subtract baseId
|
||||
|
||||
registerTestToken :: AgentClient -> ByteString -> NotificationsMode -> APNSMockServer -> ExceptT AgentErrorType IO DeviceToken
|
||||
registerTestToken a token mode apns = do
|
||||
registerTestToken a token mode (APNSMockServer apns) = do
|
||||
let tkn = APNSDeviceToken PPApnsTest token
|
||||
NTRegistered <- registerNtfToken a tkn mode
|
||||
Just APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
Just PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData'}} <-
|
||||
timeout 1000000 $ getMockNotification apns tkn
|
||||
verification' <- ntfData' .-> "verification"
|
||||
nonce' <- C.cbNonce <$> ntfData' .-> "nonce"
|
||||
@@ -1032,10 +1032,10 @@ testMessage_ apns a aId b bId msg = do
|
||||
ackMessage a bId msgId Nothing
|
||||
|
||||
messageNotification :: HasCallStack => APNSMockServer -> DeviceToken -> ExceptT AgentErrorType IO (C.CbNonce, ByteString)
|
||||
messageNotification apns tkn = do
|
||||
messageNotification (APNSMockServer apns) tkn = do
|
||||
500000 `timeout` getMockNotification apns tkn >>= \case
|
||||
Nothing -> error "no notification"
|
||||
Just APNSMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
|
||||
Just PushMockRequest {notification = APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData}} -> do
|
||||
nonce <- C.cbNonce <$> ntfData .-> "nonce"
|
||||
message <- ntfData .-> "message"
|
||||
pure (nonce, message)
|
||||
@@ -1049,14 +1049,14 @@ messageNotificationData c apns = do
|
||||
pure $ L.last pnMsgs
|
||||
|
||||
noNotification :: AgentClient -> APNSMockServer -> ExceptT AgentErrorType IO ()
|
||||
noNotification c apns = do
|
||||
noNotification c (APNSMockServer apns) = do
|
||||
NtfToken {deviceToken} <- getNtfTokenData c
|
||||
500000 `timeout` getMockNotification apns deviceToken >>= \case
|
||||
Nothing -> pure ()
|
||||
_ -> error "unexpected notification"
|
||||
|
||||
noNotifications :: APNSMockServer -> ExceptT AgentErrorType IO ()
|
||||
noNotifications apns = do
|
||||
noNotifications (APNSMockServer apns) = do
|
||||
500000 `timeout` getAnyMockNotification apns >>= \case
|
||||
Nothing -> pure ()
|
||||
_ -> error "unexpected notification"
|
||||
|
||||
@@ -22,15 +22,19 @@ import Control.Monad.Except (runExceptT)
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..), (.:))
|
||||
import qualified Data.Aeson as J
|
||||
import Data.Aeson.Types ((.=))
|
||||
import qualified Data.Aeson.Types as JT
|
||||
import Data.ByteString.Builder (lazyByteString)
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.Map.Strict as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo)
|
||||
import GHC.Generics (Generic)
|
||||
import qualified Network.HPACK as H
|
||||
import qualified Network.HPACK.Token as H
|
||||
import Network.HTTP.Types (Status)
|
||||
import qualified Network.HTTP.Types as N
|
||||
import qualified Network.HTTP2.Server as H
|
||||
@@ -42,7 +46,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..), chooseTransportHost,
|
||||
import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse)
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfResponse, WPTokenParams (..))
|
||||
import Simplex.Messaging.Notifications.Server (runNtfServerBlocking)
|
||||
import Simplex.Messaging.Notifications.Server.Env
|
||||
import Simplex.Messaging.Notifications.Server.Main (getVapidKey)
|
||||
@@ -70,6 +74,9 @@ testHost = "localhost"
|
||||
apnsTestPort :: ServiceName
|
||||
apnsTestPort = "6010"
|
||||
|
||||
wpTestPort :: ServiceName
|
||||
wpTestPort = "6011"
|
||||
|
||||
testKeyHash :: C.KeyHash
|
||||
testKeyHash = "LcJUMfVhwD8yxjAiSaDzzGF3-kLG4Uh0Fl_ZIjrRwjI="
|
||||
|
||||
@@ -224,23 +231,34 @@ ntfServerTest _ t = runNtfTest $ \h -> tPut' h t >> tGet' h
|
||||
ntfTest :: Transport c => TProxy c 'TServer -> (THandleNTF c 'TClient -> IO ()) -> Expectation
|
||||
ntfTest _ test' = runNtfTest test' `shouldReturn` ()
|
||||
|
||||
data APNSMockRequest = APNSMockRequest
|
||||
{ notification :: APNSNotification
|
||||
data PushMockRequest a = PushMockRequest
|
||||
{ notification :: a
|
||||
}
|
||||
|
||||
data APNSMockResponse = APNSRespOk | APNSRespError Status Text
|
||||
data PushMockResponse = PushRespOk | PushRespError Status Text
|
||||
|
||||
data APNSMockServer = APNSMockServer
|
||||
data PushMockServer a = PushMockServer
|
||||
{ action :: Async (),
|
||||
notifications :: TM.TMap ByteString (TBQueue APNSMockRequest),
|
||||
notifications :: TM.TMap ByteString (TBQueue (PushMockRequest a)),
|
||||
http2Server :: HTTP2Server
|
||||
}
|
||||
|
||||
apnsMockServerConfig :: HTTP2ServerConfig
|
||||
apnsMockServerConfig =
|
||||
data WPNotification = WPNotification
|
||||
{ authorization :: Maybe ByteString,
|
||||
encoding :: Maybe ByteString,
|
||||
ttl :: Maybe ByteString,
|
||||
urgency :: Maybe ByteString,
|
||||
body :: ByteString
|
||||
}
|
||||
|
||||
newtype APNSMockServer = APNSMockServer (PushMockServer APNSNotification)
|
||||
newtype WPMockServer = WPMockServer (PushMockServer WPNotification)
|
||||
|
||||
pushMockServerConfig :: ServiceName -> HTTP2ServerConfig
|
||||
pushMockServerConfig port =
|
||||
HTTP2ServerConfig
|
||||
{ qSize = 2,
|
||||
http2Port = apnsTestPort,
|
||||
http2Port = port,
|
||||
bufferSize = 16384,
|
||||
bodyHeadSize = 16384,
|
||||
serverSupported = http2TLSParams,
|
||||
@@ -254,7 +272,14 @@ apnsMockServerConfig =
|
||||
}
|
||||
|
||||
withAPNSMockServer :: (APNSMockServer -> IO a) -> IO a
|
||||
withAPNSMockServer = E.bracket (getAPNSMockServer apnsMockServerConfig) closeAPNSMockServer
|
||||
withAPNSMockServer = E.bracket (getAPNSMockServer $ pushMockServerConfig apnsTestPort) closeAPNSMockServer
|
||||
where
|
||||
closeAPNSMockServer (APNSMockServer a) = closePushMockServer a
|
||||
|
||||
withWPMockServer :: (WPMockServer -> IO a) -> IO a
|
||||
withWPMockServer = E.bracket (getWPMockServer $ pushMockServerConfig wpTestPort) closeWPMockServer
|
||||
where
|
||||
closeWPMockServer (WPMockServer a) = closePushMockServer a
|
||||
|
||||
deriving instance Generic APNSAlertBody
|
||||
|
||||
@@ -284,36 +309,63 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do
|
||||
http2Server <- getHTTP2Server config
|
||||
notifications <- TM.emptyIO
|
||||
action <- async $ runAPNSMockServer notifications http2Server
|
||||
pure APNSMockServer {action, notifications, http2Server}
|
||||
pure $ APNSMockServer PushMockServer {action, notifications, http2Server}
|
||||
where
|
||||
runAPNSMockServer notifications HTTP2Server {reqQ} = forever $ do
|
||||
HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
|
||||
let sendApnsResponse = \case
|
||||
APNSRespOk -> sendResponse $ H.responseNoBody N.ok200 []
|
||||
APNSRespError status reason ->
|
||||
PushRespOk -> sendResponse $ H.responseNoBody N.ok200 []
|
||||
PushRespError status reason ->
|
||||
sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode APNSErrorResponse {reason}
|
||||
case J.decodeStrict' bodyHead of
|
||||
Just notification -> do
|
||||
Just token <- pure $ B.stripPrefix "/3/device/" =<< H.requestPath request
|
||||
q <- atomically $ TM.lookup token notifications >>= maybe (newTokenQueue token) pure
|
||||
atomically $ writeTBQueue q APNSMockRequest {notification}
|
||||
sendApnsResponse APNSRespOk
|
||||
atomically $ writeTBQueue q PushMockRequest {notification}
|
||||
sendApnsResponse PushRespOk
|
||||
where
|
||||
newTokenQueue token = newTBQueue qSize >>= \q -> TM.insert token q notifications >> pure q
|
||||
_ -> do
|
||||
putStrLn $ "runAPNSMockServer J.decodeStrict' error, reqBody: " <> show bodyHead
|
||||
sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body"
|
||||
sendApnsResponse $ PushRespError N.badRequest400 "bad_request_body"
|
||||
|
||||
getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest
|
||||
getMockNotification _ (WPDeviceToken _ _) = liftIO . throwIO $ userError "Invalid pusher"
|
||||
getMockNotification APNSMockServer {notifications} (APNSDeviceToken _ token) = do
|
||||
getWPMockServer :: HTTP2ServerConfig -> IO WPMockServer
|
||||
getWPMockServer config@HTTP2ServerConfig {qSize} = do
|
||||
http2Server <- getHTTP2Server config
|
||||
notifications <- TM.emptyIO
|
||||
action <- async $ runWPMockServer notifications http2Server
|
||||
pure $ WPMockServer PushMockServer {action, notifications, http2Server}
|
||||
where
|
||||
runWPMockServer notifications HTTP2Server {reqQ} = forever $ do
|
||||
HTTP2Request {request, reqBody = HTTP2Body {bodyHead}, sendResponse} <- atomically $ readTBQueue reqQ
|
||||
let sendWPResponse = \case
|
||||
PushRespOk -> sendResponse $ H.responseNoBody N.ok200 []
|
||||
PushRespError status reason ->
|
||||
sendResponse . H.responseBuilder status [] . lazyByteString $ J.encode $ J.object ["error" .= reason]
|
||||
path = fromMaybe "/default" $ H.requestPath request
|
||||
(_, headers) = H.requestHeaders request
|
||||
authorization = H.getHeaderValue H.tokenAuthorization headers
|
||||
encoding = H.getHeaderValue H.tokenContentEncoding headers
|
||||
ttl = H.getHeaderValue (H.toToken "TTL") headers
|
||||
urgency = H.getHeaderValue (H.toToken "urgency") headers
|
||||
notification = WPNotification {body = bodyHead, authorization, encoding, ttl, urgency}
|
||||
q <- atomically $ TM.lookup path notifications >>= maybe (newTokenQueue path) pure
|
||||
atomically $ writeTBQueue q PushMockRequest {notification}
|
||||
sendWPResponse PushRespOk
|
||||
where
|
||||
newTokenQueue path = newTBQueue qSize >>= \q -> TM.insert path q notifications >> pure q
|
||||
|
||||
getMockNotification :: MonadIO m => PushMockServer a -> DeviceToken -> m (PushMockRequest a)
|
||||
getMockNotification PushMockServer {notifications} (WPDeviceToken _ (WPTokenParams path _)) = do
|
||||
atomically $ TM.lookup path notifications >>= maybe retry readTBQueue
|
||||
getMockNotification PushMockServer {notifications} (APNSDeviceToken _ token) = do
|
||||
atomically $ TM.lookup token notifications >>= maybe retry readTBQueue
|
||||
|
||||
getAnyMockNotification :: MonadIO m => APNSMockServer -> m APNSMockRequest
|
||||
getAnyMockNotification APNSMockServer {notifications} = do
|
||||
getAnyMockNotification :: MonadIO m => PushMockServer a -> m (PushMockRequest a)
|
||||
getAnyMockNotification PushMockServer {notifications} = do
|
||||
atomically $ readTVar notifications >>= mapM readTBQueue . M.elems >>= \case [] -> retry; ntf : _ -> pure ntf
|
||||
|
||||
closeAPNSMockServer :: APNSMockServer -> IO ()
|
||||
closeAPNSMockServer APNSMockServer {action, http2Server} = do
|
||||
closePushMockServer :: PushMockServer a -> IO ()
|
||||
closePushMockServer PushMockServer {action, http2Server} = do
|
||||
closeHTTP2Server http2Server
|
||||
uninterruptibleCancel action
|
||||
|
||||
@@ -48,11 +48,14 @@ import Simplex.Messaging.Transport
|
||||
import Test.Hspec hiding (fit, it)
|
||||
import UnliftIO.STM
|
||||
import Util
|
||||
import Simplex.Messaging.Encoding.String (StrEncoding(..))
|
||||
import System.Environment (setEnv)
|
||||
|
||||
ntfServerTests :: (ASrvTransport, AStoreType) -> Spec
|
||||
ntfServerTests ps@(t, _) = do
|
||||
describe "Notifications server protocol syntax" $ ntfSyntaxTests t
|
||||
describe "Notification subscriptions (NKEY)" $ testNotificationSubscription ps createNtfQueueNKEY
|
||||
describe "APNS notification subscriptions (NKEY)" $ testAPNSNotificationSubscription ps createNtfQueueNKEY
|
||||
describe "WP notification subscriptions (NKEY)" $ testWPNotificationSubscription ps createNtfQueueNKEY
|
||||
-- describe "Notification subscriptions (NEW with ntf creds)" $ testNotificationSubscription ps createNtfQueueNEW
|
||||
describe "Retried notification subscription" $ testRetriedNtfSubscription ps
|
||||
|
||||
@@ -99,22 +102,22 @@ v .-> key =
|
||||
let J.Object o = v
|
||||
in U.decodeLenient . encodeUtf8 <$> JT.parseEither (J..: key) o
|
||||
|
||||
testNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec
|
||||
testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
it "should create notification subscription and notify when message is received" $ do
|
||||
testAPNSNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec
|
||||
testAPNSNotificationSubscription (ATransport t, msType) createQueue =
|
||||
it "should create APNS notification subscription and notify when message is received" $ do
|
||||
g <- C.newRandom
|
||||
(sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
|
||||
let tkn = APNSDeviceToken PPApnsTest "abcd"
|
||||
withAPNSMockServer $ \apns ->
|
||||
withAPNSMockServer $ \(APNSMockServer apns) ->
|
||||
smpTest2 t msType $ \rh sh ->
|
||||
ntfTest t $ \nh -> do
|
||||
((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) <- createQueue rh sPub nPub
|
||||
-- register and verify token
|
||||
RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
let dhSecret = C.dh' ntfDh dhPriv
|
||||
decryptCode nd =
|
||||
@@ -127,7 +130,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
RespNtf "1a" NoEntity (NRTknId tId1 ntfDh1) <- signSendRecvNtf nh tknKey ("1a", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
|
||||
tId1 `shouldBe` tId
|
||||
ntfDh1 `shouldBe` ntfDh
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData1}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData1}} <-
|
||||
getMockNotification apns tkn
|
||||
let code1 = decryptCode ntfData1
|
||||
code `shouldBe` code1
|
||||
@@ -141,7 +144,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
threadDelay 50000
|
||||
Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello")
|
||||
-- receive notification
|
||||
APNSMockRequest {notification} <- getMockNotification apns tkn
|
||||
PushMockRequest {notification} <- getMockNotification apns tkn
|
||||
let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData'} = notification
|
||||
Right nonce' = C.cbNonce <$> ntfData' .-> "nonce"
|
||||
Right message = ntfData' .-> "message"
|
||||
@@ -163,7 +166,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
let tkn' = APNSDeviceToken PPApnsTest "efgh"
|
||||
RespNtf "7" tId' NROk <- signSendRecvNtf nh tknKey ("7", tId, TRPL tkn')
|
||||
tId `shouldBe` tId'
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData2}} <-
|
||||
getMockNotification apns tkn'
|
||||
let Right verification2 = ntfData2 .-> "verification"
|
||||
Right nonce2 = C.cbNonce <$> ntfData2 .-> "nonce"
|
||||
@@ -172,7 +175,7 @@ testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
RespNtf "8a" _ (NRTkn NTActive) <- signSendRecvNtf nh tknKey ("8a", tId, TCHK)
|
||||
-- send message
|
||||
Resp "9" _ OK <- signSendRecv sh sKey ("9", sId, _SEND' "hello 2")
|
||||
APNSMockRequest {notification = notification3} <- getMockNotification apns tkn'
|
||||
PushMockRequest {notification = notification3} <- getMockNotification apns tkn'
|
||||
let APNSNotification {aps = APNSMutableContent {}, notificationData = Just ntfData3} = notification3
|
||||
Right nonce3 = C.cbNonce <$> ntfData3 .-> "nonce"
|
||||
Right message3 = ntfData3 .-> "message"
|
||||
@@ -182,6 +185,32 @@ testNotificationSubscription (ATransport t, msType) createQueue =
|
||||
smpServer3 `shouldBe` srv
|
||||
notifierId3 `shouldBe` nId
|
||||
|
||||
testWPNotificationSubscription :: (ASrvTransport, AStoreType) -> CreateQueueFunc -> Spec
|
||||
testWPNotificationSubscription (ATransport t, msType) createQueue =
|
||||
it "should create WP notification subscription and notify when message is received" $ do
|
||||
g <- C.newRandom
|
||||
(sPub, sKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(nPub, nKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
|
||||
let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM"
|
||||
tkn = WPDeviceToken (WPP $ WPSrvLoc $ SrvLoc "localhost" wpTestPort) params
|
||||
_ <- setEnv "SYSTEM_CERTIFICATE_PATH" "tests/fixtures/"
|
||||
withWPMockServer $ \(WPMockServer wp) ->
|
||||
smpTest2 t msType $ \rh sh ->
|
||||
ntfTest t $ \nh -> do
|
||||
((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret) <- createQueue rh sPub nPub
|
||||
-- register and verify token
|
||||
RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
|
||||
PushMockRequest {notification = WPNotification {authorization, encoding, ttl, urgency, body}} <-
|
||||
getMockNotification wp tkn
|
||||
encoding `shouldBe` Just "aes128gcm"
|
||||
ttl `shouldBe` Just "2592000"
|
||||
urgency `shouldBe` Just "high"
|
||||
-- TODO: uncomment when vapid is merged
|
||||
-- authorization `shouldContainBS` "vapid t="
|
||||
|
||||
|
||||
testRetriedNtfSubscription :: (ASrvTransport, AStoreType) -> Spec
|
||||
testRetriedNtfSubscription (ATransport t, msType) =
|
||||
it "should allow retrying to create notification subscription with the same token and key" $ do
|
||||
@@ -233,13 +262,13 @@ createNtfQueueNKEY h sPub nPub = do
|
||||
pure ((sId, rId, rKey, rcvDhSecret), nId, rcvNtfDhSecret)
|
||||
|
||||
registerToken :: Transport c => THandleNTF c 'TClient -> APNSMockServer -> ByteString -> IO (C.APrivateAuthKey, C.DhSecretX25519, NtfEntityId, NtfRegCode)
|
||||
registerToken nh apns token = do
|
||||
registerToken nh (APNSMockServer apns) token = do
|
||||
g <- C.newRandom
|
||||
(tknPub, tknKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
||||
(dhPub, dhPriv :: C.PrivateKeyX25519) <- atomically $ C.generateKeyPair g
|
||||
let tkn = APNSDeviceToken PPApnsTest token
|
||||
RespNtf "1" NoEntity (NRTknId tId ntfDh) <- signSendRecvNtf nh tknKey ("1", NoEntity, TNEW $ NewNtfTkn tkn tknPub dhPub)
|
||||
APNSMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
PushMockRequest {notification = APNSNotification {aps = APNSBackground _, notificationData = Just ntfData}} <-
|
||||
getMockNotification apns tkn
|
||||
let dhSecret = C.dh' ntfDh dhPriv
|
||||
decryptCode nd =
|
||||
|
||||
Reference in New Issue
Block a user