Skip to content

Webpush requests #1613

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 10 commits into from
Closed

Webpush requests #1613

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
e90c15b
Move generic push functions to Push.hs
p1gp1g Jun 26, 2025
c08c379
Fix move push
p1gp1g Jul 11, 2025
e7e7c9b
Rename APNSDeviceToken
p1gp1g Aug 27, 2025
64269c2
Add WPDeviceToken
p1gp1g Aug 27, 2025
a24024c
Prepare webpush requests
p1gp1g Jul 16, 2025
2205a1f
Use content of push notif with web push
p1gp1g Jul 16, 2025
1295b28
Lint liftPPWPError
p1gp1g Jul 18, 2025
720fb40
Encrypt wp notifications
p1gp1g Jul 18, 2025
9d30af4
Fix Urgency case
p1gp1g Aug 18, 2025
4a39c4a
Merge branch 'unified-push' into webpush_requests
epoberezkin Aug 29, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
5 changes: 5 additions & 0 deletions simplexmq.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -260,6 +260,8 @@ library
Simplex.Messaging.Notifications.Server.Prometheus
Simplex.Messaging.Notifications.Server.Push
Simplex.Messaging.Notifications.Server.Push.APNS
Simplex.Messaging.Notifications.Server.Push.WebPush
Simplex.Messaging.Notifications.Server.Push
Simplex.Messaging.Notifications.Server.Push.APNS.Internal
Simplex.Messaging.Notifications.Server.Stats
Simplex.Messaging.Notifications.Server.Store
Expand Down Expand Up @@ -291,6 +293,7 @@ library
, attoparsec ==0.14.*
, base >=4.14 && <5
, base64-bytestring >=1.0 && <1.3
, binary ==0.8.*
, composition ==1.0.*
, constraints >=0.12 && <0.14
, containers ==0.6.*
Expand All @@ -303,6 +306,8 @@ library
, directory ==1.3.*
, filepath ==1.4.*
, hourglass ==0.2.*
, http-client ==0.7.*
, http-client-tls ==0.3.6.*
, http-types ==0.12.*
, http2 >=4.2.2 && <4.3
, iproute ==1.7.*
Expand Down
2 changes: 1 addition & 1 deletion src/Simplex/Messaging/Agent/Client.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1316,7 +1316,7 @@ runNTFServerTest c@AgentClient {presetDomains} nm userId (ProtoServerWithAuth sr
(nKey, npKey) <- atomically $ C.generateAuthKeyPair a g
(dhKey, _) <- atomically $ C.generateKeyPair g
r <- runExceptT $ do
let deviceToken = DeviceToken PPApnsNull "test_ntf_token"
let deviceToken = APNSDeviceToken PPApnsNull "test_ntf_token"
(tknId, _) <- liftError (testErr TSCreateNtfToken) $ ntfRegisterToken ntf nm npKey (NewNtfTkn deviceToken nKey dhKey)
liftError (testErr TSDeleteNtfToken) $ ntfDeleteToken ntf nm npKey tknId
ok <- netTimeoutInt (tcpTimeout $ networkConfig cfg) nm `timeout` closeProtocolClient ntf
Expand Down
27 changes: 18 additions & 9 deletions src/Simplex/Messaging/Agent/Store/AgentStore.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 = DeviceToken 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
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

we most likely need to add fields for webpush tokens to the table.

upsertNtfServer_ db srv
DB.execute
db
Expand All @@ -1409,10 +1410,12 @@ getSavedNtfToken db = do
let ntfServer = NtfServer host port keyHash
ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
ntfMode = fromMaybe NMPeriodic ntfMode_
in NtfToken {deviceToken = DeviceToken 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 = DeviceToken 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
Expand All @@ -1424,8 +1427,10 @@ updateNtfTokenRegistration db NtfToken {deviceToken = DeviceToken provider token
(tknId, ntfDhSecret, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)

updateDeviceToken :: DB.Connection -> NtfToken -> DeviceToken -> IO ()
updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} (DeviceToken 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|
Expand All @@ -1436,7 +1441,8 @@ updateDeviceToken db NtfToken {deviceToken = DeviceToken provider token, ntfServ
(toProvider, toToken, NTRegistered, Nothing :: Maybe NtfTknAction, updatedAt, provider, token, host, port)

updateNtfMode :: DB.Connection -> NtfToken -> NotificationsMode -> IO ()
updateNtfMode db NtfToken {deviceToken = DeviceToken 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
Expand All @@ -1448,7 +1454,8 @@ updateNtfMode db NtfToken {deviceToken = DeviceToken provider token, ntfServer =
(ntfMode, updatedAt, provider, token, host, port)

updateNtfToken :: DB.Connection -> NtfToken -> NtfTknStatus -> Maybe NtfTknAction -> IO ()
updateNtfToken db NtfToken {deviceToken = DeviceToken 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
Expand All @@ -1460,7 +1467,8 @@ updateNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer
(tknStatus, tknAction, updatedAt, provider, token, host, port)

removeNtfToken :: DB.Connection -> NtfToken -> IO ()
removeNtfToken db NtfToken {deviceToken = DeviceToken provider token, ntfServer = ProtocolServer {host, port}} =
removeNtfToken db NtfToken {deviceToken, ntfServer = ProtocolServer {host, port}} = do
let (provider, token) = deviceTokenFields deviceToken
DB.execute
db
[sql|
Expand Down Expand Up @@ -1785,7 +1793,8 @@ getActiveNtfToken db =
let ntfServer = NtfServer host port keyHash
ntfDhKeys = (ntfDhPubKey, ntfDhPrivKey)
ntfMode = fromMaybe NMPeriodic ntfMode_
in NtfToken {deviceToken = DeviceToken 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} =
Expand Down
22 changes: 21 additions & 1 deletion src/Simplex/Messaging/Crypto.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -127,6 +127,7 @@ module Simplex.Messaging.Crypto
encryptAEAD,
decryptAEAD,
encryptAESNoPad,
encryptAES128NoPad,
decryptAESNoPad,
authTagSize,
randomAesKey,
Expand Down Expand Up @@ -209,7 +210,7 @@ import Control.Exception (Exception)
import Control.Monad
import Control.Monad.Except
import Control.Monad.Trans.Except
import Crypto.Cipher.AES (AES256)
import Crypto.Cipher.AES (AES256, AES128)
import qualified Crypto.Cipher.Types as AES
import qualified Crypto.Cipher.XSalsa as XSalsa
import qualified Crypto.Error as CE
Expand Down Expand Up @@ -895,6 +896,8 @@ data CryptoError
CERatchetEarlierMessage Word32
| -- | duplicate message number
CERatchetDuplicateMessage
| -- | unable to decode ecc key
CryptoInvalidECCKey CE.CryptoError
Comment on lines +899 to +900
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Suggested change
| -- | unable to decode ecc key
CryptoInvalidECCKey CE.CryptoError

This error is not necessary as it would be a parsing error.

deriving (Eq, Show, Exception)

aesKeySize :: Int
Expand Down Expand Up @@ -1021,11 +1024,22 @@ encryptAESNoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag
encryptAESNoPad key iv = encryptAEADNoPad key iv ""
{-# INLINE encryptAESNoPad #-}

-- Used to encrypt WebPush notifications
-- This function requires 12 bytes IV, it does not transform IV.
encryptAES128NoPad :: Key -> GCMIV -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAES128NoPad key iv = encryptAEAD128NoPad key iv ""
{-# INLINE encryptAES128NoPad #-}

encryptAEADNoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEADNoPad aesKey ivBytes ad msg = do
aead <- initAEADGCM aesKey ivBytes
pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize

encryptAEAD128NoPad :: Key -> GCMIV -> ByteString -> ByteString -> ExceptT CryptoError IO (AuthTag, ByteString)
encryptAEAD128NoPad aesKey ivBytes ad msg = do
aead <- initAEAD128GCM aesKey ivBytes
pure . first AuthTag $ AES.aeadSimpleEncrypt aead ad msg authTagSize

-- | AEAD-GCM decryption with associated data.
--
-- Used as part of double ratchet encryption.
Expand Down Expand Up @@ -1125,6 +1139,12 @@ initAEADGCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
cipher <- AES.cipherInit aesKey
AES.aeadInit AES.AEAD_GCM cipher ivBytes

-- this function requires 12 bytes IV, it does not transforms IV.
initAEAD128GCM :: Key -> GCMIV -> ExceptT CryptoError IO (AES.AEAD AES128)
initAEAD128GCM (Key aesKey) (GCMIV ivBytes) = cryptoFailable $ do
cipher <- AES.cipherInit aesKey
AES.aeadInit AES.AEAD_GCM cipher ivBytes

-- | Random AES256 key.
randomAesKey :: TVar ChaChaDRG -> STM Key
randomAesKey = fmap Key . randomBytes aesKeySize
Expand Down
98 changes: 87 additions & 11 deletions src/Simplex/Messaging/Notifications/Protocol.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Proposed type for push provider (it's needed as a key for the connected client), but it probably is not needed during parsing of DeviceToken:

data PushProvider = PPAPNS APNSProvider | PPWP WPProvider


instance Encoding PushProvider where
Expand All @@ -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
Expand All @@ -399,44 +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 DeviceToken = DeviceToken PushProvider ByteString
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
Comment on lines +456 to +458
Copy link
Member

@epoberezkin epoberezkin Aug 31, 2025 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Proposed type for DeviceToken is

data DeviceToken
  = APNSDeviceToken APNSProvider ByteString
  | WPDeviceToken WPProvider WPTokenParams
  
newtype WPProvider = WPP (ProtocolServer 'WebPush) -- so we can add params if needed
  
data APNSProvider
  = PPApnsDev -- provider for Apple development environment
  | PPApnsProd -- production environment, including TestFlight
  | PPApnsTest
  
data WPTokenParams = WPTokenParams
  { wpPath :: ByteString, -- parser should validate it's a valid type and possibly it should be  
    wpAuth :: ByteString, -- if we enforce size constraints, should also be in parser.
    wpKey :: ECC.Point -- or another correct type that is needed for encryption, so it fails in parser and not there
  }

General approach is to parse early, to the most narrow type that is applicable at the point of parsing, and not at the point of using it.

deriving (Eq, Ord, Show)

instance Encoding DeviceToken where
smpEncode (DeviceToken p t) = smpEncode (p, t)
smpP = DeviceToken <$> 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 (DeviceToken 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" $> DeviceToken PPApnsNull "test_ntf_token"
hexToken = DeviceToken <$> strP <* A.space <*> hexStringP
nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token"
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 (DeviceToken pp t) = J.pairs $ "pushProvider" .= decodeLatin1 (strEncode pp) <> "token" .= decodeLatin1 t
toJSON (DeviceToken pp t) = J.object ["pushProvider" .= decodeLatin1 (strEncode pp), "token" .= decodeLatin1 t]
toEncoding token = case token of
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

why do we need JSON encodings for the token? If we do, then we need to use derived ToJSON/FromJson instances.

Possibly, it is only needed for webpush tokens?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

IIRC, this is used for the APNS token on iOS. So I have extended the function to webpush tokens as well

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 $ DeviceToken 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)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

this function seems unnecessary, as it's better to store components as separate fields and split/combine when saving to the database.

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,
Expand Down
7 changes: 5 additions & 2 deletions src/Simplex/Messaging/Notifications/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -629,7 +629,8 @@ showServer' = decodeLatin1 . strEncode . host

ntfPush :: NtfPushServer -> M ()
ntfPush s@NtfPushServer {pushQ} = forever $ do
(srvHost_, tkn@NtfTknRec {ntfTknId, token = t@(DeviceToken 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
Expand Down Expand Up @@ -675,6 +676,8 @@ ntfPush s@NtfPushServer {pushQ} = forever $ do
void $ updateTknStatus st tkn $ NTInvalid $ Just r
err e
PPPermanentError -> err e
PPInvalidPusher -> err e
_ -> err e
where
retryDeliver :: IO (Either PushProviderError ())
retryDeliver = do
Expand Down Expand Up @@ -905,7 +908,7 @@ withNtfStore stAction continue = do
Right a -> continue a

incNtfStatT :: DeviceToken -> (NtfServerStats -> IORef Int) -> M ()
incNtfStatT (DeviceToken PPApnsNull _) _ = pure ()
incNtfStatT (APNSDeviceToken PPApnsNull _) _ = pure ()
incNtfStatT _ statSel = incNtfStat statSel
{-# INLINE incNtfStatT #-}

Expand Down
Loading
Loading