webpush: tests

simplexmq.cabal

@@ -305,6 +305,7 @@ library
     , containers ==0.6.*
     , crypton ==0.34.*
     , crypton-x509 ==1.7.*
+    , crypton-x509-system ==1.6.*
     , crypton-x509-store ==1.6.*
     , crypton-x509-validation ==1.6.*
     , cryptostore ==0.3.*

src/Simplex/Messaging/Notifications/Server/Env.hs

@@ -33,7 +33,7 @@ import Simplex.Messaging.Notifications.Server.Store.Postgres
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.StoreLog (readWriteNtfSTMStore)
 import Simplex.Messaging.Notifications.Transport (NTFVersion, VersionRangeNTF)
-import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), Transmission)
+import Simplex.Messaging.Protocol (BasicAuth, CorrId, Party (..), SMPServer, SParty (..), Transmission, SrvLoc (..))
 import Simplex.Messaging.Server.Env.STM (StartOptions (..))
 import Simplex.Messaging.Server.Expiration
 import Simplex.Messaging.Server.QueueStore.Postgres.Config (PostgresStoreCfg (..))
@@ -46,9 +46,10 @@ import Simplex.Messaging.Transport.Server (AddHTTP, ServerCredentials, Transport
 import System.Exit (exitFailure)
 import System.Mem.Weak (Weak)
 import UnliftIO.STM
-import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient)
+import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClientH1, wpPushProviderClientH2, wpHTTP2Client)
 import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager)
 import Network.HTTP.Client.TLS (tlsManagerSettings)
+import Simplex.Messaging.Util (tshow)
 
 data NtfServerConfig = NtfServerConfig
   { transports :: [(ServiceName, ASrvTransport, AddHTTP)],
@@ -177,10 +178,14 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do
     Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig
 
 newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient
-newWPPushClient NtfPushServer {pushClients} pp = do
+newWPPushClient NtfPushServer {pushClients} (WPP (WPSrvLoc (SrvLoc h p))) = do
   logDebug "New WP Client requested"
-  -- We use one http manager per push server (which may be used by different clients)
-  wpPushProviderClient <$> wpHTTPManager
+  r <- wpHTTP2Client h p
+  case r of
+    Right client -> pure $ wpPushProviderClientH2 client
+    Left e -> do
+      logError $ "Error connecting to H2 WP: " <> tshow e
+      wpPushProviderClientH1 <$> wpHTTPManager
 
 wpHTTPManager :: IO Manager
 wpHTTPManager = newManager tlsManagerSettings {

src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs

@@ -8,9 +8,8 @@
 
 module Simplex.Messaging.Notifications.Server.Push.WebPush where
 
-import Network.HTTP.Client
 import qualified Simplex.Messaging.Crypto as C
-import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest, WPProvider (..))
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -19,7 +18,6 @@ import Simplex.Messaging.Util (tshow)
 import qualified Data.ByteString.Char8 as B
 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.Binary as Bin
@@ -32,25 +30,67 @@ import qualified Crypto.Cipher.Types as CT
 import qualified Crypto.MAC.HMAC as HMAC
 import qualified Crypto.PubKey.ECC.DH as ECDH
 import qualified Crypto.PubKey.ECC.Types as ECC
+import Simplex.Messaging.Transport.HTTP2.Client (HTTP2Client, getHTTP2Client, defaultHTTP2ClientConfig, HTTP2ClientError, HTTP2Response (..), sendRequest)
+import Network.Socket (ServiceName, HostName)
+import System.X509.Unix
+import qualified Network.HTTP.Types as N
+import Network.HTTP.Client
+import qualified Network.HTTP2.Client as H2
+import Data.ByteString.Builder (lazyByteString)
+import Simplex.Messaging.Encoding.String (StrEncoding(..))
+import Data.Bifunctor (first)
 
-wpPushProviderClient :: Manager -> PushProviderClient
-wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
-wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do
+wpHTTP2Client :: HostName -> ServiceName -> IO (Either HTTP2ClientError HTTP2Client)
+wpHTTP2Client h p = do
+  caStore <- Just <$> getSystemCertificateStore
+  let config = defaultHTTP2ClientConfig
+  getHTTP2Client h p caStore config nop
+  where
+    nop = pure ()
+
+wpHeaders :: [(N.HeaderName, B.ByteString)]
+wpHeaders = [
+  -- Why http2-client doesn't accept TTL AND Urgency?
+  -- Keeping Urgency for now, the TTL should be around 30 days by default on the push servers
+  -- ("TTL", "2592000"), -- 30 days
+  ("Urgency", "high"),
+  ("Content-Encoding", "aes128gcm")
+  -- TODO: topic for pings and interval
+  ]
+
+wpHTTP2Req :: B.ByteString -> BL.ByteString -> H2.Request
+wpHTTP2Req path s =  H2.requestBuilder N.methodPost path wpHeaders (lazyByteString s)
+
+wpPushProviderClientH2 :: HTTP2Client -> PushProviderClient
+wpPushProviderClientH2 _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClientH2 http2 NtfTknRec {token = (WPDeviceToken (WPP p) param)} pn = do
+  -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
+  -- parsing will happen in DeviceToken parser, so it won't fail here
+  encBody <- body
+  let req = wpHTTP2Req (wpPath param) $ BL.fromStrict encBody
+  logDebug $ "HTTP/2 Request to " <> tshow (strEncode p)
+  HTTP2Response {response} <- liftHTTPS2 $ sendRequest http2 req Nothing
+  let status = H2.responseStatus response
+  if status >= Just N.ok200 && status < Just N.status300
+  then pure ()
+  else throwError $ fromStatusCode status
+  where
+    body :: ExceptT PushProviderError IO B.ByteString
+    body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn)
+    liftHTTPS2 a = ExceptT $ first PPConnection <$> a
+
+wpPushProviderClientH1 :: Manager -> PushProviderClient
+wpPushProviderClientH1 _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher
+wpPushProviderClientH1 mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do
   -- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
   -- parsing will happen in DeviceToken parser, so it won't fail here
   r <- wpRequest token
