diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 7957e0ad8..dfc18013e 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -394,6 +394,9 @@ newtype WPSrvLoc = WPSrvLoc SrvLoc newtype WPProvider = WPP WPSrvLoc deriving (Eq, Ord, Show) +wpAud :: WPProvider -> B.ByteString +wpAud (WPP (WPSrvLoc (SrvLoc aud _))) = B.pack aud + instance Encoding PushProvider where smpEncode = \case PPAPNS p -> smpEncode p diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index b15e45d83..1b3ad1230 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -49,6 +49,7 @@ import UnliftIO.STM import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient, WebPushConfig) import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager) import Network.HTTP.Client.TLS (tlsManagerSettings) +import Data.IORef (newIORef) data NtfServerConfig = NtfServerConfig { transports :: [(ServiceName, ASrvTransport, AddHTTP)], @@ -179,10 +180,12 @@ newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient -newWPPushClient NtfPushServer {pushClients} pp = do +newWPPushClient NtfPushServer {wpConfig, pushClients} pp = do logDebug "New WP Client requested" -- We use one http manager per push server (which may be used by different clients) - wpPushProviderClient <$> wpHTTPManager + manager <- wpHTTPManager + cache <- newIORef Nothing + pure $ wpPushProviderClient wpConfig cache manager wpHTTPManager :: IO Manager wpHTTPManager = newManager tlsManagerSettings { diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs index 1f3579545..1039e5448 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push.hs @@ -12,6 +12,8 @@ module Simplex.Messaging.Notifications.Server.Push where import Crypto.Hash.Algorithms (SHA256 (..)) import qualified Crypto.PubKey.ECC.ECDSA as EC +import qualified Crypto.PubKey.ECC.Types as ECT +import qualified Crypto.Store.PKCS8 as PK import Data.ASN1.BinaryEncoding (DER (..)) import Data.ASN1.Encoding import Data.ASN1.Types @@ -25,6 +27,7 @@ import Data.Int (Int64) import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Data.Time.Clock.System +import qualified Data.X509 as X import Simplex.Messaging.Notifications.Protocol import Simplex.Messaging.Parsers (defaultJSON) import Simplex.Messaging.Transport.HTTP2.Client (HTTP2ClientError) @@ -36,14 +39,21 @@ import Control.Monad.Except (ExceptT) import GHC.Exception (SomeException) data JWTHeader = JWTHeader - { alg :: Text, -- key algorithm, ES256 for APNS - kid :: Text -- key ID + { typ :: Text, -- "JWT" + alg :: Text, -- key algorithm, ES256 for APNS + kid :: Maybe Text -- key ID } deriving (Show) +mkJWTHeader :: Text -> Maybe Text -> JWTHeader +mkJWTHeader alg kid = JWTHeader { typ = "JWT", alg, kid } + data JWTClaims = JWTClaims - { iss :: Text, -- issuer, team ID for APNS - iat :: Int64 -- issue time, seconds from epoch + { iss :: Maybe Text, -- issuer, team ID for APNS + iat :: Maybe Int64, -- issue time, seconds from epoch for APNS + exp :: Maybe Int64, -- expired time, seconds from epoch for web push + aud :: Maybe Text, -- audience, for web push + sub :: Maybe Text -- subject, to be inform if there is an issue, for web push } deriving (Show) @@ -53,7 +63,15 @@ data JWTToken = JWTToken JWTHeader JWTClaims mkJWTToken :: JWTHeader -> Text -> IO JWTToken mkJWTToken hdr iss = do iat <- systemSeconds <$> getSystemTime - pure $ JWTToken hdr JWTClaims {iss, iat} + pure $ JWTToken hdr $ jwtClaims iat + where + jwtClaims iat = JWTClaims + { iss = Just iss, + iat = Just iat, + exp = Nothing, + aud = Nothing, + sub = Nothing + } type SignedJWTToken = ByteString @@ -71,6 +89,12 @@ signedJWTToken pk (JWTToken hdr claims) = do jwtEncode = U.encodeUnpadded . LB.toStrict . J.encode serialize sig = U.encodeUnpadded $ encodeASN1' DER [Start Sequence, IntVal (EC.sign_r sig), IntVal (EC.sign_s sig), End Sequence] +readECPrivateKey :: FilePath -> IO EC.PrivateKey +readECPrivateKey f = do + -- this pattern match is specific to APNS key type, it may need to be extended for other push providers + [PK.Unprotected (X.PrivKeyEC X.PrivKeyEC_Named {privkeyEC_name, privkeyEC_priv})] <- PK.readKeyFile f + pure EC.PrivateKey {private_curve = ECT.getCurveByName privkeyEC_name, private_d = privkeyEC_priv} + data PushNotification = PNVerification NtfRegCode | PNMessage (NonEmpty PNMessageData) diff --git a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs index 4e6b099e1..929360b53 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -162,7 +162,7 @@ createAPNSPushClient apnsHost apnsCfg@APNSPushClientConfig {authKeyFileEnv, auth void $ connectHTTPS2 apnsHost apnsCfg https2Client privateKey <- C.readECPrivateKey =<< getEnv authKeyFileEnv authKeyId <- T.pack <$> getEnv authKeyIdEnv - let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId} + let jwtHeader = mkJWTHeader authKeyAlg (Just authKeyId) jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey nonceDrg <- C.newRandom pure APNSPushClient {https2Client, privateKey, jwtHeader, jwtToken, nonceDrg, apnsHost, apnsCfg} @@ -178,7 +178,8 @@ getApnsJWTToken APNSPushClient {apnsCfg = APNSPushClientConfig {appTeamId, token atomically $ writeTVar jwtToken t pure signedJWT' where - jwtTokenAge (JWTToken _ JWTClaims {iat}) = subtract iat . systemSeconds <$> getSystemTime + jwtTokenAge (JWTToken _ JWTClaims {iat = Just iat}) = subtract iat . systemSeconds <$> getSystemTime + jwtTokenAge (JWTToken _ JWTClaims {iat = Nothing}) = pure maxBound :: IO Int64 mkApnsJWTToken :: Text -> JWTHeader -> EC.PrivateKey -> IO (JWTToken, SignedJWTToken) mkApnsJWTToken appTeamId jwtHeader privateKey = do diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index 959eb3fd6..704726380 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -10,7 +10,7 @@ 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 (..), wpRequest) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest, wpAud) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except @@ -34,6 +34,10 @@ import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import qualified Data.ByteString.Base64.URL as B64 +import Data.IORef +import Data.Int (Int64) +import Data.Time.Clock.System (systemSeconds, getSystemTime) +import qualified Data.Text.Encoding as T -- | Vapid -- | fp: fingerprint, base64url encoded without padding @@ -53,18 +57,76 @@ data WebPushConfig = WebPushConfig { vapidKey :: VapidKey } -wpPushProviderClient :: Manager -> PushProviderClient -wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher -wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = do +data WPCache = WPCache + { vapidHeader :: B.ByteString, + expire :: Int64 + } + +getVapidHeader :: VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString +getVapidHeader vapidK cache uriAuthority = do + h <- readIORef cache + now <- systemSeconds <$> getSystemTime + case h of + Nothing -> newCacheEntry now + Just entry -> if expire entry > now then pure $ vapidHeader entry + else newCacheEntry now + where + newCacheEntry :: Int64 -> IO B.ByteString + newCacheEntry now = do + -- The new entry expires in one hour + let expire = now + 3600 + vapidHeader <- mkVapidHeader vapidK uriAuthority expire + let entry = Just WPCache { vapidHeader, expire } + atomicWriteIORef cache entry + pure vapidHeader + +-- | With time in input for the tests +getVapidHeader' :: Int64 -> VapidKey -> IORef (Maybe WPCache) -> B.ByteString -> IO B.ByteString +getVapidHeader' now vapidK cache uriAuthority = do + h <- readIORef cache + case h of + Nothing -> newCacheEntry + Just entry -> if expire entry > now then pure $ vapidHeader entry + else newCacheEntry + where + newCacheEntry :: IO B.ByteString + newCacheEntry = do + -- The new entry expires in one hour + let expire = now + 3600 + vapidHeader <- mkVapidHeader vapidK uriAuthority expire + let entry = Just WPCache { vapidHeader, expire } + atomicWriteIORef cache entry + pure vapidHeader + +-- | mkVapidHeader -> vapid -> endpoint -> expire -> vapid header +mkVapidHeader :: VapidKey -> B.ByteString -> Int64 -> IO B.ByteString +mkVapidHeader VapidKey {key, fp} uriAuthority expire = do + let jwtHeader = mkJWTHeader "ES256" Nothing + jwtClaims = JWTClaims + { iss = Nothing, + iat = Nothing, + exp = Just expire, + aud = Just $ T.decodeUtf8 uriAuthority, + sub = Just "https://github.com/simplex-chat/simplexmq/" + } + jwt = JWTToken jwtHeader jwtClaims + signedToken <- signedJWTToken key jwt + pure $ "vapid t=" <> signedToken <> ",k=" <> fp + +wpPushProviderClient :: WebPushConfig -> IORef (Maybe WPCache) -> Manager -> PushProviderClient +wpPushProviderClient _ _ _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher +wpPushProviderClient conf cache mg NtfTknRec {token = token@(WPDeviceToken pp 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 + vapidH <- liftPPWPError $ getVapidHeader (vapidKey conf) cache aud logDebug $ "Request to " <> tshow (host r) encBody <- body let requestHeaders = [ ("TTL", "2592000"), -- 30 days ("Urgency", "high"), - ("Content-Encoding", "aes128gcm") + ("Content-Encoding", "aes128gcm"), + ("Authorization", vapidH) -- TODO: topic for pings and interval ] req = @@ -79,6 +141,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d where body :: ExceptT PushProviderError IO B.ByteString body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn) + aud = wpAud pp -- | encrypt :: UA key -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs index 64d04f86e..b884c964b 100644 --- a/tests/NtfWPTests.hs +++ b/tests/NtfWPTests.hs @@ -10,7 +10,7 @@ import Simplex.Messaging.Encoding.String (StrEncoding(..)) import qualified Data.ByteString as B import qualified Crypto.PubKey.ECC.Types as ECC import Simplex.Messaging.Notifications.Protocol -import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN) +import Simplex.Messaging.Notifications.Server.Push.WebPush (wpEncrypt', encodeWPN, getVapidHeader') import Control.Monad.Except (runExceptT) import qualified Data.ByteString.Lazy as BL import Simplex.Messaging.Notifications.Server.Push @@ -18,6 +18,9 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Simplex.Messaging.Crypto as C import Data.Time.Clock.System (SystemTime(..)) import Data.Either (isLeft) +import Data.IORef (newIORef) +import Simplex.Messaging.Notifications.Server.Main (getVapidKey) +import Control.Monad (unless) ntfWPTests :: Spec ntfWPTests = describe "NTF Protocol" $ do @@ -25,6 +28,7 @@ ntfWPTests = describe "NTF Protocol" $ do it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding it "Encrypt RFC8291 example" testWPEncryption it "PushNotifications encoding" testPNEncoding + it "Vapid header cache" testVapidCache testWPDeviceTokenStrEncoding :: Expectation testWPDeviceTokenStrEncoding = do @@ -89,3 +93,29 @@ testPNEncoding = do let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA" let now = MkSystemTime 1761827386 0 PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| [] + +testVapidCache :: Expectation +testVapidCache = do + let wpaud = "https://localhost" + let now = 1761900906 + cache <- newIORef Nothing + vapidKey <- getVapidKey "tests/fixtures/vapid.privkey" + v1 <- getVapidHeader' now vapidKey cache wpaud + v2 <- getVapidHeader' now vapidKey cache wpaud + v1 `shouldBe` v2 + -- we just don't test the signature here + v1 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9.eyJleHAiOjE3NjE5MDQ1MDYsImF1ZCI6Imh0dHBzOi8vbG9jYWxob3N0Iiwic3ViIjoiaHR0cHM6Ly9naXRodWIuY29tL3NpbXBsZXgtY2hhdC9zaW1wbGV4bXEvIn0." + v1 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA" + v3 <- getVapidHeader' (now + 3600) vapidKey cache wpaud + v1 `shouldNotBe` v3 + v3 `shouldContainBS` "vapid t=eyJ0eXAiOiJKV1QiLCJhbGciOiJFUzI1NiJ9." + v3 `shouldContainBS` ",k=BIk7ASkEr1A1rJRGXMKi77tAGj3dRouSgZdW6S5pee7a3h7fkvd0OYQixy4yj35UFZt8hd9TwAQiybDK_HJLwJA" + +shouldContainBS :: B.ByteString -> B.ByteString -> Expectation +shouldContainBS actual expected = + unless (expected `B.isInfixOf` actual) $ + expectationFailure $ + "Expected ByteString to contain:\n" ++ + show expected ++ + "\nBut got:\n" ++ + show actual