From e43f2c439d04b367d199ae98616e76f453e872a6 Mon Sep 17 00:00:00 2001 From: Sergey Ivanov Date: Wed, 12 Jul 2023 23:24:37 +0400 Subject: [PATCH] wip --- .../lib/HBS2/Net/Proto/EncryptionHandshake.hs | 26 +++++++++---------- hbs2-peer/app/Brains.hs | 8 +++--- hbs2-peer/app/PeerMain.hs | 10 +++---- hbs2-peer/app/ProxyMessaging.hs | 10 +++++++ 4 files changed, 31 insertions(+), 23 deletions(-) diff --git a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs index dc373cb3..4ab3c59b 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs @@ -85,7 +85,7 @@ sendBeginEncryptionExchange penv creds peer pubkey = do request peer (BeginEncryptionExchange @e nonce0 sign pubkey) data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter - { encHandshake_considerPeerAsymmKey :: PeerAddr e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m () + { encHandshake_considerPeerAsymmKey :: Peer e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m () } @@ -121,11 +121,10 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case ResetEncryptionKeys -> do peer <- thatPeer proto - paddr <- toPeerAddr peer mpeerData <- find (KnownPeerKey peer) id -- TODO: check theirsign - trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, paddr, mpeerData) - encHandshake_considerPeerAsymmKey paddr mpeerData Nothing + trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData) + encHandshake_considerPeerAsymmKey peer mpeerData Nothing creds <- getCredentials @s let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv @@ -133,13 +132,10 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case BeginEncryptionExchange nonce0 theirsign theirpubkey -> do peer <- thatPeer proto - paddr <- toPeerAddr peer mpeerData <- find (KnownPeerKey peer) id -- TODO: check theirsign - trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, paddr, mpeerData) - - encHandshake_considerPeerAsymmKey paddr mpeerData (Just theirpubkey) + trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, mpeerData) -- взять свои ключи creds <- getCredentials @s @@ -150,21 +146,23 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case let sign = makeSign @s (view peerSignSk creds) (unEENonce nonce0 <> (cs . serialise) ourpubkey) -- отправить обратно вместе с публичным ключом + -- отправится пока ещё в плоском виде response (AckEncryptionExchange @e nonce0 sign ourpubkey) - emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey) + -- Только после этого прописываем его ключ у себя + encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey) + -- emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey) AckEncryptionExchange nonce0 theirsign theirpubkey -> do peer <- thatPeer proto - paddr <- toPeerAddr peer mpeerData <- find (KnownPeerKey peer) id -- TODO: check theirsign - trace $ "EHSP AckEncryptionExchange from" <+> viaShow (peer, paddr, mpeerData) + trace $ "EHSP AckEncryptionExchange from" <+> viaShow (peer, mpeerData) - encHandshake_considerPeerAsymmKey paddr mpeerData (Just theirpubkey) - - emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey) + -- Прописываем его ключ у себя + encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey) + -- emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey) where proto = Proxy @(EncryptionHandshake e) diff --git a/hbs2-peer/app/Brains.hs b/hbs2-peer/app/Brains.hs index 87045fcd..6df0c074 100644 --- a/hbs2-peer/app/Brains.hs +++ b/hbs2-peer/app/Brains.hs @@ -610,7 +610,7 @@ insertPeerAsymmKey :: forall e m . , MonadIO m ) => BasicBrains e - -> PeerAddr e + -> Peer e -> Encrypt.PublicKey -> m () @@ -630,7 +630,7 @@ insertPeerSymmKey :: forall e m . , MonadIO m ) => BasicBrains e - -> PeerAddr e + -> Peer e -> Encrypt.CombinedKey -> m () @@ -646,7 +646,7 @@ insertPeerSymmKey br peer hSymmKey = do |] (show $ pretty peer, show hSymmKey) deletePeerAsymmKey :: forall e m . (e ~ L4Proto, MonadIO m) - => BasicBrains e -> PeerAddr e -> m () + => BasicBrains e -> Peer e -> m () deletePeerAsymmKey br peer = void $ liftIO $ execute (view brainsDb br) [qc| @@ -655,7 +655,7 @@ deletePeerAsymmKey br peer = |] (Only (show $ pretty peer)) deletePeerSymmKey :: forall e m . (e ~ L4Proto, MonadIO m) - => BasicBrains e -> PeerAddr e -> m () + => BasicBrains e -> Peer e -> m () deletePeerSymmKey br peer = void $ liftIO $ execute (view brainsDb br) [qc| diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 16ff1bcb..6150bdcf 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -650,13 +650,13 @@ runPeer opts = U.handle (\e -> myException e ( MonadIO m ) => EncryptionHandshakeAdapter L4Proto m s encryptionHshakeAdapter = EncryptionHandshakeAdapter - { encHandshake_considerPeerAsymmKey = \addr mpeerData -> \case + { encHandshake_considerPeerAsymmKey = \peer mpeerData -> \case Nothing -> do - deletePeerAsymmKey brains addr - deletePeerSymmKey brains addr + deletePeerAsymmKey brains peer + deletePeerSymmKey brains peer Just pk -> do - insertPeerAsymmKey brains addr pk - insertPeerSymmKey brains addr $ + insertPeerAsymmKey brains peer pk + insertPeerSymmKey brains peer $ genCommonSecret @s (privKeyFromKeypair @s (view envAsymmetricKeyPair penv)) pk diff --git a/hbs2-peer/app/ProxyMessaging.hs b/hbs2-peer/app/ProxyMessaging.hs index 88c15441..3e4c403e 100644 --- a/hbs2-peer/app/ProxyMessaging.hs +++ b/hbs2-peer/app/ProxyMessaging.hs @@ -151,6 +151,16 @@ receiveFromProxyMessaging bus _ = liftIO do encKeys <- (liftIO . readTVarIO) (view proxyEncryptionKeys bus) fmap (w, ) <$> dfm whom (Map.lookup whom encKeys) msg + -- Здесь: + -- 1. У нас есть ключ сессии и мы не смогли расшифровать -> do + -- удаляем у себя ключ + -- отправляем sendResetEncryptionKeys + -- 2. У нас нет ключа сессии -> do + -- просто передаём сообщение как есть + + -- В протоколе пингов: + -- 1. Если слишком долго нет ответа на ping, то удаляем у себя ключ, отправляем sendResetEncryptionKeys + -- TODO: -- Если мы не смогли, по любой причине, расшифровать сообщение, -- то нужно стереть у себя ключ