Actual handlers for ProxyMessaging

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

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

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

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
                     }