wip

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)
+      trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData)
-      encHandshake_considerPeerAsymmKey paddr mpeerData Nothing
+      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)
+      trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, mpeerData)
-
-      encHandshake_considerPeerAsymmKey paddr mpeerData (Just theirpubkey)
 
       -- взять свои ключи
       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)
+      -- Прописываем его ключ у себя
-
+      encHandshake_considerPeerAsymmKey peer mpeerData (Just theirpubkey)
-      emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
+      -- emit PeerAsymmInfoKey (PeerAsymmPubKey peer theirpubkey)
 
   where
     proto = Proxy @(EncryptionHandshake e)

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|

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
+                            deletePeerAsymmKey brains peer
-                            deletePeerSymmKey brains addr
+                            deletePeerSymmKey brains peer
                         Just pk -> do
-                            insertPeerAsymmKey brains addr pk
+                            insertPeerAsymmKey brains peer pk
-                            insertPeerSymmKey brains addr $
+                            insertPeerSymmKey brains peer $
                                 genCommonSecret @s
                                     (privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
                                     pk

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:
     -- Если мы не смогли, по любой причине, расшифровать сообщение,
     --   то нужно стереть у себя ключ