Use content of push notif with web push

This commit is contained in:
sim
2025-07-16 18:13:48 +02:00
parent a24024c0b8
commit 2205a1fb7c

View File

@@ -13,20 +13,25 @@
module Simplex.Messaging.Notifications.Server.Push.WebPush where
import Network.HTTP.Client
import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..))
import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken), WPEndpoint (..), encodePNMessages, PNMessageData)
import Simplex.Messaging.Notifications.Server.Store.Types
import Simplex.Messaging.Notifications.Server.Push
import Control.Monad.Except
import Control.Logger.Simple (logDebug)
import Simplex.Messaging.Util (tshow)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Char8 (ByteString)
import Control.Monad.IO.Class (liftIO)
import Control.Exception ( fromException, SomeException, try )
import qualified Network.HTTP.Types as N
import qualified Data.Aeson as J
import Data.Aeson ((.=))
import qualified Data.ByteString.Lazy as BL
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Text.Encoding as T
import qualified Data.Text as T
wpPushProviderClient :: Manager -> PushProviderClient
wpPushProviderClient mg tkn _ = do
wpPushProviderClient mg tkn pn = do
e <- B.unpack <$> endpoint tkn
r <- liftPPWPError $ parseUrlThrow e
logDebug $ "Request to " <> tshow r.host
@@ -39,18 +44,27 @@ wpPushProviderClient mg tkn _ = do
let req = r {
method = "POST"
, requestHeaders
, requestBody = "ping"
, requestBody = RequestBodyLBS $ encodePN pn
, redirectCount = 0
}
_ <- liftPPWPError $ httpNoBody req mg
pure ()
where
endpoint :: NtfTknRec -> ExceptT PushProviderError IO ByteString
endpoint :: NtfTknRec -> ExceptT PushProviderError IO B.ByteString
endpoint NtfTknRec {token} = do
case token of
WPDeviceToken WPEndpoint{ endpoint = e } -> pure e
_ -> fail "Wrong device token"
encodePN :: PushNotification -> BL.ByteString
encodePN pn = J.encode $ case pn of
PNVerification code -> J.object [ "verification" .= code ]
PNMessage d -> J.object [ "message" .= encodeData d ]
PNCheckMessages -> J.object [ "checkMessages" .= True ]
where
encodeData :: NonEmpty PNMessageData -> String
encodeData a = T.unpack . T.decodeUtf8 $ encodePNMessages a
liftPPWPError :: IO a -> ExceptT PushProviderError IO a
liftPPWPError = liftPPWPError' toPPWPError