mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-08-29 07:48:25 +00:00
clean up WP encryption
This commit is contained in:
Evgeny Poberezkin
@@ -28,7 +28,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 (Word16, Word64)
|
||||
import Simplex.Messaging.Agent.Protocol (updateSMPServerHosts)
|
||||
import Simplex.Messaging.Agent.Store.DB (FromField (..), ToField (..), fromTextField_)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
@@ -39,7 +39,6 @@ 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)
|
||||
|
||||
@@ -546,52 +545,50 @@ data WPKey = WPKey
|
||||
-- | 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 -> ByteString
|
||||
uncompressEncodePoint (ECC.Point x y) = "\x04" <> encodeBigInt x <> encodeBigInt y
|
||||
uncompressEncodePoint ECC.PointO = "\0"
|
||||
|
||||
uncompressDecodePoint :: BL.ByteString -> Either CE.CryptoError ECC.Point
|
||||
uncompressDecodePoint :: ByteString -> Either String 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
|
||||
| B.null s = Left "KeySizeInvalid"
|
||||
| B.head s /= '\x04' = Left "PointFormatUnsupported"
|
||||
| B.length s /= 65 = Left "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
|
||||
let s' = B.drop 1 s
|
||||
x <- decodeBigInt $ B.take 32 s'
|
||||
y <- decodeBigInt $ B.drop 32 s'
|
||||
pure $ ECC.Point x y
|
||||
|
||||
-- Used to test encryption against the RFC8291 Example - which gives the AS private key
|
||||
uncompressDecodePrivateNumber :: BL.ByteString -> Either CE.CryptoError ECC.PrivateNumber
|
||||
uncompressDecodePrivateNumber :: ByteString -> Either String ECC.PrivateNumber
|
||||
uncompressDecodePrivateNumber s
|
||||
| BL.length s /= 32 = Left CE.CryptoError_KeySizeInvalid
|
||||
| otherwise = do
|
||||
decodeBigInt s
|
||||
| B.length s /= 32 = Left "KeySizeInvalid"
|
||||
| otherwise = decodeBigInt s
|
||||
|
||||
uncompressEncode :: WPP256dh -> BL.ByteString
|
||||
uncompressEncode :: WPP256dh -> ByteString
|
||||
uncompressEncode (WPP256dh p) = uncompressEncodePoint p
|
||||
|
||||
uncompressDecode :: BL.ByteString -> Either CE.CryptoError WPP256dh
|
||||
uncompressDecode :: ByteString -> Either String WPP256dh
|
||||
uncompressDecode bs = WPP256dh <$> uncompressDecodePoint bs
|
||||
|
||||
encodeBigInt :: Integer -> BL.ByteString
|
||||
encodeBigInt i = do
|
||||
encodeBigInt :: Integer -> ByteString
|
||||
encodeBigInt i =
|
||||
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)
|
||||
in BL.toStrict $ Bin.encode (w64 s3, w64 s2, w64 s1, w64 i)
|
||||
where
|
||||
w64 :: Integer -> Bin.Word64
|
||||
w64 :: Integer -> Word64
|
||||
w64 = fromIntegral
|
||||
|
||||
decodeBigInt :: BL.ByteString -> Either CE.CryptoError Integer
|
||||
decodeBigInt :: ByteString -> Either String Integer
|
||||
decodeBigInt s
|
||||
| BL.length s /= 32 = Left CE.CryptoError_PointSizeInvalid
|
||||
| B.length s /= 32 = Left "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
|
||||
let (w3, w2, w1, w0) = Bin.decode (BL.fromStrict s) :: (Word64, Word64, Word64, Word64)
|
||||
in Right $ shift 3 w3 + shift 2 w2 + shift 1 w1 + fromIntegral w0
|
||||
where
|
||||
shift i w = Bits.shiftL (fromIntegral w) (64 * i)
|
||||
|
||||
@@ -610,18 +607,12 @@ instance StrEncoding WPAuth where
|
||||
strP = toWPAuth <$?> strP
|
||||
|
||||
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
|
||||
smpEncode p = smpEncode $ uncompressEncode p
|
||||
smpP = uncompressDecode <$?> smpP
|
||||
|
||||
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
|
||||
strEncode p = strEncode $ uncompressEncode p
|
||||
strP = uncompressDecode <$?> strP
|
||||
|
||||
instance Encoding WPKey where
|
||||
smpEncode WPKey {wpAuth, wpP256dh} = smpEncode (wpAuth, wpP256dh)
|
||||
|
||||
@@ -257,7 +257,6 @@ data APNSErrorResponse = APNSErrorResponse {reason :: Text}
|
||||
|
||||
$(JQ.deriveFromJSON defaultJSON ''APNSErrorResponse)
|
||||
|
||||
-- TODO [webpush] change type accept token components so it only allows APNS token
|
||||
apnsPushProviderClient :: APNSPushClient -> PushProviderClient 'APNS
|
||||
apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn (APNSDeviceToken _ tknStr) pn = do
|
||||
http2 <- liftHTTPS2 $ getApnsHTTP2Client c
|
||||
|
||||
@@ -10,37 +10,37 @@
|
||||
|
||||
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 (..), PushType (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
|
||||
import Simplex.Messaging.Notifications.Server.Push
|
||||
import Control.Monad.Except
|
||||
import Control.Exception (SomeException, fromException, try)
|
||||
import Control.Logger.Simple (logDebug)
|
||||
import Simplex.Messaging.Util (tshow)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Exception ( fromException, SomeException, try )
|
||||
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.ByteArray as BA
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
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.MAC.HMAC as HMAC
|
||||
import qualified Crypto.PubKey.ECC.DH as ECDH
|
||||
import qualified Crypto.PubKey.ECC.Types as ECC
|
||||
import Crypto.Random (MonadRandom(getRandomBytes))
|
||||
import Data.Aeson ((.=))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Binary as Bin
|
||||
import qualified Data.ByteArray as BA
|
||||
import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Network.HTTP.Client
|
||||
import qualified Network.HTTP.Types as N
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushType (..), WPAuth (..), WPKey (..), WPTokenParams (..), WPP256dh (..), uncompressEncodePoint, wpRequest)
|
||||
import Simplex.Messaging.Notifications.Server.Push
|
||||
import Simplex.Messaging.Util (liftError', tshow)
|
||||
|
||||
wpPushProviderClient :: Manager -> PushProviderClient 'WebPush
|
||||
wpPushProviderClient mg _ t@(WPDeviceToken _ params) pn = do
|
||||
-- TODO [webpush] this function should accept type that is restricted to WP token (so, possibly WPProvider and WPTokenParams)
|
||||
-- parsing will happen in DeviceToken parser, so it won't fail here
|
||||
r <- wpRequest t
|
||||
logDebug $ "Request to " <> tshow (host r)
|
||||
encBody <- body
|
||||
logDebug $ "Web Push request to " <> tshow (host r)
|
||||
encBody <- withExceptT PPCryptoError $ wpEncrypt (wpKey params) (BL.toStrict $ encodeWPN pn)
|
||||
let requestHeaders =
|
||||
[ ("TTL", "2592000"), -- 30 days
|
||||
("Urgency", "high"),
|
||||
@@ -54,55 +54,47 @@ wpPushProviderClient mg _ t@(WPDeviceToken _ params) pn = do
|
||||
requestBody = RequestBodyBS encBody,
|
||||
redirectCount = 0
|
||||
}
|
||||
_ <- liftPPWPError $ httpNoBody req mg
|
||||
pure ()
|
||||
where
|
||||
body :: ExceptT PushProviderError IO B.ByteString
|
||||
body = withExceptT PPCryptoError $ wpEncrypt (wpKey params) (BL.toStrict $ encodeWPN pn)
|
||||
void $ liftError' toPPWPError $ try $ httpNoBody req mg
|
||||
|
||||
-- | encrypt :: UA key -> clear -> cipher
|
||||
-- | https://www.rfc-editor.org/rfc/rfc8291#section-3.4
|
||||
wpEncrypt :: WPKey -> B.ByteString -> ExceptT C.CryptoError IO B.ByteString
|
||||
wpEncrypt :: WPKey -> ByteString -> ExceptT C.CryptoError IO ByteString
|
||||
wpEncrypt wpKey clearT = do
|
||||
salt :: B.ByteString <- liftIO $ getRandomBytes 16
|
||||
salt :: ByteString <- liftIO $ getRandomBytes 16
|
||||
asPrivK <- liftIO $ ECDH.generatePrivate $ ECC.getCurveByName ECC.SEC_p256r1
|
||||
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 -> ECC.PrivateNumber -> ByteString -> ByteString -> ExceptT C.CryptoError IO 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 = uncompressEncodePoint $ uaPubK
|
||||
let asPubKS = 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
|
||||
ikm = hmac prkKey (keyInfo <> "\x01")
|
||||
prk = hmac salt ikm
|
||||
cekInfo = "Content-Encoding: aes128gcm\0" :: B.ByteString
|
||||
cek = takeHM 16 $ hmac prk (cekInfo <> "\x01")
|
||||
nonceInfo = "Content-Encoding: nonce\0" :: B.ByteString
|
||||
nonce = takeHM 12 $ hmac prk (nonceInfo <> "\x01")
|
||||
cekInfo = "Content-Encoding: aes128gcm\0" :: ByteString
|
||||
cek = B.take 16 $ BA.convert $ hmac prk (cekInfo <> "\x01")
|
||||
nonceInfo = "Content-Encoding: nonce\0" :: ByteString
|
||||
nonce = B.take 12 $ BA.convert $ 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 <> 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"
|
||||
(C.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 (BA.convert ecdhSecret :: ByteString)
|
||||
-- liftIO . print . strEncode $ takeHM 32 prkKey
|
||||
-- liftIO . print $ strEncode cek
|
||||
-- liftIO . print $ strEncode cipherT
|
||||
pure $ header <> cipherT <> BA.convert tag
|
||||
where
|
||||
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
|
||||
ivFrom :: B.ByteString -> ExceptT C.CryptoError IO C.GCMIV
|
||||
ivFrom s = case C.gcmIV s of
|
||||
Left e -> throwE e
|
||||
Right iv -> pure iv
|
||||
ivFrom :: ByteString -> ExceptT C.CryptoError IO C.GCMIV
|
||||
ivFrom s = liftEither $ C.gcmIV s
|
||||
|
||||
encodeWPN :: PushNotification -> BL.ByteString
|
||||
encodeWPN pn = J.encode $ case pn of
|
||||
@@ -113,12 +105,6 @@ encodeWPN pn = J.encode $ case pn of
|
||||
PNMessage _ -> J.object ["checkMessages" .= True]
|
||||
PNCheckMessages -> J.object ["checkMessages" .= True]
|
||||
|
||||
liftPPWPError :: IO a -> ExceptT PushProviderError IO a
|
||||
liftPPWPError = liftPPWPError' toPPWPError
|
||||
|
||||
liftPPWPError' :: (SomeException -> PushProviderError) -> IO a -> ExceptT PushProviderError IO a
|
||||
liftPPWPError' err a = liftIO (try @SomeException a) >>= either (throwError . err) return
|
||||
|
||||
toPPWPError :: SomeException -> PushProviderError
|
||||
toPPWPError e = case fromException e of
|
||||
Just (InvalidUrlException _ _) -> PPWPInvalidUrl
|
||||
|
||||
+1
-1
@@ -64,7 +64,7 @@ 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"
|
||||
let privBS :: B.ByteString = either error id $ strDecode "yfWPiYE-n46HLnH0KqZOF1fJJU3MYrct3AELtAQ-oRw"
|
||||
asPriv :: ECC.PrivateNumber <- case uncompressDecodePrivateNumber privBS of
|
||||
Left e -> fail $ "Cannot decode PrivateNumber from b64 " <> show e
|
||||
Right p -> pure p
|
||||
|
||||
Reference in New Issue
Block a user