-  logDebug $ "Request to " <> tshow (host r)
+  logDebug $ "HTTP/1 Request to " <> tshow (host r)
   encBody <- body
-  let requestHeaders =
-        [ ("TTL", "2592000"), -- 30 days
-          ("Urgency", "high"),
-          ("Content-Encoding", "aes128gcm")
-    -- TODO: topic for pings and interval
-        ]
-      req =
+  let req =
         r
           { method = "POST",
-            requestHeaders,
+            requestHeaders = wpHeaders,
             requestBody = RequestBodyBS encBody,
             redirectCount = 0
           }
@@ -122,13 +162,14 @@ liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . er
 toPPWPError :: SomeException -> PushProviderError
 toPPWPError e = case fromException e of
     Just (InvalidUrlException _ _) -> PPWPInvalidUrl
-    Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (responseStatus resp) ("" :: String)
+    Just (HttpExceptionRequest _ (StatusCodeException resp _)) -> fromStatusCode (Just $ responseStatus resp)
     _ -> PPWPOtherError e
-  where
-    fromStatusCode status reason
-      | status == N.status200 = PPWPRemovedEndpoint
-      | status == N.status410 = PPWPRemovedEndpoint
-      | status == N.status413 = PPWPRequestTooLong
-      | status == N.status429 = PPRetryLater
-      | status >= N.status500 = PPRetryLater
-      | otherwise = PPResponseError (Just status) (tshow reason)
+
+fromStatusCode :: Maybe N.Status -> PushProviderError
+fromStatusCode status
+  | status == Just N.status404 = PPWPRemovedEndpoint
+  | status == Just N.status410 = PPWPRemovedEndpoint
+  | status == Just N.status413 = PPWPRequestTooLong
+  | status == Just N.status429 = PPRetryLater
+  | status >= Just N.status500 = PPRetryLater
+  | otherwise = PPResponseError status "Invalid response"