diff --git a/src/Simplex/Messaging/Agent/Store/AgentStore.hs b/src/Simplex/Messaging/Agent/Store/AgentStore.hs index e19c34f32..3911a2eba 100644 --- a/src/Simplex/Messaging/Agent/Store/AgentStore.hs +++ b/src/Simplex/Messaging/Agent/Store/AgentStore.hs @@ -278,7 +278,7 @@ import Simplex.Messaging.Crypto.Ratchet (PQEncryption (..), PQSupport (..), Ratc import qualified Simplex.Messaging.Crypto.Ratchet as CR import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String -import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..)) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfSubscriptionId, NtfTknStatus (..), NtfTokenId, SMPQueueNtf (..), deviceTokenFields, deviceToken') import Simplex.Messaging.Notifications.Types import Simplex.Messaging.Parsers (parseAll) import Simplex.Messaging.Protocol @@ -1382,7 +1382,8 @@ deleteCommand db cmdId = DB.execute db "DELETE FROM commands WHERE command_id = ?" (Only cmdId) createNtfToken :: DB.Connection -> NtfToken -> IO () -createNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do +createNtfToken db NtfToken {deviceToken, ntfServer = srv@ProtocolServer {host, port}, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey), ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} = do + let (provider, token) = deviceTokenFields deviceToken upsertNtfServer_ db srv DB.execute db @@ -1409,10 +1410,12 @@ getSavedNtfToken db = do let ntfServer = NtfServer host port keyHash ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey) ntfMode = fromMaybe NMPeriodic ntfMode_ - in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} + deviceToken = deviceToken' provider dt + in NtfToken {deviceToken, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} updateNtfTokenRegistration :: DB.Connection -> NtfToken -> NtfTokenId -> C.DhSecretX25519 -> IO () -updateNtfTokenRegistration db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do +updateNtfTokenRegistration db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} tknId ntfDhSecret = do + let (provider, token) = deviceTokenFields deviceToken updatedAt <- getCurrentTime DB.execute db @@ -1424,8 +1427,10 @@ updateNtfTokenRegistration db NtfToken {deviceToken = APNSDeviceToken provider t (tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port) updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO () -updateDeviceToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} (APNSDeviceToken toProvider toToken) = do +updateDeviceToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} toDt = do + let (provider, token) = deviceTokenFields deviceToken updatedAt <- getCurrentTime + let (toProvider, toToken) = deviceTokenFields toDt DB.execute db [sql| @@ -1436,7 +1441,8 @@ updateDeviceToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntf (toProvider, toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port) updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO () -updateNtfMode db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} ntfMode = do +updateNtfMode db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} ntfMode = do + let (provider, token) = deviceTokenFields deviceToken updatedAt <- getCurrentTime DB.execute db @@ -1448,7 +1454,8 @@ updateNtfMode db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServ (ntfMode, updatedAt, provider, token, host, port) updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO () -updateNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do +updateNtfToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} tknStatus tknAction = do + let (provider, token) = deviceTokenFields deviceToken updatedAt <- getCurrentTime DB.execute db @@ -1460,7 +1467,8 @@ updateNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfSer (tknStatus, tknAction, updatedAt, provider, token, host, port) removeNtfToken :: DB.Connection -> NtfToken -> IO () -removeNtfToken db NtfToken {deviceToken = APNSDeviceToken provider token, ntfServer = ProtocolServer {host, port}} = +removeNtfToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} = do + let (provider, token) = deviceTokenFields deviceToken DB.execute db [sql| @@ -1785,7 +1793,8 @@ getActiveNtfToken db = let ntfServer = NtfServer host port keyHash ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey) ntfMode = fromMaybe NMPeriodic ntfMode_ - in NtfToken {deviceToken = APNSDeviceToken provider dt, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} + deviceToken = deviceToken' provider dt + in NtfToken {deviceToken, ntfServer, ntfTokenId, ntfPubKey, ntfPrivKey, ntfDhKeys, ntfDhSecret, ntfTknStatus, ntfTknAction, ntfMode} getNtfRcvQueue :: DB.Connection -> SMPQueueNtf -> IO (Either StoreError (ConnId, Int64, RcvNtfDhSecret, Maybe UTCTime)) getNtfRcvQueue db SMPQueueNtf {smpServer = (SMPServer host port _), notifierId} = diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 1c7bf5cff..4806c3ddd 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -35,6 +35,7 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake) import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..)) import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) +import Control.Monad (when) data NtfEntity = Token | Subscription deriving (Show) @@ -377,6 +378,7 @@ data PushProvider | PPApnsProd -- production environment, including TestFlight | PPApnsTest -- used for tests, to use APNS mock server | PPApnsNull -- used to test servers from the client - does not communicate with APNS + | PPWebPush -- used for webpush (FCM, UnifiedPush, potentially desktop) deriving (Eq, Ord, Show) instance Encoding PushProvider where @@ -385,12 +387,14 @@ instance Encoding PushProvider where PPApnsProd -> "AP" PPApnsTest -> "AT" PPApnsNull -> "AN" + PPWebPush -> "WP" smpP = A.take 2 >>= \case "AD" -> pure PPApnsDev "AP" -> pure PPApnsProd "AT" -> pure PPApnsTest "AN" -> pure PPApnsNull + "WP" -> pure PPWebPush _ -> fail "bad PushProvider" instance StrEncoding PushProvider where @@ -399,45 +403,116 @@ instance StrEncoding PushProvider where PPApnsProd -> "apns_prod" PPApnsTest -> "apns_test" PPApnsNull -> "apns_null" + PPWebPush -> "webpush" strP = A.takeTill (== ' ') >>= \case "apns_dev" -> pure PPApnsDev "apns_prod" -> pure PPApnsProd "apns_test" -> pure PPApnsTest "apns_null" -> pure PPApnsNull + "webpush" -> pure PPWebPush _ -> fail "bad PushProvider" instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode +data WPEndpoint = WPEndpoint { endpoint::ByteString, auth::ByteString, p256dh::ByteString } + deriving (Eq, Ord, Show) + +instance Encoding WPEndpoint where + smpEncode WPEndpoint { endpoint, auth, p256dh } = smpEncode (endpoint, auth, p256dh) + smpP = do + endpoint <- smpP + auth <- smpP + p256dh <- smpP + pure WPEndpoint { endpoint, auth, p256dh } + +instance StrEncoding WPEndpoint where + strEncode WPEndpoint { endpoint, auth, p256dh } = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh + strP = do + endpoint <- A.takeWhile (/= ' ') + _ <- A.char ' ' + (auth, p256dh) <- strP + -- auth is a 16 bytes long random key + when (B.length auth /= 16) $ fail "Invalid auth key length" + -- p256dh is a public key on the P-256 curve, encoded in uncompressed format + -- 0x04 + the 2 points = 65 bytes + when (B.length p256dh /= 65) $ fail "Invalid p256dh key length" + when (B.take 1 p256dh /= "\x04") $ fail "Invalid p256dh key, doesn't start with 0x04" + pure WPEndpoint { endpoint, auth, p256dh } + +instance ToJSON WPEndpoint where + toEncoding WPEndpoint { endpoint, auth, p256dh } = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh) + toJSON WPEndpoint { endpoint, auth, p256dh } = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ] + +instance FromJSON WPEndpoint where + parseJSON = J.withObject "WPEndpoint" $ \o -> do + endpoint <- encodeUtf8 <$> o .: "endpoint" + auth <- strDecode . encodeUtf8 <$?> o .: "auth" + p256dh <- strDecode . encodeUtf8 <$?> o .: "p256dh" + pure WPEndpoint { endpoint, auth, p256dh } + data DeviceToken = APNSDeviceToken PushProvider ByteString + | WPDeviceToken WPEndpoint deriving (Eq, Ord, Show) instance Encoding DeviceToken where - smpEncode (APNSDeviceToken p t) = smpEncode (p, t) - smpP = APNSDeviceToken <$> smpP <*> smpP + smpEncode token = case token of + APNSDeviceToken p t -> smpEncode (p, t) + WPDeviceToken t -> smpEncode (PPWebPush, t) + smpP = do + pp <- smpP + case pp of + PPWebPush -> WPDeviceToken <$> smpP + _ -> APNSDeviceToken pp <$> smpP instance StrEncoding DeviceToken where - strEncode (APNSDeviceToken p t) = strEncode p <> " " <> t - strP = nullToken <|> hexToken + strEncode token = case token of + APNSDeviceToken p t -> strEncode p <> " " <> t + WPDeviceToken t -> strEncode PPWebPush <> " " <> strEncode t + strP = nullToken <|> deviceToken where nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token" - hexToken = APNSDeviceToken <$> strP <* A.space <*> hexStringP + deviceToken = do + pp <- strP_ + case pp of + PPWebPush -> WPDeviceToken <$> strP + _ -> APNSDeviceToken pp <$> hexStringP hexStringP = A.takeWhile (`B.elem` "0123456789abcdef") >>= \s -> if even (B.length s) then pure s else fail "odd number of hex characters" instance ToJSON DeviceToken where - toEncoding (APNSDeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t - toJSON (APNSDeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t] + toEncoding token = case token of + APNSDeviceToken pp t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t + WPDeviceToken t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode PPWebPush) <> "token" .= toJSON t + toJSON token = case token of + APNSDeviceToken pp t -> J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t] + WPDeviceToken t -> J.object ["pushProvider" .= decodeLatin1 (strEncode PPWebPush), "token" .= toJSON t] instance FromJSON DeviceToken where parseJSON = J.withObject "DeviceToken" $ \o -> do pp <- strDecode . encodeUtf8 <$?> o .: "pushProvider" - t <- encodeUtf8 <$> o .: "token" - pure $ APNSDeviceToken pp t + case pp of + PPWebPush -> do + WPDeviceToken <$> (o .: "token") + _ -> do + t <- encodeUtf8 <$> (o .: "token") + pure $ APNSDeviceToken pp t + +-- | Returns fields for the device token (pushProvider, token) +deviceTokenFields :: DeviceToken -> (PushProvider, ByteString) +deviceTokenFields dt = case dt of + APNSDeviceToken pp t -> (pp, t) + WPDeviceToken t -> (PPWebPush, strEncode t) + +-- | Returns the device token from the fields (pushProvider, token) +deviceToken' :: PushProvider -> ByteString -> DeviceToken +deviceToken' pp t = case pp of + PPWebPush -> WPDeviceToken <$> either error id $ strDecode t + _ -> APNSDeviceToken pp t -- List of PNMessageData uses semicolon-separated encoding instead of strEncode, -- because strEncode of NonEmpty list uses comma for separator, diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 859cbe142..152906521 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -629,7 +629,8 @@ showServer' = decodeLatin1 . strEncode . host ntfPush :: NtfPushServer -> M () ntfPush s@NtfPushServer {pushQ} = forever $ do - (srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(APNSDeviceToken pp _), tknStatus}, ntf) <- atomically (readTBQueue pushQ) + (srvHost_, tkn@NtfTknRec {ntfTknId, token = t, tknStatus}, ntf) <- atomically (readTBQueue pushQ) + let (pp, _) = deviceTokenFields t liftIO $ logDebug $ "sending push notification to " <> T.pack (show pp) st <- asks store case ntf of diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index 7ed258b9a..33a8a194a 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -25,6 +25,7 @@ import Simplex.Messaging.Client (ProtocolClientConfig (..)) import Simplex.Messaging.Client.Agent import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Notifications.Protocol +import Simplex.Messaging.Notifications.Server.Push import Simplex.Messaging.Notifications.Server.Push.APNS import Simplex.Messaging.Notifications.Server.Stats import Simplex.Messaging.Notifications.Server.Store (newNtfSTMStore) diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs index b9b2700ce..b01c68ce0 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -130,6 +130,7 @@ apnsProviderHost = \case PPApnsTest -> Just "localhost" PPApnsDev -> Just "api.sandbox.push.apple.com" PPApnsProd -> Just "api.push.apple.com" + _ -> Nothing defaultAPNSPushClientConfig :: APNSPushClientConfig defaultAPNSPushClientConfig = @@ -256,7 +257,8 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text} $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse) apnsPushProviderClient :: APNSPushClient -> PushProviderClient -apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do +apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token} pn = do + tknStr <- deviceToken token http2 <- liftHTTPS2 $ getApnsHTTP2Client c nonce <- atomically $ C.randomCbNonce nonceDrg apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn @@ -270,6 +272,9 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token else logWarn $ "APNS error: " <> T.pack (show status) <> " " <> reason' <> apnsIds response result status reason' where + deviceToken t = case t of + APNSDeviceToken _ dt -> pure dt + _ -> throwE PPInvalidPusher apnsIds response = headerStr "apns-id" <> headerStr "apns-unique-id" where headerStr name = diff --git a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs index 0c8600510..e7e16b6f5 100644 --- a/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs +++ b/src/Simplex/Messaging/Notifications/Server/Store/Postgres.hs @@ -126,8 +126,9 @@ insertNtfTknQuery = |] replaceNtfToken :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ()) -replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToken), tknStatus, tknRegCode = code@(NtfRegCode regCode)} = +replaceNtfToken st NtfTknRec {ntfTknId, token, tknStatus, tknRegCode = code@(NtfRegCode regCode)} = withFastDB "replaceNtfToken" st $ \db -> runExceptT $ do + let (pp, ppToken) = deviceTokenFields token ExceptT $ assertUpdated <$> DB.execute db @@ -141,7 +142,7 @@ replaceNtfToken st NtfTknRec {ntfTknId, token = token@(APNSDeviceToken pp ppToke ntfTknToRow :: NtfTknRec -> NtfTknRow ntfTknToRow NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} = - let APNSDeviceToken pp ppToken = token + let (pp, ppToken) = deviceTokenFields token NtfRegCode regCode = tknRegCode in (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt) @@ -151,7 +152,8 @@ getNtfToken st tknId = getNtfToken_ st " WHERE token_id = ?" (Only tknId) findNtfTokenRegistration :: NtfPostgresStore -> NewNtfEntity 'Token -> IO (Either ErrorType (Maybe NtfTknRec)) -findNtfTokenRegistration st (NewNtfTkn (APNSDeviceToken pp ppToken) tknVerifyKey _) = +findNtfTokenRegistration st (NewNtfTkn token tknVerifyKey _) = do + let (pp, ppToken) = deviceTokenFields token getNtfToken_ st " WHERE push_provider = ? AND push_provider_token = ? AND verify_key = ?" (pp, Binary ppToken, tknVerifyKey) getNtfToken_ :: ToRow q => NtfPostgresStore -> Query -> q -> IO (Either ErrorType (Maybe NtfTknRec)) @@ -179,7 +181,7 @@ ntfTknQuery = rowToNtfTkn :: NtfTknRow -> NtfTknRec rowToNtfTkn (ntfTknId, pp, Binary ppToken, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, Binary regCode, tknCronInterval, tknUpdatedAt) = - let token = APNSDeviceToken pp ppToken + let token = deviceToken' pp ppToken tknRegCode = NtfRegCode regCode in NtfTknRec {ntfTknId, token, tknStatus, tknVerifyKey, tknDhPrivKey, tknDhSecret, tknRegCode, tknCronInterval, tknUpdatedAt} @@ -374,8 +376,9 @@ setTknStatusConfirmed st NtfTknRec {ntfTknId} = when (updated > 0) $ withLog "updateTknStatus" st $ \sl -> logTokenStatus sl ntfTknId NTConfirmed setTokenActive :: NtfPostgresStore -> NtfTknRec -> IO (Either ErrorType ()) -setTokenActive st tkn@NtfTknRec {ntfTknId, token = APNSDeviceToken pp ppToken} = +setTokenActive st tkn@NtfTknRec {ntfTknId, token} = withFastDB' "setTokenActive" st $ \db -> do + let (pp, ppToken) = deviceTokenFields token updateTknStatus_ st db tkn NTActive -- this removes other instances of the same token, e.g. because of repeated token registration attempts tknIds <-