diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index 6457d2b84..625113c75 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -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