From 3316bb3d44040c1941ac4496415fa3f066c8dbfb Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Wed, 19 Jul 2023 00:20:43 +0400
Subject: [PATCH] traces encryption events

---
 hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs |  6 +++---
 hbs2-peer/app/PeerMain.hs                           | 12 +++++++++++-
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
index 3e506d1e..0b974e76 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
@@ -106,7 +106,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
       peer <- thatPeer proto
       mpeerData <- find (KnownPeerKey peer) id
       -- TODO: check theirsign
-      trace $ "EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData)
+      trace $ "ENCRYPTION EHSP ResetEncryptionKeys from" <+> viaShow (peer, mpeerData)
 
       -- сначала удалим у себя его прошлый ключ
       encHandshake_considerPeerAsymmKey peer Nothing
@@ -120,7 +120,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
       mpeerData <- find (KnownPeerKey peer) id
       -- TODO: check theirsign
 
-      trace $ "EHSP BeginEncryptionExchange from" <+> viaShow (peer, mpeerData)
+      trace $ "ENCRYPTION EHSP BeginEncryptionExchange from" <+> viaShow (peer, mpeerData)
 
       -- взять свои ключи
       creds <- getCredentials @s
@@ -145,7 +145,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
       mpeerData <- find (KnownPeerKey peer) id
       -- TODO: check theirsign
 
-      trace $ "EHSP AckEncryptionExchange from" <+> viaShow (peer, mpeerData)
+      trace $ "ENCRYPTION EHSP AckEncryptionExchange from" <+> viaShow (peer, mpeerData)
 
       -- Он уже прописал у себя наш публичный ключ и готов общаться шифрованными сообщениями
       -- Прописываем его ключ у себя
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 071cb412..42a997e1 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -582,7 +582,15 @@ runPeer opts = U.handle (\e -> myException e
       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
+                  mkey <- join <$> forM mpeerData \peerData -> getEncryptionKey penv peerData
+                  case mkey of
+                      Nothing ->
+                          trace $ "ENCRYPTION empty getEncryptionKey"
+                              <+> pretty peer <+> viaShow mpeerData
+                      Just k ->
+                          trace $ "ENCRYPTION success getEncryptionKey"
+                              <+> pretty peer <+> viaShow mpeerData <+> viaShow k
+                  pure mkey
 
             , _proxy_clearEncryptionKey = \peer -> do
                   mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
@@ -678,6 +686,7 @@ runPeer opts = U.handle (\e -> myException e
                           mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
                           case mpubkey of
                               Nothing -> do
+                                  trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow mpeerData
                                   -- deletePeerAsymmKey brains peer
                                   forM_ mpeerData \peerData ->
                                       deletePeerAsymmKey' brains (show peerData)
@@ -686,6 +695,7 @@ runPeer opts = U.handle (\e -> myException e
                                   let symmk = genCommonSecret @s
                                           (privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
                                           pk
+                                  trace $ "ENCRYPTION store key" <+> pretty peer <+> viaShow mpeerData
                                   case mpeerData of
                                       Nothing -> do
                                           -- insertPeerAsymmKey brains peer pk symmk