dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-04-28 04:05:17 +00:00
Code Issues Packages Projects Releases Wiki Activity

binary X509 encoding for RSA key send during transport handshake (#105)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2021-04-24 12:46:57 +01:00
committed by GitHub
parent 3187bc8140
commit cddff78719
6 changed files with 89 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Messaging/Crypto.hs
+24 -13
View File
@@ -33,10 +33,12 @@ module Simplex.Messaging.Crypto
decryptAES,
serializePrivKey,
serializePubKey,
binaryEncodePubKey,
serializeKeyHash,
getKeyHash,
privKeyP,
pubKeyP,
binaryPubKeyP,
keyHashP,
authTagSize,
authTagToBS,
@@ -179,8 +181,8 @@ generateKeyPair size = loop
then loop
else pure (PublicKey k, mkPrivateKey pk)
rsaPrivateSize :: PrivateKey k => k -> Int
rsaPrivateSize = R.public_size . R.private_pub . rsaPrivateKey
privateKeySize :: PrivateKey k => k -> Int
privateKeySize = R.public_size . R.private_pub . rsaPrivateKey
publicKey :: FullPrivateKey -> PublicKey
publicKey = PublicKey . R.private_pub . rsaPrivateKey
@@ -258,7 +260,7 @@ encrypt k paddedSize msg = do
decrypt :: PrivateKey k => k -> ByteString -> ExceptT CryptoError IO ByteString
decrypt pk msg'' = do
let (encHeader, msg') = B.splitAt (rsaPrivateSize pk) msg''
let (encHeader, msg') = B.splitAt (privateKeySize pk) msg''
header <- decryptOAEP pk encHeader
Header {aesKey, ivBytes, authTag, msgSize} <- except $ parseHeader header
msg <- decryptAES aesKey ivBytes msg' authTag
@@ -342,6 +344,9 @@ serializePrivKey pk = "rsa:" <> encodePrivKey pk
pubKeyP :: Parser PublicKey
pubKeyP = keyP decodePubKey <|> legacyPubKeyP
binaryPubKeyP :: Parser PublicKey
binaryPubKeyP = either fail pure . binaryDecodePubKey =<< A.takeByteString
privKeyP :: PrivateKey k => Parser k
privKeyP = keyP decodePrivKey <|> legacyPrivKeyP
@@ -382,28 +387,34 @@ safeRsaPrivateKey (size, n, d) =
}
encodePubKey :: PublicKey -> ByteString
encodePubKey = encodeKey . PubKeyRSA . rsaPublicKey
encodePubKey = encode . binaryEncodePubKey
binaryEncodePubKey :: PublicKey -> ByteString
binaryEncodePubKey = binaryEncodeKey . PubKeyRSA . rsaPublicKey
encodePrivKey :: PrivateKey k => k -> ByteString
encodePrivKey = encodeKey . PrivKeyRSA . rsaPrivateKey
encodePrivKey = encode . binaryEncodeKey . PrivKeyRSA . rsaPrivateKey
encodeKey :: ASN1Object a => a -> ByteString
encodeKey k = encode . toStrict . encodeASN1 DER $ toASN1 k []
binaryEncodeKey :: ASN1Object a => a -> ByteString
binaryEncodeKey k = toStrict . encodeASN1 DER $ toASN1 k []
decodePubKey :: ByteString -> Either String PublicKey
decodePubKey s =
decodeKey s >>= \case
decodePubKey = binaryDecodePubKey <=< decode
binaryDecodePubKey :: ByteString -> Either String PublicKey
binaryDecodePubKey =
binaryDecodeKey >=> \case
(PubKeyRSA k, []) -> Right $ PublicKey k
r -> keyError r
decodePrivKey :: PrivateKey k => ByteString -> Either String k
decodePrivKey s =
decodeKey s >>= \case
decodePrivKey =
decode >=> binaryDecodeKey >=> \case
(PrivKeyRSA pk, []) -> Right $ mkPrivateKey pk
r -> keyError r
decodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
decodeKey s = fromASN1 =<< first show . decodeASN1 DER . fromStrict =<< decode s
binaryDecodeKey :: ASN1Object a => ByteString -> Either String (a, [ASN1])
binaryDecodeKey = fromASN1 <=< first show . decodeASN1 DER . fromStrict
keyError :: (a, [ASN1]) -> Either String b
keyError = \case
src/Simplex/Messaging/Transport.hs
+53 -15
View File
@@ -32,7 +32,7 @@ import GHC.IO.Exception (IOErrorType (..))
import GHC.IO.Handle.Internals (ioe_EOF)
import Generic.Random (genericArbitraryU)
import Network.Socket
import Network.Transport.Internal (encodeWord32)
import Network.Transport.Internal (decodeNum16, decodeNum32, encodeEnum16, encodeEnum32, encodeWord32)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Parsers (parse, parseAll, parseRead1)
import Simplex.Messaging.Util (bshow, liftError)
@@ -172,6 +172,7 @@ data HandshakeError
| DECRYPT
| VERSION
| RSA_KEY
| HEADER
| AES_KEYS
| BAD_HASH
| MAJOR_VERSION
@@ -233,15 +234,18 @@ makeNextIV SessionKey {baseIV, counter} = atomically $ do
-- The numbers in function names refer to the steps in the document
serverHandshake :: Handle -> C.FullKeyPair -> ExceptT TransportError IO THandle
serverHandshake h (k, pk) = do
liftIO sendPublicKey_1
liftIO sendHeaderAndPublicKey_1
encryptedKeys <- receiveEncryptedKeys_4
HandshakeKeys {sndKey, rcvKey} <- decryptParseKeys_5 encryptedKeys
th <- liftIO $ transportHandle h rcvKey sndKey -- keys are swapped here
th <- liftIO $ transportHandle h rcvKey sndKey transportBlockSize -- keys are swapped here
sendWelcome_6 th
pure th
where
sendPublicKey_1 :: IO ()
sendPublicKey_1 = putLn h $ C.serializePubKey k
sendHeaderAndPublicKey_1 :: IO ()
sendHeaderAndPublicKey_1 = do
let sKey = C.binaryEncodePubKey k
header = TransportHeader {blockSize = transportBlockSize, keySize = B.length sKey}
B.hPut h $ binaryTransportHeader header <> sKey
receiveEncryptedKeys_4 :: ExceptT TransportError IO ByteString
receiveEncryptedKeys_4 =
liftIO (B.hGet h $ C.publicKeySize k) >>= \case
@@ -258,20 +262,25 @@ serverHandshake h (k, pk) = do
-- The numbers in function names refer to the steps in the document
clientHandshake :: Handle -> Maybe C.KeyHash -> ExceptT TransportError IO THandle
clientHandshake h keyHash = do
k <- getPublicKey_1_2
(k, blkSize) <- getHeaderAndPublicKey_1_2
keys@HandshakeKeys {sndKey, rcvKey} <- liftIO generateKeys_3
sendEncryptedKeys_4 k keys
th <- liftIO $ transportHandle h sndKey rcvKey
th <- liftIO $ transportHandle h sndKey rcvKey blkSize
getWelcome_6 th >>= checkVersion
pure th
where
getPublicKey_1_2 :: ExceptT TransportError IO C.PublicKey
getPublicKey_1_2 = do
s <- liftIO $ getLn h
getHeaderAndPublicKey_1_2 :: ExceptT TransportError IO (C.PublicKey, Int)
getHeaderAndPublicKey_1_2 = do
header <- liftIO (B.hGet h transportHeaderSize)
TransportHeader {blockSize, keySize} <- liftEither $ parse transportHeaderP (TEHandshake HEADER) header
when (blockSize < transportBlockSize || blockSize > maxTransportBlockSize) $
throwError $ TEHandshake HEADER
s <- liftIO $ B.hGet h keySize
maybe (pure ()) (validateKeyHash_2 s) keyHash
liftEither $ parseKey s
key <- liftEither $ parseKey s
pure (key, blockSize)
parseKey :: ByteString -> Either TransportError C.PublicKey
parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.pubKeyP
parseKey = first (const $ TEHandshake RSA_KEY) . parseAll C.binaryPubKeyP
validateKeyHash_2 :: ByteString -> C.KeyHash -> ExceptT TransportError IO ()
validateKeyHash_2 k kHash
| C.getKeyHash k == kHash = pure ()
@@ -296,6 +305,35 @@ clientHandshake h keyHash = do
when (major smpVersion > major currentSMPVersion) . throwE $
TEHandshake MAJOR_VERSION
data TransportHeader = TransportHeader {blockSize :: Int, keySize :: Int}
deriving (Eq, Show)
binaryRsaTransport :: Int
binaryRsaTransport = 0
transportBlockSize :: Int
transportBlockSize = 8192
maxTransportBlockSize :: Int
maxTransportBlockSize = 65536
transportHeaderSize :: Int
transportHeaderSize = 8
binaryTransportHeader :: TransportHeader -> ByteString
binaryTransportHeader TransportHeader {blockSize, keySize} =
encodeEnum32 blockSize <> encodeEnum16 binaryRsaTransport <> encodeEnum16 keySize
transportHeaderP :: Parser TransportHeader
transportHeaderP = TransportHeader <$> int32 <* binaryRsaTransportP <*> int16
where
int32 = decodeNum32 <$> A.take 4
int16 = decodeNum16 <$> A.take 2
binaryRsaTransportP = binaryRsa <$> int16
binaryRsa :: Int -> Parser Int
binaryRsa 0 = pure 0
binaryRsa _ = fail "unknown transport mode"
serializeHandshakeKeys :: HandshakeKeys -> ByteString
serializeHandshakeKeys HandshakeKeys {sndKey, rcvKey} =
serializeKey sndKey <> serializeKey rcvKey
@@ -315,8 +353,8 @@ handshakeKeysP = HandshakeKeys <$> keyP <*> keyP
parseHandshakeKeys :: ByteString -> Either TransportError HandshakeKeys
parseHandshakeKeys = parse handshakeKeysP $ TEHandshake AES_KEYS
transportHandle :: Handle -> SessionKey -> SessionKey -> IO THandle
transportHandle h sk rk = do
transportHandle :: Handle -> SessionKey -> SessionKey -> Int -> IO THandle
transportHandle h sk rk blockSize = do
sndCounter <- newTVarIO 0
rcvCounter <- newTVarIO 0
pure
@@ -324,5 +362,5 @@ transportHandle h sk rk = do
{ handle = h,
sndKey = sk {counter = sndCounter},
rcvKey = rk {counter = rcvCounter},
blockSize = 8192
blockSize
}
src/Simplex/Messaging/Util.hs
+3 -3
View File
@@ -39,11 +39,11 @@ infixl 4 <$$>
bshow :: Show a => a -> ByteString
bshow = B.pack . show
liftIOEither :: (MonadUnliftIO m, MonadError e m) => IO (Either e a) -> m a
liftIOEither :: (MonadIO m, MonadError e m) => IO (Either e a) -> m a
liftIOEither a = liftIO a >>= liftEither
liftError :: (MonadUnliftIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a
liftError :: (MonadIO m, MonadError e' m) => (e -> e') -> ExceptT e IO a -> m a
liftError f = liftEitherError f . runExceptT
liftEitherError :: (MonadUnliftIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
liftEitherError :: (MonadIO m, MonadError e' m) => (e -> e') -> IO (Either e a) -> m a
liftEitherError f a = liftIOEither (first f <$> a)