13
13
module Simplex.Messaging.Notifications.Server.Push.WebPush where
14
14
15
15
import Network.HTTP.Client
16
- import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken ), WPEndpoint (.. ))
16
+ import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken ), WPEndpoint (.. ), encodePNMessages , PNMessageData )
17
17
import Simplex.Messaging.Notifications.Server.Store.Types
18
18
import Simplex.Messaging.Notifications.Server.Push
19
19
import Control.Monad.Except
20
20
import Control.Logger.Simple (logDebug )
21
21
import Simplex.Messaging.Util (tshow )
22
22
import qualified Data.ByteString.Char8 as B
23
- import Data.ByteString.Char8 (ByteString )
24
23
import Control.Monad.IO.Class (liftIO )
25
24
import Control.Exception ( fromException , SomeException , try )
26
25
import qualified Network.HTTP.Types as N
26
+ import qualified Data.Aeson as J
27
+ import Data.Aeson ((.=) )
28
+ import qualified Data.ByteString.Lazy as BL
29
+ import Data.List.NonEmpty (NonEmpty )
30
+ import qualified Data.Text.Encoding as T
31
+ import qualified Data.Text as T
27
32
28
33
wpPushProviderClient :: Manager -> PushProviderClient
29
- wpPushProviderClient mg tkn _ = do
34
+ wpPushProviderClient mg tkn pn = do
30
35
e <- B. unpack <$> endpoint tkn
31
36
r <- liftPPWPError $ parseUrlThrow e
32
37
logDebug $ " Request to " <> tshow r. host
@@ -39,18 +44,27 @@ wpPushProviderClient mg tkn _ = do
39
44
let req = r {
40
45
method = " POST"
41
46
, requestHeaders
42
- , requestBody = " ping "
47
+ , requestBody = RequestBodyLBS $ encodePN pn
43
48
, redirectCount = 0
44
49
}
45
50
_ <- liftPPWPError $ httpNoBody req mg
46
51
pure ()
47
52
where
48
- endpoint :: NtfTknRec -> ExceptT PushProviderError IO ByteString
53
+ endpoint :: NtfTknRec -> ExceptT PushProviderError IO B. ByteString
49
54
endpoint NtfTknRec {token} = do
50
55
case token of
51
56
WPDeviceToken WPEndpoint { endpoint = e } -> pure e
52
57
_ -> fail " Wrong device token"
53
58
59
+ encodePN :: PushNotification -> BL. ByteString
60
+ encodePN pn = J. encode $ case pn of
61
+ PNVerification code -> J. object [ " verification" .= code ]
62
+ PNMessage d -> J. object [ " message" .= encodeData d ]
63
+ PNCheckMessages -> J. object [ " checkMessages" .= True ]
64
+ where
65
+ encodeData :: NonEmpty PNMessageData -> String
66
+ encodeData a = T. unpack . T. decodeUtf8 $ encodePNMessages a
67
+
54
68
liftPPWPError :: IO a -> ExceptT PushProviderError IO a
55
69
liftPPWPError = liftPPWPError' toPPWPError
56
70
0 commit comments