voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

do not pass PeerData to encHandshake_considerPeerAsymmKey

This commit is contained in:
Sergey Ivanov 2023-07-18 23:14:15 +04:00
parent a0334f5dee
commit 00bac2047f
2 changed files with 24 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
View File

@ -75,7 +75,7 @@ sendBeginEncryptionExchange creds ourpubkey peer = do
request peer (BeginEncryptionExchange @e sign ourpubkey) request peer (BeginEncryptionExchange @e sign ourpubkey)
data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter
{ encHandshake_considerPeerAsymmKey :: Peer e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m () { encHandshake_considerPeerAsymmKey :: Peer e -> Maybe Encrypt.PublicKey -> m ()
} }
@ -109,7 +109,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData) trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData)
-- сначала удалим у себя его прошлый ключ -- сначала удалим у себя его прошлый ключ
encHandshake_considerPeerAsymmKey peer mpeerData Nothing encHandshake_considerPeerAsymmKey peer Nothing
creds <- getCredentials @s creds <- getCredentials @s
let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv
@ -131,14 +131,14 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
let sign = makeSign @s (view peerSignSk creds) ((cs . serialise) ourpubkey) let sign = makeSign @s (view peerSignSk creds) ((cs . serialise) ourpubkey)
-- сначала удалим у себя его прошлый ключ -- сначала удалим у себя его прошлый ключ
encHandshake_considerPeerAsymmKey peer mpeerData Nothing encHandshake_considerPeerAsymmKey peer Nothing
-- отправить обратно свой публичный ключ -- отправить обратно свой публичный ключ
-- отправится пока ещё в плоском виде -- отправится пока ещё в плоском виде
response (AckEncryptionExchange @e sign ourpubkey) response (AckEncryptionExchange @e sign ourpubkey)
-- Только после этого прописываем его ключ у себя -- Только после этого прописываем его ключ у себя
encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey) encHandshake_considerPeerAsymmKey peer (Just theirpubkey)
AckEncryptionExchange theirsign theirpubkey -> do AckEncryptionExchange theirsign theirpubkey -> do
peer <- thatPeer proto peer <- thatPeer proto
@ -149,7 +149,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
-- Он уже прописал у себя наш публичный ключ и готов общаться шифрованными сообщениями -- Он уже прописал у себя наш публичный ключ и готов общаться шифрованными сообщениями
-- Прописываем его ключ у себя -- Прописываем его ключ у себя
encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey) encHandshake_considerPeerAsymmKey peer (Just theirpubkey)
where where
proto = Proxy @(EncryptionHandshake e) proto = Proxy @(EncryptionHandshake e)

35
hbs2-peer/app/PeerMain.hs
View File

@ -673,22 +673,25 @@ runPeer opts = U.handle (\e -> myException e
, EventEmitter e (PeerAsymmInfo e) m , EventEmitter e (PeerAsymmInfo e) m
) => EncryptionHandshakeAdapter L4Proto m s ) => EncryptionHandshakeAdapter L4Proto m s
encryptionHshakeAdapter = EncryptionHandshakeAdapter encryptionHshakeAdapter = EncryptionHandshakeAdapter
{ encHandshake_considerPeerAsymmKey = \peer mpeerData -> \case { encHandshake_considerPeerAsymmKey = \peer mpubkey -> withPeerM penv do
Nothing -> do mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
-- deletePeerAsymmKey brains peer case mpubkey of
forM_ mpeerData \peerData -> Nothing -> do
deletePeerAsymmKey' brains (show peerData) -- deletePeerAsymmKey brains peer
Just pk -> do forM_ mpeerData \peerData ->
-- emit PeerAsymmInfoKey (PeerAsymmPubKey peer pk) deletePeerAsymmKey' brains (show peerData)
let symmk = genCommonSecret @s Just pk -> do
(privKeyFromKeypair @s (view envAsymmetricKeyPair penv)) -- emit PeerAsymmInfoKey (PeerAsymmPubKey peer pk)
pk let symmk = genCommonSecret @s
case mpeerData of (privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
Nothing -> do pk
-- insertPeerAsymmKey brains peer pk symmk case mpeerData of
pure () Nothing -> do
Just peerData -> -- insertPeerAsymmKey brains peer pk symmk
insertPeerAsymmKey' brains (show peerData) pk symmk pure ()
Just peerData ->
insertPeerAsymmKey' brains (show peerData) pk symmk
} }
env <- ask env <- ask