[webpush] Small fixes

simplexmq.cabal

@@ -306,6 +306,7 @@ library
     , directory ==1.3.*
     , filepath ==1.4.*
     , hourglass ==0.2.*
+    , http-client ==0.7.*
     , http-types ==0.12.*
     , http2 >=4.2.2 && <4.3
     , iproute ==1.7.*
@@ -337,7 +338,6 @@ library
         case-insensitive ==1.2.*
       , hashable ==1.4.*
       , ini ==0.4.1
-      , http-client ==0.7.*
       , http-client-tls ==0.3.6.*
       , optparse-applicative >=0.15 && <0.17
       , process ==1.6.*
@@ -508,6 +508,7 @@ test-suite simplexmq-test
           AgentTests.NotificationTests
           NtfClient
           NtfServerTests
+          NtfWPTests
           PostgresSchemaDump
   hs-source-dirs:
       tests

src/Simplex/Messaging/Agent.hs

@@ -97,8 +97,10 @@ module Simplex.Messaging.Agent
     reconnectSMPServer,
     registerNtfToken,
     verifyNtfToken,
+    verifySavedNtfToken,
     checkNtfToken,
     deleteNtfToken,
+    deleteSavedNtfToken,
     getNtfToken,
     getNtfTokenData,
     toggleConnectionNtfs,
@@ -592,6 +594,11 @@ verifyNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> C.CbNonce
 verifyNtfToken c = withAgentEnv c .:: verifyNtfToken' c
 {-# INLINE verifyNtfToken #-}
 
+-- | Verify saved device notifications token
+verifySavedNtfToken :: AgentClient -> NetworkRequestMode -> ByteString -> AE ()
+verifySavedNtfToken c = withAgentEnv c .: verifySavedNtfToken' c
+{-# INLINE verifySavedNtfToken #-}
+
 checkNtfToken :: AgentClient -> NetworkRequestMode -> DeviceToken -> AE NtfTknStatus
 checkNtfToken c = withAgentEnv c .: checkNtfToken' c
 {-# INLINE checkNtfToken #-}
@@ -600,6 +607,10 @@ deleteNtfToken :: AgentClient -> DeviceToken -> AE ()
 deleteNtfToken c = withAgentEnv c . deleteNtfToken' c
 {-# INLINE deleteNtfToken #-}
 
+deleteSavedNtfToken :: AgentClient -> AE ()
+deleteSavedNtfToken c = withAgentEnv c $ deleteSavedNtfToken' c
+{-# INLINE deleteSavedNtfToken #-}
+
 getNtfToken :: AgentClient -> AE (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken c = withAgentEnv c $ getNtfToken' c
 {-# INLINE getNtfToken #-}
@@ -2359,6 +2370,19 @@ verifyNtfToken' c nm deviceToken nonce code =
         when (ntfMode == NMInstant) $ initializeNtfSubs c
     _ -> throwE $ CMD PROHIBITED "verifyNtfToken: no token"
 
+verifySavedNtfToken' :: AgentClient -> NetworkRequestMode -> ByteString -> AM ()
+verifySavedNtfToken' c nm code =
+  withStore' c getSavedNtfToken >>= \case
+    Just tkn@NtfToken {ntfTokenId = Just tknId, ntfMode} -> do
+      let code' = NtfRegCode code
+      toStatus <-
+        withToken c nm tkn (Just (NTConfirmed, NTAVerify code')) (NTActive, Just NTACheck) $
+          agentNtfVerifyToken c nm tknId tkn code'
+      when (toStatus == NTActive) $ do
+        lift $ setCronInterval c nm tknId tkn
+        when (ntfMode == NMInstant) $ initializeNtfSubs c
+    _ -> throwE $ CMD PROHIBITED "verifySavedNtfToken: no token"
+
 setCronInterval :: AgentClient -> NetworkRequestMode -> NtfTokenId -> NtfToken -> AM' ()
 setCronInterval c nm tknId tkn = do
   cron <- asks $ ntfCron . config
@@ -2387,6 +2411,15 @@ deleteNtfToken' c deviceToken =
       deleteNtfSubs c NSCSmpDelete
     _ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
 
+
+deleteSavedNtfToken' :: AgentClient -> AM ()
+deleteSavedNtfToken' c =
+  withStore' c getSavedNtfToken >>= \case
+    Just tkn -> do
+      deleteToken c tkn
+      deleteNtfSubs c NSCSmpDelete
+    _ -> throwE $ CMD PROHIBITED "deleteSavedNtfToken: no token"
+
 getNtfToken' :: AgentClient -> AM (DeviceToken, NtfTknStatus, NotificationsMode, NtfServer)
 getNtfToken' c =
   withStore' c getSavedNtfToken >>= \case

src/Simplex/Messaging/Crypto.hs

@@ -86,13 +86,18 @@ module Simplex.Messaging.Crypto
     signatureKeyPair,
     publicToX509,
     encodeASNObj,
+    readECPrivateKey,
 
     -- * key encoding/decoding
     encodePubKey,
     decodePubKey,
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    encodeBigInt,
+    uncompressEncodePoint,
+    uncompressDecodePoint,
+    uncompressDecodePrivateNumber,
 
     -- * sign/verify
     Signature (..),
@@ -251,6 +256,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 +1543,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)
+