From 63c4647f3904437f3522d20ee0cb0fc44d205f12 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin Date: Tue, 11 Nov 2025 16:54:38 +0000 Subject: [PATCH] refactor --- .../Messaging/Notifications/Protocol.hs | 88 +++++-------------- .../Notifications/Server/Push/WebPush.hs | 22 ++--- .../Server/Store/ntf_server_schema.sql | 36 +++++++- 3 files changed, 67 insertions(+), 79 deletions(-) diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 93d18389b..07488c336 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -17,8 +17,8 @@ import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) import qualified Data.Aeson as J import qualified Data.Aeson.Encoding as JE import qualified Data.Attoparsec.ByteString.Char8 as A +import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B -import qualified Data.ByteString as S import Data.Functor (($>)) import Data.Kind import Data.List.NonEmpty (NonEmpty (..)) @@ -27,7 +27,7 @@ import Data.Maybe (isNothing) import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock.System import Data.Type.Equality -import Data.Word (Word8, Word16) +import Data.Word (Word16) import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts) import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_) import qualified Simplex.Messaging.Crypto as C @@ -113,7 +113,7 @@ instance ProtocolMsgTag NtfCmdTag where instance NtfEntityI e => ProtocolMsgTag (NtfCommandTag e) where decodeTag s = decodeTag s >>= (\(NCT _ t) -> checkEntity' t) -newtype NtfRegCode = NtfRegCode B.ByteString +newtype NtfRegCode = NtfRegCode ByteString deriving (Eq, Show) instance Encoding NtfRegCode where @@ -212,7 +212,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh SDEL -> e SDEL_ PING -> e PING_ where - e :: Encoding a => a -> B.ByteString + e :: Encoding a => a -> ByteString e = smpEncode protocolP _v tag = (\(NtfCmd _ c) -> checkEntity c) <$?> protocolP _v (NCT (sNtfEntity @e) tag) @@ -321,7 +321,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where NRSub stat -> e (NRSub_, ' ', stat) NRPong -> e NRPong_ where - e :: Encoding a => a -> B.ByteString + e :: Encoding a => a -> ByteString e = smpEncode protocolP _v = \case @@ -460,48 +460,12 @@ instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe instance ToField PushProvider where toField = toField . decodeLatin1 . strEncode -tupleToList16 - :: (a,a,a,a, - a,a,a,a, - a,a,a,a, - a,a,a,a) - -> [a] -tupleToList16 - (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) = - [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] +newtype WPAuth = WPAuth {unWPAuth :: ByteString} deriving (Eq, Ord, Show) -listToTuple16 - :: [a] - -> Maybe (a,a,a,a, - a,a,a,a, - a,a,a,a, - a,a,a,a) -listToTuple16 - [a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15] = - Just (a0,a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14,a15) -listToTuple16 _ = Nothing - -newtype Auth = Auth (Word8, Word8, Word8, Word8, - Word8, Word8, Word8, Word8, - Word8, Word8, Word8, Word8, - Word8, Word8, Word8, Word8) - -instance Eq Auth where - (Auth t1) == (Auth t2) = tupleToList16 t1 == tupleToList16 t2 - -instance Ord Auth where - compare (Auth t1) (Auth t2) = compare (tupleToList16 t1) (tupleToList16 t2) - -instance Show Auth where - show (Auth t) = "Auth " ++ show (tupleToList16 t) - -authFromByteString :: S.ByteString -> Maybe Auth -authFromByteString bs = do - tup <- listToTuple16 $ S.unpack bs - pure (Auth tup) - -authToByteString :: Auth -> S.ByteString -authToByteString (Auth a) = S.pack $ tupleToList16 a +toWPAuth :: ByteString -> Either String WPAuth +toWPAuth s + | B.length s == 16 = Right $ WPAuth s + | otherwise = Left "bad WPAuth" newtype WPP256dh = WPP256dh ECC.PublicPoint deriving (Eq, Show) @@ -515,7 +479,7 @@ instance Ord WPP256dh where comparePt (ECC.Point x1 y1) (ECC.Point x2 y2) = compare (x1, y1) (x2, y2) data WPKey = WPKey - { wpAuth :: Auth, + { wpAuth :: WPAuth, wpP256dh :: WPP256dh } deriving (Eq, Ord, Show) @@ -573,24 +537,18 @@ decodeBigInt s shift i w = Bits.shiftL (fromIntegral w) (64 * i) data WPTokenParams = WPTokenParams - { wpPath :: B.ByteString, + { wpPath :: ByteString, wpKey :: WPKey } deriving (Eq, Ord, Show) -instance Encoding Auth where - smpEncode a = smpEncode $ authToByteString a - smpP = smpP >>= \bs -> - case authFromByteString bs of - Nothing -> fail "Invalid auth" - Just a -> pure a +instance Encoding WPAuth where + smpEncode = smpEncode . unWPAuth + smpP = toWPAuth <$?> smpP -instance StrEncoding Auth where - strEncode a = strEncode $ authToByteString a - strP = strP >>= \bs -> - case authFromByteString bs of - Nothing -> fail "Invalid auth" - Just a -> pure a +instance StrEncoding WPAuth where + strEncode = strEncode . unWPAuth + strP = toWPAuth <$?> strP instance Encoding WPP256dh where smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p @@ -635,7 +593,7 @@ instance StrEncoding WPTokenParams where pure WPTokenParams {wpPath, wpKey} data DeviceToken - = APNSDeviceToken APNSProvider B.ByteString + = APNSDeviceToken APNSProvider ByteString | WPDeviceToken WPProvider WPTokenParams deriving (Eq, Ord, Show) @@ -689,13 +647,13 @@ instance FromJSON DeviceToken where -- | Returns fields for the device token (pushProvider, token) -- TODO [webpush] save token as separate fields -deviceTokenFields :: DeviceToken -> (PushProvider, B.ByteString) +deviceTokenFields :: DeviceToken -> (PushProvider, ByteString) deviceTokenFields dt = case dt of APNSDeviceToken p t -> (PPAPNS p, t) WPDeviceToken p t -> (PPWP p, strEncode t) -- | Returns the device token from the fields (pushProvider, token) -deviceToken' :: PushProvider -> B.ByteString -> DeviceToken +deviceToken' :: PushProvider -> ByteString -> DeviceToken deviceToken' pp t = case pp of PPAPNS p -> APNSDeviceToken p t PPWP p -> WPDeviceToken p <$> either error id $ strDecode t @@ -711,7 +669,7 @@ wpRequest (WPDeviceToken (WPP s) param) = do -- List of PNMessageData uses semicolon-separated encoding instead of strEncode, -- because strEncode of NonEmpty list uses comma for separator, -- and encoding of PNMessageData's smpQueue has comma in list of hosts -encodePNMessages :: NonEmpty PNMessageData -> B.ByteString +encodePNMessages :: NonEmpty PNMessageData -> ByteString encodePNMessages = B.intercalate ";" . map strEncode . L.toList pnMessagesP :: A.Parser (NonEmpty PNMessageData) @@ -756,7 +714,7 @@ data NtfSubStatus | -- | SMP SERVICE error - rejected service signature on individual subscriptions NSService | -- | SMP error other than AUTH - NSErr B.ByteString + NSErr ByteString deriving (Eq, Ord, Show) ntfShouldSubscribe :: NtfSubStatus -> Bool diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index 9a02ce1e0..9b1ebb9f8 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 (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, authToByteString, wpRequest) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except @@ -25,9 +25,6 @@ import Data.Aeson ((.=)) import qualified Data.Binary as Bin import qualified Data.ByteArray as BA 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 import Control.Monad.Trans.Except (throwE) import Crypto.Hash.Algorithms (SHA256) import Crypto.Random (MonadRandom(getRandomBytes)) @@ -61,7 +58,7 @@ wpPushProviderClient mg NtfTknRec {token = token@(WPDeviceToken _ param)} pn = d pure () where body :: ExceptT PushProviderError IO B.ByteString - body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodePN pn) + body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodeWPN pn) -- | encrypt :: UA key -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 @@ -78,7 +75,7 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do let uaPubKS = BL.toStrict . uncompressEncodePoint $ uaPubK let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK - prkKey = hmac auth ecdhSecret + prkKey = hmac (unWPAuth wpAuth) ecdhSecret keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS ikm = hmac prkKey (keyInfo <> "\x01") prk = hmac salt ikm @@ -99,7 +96,6 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do -- liftIO . print $ strEncode cipherT pure $ header <> cipherT <> BA.convert tag where - auth = authToByteString wpAuth hmac k v = HMAC.hmac k v :: HMAC.HMAC SHA256 takeHM :: Int -> HMAC.HMAC SHA256 -> B.ByteString takeHM n v = BL.toStrict $ BL.pack $ take n $ BA.unpack v @@ -108,14 +104,14 @@ wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do Left e -> throwE e Right iv -> pure iv -encodePN :: PushNotification -> BL.ByteString -encodePN pn = J.encode $ case pn of +encodeWPN :: PushNotification -> BL.ByteString +encodeWPN pn = J.encode $ case pn of PNVerification code -> J.object ["verification" .= code] - PNMessage d -> J.object ["message" .= encodeData d] + -- This hack prevents sending unencrypted message metadata in notifications, as we do not use it in the client - it simply receives all messages on each notification. + -- If we decide to change it to pull model as used in iOS, we can change JSON key to "message" with any payload, as the current clients would interpret it as "checkMessages". + -- In this case an additional encryption layer would need to be added here, in the same way as with APNS notifications. + PNMessage _ -> J.object ["checkMessages" .= True] 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 diff --git a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql index 3b155fa1a..535652b68 100644 --- a/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql +++ b/src/Simplex/Messaging/Notifications/Server/Store/ntf_server_schema.sql @@ -92,7 +92,31 @@ CREATE TABLE ntf_server.tokens ( reg_code bytea NOT NULL, cron_interval bigint NOT NULL, cron_sent_at bigint, - updated_at bigint + updated_at bigint, + wp_server_id bigint, + wp_path text, + wp_auth bytea, + wp_key bytea +); + + + +CREATE TABLE ntf_server.webpush_servers ( + wp_server_id bigint NOT NULL, + wp_host text NOT NULL, + wp_port text NOT NULL, + wp_keyhash bytea NOT NULL +); + + + +ALTER TABLE ntf_server.webpush_servers ALTER COLUMN wp_server_id ADD GENERATED ALWAYS AS IDENTITY ( + SEQUENCE NAME ntf_server.webpush_servers_wp_server_id_seq + START WITH 1 + INCREMENT BY 1 + NO MINVALUE + NO MAXVALUE + CACHE 1 ); @@ -122,6 +146,11 @@ ALTER TABLE ONLY ntf_server.tokens +ALTER TABLE ONLY ntf_server.webpush_servers + ADD CONSTRAINT webpush_servers_pkey PRIMARY KEY (wp_server_id); + + + CREATE INDEX idx_last_notifications_subscription_id ON ntf_server.last_notifications USING btree (subscription_id); @@ -178,3 +207,8 @@ ALTER TABLE ONLY ntf_server.subscriptions +ALTER TABLE ONLY ntf_server.tokens + ADD CONSTRAINT tokens_wp_server_id_fkey FOREIGN KEY (wp_server_id) REFERENCES ntf_server.webpush_servers(wp_server_id) ON UPDATE RESTRICT ON DELETE RESTRICT; + + +