Move functions to encode/decode EC keys to Crypto module

This commit is contained in:
sim
2025-12-05 13:44:18 +01:00
parent 1007deb1f5
commit 3402d64029
6 changed files with 70 additions and 62 deletions
@@ -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,
@@ -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)
@@ -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
@@ -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