diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs index d548498d..fd61ae4c 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer.hs @@ -167,6 +167,13 @@ setEncryptionKey :: setEncryptionKey penv pd msecret = atomically $ modifyTVar' (_envEncryptionKeys penv) $ Lens.at pd .~ msecret +getEncryptionKey :: + ( Hashable (PubKey 'Sign (Encryption L4Proto)) + , Hashable PeerNonce + ) => PeerEnv L4Proto -> PeerData L4Proto -> IO (Maybe (CommonSecret (Encryption L4Proto))) +getEncryptionKey penv pd = + readTVarIO (_envEncryptionKeys penv) <&> preview (Lens.ix pd) + newtype PeerM e m a = PeerM { fromPeerM :: ReaderT (PeerEnv e) m a } deriving newtype ( Functor , Applicative diff --git a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs index d5e46075..45edade4 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs @@ -65,16 +65,14 @@ sendBeginEncryptionExchange :: forall e s m . , e ~ L4Proto , s ~ Encryption e ) - => PeerEnv e - -> PeerCredentials s - -> Peer e + => PeerCredentials s -> PubKey 'Encrypt (Encryption e) + -> Peer e -> m () -sendBeginEncryptionExchange penv creds peer pubkey = do - let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv +sendBeginEncryptionExchange creds ourpubkey peer = do let sign = makeSign @s (view peerSignSk creds) ((cs . serialise) ourpubkey) - request peer (BeginEncryptionExchange @e sign pubkey) + request peer (BeginEncryptionExchange @e sign ourpubkey) data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter { encHandshake_considerPeerAsymmKey :: Peer e -> Maybe (PeerData e) -> Maybe Encrypt.PublicKey -> m () @@ -115,7 +113,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case creds <- getCredentials @s let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv - sendBeginEncryptionExchange @e penv creds peer ourpubkey + sendBeginEncryptionExchange @e creds ourpubkey peer BeginEncryptionExchange theirsign theirpubkey -> do peer <- thatPeer proto diff --git a/hbs2-peer/app/EncryptionKeys.hs b/hbs2-peer/app/EncryptionKeys.hs index 69a702b3..88270923 100644 --- a/hbs2-peer/app/EncryptionKeys.hs +++ b/hbs2-peer/app/EncryptionKeys.hs @@ -74,4 +74,4 @@ encryptionHandshakeWorker pconf penv creds EncryptionHandshakeAdapter{..} = do forM_ peers \peer -> do -- TODO: Только если ещё не знаем ключ ноды - sendBeginEncryptionExchange @e penv creds peer ourpubkey + sendBeginEncryptionExchange @e creds ourpubkey peer diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 42df97a4..e1d4ef18 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -578,12 +578,26 @@ runPeer opts = U.handle (\e -> myException e pure $ Just tcpEnv (proxy, penv) <- mdo - proxy <- newProxyMessaging mess tcp >>= \p -> do - pure p - { _proxy_getEncryptionKey = undefined - , _proxy_clearEncryptionKey = undefined - , _proxy_sendResetEncryptionKeys = undefined - , _proxy_sendBeginEncryptionExchange = undefined + proxy <- newProxyMessaging mess tcp >>= \peer -> pure peer + { _proxy_getEncryptionKey = \peer -> do + mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id + join <$> forM mpeerData \peerData -> getEncryptionKey penv peerData + + , _proxy_clearEncryptionKey = \peer -> do + mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id + forM_ mpeerData \peerData -> setEncryptionKey penv peerData Nothing + -- deletePeerAsymmKey brains peer + forM_ mpeerData \peerData -> + deletePeerAsymmKey' brains (show peerData) + + , _proxy_sendResetEncryptionKeys = \peer -> withPeerM penv do + sendResetEncryptionKeys peer + + , _proxy_sendBeginEncryptionExchange = \peer -> withPeerM penv do + sendBeginEncryptionExchange pc + ((pubKeyFromKeypair @s . view envAsymmetricKeyPair) penv) + peer + } penv <- newPeerEnv (AnyStorage s) (Fabriq proxy) (getOwnPeer mess) pure (proxy, penv) @@ -661,7 +675,7 @@ runPeer opts = U.handle (\e -> myException e encryptionHshakeAdapter = EncryptionHandshakeAdapter { encHandshake_considerPeerAsymmKey = \peer mpeerData -> \case Nothing -> do - deletePeerAsymmKey brains peer + -- deletePeerAsymmKey brains peer forM_ mpeerData \peerData -> deletePeerAsymmKey' brains (show peerData) Just pk -> do @@ -670,7 +684,9 @@ runPeer opts = U.handle (\e -> myException e (privKeyFromKeypair @s (view envAsymmetricKeyPair penv)) pk case mpeerData of - Nothing -> insertPeerAsymmKey brains peer pk symmk + Nothing -> do + -- insertPeerAsymmKey brains peer pk symmk + pure () Just peerData -> insertPeerAsymmKey' brains (show peerData) pk symmk }