Move functions to encode/decode EC keys to Crypto module

src/Simplex/Messaging/Crypto.hs

@@ -87,6 +87,7 @@ module Simplex.Messaging.Crypto
     signatureKeyPair,
     publicToX509,
     encodeASNObj,
+    readECPrivateKey,
 
     -- * key encoding/decoding
     encodePubKey,
@@ -94,6 +95,9 @@ module Simplex.Messaging.Crypto
     encodePrivKey,
     decodePrivKey,
     pubKeyBytes,
+    uncompressEncodePoint,
+    uncompressDecodePoint,
+    uncompressDecodePrivateNumber,
 
     -- * sign/verify
     Signature (..),
@@ -252,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
@@ -1542,3 +1552,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)
+

src/Simplex/Messaging/Notifications/Protocol.hs

@@ -484,57 +484,11 @@ data WPKey = WPKey
   }
   deriving (Eq, Ord, Show)
 
--- | 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
-
 uncompressEncode :: WPP256dh -> BL.ByteString
-uncompressEncode (WPP256dh p) = uncompressEncodePoint p
+uncompressEncode (WPP256dh p) = C.uncompressEncodePoint p
 
 uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
-uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs
-
-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)
+uncompressDecode bs = WPP256dh <$> C.uncompressDecodePoint bs
 
 data WPTokenParams = WPTokenParams
   { wpPath :: ByteString,

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)

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

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 (..), uncompressEncodePoint, wpRequest)
+import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), wpRequest)
 import Simplex.Messaging.Notifications.Server.Store.Types
 import Simplex.Messaging.Notifications.Server.Push
 import Control.Monad.Except
@@ -72,8 +72,8 @@ wpEncrypt wpKey clearT = do
 -- | 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 . uncompressEncodePoint $ uaPubK
-  let asPubKS = BL.toStrict . uncompressEncodePoint . ECDH.calculatePublic (ECC.getCurveByName ECC.SEC_p256r1) $ asPrivK
+  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 (unWPAuth wpAuth) ecdhSecret
       keyInfo = "WebPush: info\0" <> uaPubKS <> asPubKS

tests/NtfWPTests.hs

@@ -65,7 +65,7 @@ testWPEncryption = do
   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 uncompressDecodePrivateNumber privBS of
+  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