diff --git a/simplexmq.cabal b/simplexmq.cabal index 1ff387862..7643515d8 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -508,6 +508,7 @@ test-suite simplexmq-test AgentTests.NotificationTests NtfClient NtfServerTests + NtfWPTests PostgresSchemaDump hs-source-dirs: tests diff --git a/src/Simplex/Messaging/Crypto.hs b/src/Simplex/Messaging/Crypto.hs index 46d8dd10a..8adaf06cc 100644 --- a/src/Simplex/Messaging/Crypto.hs +++ b/src/Simplex/Messaging/Crypto.hs @@ -86,6 +86,7 @@ module Simplex.Messaging.Crypto signatureKeyPair, publicToX509, encodeASNObj, + readECPrivateKey, -- * key encoding/decoding encodePubKey, @@ -93,6 +94,9 @@ module Simplex.Messaging.Crypto encodePrivKey, decodePrivKey, pubKeyBytes, + uncompressEncodePoint, + uncompressDecodePoint, + uncompressDecodePrivateNumber, -- * sign/verify Signature (..), @@ -251,6 +255,12 @@ import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (parseAll, parseString) import Simplex.Messaging.Util ((<$?>)) +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.Store.PKCS8 as PK +import qualified Crypto.PubKey.ECC.Types as ECC +import qualified Data.ByteString.Lazy as BL +import qualified Data.Binary as Bin +import qualified Data.Bits as Bits -- | Cryptographic algorithms. data Algorithm = Ed25519 | Ed448 | X25519 | X448 @@ -1532,3 +1542,56 @@ keyError :: (a, [ASN1]) -> Either String b keyError = \case (_, []) -> Left "unknown key algorithm" _ -> Left "more than one key" + +readECPrivateKey :: FilePath -> IO ECDSA.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 ECDSA.PrivateKey {private_curve = ECC.getCurveByName privkeyEC_name, private_d = privkeyEC_priv} + +-- | Elliptic-Curve-Point-to-Octet-String Conversion without compression +-- | as required by RFC8291 +-- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 +uncompressEncodePoint :: ECC.Point -> BL.ByteString +uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y +uncompressEncodePoint ECC.PointO = "\0" + +uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point +uncompressDecodePoint "\0" = pure ECC.PointO +uncompressDecodePoint s + | BL.take 1 s /= prefix = Left CE.CryptoError_PointFormatUnsupported + | BL.length s /= 65 = Left CE.CryptoError_KeySizeInvalid + | otherwise = do + let s' = BL.drop 1 s + x <- decodeBigInt $ BL.take 32 s' + y <- decodeBigInt $ BL.drop 32 s' + pure $ ECC.Point x y + where + prefix = "\x04" :: BL.ByteString + +-- Used to test encryption against the RFC8291 Example - which gives the AS private key +uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber +uncompressDecodePrivateNumber s + | BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid + | otherwise = do + decodeBigInt s + +encodeBigInt :: Integer -> BL.ByteString +encodeBigInt i = do + let s1 = Bits.shiftR i 64 + s2 = Bits.shiftR s1 64 + s3 = Bits.shiftR s2 64 + Bin.encode (w64 s3, w64 s2, w64 s1, w64 i) + where + w64 :: Integer -> Bin.Word64 + w64 = fromIntegral + +decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer +decodeBigInt s + | BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid + | otherwise = do + let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 ) + pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0 + where + shift i w = Bits.shiftL (fromIntegral w) (64 * i) + diff --git a/src/Simplex/Messaging/Notifications/Protocol.hs b/src/Simplex/Messaging/Notifications/Protocol.hs index 1b074be43..a7242bb8c 100644 --- a/src/Simplex/Messaging/Notifications/Protocol.hs +++ b/src/Simplex/Messaging/Notifications/Protocol.hs @@ -12,14 +12,13 @@ module Simplex.Messaging.Notifications.Protocol where import Control.Applicative (optional, (<|>)) -import Control.Monad import qualified Crypto.PubKey.ECC.Types as ECC 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 (..)) @@ -28,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 (Word16) +import Data.Word (Word8, Word16) import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts) import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_) import qualified Simplex.Messaging.Crypto as C @@ -37,6 +36,11 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Transport (NTFVersion, invalidReasonNTFVersion, ntfClientHandshake) import Simplex.Messaging.Protocol hiding (Command (..), CommandTag (..)) import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Binary as Bin +import qualified Crypto.Error as CE +import qualified Data.Bits as Bits +import Network.HTTP.Client (Request, parseUrlThrow) data NtfEntity = Token | Subscription deriving (Show) @@ -109,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 ByteString +newtype NtfRegCode = NtfRegCode B.ByteString deriving (Eq, Show) instance Encoding NtfRegCode where @@ -208,7 +212,7 @@ instance NtfEntityI e => ProtocolEncoding NTFVersion ErrorType (NtfCommand e) wh SDEL -> e SDEL_ PING -> e PING_ where - e :: Encoding a => a -> ByteString + e :: Encoding a => a -> B.ByteString e = smpEncode protocolP _v tag = (\(NtfCmd _ c) -> checkEntity c) <$?> protocolP _v (NCT (sNtfEntity @e) tag) @@ -317,7 +321,7 @@ instance ProtocolEncoding NTFVersion ErrorType NtfResponse where NRSub stat -> e (NRSub_, ' ', stat) NRPong -> e NRPong_ where - e :: Encoding a => a -> ByteString + e :: Encoding a => a -> B.ByteString e = smpEncode protocolP _v = \case @@ -384,7 +388,10 @@ data APNSProvider | PPApnsNull -- used to test servers from the client - does not communicate with APNS deriving (Eq, Ord, Show) -newtype WPProvider = WPP (ProtocolServer 'PHTTPS) +newtype WPSrvLoc = WPSrvLoc SrvLoc + deriving (Eq, Ord, Show) + +newtype WPProvider = WPP WPSrvLoc deriving (Eq, Ord, Show) instance Encoding PushProvider where @@ -433,6 +440,14 @@ instance StrEncoding APNSProvider where "apns_null" -> pure PPApnsNull _ -> fail "bad APNSProvider" +instance Encoding WPSrvLoc where + smpEncode (WPSrvLoc srv) = smpEncode srv + smpP = WPSrvLoc <$> smpP + +instance StrEncoding WPSrvLoc where + strEncode (WPSrvLoc srv) = "https://" <> strEncode srv + strP = WPSrvLoc <$> ("https://" *> strP) + instance Encoding WPProvider where smpEncode (WPP srv) = "WP" <> smpEncode srv smpP = WPP <$> ("WP" *> smpP) @@ -441,64 +456,141 @@ instance StrEncoding WPProvider where strEncode (WPP srv) = "webpush " <> strEncode srv strP = WPP <$> ("webpush " *> strP) -instance FromField APNSProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 - -instance ToField APNSProvider where toField = toField . decodeLatin1 . strEncode +instance FromField PushProvider where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 + +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] + +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 + +newtype WPP256dh = WPP256dh ECC.PublicPoint + deriving (Eq, Show) -data WPTokenParams = WPTokenParams - { wpPath :: Text, -- parser should validate it's a valid type - wpAuth :: ByteString, -- if we enforce size constraints, should also be in parser. - wpKey :: WPKey -- or another correct type that is needed for encryption, so it fails in parser and not there +instance Ord WPP256dh where + compare (WPP256dh p1) (WPP256dh p2) = comparePt p1 p2 + where + comparePt ECC.PointO ECC.PointO = EQ + comparePt ECC.PointO (ECC.Point _ _) = LT + comparePt (ECC.Point _ _) ECC.PointO = GT + comparePt (ECC.Point x1 y1) (ECC.Point x2 y2) = compare (x1, y1) (x2, y2) + +data WPKey = WPKey + { wpAuth :: Auth, + wpP256dh :: WPP256dh } + deriving (Eq, Ord, Show) + +uncompressEncode :: WPP256dh -> BL.ByteString +uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p -newtype WPKey = WPKey ECC.Point +uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh +uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs -data WPEndpoint = WPEndpoint - { endpoint :: ByteString, - auth :: ByteString, - p256dh :: ByteString +data WPTokenParams = WPTokenParams + { wpPath :: B.ByteString, + wpKey :: WPKey } deriving (Eq, Ord, Show) -instance Encoding WPEndpoint where - smpEncode WPEndpoint {endpoint, auth, p256dh} = smpEncode (endpoint, auth, p256dh) +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 StrEncoding Auth where + strEncode a = strEncode $ authToByteString a + strP = strP >>= \bs -> + case authFromByteString bs of + Nothing -> fail "Invalid auth" + Just a -> pure a + +instance Encoding WPP256dh where + smpEncode p = smpEncode . BL.toStrict $ uncompressEncode p + smpP = smpP >>= \bs -> + case uncompressDecode (BL.fromStrict bs) of + Left _ -> fail "Invalid p256dh key" + Right res -> pure res + +instance StrEncoding WPP256dh where + strEncode p = strEncode . BL.toStrict $ uncompressEncode p + strP = strP >>= \bs -> + case uncompressDecode (BL.fromStrict bs) of + Left _ -> fail "Invalid p256dh key" + Right res -> pure res + +instance Encoding WPKey where + smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh) + smpP = do + wpAuth <- smpP + wpP256dh <- smpP + pure WPKey {wpAuth, wpP256dh} + +instance StrEncoding WPKey where + strEncode WPKey {wpAuth, wpP256dh} = strEncode (wpAuth, wpP256dh) + strP = do + (wpAuth, wpP256dh) <- strP + pure WPKey {wpAuth, wpP256dh} + +instance Encoding WPTokenParams where + smpEncode WPTokenParams {wpPath, wpKey} = smpEncode (wpPath, wpKey) smpP = do - endpoint <- smpP - auth <- smpP - p256dh <- smpP - pure WPEndpoint {endpoint, auth, p256dh} + wpPath <- smpP + wpKey <- smpP + pure WPTokenParams {wpPath, wpKey} -instance StrEncoding WPEndpoint where - strEncode WPEndpoint {endpoint, auth, p256dh} = endpoint <> " " <> strEncode auth <> " " <> strEncode p256dh +instance StrEncoding WPTokenParams where + strEncode WPTokenParams {wpPath, wpKey} = wpPath <> " " <> strEncode wpKey strP = do - endpoint <- A.takeWhile (/= ' ') + wpPath <- A.takeWhile (/= ' ') _ <- A.char ' ' - (auth, p256dh) <- strP - -- auth is a 16 bytes long random key - when (B.length auth /= 16) $ fail "Invalid auth key length" - -- p256dh is a public key on the P-256 curve, encoded in uncompressed format - -- 0x04 + the 2 points = 65 bytes - when (B.length p256dh /= 65) $ fail "Invalid p256dh key length" - -- TODO [webpush] parse it here (or rather in WPTokenParams) - when (B.take 1 p256dh /= "\x04") $ fail "Invalid p256dh key, doesn't start with 0x04" - pure WPEndpoint {endpoint, auth, p256dh} - -instance ToJSON WPEndpoint where - toEncoding WPEndpoint {endpoint, auth, p256dh} = J.pairs $ "endpoint" .= decodeLatin1 endpoint <> "auth" .= decodeLatin1 (strEncode auth) <> "p256dh" .= decodeLatin1 (strEncode p256dh) - toJSON WPEndpoint {endpoint, auth, p256dh} = J.object ["endpoint" .= decodeLatin1 endpoint, "auth" .= decodeLatin1 (strEncode auth), "p256dh" .= decodeLatin1 (strEncode p256dh) ] - -instance FromJSON WPEndpoint where - parseJSON = J.withObject "WPEndpoint" $ \o -> do - endpoint <- encodeUtf8 <$> o .: "endpoint" - auth <- strDecode . encodeUtf8 <$?> o .: "auth" - p256dh <- strDecode . encodeUtf8 <$?> o .: "p256dh" - pure WPEndpoint {endpoint, auth, p256dh} + wpKey <- strP + pure WPTokenParams {wpPath, wpKey} data DeviceToken - = APNSDeviceToken APNSProvider ByteString - | WPDeviceToken WPProvider WPEndpoint - -- TODO [webpush] replace with WPTokenParams - -- | WPDeviceToken WPProvider WPTokenParams + = APNSDeviceToken APNSProvider B.ByteString + | WPDeviceToken WPProvider WPTokenParams deriving (Eq, Ord, Show) instance Encoding DeviceToken where @@ -513,50 +605,67 @@ instance Encoding DeviceToken where instance StrEncoding DeviceToken where strEncode token = case token of APNSDeviceToken p t -> strEncode p <> " " <> t - WPDeviceToken p t -> strEncode (p, t) + -- We don't do strEncode (p, t), because we don't want any space between + -- p (e.g. webpush https://localhost) and t.wpPath (e.g /random) + WPDeviceToken p t -> strEncode p <> strEncode t strP = nullToken <|> deviceToken where nullToken = "apns_null test_ntf_token" $> APNSDeviceToken PPApnsNull "test_ntf_token" deviceToken = - strP_ >>= \case + strP >>= \case PPAPNS p -> APNSDeviceToken p <$> hexStringP - PPWP p -> WPDeviceToken p <$> strP - hexStringP = + PPWP p -> do + t <- WPDeviceToken p <$> strP + _ <- wpRequest t + pure t + hexStringP = do + _ <- A.space A.takeWhile (`B.elem` "0123456789abcdef") >>= \s -> if even (B.length s) then pure s else fail "odd number of hex characters" --- TODO [webpush] is it needed? instance ToJSON DeviceToken where toEncoding token = case token of APNSDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= decodeLatin1 t - WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t + -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt + WPDeviceToken p _ -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) + -- WPDeviceToken p t -> J.pairs $ "pushProvider" .= decodeLatin1 (strEncode p) <> "token" .= toJSON t toJSON token = case token of APNSDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= decodeLatin1 t] - WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t] + -- ToJSON/FromJSON isn't used for WPDeviceToken, we just include the pushProvider so it can fail properly if used to decrypt + WPDeviceToken p _ -> J.object ["pushProvider" .= decodeLatin1 (strEncode p)] + -- WPDeviceToken p t -> J.object ["pushProvider" .= decodeLatin1 (strEncode p), "token" .= toJSON t] instance FromJSON DeviceToken where parseJSON = J.withObject "DeviceToken" $ \o -> (strDecode . encodeUtf8 <$?> o .: "pushProvider") >>= \case PPAPNS p -> APNSDeviceToken p . encodeUtf8 <$> (o .: "token") - PPWP p -> WPDeviceToken p <$> (o .: "token") + PPWP _ -> fail "FromJSON not implemented for WPDeviceToken" -- | Returns fields for the device token (pushProvider, token) -- TODO [webpush] save token as separate fields -deviceTokenFields :: DeviceToken -> (PushProvider, ByteString) +deviceTokenFields :: DeviceToken -> (PushProvider, B.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 -> ByteString -> DeviceToken +deviceToken' :: PushProvider -> B.ByteString -> DeviceToken deviceToken' pp t = case pp of PPAPNS p -> APNSDeviceToken p t PPWP p -> WPDeviceToken p <$> either error id $ strDecode t +wpRequest :: MonadFail m => DeviceToken -> m Request +wpRequest (APNSDeviceToken _ _) = fail "Invalid device token" +wpRequest (WPDeviceToken (WPP s) param) = do + let endpoint = strEncode s <> wpPath param + case parseUrlThrow $ B.unpack endpoint of + Left _ -> fail "Invalid URL" + Right r -> pure r + -- 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 -> ByteString +encodePNMessages :: NonEmpty PNMessageData -> B.ByteString encodePNMessages = B.intercalate ";" . map strEncode . L.toList pnMessagesP :: A.Parser (NonEmpty PNMessageData) @@ -601,7 +710,7 @@ data NtfSubStatus | -- | SMP SERVICE error - rejected service signature on individual subscriptions NSService | -- | SMP error other than AUTH - NSErr ByteString + NSErr B.ByteString deriving (Eq, Ord, Show) ntfShouldSubscribe :: NtfSubStatus -> Bool diff --git a/src/Simplex/Messaging/Notifications/Server/Env.hs b/src/Simplex/Messaging/Notifications/Server/Env.hs index a4b2fca6e..ec7ae5166 100644 --- a/src/Simplex/Messaging/Notifications/Server/Env.hs +++ b/src/Simplex/Messaging/Notifications/Server/Env.hs @@ -47,7 +47,7 @@ import System.Exit (exitFailure) import System.Mem.Weak (Weak) import UnliftIO.STM import Simplex.Messaging.Notifications.Server.Push.WebPush (wpPushProviderClient) -import Network.HTTP.Client (newManager) +import Network.HTTP.Client (newManager, ManagerSettings (..), Request (..), Manager) import Network.HTTP.Client.TLS (tlsManagerSettings) data NtfServerConfig = NtfServerConfig @@ -165,25 +165,35 @@ newNtfPushServer qSize apnsConfig = do newPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient newPushClient s pp = do case pp of - PPWebPush -> newWPPushClient s - _ -> newAPNSPushClient s pp + PPWP p -> newWPPushClient s p + PPAPNS p -> newAPNSPushClient s p -newAPNSPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient +newAPNSPushClient :: NtfPushServer -> APNSProvider -> IO PushProviderClient newAPNSPushClient NtfPushServer {apnsConfig, pushClients} pp = do c <- case apnsProviderHost pp of Nothing -> pure $ \_ _ -> pure () Just host -> apnsPushProviderClient <$> createAPNSPushClient host apnsConfig - atomically $ TM.insert pp c pushClients + atomically $ TM.insert (PPAPNS pp) c pushClients pure c -newWPPushClient :: NtfPushServer -> IO PushProviderClient -newWPPushClient NtfPushServer {pushClients} = do +newWPPushClient :: NtfPushServer -> WPProvider -> IO PushProviderClient +newWPPushClient NtfPushServer {pushClients} pp = do logDebug "New WP Client requested" - manager <- newManager tlsManagerSettings + -- We use one http manager per push server (which may be used by different clients) + manager <- wpHTTPManager let c = wpPushProviderClient manager - atomically $ TM.insert PPWebPush c pushClients + atomically $ TM.insert (PPWP pp) c pushClients pure c +wpHTTPManager :: IO Manager +wpHTTPManager = newManager tlsManagerSettings { + -- Ideally, we should be able to override the domain resolution to + -- disable requests to non-public IPs. The risk is very limited as + -- we allow https only, and the body is encrypted. Disabling redirections + -- avoids cross-protocol redir (https => http/unix) + managerModifyRequest = \r -> pure r { redirectCount = 0 } + } + getPushClient :: NtfPushServer -> PushProvider -> IO PushProviderClient getPushClient s@NtfPushServer {pushClients} pp = TM.lookupIO pp pushClients >>= maybe (newPushClient s pp) pure diff --git a/src/Simplex/Messaging/Notifications/Server/Push.hs b/src/Simplex/Messaging/Notifications/Server/Push.hs index a2a954b08..1f3579545 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push.hs @@ -12,8 +12,6 @@ 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 @@ -27,7 +25,6 @@ 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) @@ -74,12 +71,6 @@ 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 ebe223830..4e6b099e1 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/APNS.hs @@ -160,7 +160,7 @@ createAPNSPushClient :: HostName -> APNSPushClientConfig -> IO APNSPushClient createAPNSPushClient apnsHost apnsCfg@APNSPushClientConfig {authKeyFileEnv, authKeyAlg, authKeyIdEnv, appTeamId} = do https2Client <- newTVarIO Nothing void $ connectHTTPS2 apnsHost apnsCfg https2Client - privateKey <- readECPrivateKey =<< getEnv authKeyFileEnv + privateKey <- C.readECPrivateKey =<< getEnv authKeyFileEnv authKeyId <- T.pack <$> getEnv authKeyIdEnv let jwtHeader = JWTHeader {alg = authKeyAlg, kid = authKeyId} jwtToken <- newTVarIO =<< mkApnsJWTToken appTeamId jwtHeader privateKey @@ -257,8 +257,8 @@ $(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse) -- TODO [webpush] change type accept token components so it only allows APNS token apnsPushProviderClient :: APNSPushClient -> PushProviderClient -apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token} pn = do - tknStr <- deviceToken token +apnsPushProviderClient _ NtfTknRec {token = WPDeviceToken _ _} _ = throwE PPInvalidPusher +apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token = APNSDeviceToken _ tknStr} pn = do http2 <- liftHTTPS2 $ getApnsHTTP2Client c nonce <- atomically $ C.randomCbNonce nonceDrg apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn @@ -272,9 +272,6 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknRec {token else logWarn $ "APNS error: " <> T.pack (show status) <> " " <> reason' <> apnsIds response result status reason' where - deviceToken t = case t of - APNSDeviceToken _ dt -> pure dt - _ -> throwE PPInvalidPusher apnsIds response = headerStr "apns-id" <> headerStr "apns-unique-id" where headerStr name = diff --git a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs index be681b034..24beb7a39 100644 --- a/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs +++ b/src/Simplex/Messaging/Notifications/Server/Push/WebPush.hs @@ -1,10 +1,7 @@ -{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use newtype instead of data" #-} @@ -13,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), WPEndpoint (..), encodePNMessages, PNMessageData) +import Simplex.Messaging.Notifications.Protocol (DeviceToken (WPDeviceToken, APNSDeviceToken), encodePNMessages, PNMessageData, WPKey (..), WPTokenParams (..), WPP256dh (..), authToByteString, wpRequest) import Simplex.Messaging.Notifications.Server.Store.Types import Simplex.Messaging.Notifications.Server.Push import Control.Monad.Except @@ -26,7 +23,6 @@ import qualified Network.HTTP.Types as N import qualified Data.Aeson as J import Data.Aeson ((.=)) import qualified Data.Binary as Bin -import qualified Data.Bits as Bits import qualified Data.ByteArray as BA import qualified Data.ByteString.Lazy as BL import Data.List.NonEmpty (NonEmpty) @@ -36,20 +32,18 @@ import Control.Monad.Trans.Except (throwE) import Crypto.Hash.Algorithms (SHA256) import Crypto.Random (MonadRandom(getRandomBytes)) import qualified Crypto.Cipher.Types as CT -import qualified Crypto.Error as CE import qualified Crypto.MAC.HMAC as HMAC import qualified Crypto.PubKey.ECC.DH as ECDH import qualified Crypto.PubKey.ECC.Types as ECC -import GHC.Base (when) wpPushProviderClient :: Manager -> PushProviderClient -wpPushProviderClient mg tkn pn = do - -- TODO [webpush] parsing will happen in DeviceToken parser, so it won't fail here +wpPushProviderClient _ NtfTknRec {token = APNSDeviceToken _ _} _ = throwE PPInvalidPusher +wpPushProviderClient 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) - wpe@WPEndpoint {endpoint} <- tokenEndpoint tkn - r <- liftPPWPError $ parseUrlThrow $ B.unpack endpoint + -- parsing will happen in DeviceToken parser, so it won't fail here + r <- wpRequest token logDebug $ "Request to " <> tshow (host r) - encBody <- body wpe + encBody <- body let requestHeaders = [ ("TTL", "2592000"), -- 30 days ("Urgency", "high"), @@ -66,27 +60,26 @@ wpPushProviderClient mg tkn pn = do _ <- liftPPWPError $ httpNoBody req mg pure () where - tokenEndpoint :: NtfTknRec -> ExceptT PushProviderError IO WPEndpoint - tokenEndpoint NtfTknRec {token} = do - case token of - WPDeviceToken _p e -> pure e - _ -> fail "Wrong device token" - -- TODO: move to PPIndalidPusher ? WPEndpoint should be invalidated and removed if the key is invalid, but the validation key is never sent - body :: WPEndpoint -> ExceptT PushProviderError IO B.ByteString - body WPEndpoint {auth, p256dh} = withExceptT PPCryptoError $ wpEncrypt auth p256dh (BL.toStrict $ encodePN pn) + body :: ExceptT PushProviderError IO B.ByteString + body = withExceptT PPCryptoError $ wpEncrypt (wpKey param) (BL.toStrict $ encodePN pn) --- | encrypt :: auth -> key -> clear -> cipher +-- | encrypt :: UA key -> clear -> cipher -- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 -wpEncrypt :: B.ByteString -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString -wpEncrypt auth uaPubKS clearT = do +wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString +wpEncrypt wpKey clearT = do salt :: B.ByteString <- liftIO $ getRandomBytes 16 asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1 - -- TODO [webpush] key parsing will happen in DeviceToken parser, so it won't fail here - uaPubK <- point uaPubKS - let asPubK = BL.toStrict . uncompressEncode . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK + wpEncrypt' wpKey asPrivK salt clearT + +-- | encrypt :: UA key -> AS key -> salt -> clear -> cipher +-- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4 +wpEncrypt' :: WPKey -> ECC.PrivateNumber -> B.ByteString -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString +wpEncrypt' WPKey {wpAuth, wpP256dh = WPP256dh uaPubK} asPrivK salt clearT = do + let uaPubKS = BL.toStrict . C.uncompressEncodePoint $ uaPubK + let asPubKS = BL.toStrict . C.uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK ecdhSecret = ECDH.getShared (ECC.getCurveByName ECC.SEC_p256r1) asPrivK uaPubK prkKey = hmac auth ecdhSecret - keyInfo = "WebPush: info\0" <> uaPubKS <> asPubK + keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS ikm = hmac prkKey (keyInfo <> "\x01") prk = hmac salt ikm cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString @@ -95,14 +88,18 @@ wpEncrypt auth uaPubKS clearT = do nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01") rs = BL.toStrict $ Bin.encode (4096 :: Bin.Word32) -- with RFC8291, it's ok to always use 4096 because there is only one single record and the final record can be smaller than rs (RFC8188) idlen = BL.toStrict $ Bin.encode (65 :: Bin.Word8) -- with RFC8291, keyid is the pubkey, so always 65 bytes - header = salt <> rs <> idlen <> asPubK + header = salt <> rs <> idlen <> asPubKS iv <- ivFrom nonce -- The last record uses a padding delimiter octet set to the value 0x02 (C.AuthTag (CT.AuthTag tag), cipherT) <- C.encryptAES128NoPad (C.Key cek) iv $ clearT <> "\x02" + -- Uncomment to see intermediate values, to compare with RFC8291 example + -- liftIO . print $ strEncode (BA.convert ecdhSecret :: B.ByteString) + -- liftIO . print . strEncode $ takeHM 32 prkKey + -- liftIO . print $ strEncode cek + -- liftIO . print $ strEncode cipherT pure $ header <> cipherT <> BA.convert tag where - point :: B.ByteString -> ExceptT C.CryptoError IO ECC.Point - point s = withExceptT C.CryptoInvalidECCKey $ uncompressDecode $ BL.fromStrict s + 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 @@ -111,46 +108,6 @@ wpEncrypt auth uaPubKS clearT = do Left e -> throwE e Right iv -> pure iv --- | Elliptic-Curve-Point-to-Octet-String Conversion without compression --- | as required by RFC8291 --- | https://www.secg.org/sec1-v2.pdf#subsubsection.2.3.3 --- TODO [webpush] add them to the encoding of WPKey -uncompressEncode :: ECC.Point -> BL.ByteString -uncompressEncode (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y -uncompressEncode ECC.PointO = "\0" - --- TODO [webpush] should be -> Either ... (which it would be in StrEncoding) -uncompressDecode :: BL.ByteString -> ExceptT CE.CryptoError IO ECC.Point -uncompressDecode "\0" = pure ECC.PointO -uncompressDecode s = do - when (BL.take 1 s /= prefix) $ throwError CE.CryptoError_PointFormatUnsupported - when (BL.length s /= 65) $ throwError CE.CryptoError_KeySizeInvalid - let s' = BL.drop 1 s - x <- decodeBigInt $ BL.take 32 s' - y <- decodeBigInt $ BL.drop 32 s' - pure $ ECC.Point x y - where - prefix = "\x04" :: BL.ByteString - -encodeBigInt :: Integer -> BL.ByteString -encodeBigInt i = do - let s1 = Bits.shiftR i 64 - s2 = Bits.shiftR s1 64 - s3 = Bits.shiftR s2 64 - Bin.encode (w64 s3, w64 s2, w64 s1, w64 i) - where - w64 :: Integer -> Bin.Word64 - w64 = fromIntegral - --- TODO [webpush] should be -> Either ... (which it would be in StrEncoding) -decodeBigInt :: BL.ByteString -> ExceptT CE.CryptoError IO Integer -decodeBigInt s = do - when (BL.length s /= 32) $ throwError CE.CryptoError_PointSizeInvalid - let (w3, w2, w1, w0) = Bin.decode s :: (Bin.Word64, Bin.Word64, Bin.Word64, Bin.Word64 ) - pure $ shift 3 w3 + shift 2 w2 + shift 1 w1 + shift 0 w0 - where - shift i w = Bits.shiftL (fromIntegral w) (64 * i) - -- TODO [webpush] use ToJSON encodePN :: PushNotification -> BL.ByteString encodePN pn = J.encode $ case pn of diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 7249ac1d2..40314ad2a 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -1144,7 +1144,7 @@ sameSrvAddr :: ProtocolServer p -> ProtocolServer p -> Bool sameSrvAddr ProtocolServer {host, port} ProtocolServer {host = h', port = p'} = host == h' && port == p' {-# INLINE sameSrvAddr #-} -data ProtocolType = PSMP | PNTF | PXFTP | PHTTPS +data ProtocolType = PSMP | PNTF | PXFTP deriving (Eq, Ord, Show) instance StrEncoding ProtocolType where @@ -1152,20 +1152,17 @@ instance StrEncoding ProtocolType where PSMP -> "smp" PNTF -> "ntf" PXFTP -> "xftp" - PHTTPS -> "https" strP = A.takeTill (\c -> c == ':' || c == ' ') >>= \case "smp" -> pure PSMP "ntf" -> pure PNTF "xftp" -> pure PXFTP - "https" -> pure PHTTPS _ -> fail "bad ProtocolType" data SProtocolType (p :: ProtocolType) where SPSMP :: SProtocolType 'PSMP SPNTF :: SProtocolType 'PNTF SPXFTP :: SProtocolType 'PXFTP - SPHTTPS :: SProtocolType 'PHTTPS deriving instance Eq (SProtocolType p) @@ -1184,7 +1181,6 @@ instance TestEquality SProtocolType where testEquality SPSMP SPSMP = Just Refl testEquality SPNTF SPNTF = Just Refl testEquality SPXFTP SPXFTP = Just Refl - testEquality SPHTTPS SPHTTPS = Just Refl testEquality _ _ = Nothing protocolType :: SProtocolType p -> ProtocolType @@ -1192,14 +1188,12 @@ protocolType = \case SPSMP -> PSMP SPNTF -> PNTF SPXFTP -> PXFTP - SPHTTPS -> PHTTPS aProtocolType :: ProtocolType -> AProtocolType aProtocolType = \case PSMP -> AProtocolType SPSMP PNTF -> AProtocolType SPNTF PXFTP -> AProtocolType SPXFTP - PHTTPS -> AProtocolType SPHTTPS instance ProtocolTypeI p => StrEncoding (SProtocolType p) where strEncode = strEncode . protocolType @@ -1237,8 +1231,6 @@ instance ProtocolTypeI 'PNTF where protocolTypeI = SPNTF instance ProtocolTypeI 'PXFTP where protocolTypeI = SPXFTP -instance ProtocolTypeI 'PHTTPS where protocolTypeI = SPHTTPS - type family UserProtocol (p :: ProtocolType) :: Constraint where UserProtocol PSMP = () UserProtocol PXFTP = () diff --git a/src/Simplex/Messaging/ServiceScheme.hs b/src/Simplex/Messaging/ServiceScheme.hs index 3cd828aa7..1f9fe22e1 100644 --- a/src/Simplex/Messaging/ServiceScheme.hs +++ b/src/Simplex/Messaging/ServiceScheme.hs @@ -9,6 +9,7 @@ import qualified Data.ByteString.Char8 as B import Data.Functor (($>)) import Network.Socket (HostName, ServiceName) import Simplex.Messaging.Encoding.String (StrEncoding (..)) +import Simplex.Messaging.Encoding (Encoding(..)) data ServiceScheme = SSSimplex | SSAppServer SrvLoc deriving (Eq, Show) @@ -24,6 +25,12 @@ instance StrEncoding ServiceScheme where data SrvLoc = SrvLoc HostName ServiceName deriving (Eq, Ord, Show) +instance Encoding SrvLoc where + smpEncode (SrvLoc h s) = smpEncode (h, s) + smpP = do + (h, s) <- smpP + pure $ SrvLoc h s + instance StrEncoding SrvLoc where strEncode (SrvLoc host port) = B.pack $ host <> if null port then "" else ':' : port strP = SrvLoc <$> host <*> (port <|> pure "") diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 43375c6e3..0912e29b2 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -355,7 +355,7 @@ testNtfTokenServerRestartReverifyTimeout t apns = do SET tkn_status = ?, tkn_action = ? WHERE provider = ? AND device_token = ? |] - (NTConfirmed, Just (NTAVerify code), PPApnsTest, "abcd" :: ByteString) + (NTConfirmed, Just (NTAVerify code), PPAPNS PPApnsTest, "abcd" :: ByteString) Just NtfToken {ntfTknStatus = NTConfirmed, ntfTknAction = Just (NTAVerify _)} <- withTransaction store getSavedNtfToken pure () threadDelay 1500000 @@ -409,7 +409,7 @@ testNtfTokenServerRestartReregisterTimeout t apns = do SET tkn_id = NULL, tkn_dh_secret = NULL, tkn_status = ?, tkn_action = ? WHERE provider = ? AND device_token = ? |] - (NTNew, Just NTARegister, PPApnsTest, "abcd" :: ByteString) + (NTNew, Just NTARegister, PPAPNS PPApnsTest, "abcd" :: ByteString) Just NtfToken {ntfTokenId = Nothing, ntfTknStatus = NTNew, ntfTknAction = Just NTARegister} <- withTransaction store getSavedNtfToken pure () threadDelay 1000000 diff --git a/tests/NtfClient.hs b/tests/NtfClient.hs index bd833446c..bdd57f61c 100644 --- a/tests/NtfClient.hs +++ b/tests/NtfClient.hs @@ -60,6 +60,7 @@ import UnliftIO.Async import UnliftIO.Concurrent import qualified UnliftIO.Exception as E import UnliftIO.STM +import Control.Exception (throwIO) testHost :: NonEmpty TransportHost testHost = "localhost" @@ -293,6 +294,7 @@ getAPNSMockServer config@HTTP2ServerConfig {qSize} = do sendApnsResponse $ APNSRespError N.badRequest400 "bad_request_body" getMockNotification :: MonadIO m => APNSMockServer -> DeviceToken -> m APNSMockRequest +getMockNotification _ (WPDeviceToken _ _) = liftIO . throwIO $ userError "Invalid pusher" getMockNotification APNSMockServer {notifications} (APNSDeviceToken _ token) = do atomically $ TM.lookup token notifications >>= maybe retry readTBQueue diff --git a/tests/NtfWPTests.hs b/tests/NtfWPTests.hs new file mode 100644 index 000000000..5b0cfb82a --- /dev/null +++ b/tests/NtfWPTests.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE DataKinds #-} + +module NtfWPTests where + +import Test.Hspec hiding (fit, it) +import Util +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', encodePN) +import Control.Monad.Except (runExceptT) +import qualified Data.ByteString.Lazy as BL +import Simplex.Messaging.Notifications.Server.Push +import Data.List.NonEmpty (NonEmpty ((:|))) +import qualified Simplex.Messaging.Crypto as C +import Data.Time.Clock.System (SystemTime(..)) +import Data.Either (isLeft) + +ntfWPTests :: Spec +ntfWPTests = describe "NTF Protocol" $ do + it "decode WPDeviceToken from string" testWPDeviceTokenStrEncoding + it "decode invalid WPDeviceToken" testInvalidWPDeviceTokenStrEncoding + it "Encrypt RFC8291 example" testWPEncryption + it "PushNotifications encoding" testPNEncoding + +testWPDeviceTokenStrEncoding :: Expectation +testWPDeviceTokenStrEncoding = do + let ts = "webpush https://localhost/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM" + -- let ts = "apns_null test_ntf_token" + -- let ts = "apns_test 11111111222222223333333344444444" + + let auth = either error id $ strDecode "AQ3VfRX3_F38J3ltcmMVRg" + let pk = either error id $ strDecode "BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM" + let params ::WPTokenParams = either error id $ strDecode "/secret AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM" + wpPath params `shouldBe` "/secret" + let key = wpKey params + wpAuth key `shouldBe` auth + wpP256dh key `shouldBe` pk + + let pp@(WPP s) :: WPProvider = either error id $ strDecode "webpush https://localhost" + + let parsed = either error id $ strDecode ts + parsed `shouldBe` WPDeviceToken pp params + -- TODO: strEncoding should be base64url _without padding_ + -- strEncode parsed `shouldBe` ts + + strEncode s <> wpPath params `shouldBe` "https://localhost/secret" + +testInvalidWPDeviceTokenStrEncoding :: Expectation +testInvalidWPDeviceTokenStrEncoding = do + -- http-client parser parseUrlThrow is very very lax, + -- e.g "https://#1" is a valid URL. But that is the same parser + -- we use to send the requests, so that's fine. + let ts = "webpush https://localhost:/ AQ3VfRX3_F38J3ltcmMVRg BKuw4WxupnnrZHqk6vCwoms4tOpitZMvFdR9eAn54yOPY4q9jpXOpl-Ui_FwbIy8ZbFCnuaS7RnO02ahuL4XxIM" + let t = strDecode ts :: Either String DeviceToken + t `shouldSatisfy` isLeft + +-- | Example from RFC8291 +testWPEncryption :: Expectation +testWPEncryption = do + let clearT :: B.ByteString = "When I grow up, I want to be a watermelon" + let pParams :: WPTokenParams = either error id $ strDecode "/push/JzLQ3raZJfFBR0aqvOMsLrt54w4rJUsV BTBZMqHH6r4Tts7J_aSIgg BCVxsr7N_eNgVRqvHtD0zTZsEc6-VV-JvLexhqUzORcxaOzi6-AYWXvTBHm4bjyPjs7Vd8pZGH6SRpkNtoIAiw4" + let salt :: B.ByteString = either error id $ strDecode "DGv6ra1nlYgDCS1FRnbzlw" + let privBS :: BL.ByteString = either error BL.fromStrict $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw" + asPriv :: ECC.PrivateNumber <- case C.uncompressDecodePrivateNumber privBS of + Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e + Right p -> pure p + mCip <- runExceptT $ wpEncrypt' (wpKey pParams) asPriv salt clearT + cipher <- case mCip of + Left _ -> fail "Cannot encrypt clear text" + Right c -> pure c + strEncode cipher `shouldBe` "DGv6ra1nlYgDCS1FRnbzlwAAEABBBP4z9KsN6nGRTbVYI_c7VJSPQTBtkgcy27mlmlMoZIIgDll6e3vCYLocInmYWAmS6TlzAC8wEqKK6PBru3jl7A_yl95bQpu6cVPTpK4Mqgkf1CXztLVBSt2Ks3oZwbuwXPXLWyouBWLVWGNWQexSgSxsj_Qulcy4a-fN" + +testPNEncoding :: Expectation +testPNEncoding = do + let pnVerif = PNVerification (NtfRegCode "abcd") + pnCheck = PNCheckMessages + pnMess = pnM "MyMessage" + enc pnCheck `shouldBe` "{\"checkMessages\":true}" + enc pnVerif `shouldBe` "{\"verification\":\"YWJjZA==\"}" + enc pnMess `shouldBe` "{\"message\":\"smp://AAAA@l/AAAA 1761827386 bm9uY2UAAAAAAAAAAAAAAAAAAAAAAAAA TXlNZXNzYWdl\"}" + where + enc p = BL.toStrict $ encodePN p + pnM :: B.ByteString -> PushNotification + pnM m = do + let smpQ = either error id $ strDecode "smp://AAAA@l/AAAA" + let now = MkSystemTime 1761827386 0 + PNMessage $ PNMessageData smpQ now (C.cbNonce "nonce") m :| [] diff --git a/tests/Test.hs b/tests/Test.hs index 364080e0c..884a1a7b1 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -45,6 +45,7 @@ import AgentTests.SchemaDump (schemaDumpTest) #if defined(dbServerPostgres) import NtfServerTests (ntfServerTests) import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts) +import NtfWPTests (ntfWPTests) import PostgresSchemaDump (postgresSchemaDumpTest) import SMPClient (testServerDBConnectInfo, testStoreDBOpts) import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations) @@ -139,6 +140,7 @@ main = do before (pure $ ASType SQSPostgres SMSJournal) smpProxyTests describe "SMP proxy, postgres-only message store" $ before (pure $ ASType SQSPostgres SMSPostgres) smpProxyTests + describe "NTF WP tests" ntfWPTests #endif describe "SMP client agent, jornal message store" $ agentTests (transport @TLS, ASType SQSMemory SMSJournal) describe "SMP proxy, jornal message store" $