Move encryption keys to ProxyMessaging

Change key for encryption key map from PeerData to EncryptionKeyIDKey Test for quasidistributiveness of the encodeFrames Move Dialog to HBS2.Net Fixes with hlint: hbs2-peer/app/PeerMain/DialogCliCommand.hs
2023-07-28 20:47:51 +04:00 · 2023-07-28 20:47:51 +04:00 · b22dc35283
parent d86a973e2d
commit b22dc35283
21 changed files with 162 additions and 157 deletions
--- a/.fixme/log
+++ b/.fixme/log
@ -1,3 +0,0 @@
-
-(fixme-set "assigned" "HPoqtobDAT" "voidlizard")
-(fixme-set "workflow" "test" "HPoqtobDAT")
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@ -120,10 +120,10 @@ library
                    , HBS2.Storage.Operations
                    , HBS2.System.Logger.Simple
                    , HBS2.System.Logger.Simple.Class
-                    , Dialog.Core
-                    , Dialog.Client
-                    , Dialog.Helpers.List
-                    , Dialog.Helpers.Streaming
+                    , HBS2.Net.Dialog.Core
+                    , HBS2.Net.Dialog.Client
+                    , HBS2.Net.Dialog.Helpers.List
+                    , HBS2.Net.Dialog.Helpers.Streaming


    -- other-modules:
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@ -11,6 +11,7 @@ module HBS2.Actors.Peer
 import HBS2.Actors
 import HBS2.Actors.Peer.Types
 import HBS2.Clock
+import HBS2.Data.Types.Crypto
 import HBS2.Data.Types.Peer
 import HBS2.Defaults
 import HBS2.Events
@ -158,30 +159,8 @@ data PeerEnv e =
  , _envSweepers      :: TVar (HashMap SKey [PeerM e IO ()])
  , _envReqMsgLimit   :: Cache (Peer e, Integer, Encoded e) ()
  , _envReqProtoLimit :: Cache (Peer e, Integer) ()
-  , _envAsymmetricKeyPair :: AsymmKeypair (Encryption e)
-  , _envEncryptionKeys :: TVar (HashMap (PeerData e) (CommonSecret (Encryption e)))
  }

-setEncryptionKey ::
-  ( Hashable (PubKey 'Sign (Encryption L4Proto))
-  , Hashable PeerNonce
-  , Show (PubKey 'Sign (Encryption L4Proto))
-  , Show PeerNonce
-  , Show (CommonSecret (Encryption L4Proto))
-  ) => PeerEnv L4Proto -> Peer L4Proto -> PeerData L4Proto -> Maybe (CommonSecret (Encryption L4Proto)) -> IO ()
-setEncryptionKey penv peer pd msecret = do
-    atomically $ modifyTVar' (_envEncryptionKeys penv) $ Lens.at pd .~ msecret
-    case msecret of
-        Nothing -> trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow pd
-        Just k ->  trace $ "ENCRYPTION store key" <+> pretty peer <+> viaShow pd <+> viaShow k
-
-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
@ -435,8 +414,6 @@ newPeerEnv s bus p = do
  _envSweepers      <- liftIO (newTVarIO mempty)
  _envReqMsgLimit   <- liftIO (Cache.newCache (Just defRequestLimit))
  _envReqProtoLimit <- liftIO (Cache.newCache (Just defRequestLimit))
-  _envAsymmetricKeyPair <- asymmNewKeypair @(Encryption e)
-  _envEncryptionKeys <- liftIO (newTVarIO mempty)
  pure PeerEnv {..}

 runPeerM :: forall e m . ( MonadIO m
--- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs
@ -8,7 +8,7 @@ module HBS2.Data.Types.Refs
 import HBS2.Base58
 import HBS2.Hash
 import HBS2.Merkle
-import HBS2.Net.Proto.Types (Encryption)
+import HBS2.Net.Proto.Types
 import HBS2.Net.Auth.Credentials
 import HBS2.Prelude

--- a/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
+++ b/hbs2-core/lib/HBS2/Net/Auth/AccessKey.hs
@ -10,6 +10,7 @@ import HBS2.Data.Types
 import HBS2.Merkle
 import HBS2.Net.Auth.Credentials
 import HBS2.Net.Proto.Definition
+import HBS2.Net.Proto.Types
 import HBS2.Prelude.Plated

 import Codec.Serialise
--- a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs
+++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs
@ -28,11 +28,6 @@ import Data.Kind

 type family EncryptPubKey e :: Type

-data CryptoAction = Sign | Encrypt
-
-type family PubKey  ( a :: CryptoAction) e  :: Type
-type family PrivKey ( a :: CryptoAction) e  :: Type
-
 class Signatures e where
  type family Signature e :: Type
  makeSign   :: PrivKey 'Sign e -> ByteString  -> Signature e
@ -207,4 +202,3 @@ instance IsEncoding (PubKey 'Encrypt e)
  => Pretty (KeyringEntry e) where
  pretty ke = fill 10 "pub-key:" <+> pretty (AsBase58 (Crypto.encode (view krPk ke)))

-
--- a/hbs2-core/lib/HBS2/Net/Dialog/Client.hs
+++ b/hbs2-core/lib/HBS2/Net/Dialog/Client.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE ImpredicativeTypes #-}
-module Dialog.Client where
+module HBS2.Net.Dialog.Client where

 -- import System.Clock
 -- import System.Timeout
@ -34,8 +34,8 @@ import UnliftIO.Exception
 import UnliftIO.STM
 import UnliftIO.Timeout

-import Dialog.Core
-import Dialog.Helpers.Streaming
+import HBS2.Net.Dialog.Core
+import HBS2.Net.Dialog.Helpers.Streaming

 ---

--- a/hbs2-core/lib/HBS2/Net/Dialog/Core.hs
+++ b/hbs2-core/lib/HBS2/Net/Dialog/Core.hs
@ -1,7 +1,7 @@
 {-# LANGUAGE StrictData #-}
 -- {-# LANGUAGE OverloadedLists #-}
 -- {-# LANGUAGE UndecidableInstances #-}
-module Dialog.Core where
+module HBS2.Net.Dialog.Core where

 -- import Data.ByteString.Builder as Builder
 -- import Data.ByteString.Builder.Internal as Builder
@ -50,7 +50,7 @@ import UnliftIO.STM
 -- import HBS2.Base58
 import Data.ByteString.Base16 qualified as B16

-import Dialog.Helpers.List
+import HBS2.Net.Dialog.Helpers.List

 type Frames = Frames' ByteString
 newtype Frames' a = Frames { unFrames :: [a] }
@ -78,8 +78,8 @@ tailAfterP p focus = fix \go -> \case

 ---

-- encodeFrames :: Frames -> ByteString
-encodeFrames :: Foldable t => t ByteString -> ByteString
+encodeFrames :: Frames -> ByteString
+-- encodeFrames :: Foldable t => t ByteString -> ByteString
 encodeFrames = F.toList >>> BSL.toStrict . runPut . \case

    []   -> pure ()
--- a/hbs2-core/lib/HBS2/Net/Dialog/Helpers/List.hs
+++ b/hbs2-core/lib/HBS2/Net/Dialog/Helpers/List.hs
@ -1,4 +1,4 @@
-module Dialog.Helpers.List where
+module HBS2.Net.Dialog.Helpers.List where

 import Control.Monad.Trans.Writer.CPS qualified as W
 import Data.Functor.Identity
--- a/hbs2-core/lib/HBS2/Net/Dialog/Helpers/Streaming.hs
+++ b/hbs2-core/lib/HBS2/Net/Dialog/Helpers/Streaming.hs
@ -1,4 +1,4 @@
-module Dialog.Helpers.Streaming where
+module HBS2.Net.Dialog.Helpers.Streaming where

 import Control.Monad.Fix
 import Data.ByteString qualified as BS
--- a/hbs2-core/lib/HBS2/Net/Proto/Dialog.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Dialog.hs
@ -3,8 +3,8 @@

 module HBS2.Net.Proto.Dialog
 ( module HBS2.Net.Proto.Dialog
-, module Dialog.Core
-, module Dialog.Client
+, module HBS2.Net.Dialog.Core
+, module HBS2.Net.Dialog.Client
 ) where

 import HBS2.Actors.Peer
@ -34,8 +34,8 @@ import Streaming.Prelude qualified as S
 import UnliftIO.Exception
 import UnliftIO.STM

-import Dialog.Client
-import Dialog.Core
+import HBS2.Net.Dialog.Client
+import HBS2.Net.Dialog.Core

 ---

--- a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs
@ -15,6 +15,7 @@ import HBS2.System.Logger.Simple

 import Crypto.Saltine.Core.Box qualified as Encrypt
 import Data.ByteString qualified as BS
+import Data.Hashable hiding (Hashed)
 import Data.String.Conversions (cs)
 import Lens.Micro.Platform

@ -68,6 +69,10 @@ sendBeginEncryptionExchange creds ourpubkey peer = do

 data EncryptionHandshakeAdapter e m s = EncryptionHandshakeAdapter
  { encHandshake_considerPeerAsymmKey :: Peer e -> Maybe Encrypt.PublicKey -> m ()
+
+  , encAsymmetricKeyPair :: AsymmKeypair (Encryption e)
+
+  , encGetEncryptionKey :: EncryptionKeyIDKey e -> m (Maybe (CommonSecret (Encryption e)))
  }


@ -88,11 +93,10 @@ encryptionHandshakeProto :: forall e s m .
    , Show (Nonce ())
    )
  => EncryptionHandshakeAdapter e m s
-  -> PeerEnv e
  -> EncryptionHandshake e
  -> m ()

-encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
+encryptionHandshakeProto EncryptionHandshakeAdapter{..} = \case

  ResetEncryptionKeys -> do
      peer <- thatPeer proto
@ -104,7 +108,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
      encHandshake_considerPeerAsymmKey peer Nothing

      creds <- getCredentials @s
-      let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv
+      ourpubkey <- pure $ pubKeyFromKeypair @s $ encAsymmetricKeyPair
      sendBeginEncryptionExchange @e creds ourpubkey peer

  BeginEncryptionExchange theirsign theirpubkey -> do
@ -117,7 +121,7 @@ encryptionHandshakeProto EncryptionHandshakeAdapter{..} penv = \case
      -- взять свои ключи
      creds <- getCredentials @s

-      let ourpubkey = pubKeyFromKeypair @s $ view envAsymmetricKeyPair penv
+      ourpubkey <- pure $ pubKeyFromKeypair @s $ encAsymmetricKeyPair

      -- подписать нонс
      let sign = makeSign @s (view peerSignSk creds) ((cs . serialise) ourpubkey)
--- a/hbs2-core/lib/HBS2/Net/Proto/Peer.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Peer.hs
@ -7,6 +7,7 @@ import HBS2.Actors.Peer
 import HBS2.Data.Types
 import HBS2.Events
 import HBS2.Net.Proto
+import HBS2.Net.Proto.Types
 import HBS2.Clock
 import HBS2.Net.Proto.Sessions
 import HBS2.Prelude.Plated
@ -228,3 +229,36 @@ instance ( Serialise (PubKey 'Sign (Encryption e))

  => Serialise (PeerHandshake e)

+
+---
+
+data EncryptionKeyIDKey e =
+  EncryptionKeyIDKey
+  { ekeyIDPeerSignKey :: PubKey 'Sign (Encryption e)
+  , ekeyIDPeerNonce :: PeerNonce
+  }
+  deriving (Generic)
+
+deriving instance
+  ( Show (PubKey 'Sign (Encryption e))
+  , Show (Nonce ())
+  ) => Show (EncryptionKeyIDKey e)
+
+deriving instance
+  ( Eq (PubKey 'Sign (Encryption e))
+  , Eq (Nonce ())
+  ) => Eq (EncryptionKeyIDKey e)
+
+instance (
+    Hashable (PubKey 'Sign (Encryption e))
+  , Hashable (Nonce ())
+  ) => Hashable (EncryptionKeyIDKey e) where
+  hashWithSalt s EncryptionKeyIDKey {..} =
+      hashWithSalt s (ekeyIDPeerSignKey, ekeyIDPeerNonce)
+
+encryptionKeyIDKeyFromPeerData :: PeerData e -> EncryptionKeyIDKey e
+encryptionKeyIDKeyFromPeerData PeerData{..} =
+    EncryptionKeyIDKey
+        { ekeyIDPeerSignKey = _peerSignKey
+        , ekeyIDPeerNonce = _peerOwnNonce
+        }
--- a/hbs2-core/lib/HBS2/Net/Proto/Types.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Types.hs
@ -28,6 +28,11 @@ import Control.Monad.Trans.Maybe
 -- e -> Transport (like, UDP or TChan)
 -- p -> L4 Protocol (like Ping/Pong)

+data CryptoAction = Sign | Encrypt
+
+type family PubKey  ( a :: CryptoAction) e  :: Type
+type family PrivKey ( a :: CryptoAction) e  :: Type
+
 type family Encryption e :: Type

 -- FIXME: move-to-a-crypto-definition-modules
@ -206,4 +211,3 @@ instance FromStringMaybe (PeerAddr L4Proto) where
 instance Serialise L4Proto
 instance Serialise (PeerAddr L4Proto)

-
--- a/hbs2-core/test/DialogSpec.hs
+++ b/hbs2-core/test/DialogSpec.hs
@ -14,8 +14,8 @@ import GHC.Generics (Generic)
 import Lens.Micro.Platform
 import System.IO

-import Dialog.Core
-import Dialog.Helpers.List
+import HBS2.Net.Dialog.Core
+import HBS2.Net.Dialog.Helpers.List

 newtype BSA = BSA { unBSA :: ByteString }
  deriving (Generic, Show)
@ -57,3 +57,7 @@ testDialog = testGroup "dialog" $ buildList do
        property' "roundtrip encode Frames" \ xs ->
            (decodeFrames . encodeFrames) xs == Right xs

+        property' "encodeFrames is quasidistributive over mappend" \ (xs, ys) ->
+            BS.drop (BS.length (encodeFrames xs)) (encodeFrames (xs <> ys))
+                == encodeFrames ys
+
--- a/hbs2-peer/app/EncryptionKeys.hs
+++ b/hbs2-peer/app/EncryptionKeys.hs
@ -56,15 +56,14 @@ encryptionHandshakeWorker :: forall e m s .
    -- , HasCredentials s m
    )
  => PeerConfig
-  -> PeerEnv e
  -> PeerCredentials s
  -> EncryptionHandshakeAdapter e m s
  -> m ()

-encryptionHandshakeWorker pconf penv creds EncryptionHandshakeAdapter{..} = do
+encryptionHandshakeWorker pconf creds EncryptionHandshakeAdapter{..} = do

    -- e :: PeerEnv e <- ask
-    let ourpubkey = pubKeyFromKeypair @s $ _envAsymmetricKeyPair penv
+    ourpubkey <- pure $ pubKeyFromKeypair @s $ encAsymmetricKeyPair

    pl <- getPeerLocator @e

@ -75,9 +74,9 @@ encryptionHandshakeWorker pconf penv creds EncryptionHandshakeAdapter{..} = do

        forM_ peers \peer -> do
            -- Только если ещё не знаем ключ ноды
-            mpeerData <- find (KnownPeerKey peer) id
-            mkey <- liftIO do
-                join <$> forM mpeerData \peerData -> getEncryptionKey penv peerData
+            mencKeyID <- (fmap . fmap) encryptionKeyIDKeyFromPeerData $
+                find (KnownPeerKey peer) id
+            mkey <- join <$> mapM encGetEncryptionKey mencKeyID
            case mkey of
                Just _ -> pure ()
                Nothing -> sendBeginEncryptionExchange @e creds ourpubkey peer
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@ -448,7 +448,7 @@ runPeer :: forall e s . ( e ~ L4Proto
                        , FromStringMaybe (PeerAddr e)
                        , s ~ Encryption e
                        , HasStorage (PeerM e IO)
-                        ) => PeerOpts -> IO ()
+                        )=> PeerOpts -> IO ()

 runPeer opts = Exception.handle (\e -> myException e
                        >> performGC
@ -574,32 +574,35 @@ runPeer opts = Exception.handle (\e -> myException e
           pure $ Just tcpEnv

  (proxy, penv) <- mdo
-      proxy <- newProxyMessaging mess tcp >>= \peer -> pure peer
+      proxy <- newProxyMessaging mess tcp >>= \proxy' -> pure proxy'
            { _proxy_getEncryptionKey = \peer -> do
-                  mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
-                  mkey <- join <$> forM mpeerData \peerData -> getEncryptionKey penv peerData
+                  mencKeyID <- (fmap . fmap) encryptionKeyIDKeyFromPeerData $
+                      withPeerM penv $ find (KnownPeerKey peer) id
+                  mkey <- join <$> forM mencKeyID \encKeyID ->
+                      getEncryptionKey proxy encKeyID
                  case mkey of
                      Nothing ->
                          trace1 $ "ENCRYPTION empty getEncryptionKey"
-                              <+> pretty peer <+> viaShow mpeerData
+                              <+> pretty peer <+> viaShow mencKeyID
                      Just k ->
                          trace1 $ "ENCRYPTION success getEncryptionKey"
-                              <+> pretty peer <+> viaShow mpeerData <+> viaShow k
+                              <+> pretty peer <+> viaShow mencKeyID <+> viaShow k
                  pure mkey

            , _proxy_clearEncryptionKey = \peer -> do
-                  mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
-                  forM_ mpeerData \peerData -> setEncryptionKey penv peer peerData Nothing
+                  mencKeyID <- (fmap . fmap) encryptionKeyIDKeyFromPeerData $
+                      withPeerM penv $ find (KnownPeerKey peer) id
+                  forM_ mencKeyID \encKeyID -> setEncryptionKey proxy peer encKeyID Nothing
                  -- deletePeerAsymmKey brains peer
-                  forM_ mpeerData \peerData ->
-                      deletePeerAsymmKey' brains (show peerData)
+                  forM_ mencKeyID \encKeyID ->
+                      deletePeerAsymmKey' brains (show encKeyID)

            , _proxy_sendResetEncryptionKeys = \peer -> withPeerM penv do
                  sendResetEncryptionKeys peer

            , _proxy_sendBeginEncryptionExchange = \peer -> withPeerM penv do
                  sendBeginEncryptionExchange pc
-                      ((pubKeyFromKeypair @s . view envAsymmetricKeyPair) penv)
+                      ((pubKeyFromKeypair @s . _proxy_asymmetricKeyPair) proxy)
                      peer

          }
@ -687,27 +690,32 @@ runPeer opts = Exception.handle (\e -> myException e
                      ) => EncryptionHandshakeAdapter L4Proto m s
                  encryptionHshakeAdapter = EncryptionHandshakeAdapter
                    { encHandshake_considerPeerAsymmKey = \peer mpubkey -> withPeerM penv do
-                          mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
+                          mencKeyID <- (fmap . fmap) encryptionKeyIDKeyFromPeerData $
+                              withPeerM penv $ find (KnownPeerKey peer) id
                          case mpubkey of
                              Nothing -> do
-                                  -- trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow mpeerData
+                                  -- trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow mencKeyID
                                  -- deletePeerAsymmKey brains peer
-                                  forM_ mpeerData \peerData ->
-                                      deletePeerAsymmKey' brains (show peerData)
+                                  forM_ mencKeyID \encKeyID ->
+                                      deletePeerAsymmKey' brains (show encKeyID)
                              Just pk -> do
                                  -- emit PeerAsymmInfoKey (PeerAsymmPubKey peer pk)
                                  let symmk = genCommonSecret @s
-                                          (privKeyFromKeypair @s (view envAsymmetricKeyPair penv))
+                                          (privKeyFromKeypair @s (_proxy_asymmetricKeyPair proxy))
                                          pk
-                                  case mpeerData of
+                                  case mencKeyID of
                                      Nothing -> do
                                          -- insertPeerAsymmKey brains peer pk symmk
                                          -- insertPeerAsymmKey' brains (show peer) pk symmk
-                                          trace $ "ENCRYPTION can not store key. No peerData"
-                                              <+> pretty peer <+> viaShow mpeerData
-                                      Just peerData -> do
-                                          liftIO $ setEncryptionKey penv peer peerData (Just symmk)
-                                          insertPeerAsymmKey' brains (show peerData) pk symmk
+                                          trace $ "ENCRYPTION can not store key. No encKeyID"
+                                              <+> pretty peer <+> viaShow mencKeyID
+                                      Just encKeyID -> do
+                                          liftIO $ setEncryptionKey proxy peer encKeyID (Just symmk)
+                                          insertPeerAsymmKey' brains (show encKeyID) pk symmk
+
+                    , encAsymmetricKeyPair = _proxy_asymmetricKeyPair proxy
+
+                    , encGetEncryptionKey = liftIO . getEncryptionKey proxy

                    }

@ -724,11 +732,12 @@ runPeer opts = Exception.handle (\e -> myException e
              addPeers @e pl ps

              subscribe @e PeerExpiredEventKey \(PeerExpiredEvent peer {-mpeerData-}) -> liftIO do
-                  mpeerData <- withPeerM penv $ find (KnownPeerKey peer) id
-                  forM_ mpeerData \peerData -> setEncryptionKey penv peer peerData Nothing
+                  mencKeyID <- (fmap . fmap) encryptionKeyIDKeyFromPeerData $
+                               withPeerM penv $ find (KnownPeerKey peer) id
+                  forM_ mencKeyID \encKeyID -> setEncryptionKey proxy peer encKeyID Nothing
                  -- deletePeerAsymmKey brains peer
-                  forM_ mpeerData \peerData ->
-                      deletePeerAsymmKey' brains (show peerData)
+                  forM_ mencKeyID \encKeyID ->
+                      deletePeerAsymmKey' brains (show encKeyID)

              subscribe @e PeerAnnounceEventKey $ \(PeerAnnounceEvent pip nonce) -> do
               unless (nonce == pnonce) $ do
@ -871,7 +880,7 @@ runPeer opts = Exception.handle (\e -> myException e
                peerThread "blockDownloadLoop" (blockDownloadLoop denv)

                peerThread "encryptionHandshakeWorker"
-                    (EncryptionKeys.encryptionHandshakeWorker @e conf penv pc encryptionHshakeAdapter)
+                    (EncryptionKeys.encryptionHandshakeWorker @e conf pc encryptionHshakeAdapter)

                let tcpProbeWait :: Timeout 'Seconds
                    tcpProbeWait = (fromInteger . fromMaybe 300) (cfgValue @PeerTcpProbeWaitKey conf)
@ -991,7 +1000,7 @@ runPeer opts = Exception.handle (\e -> myException e
                    , makeResponse (blockChunksProto adapter)
                    , makeResponse blockAnnounceProto
                    , makeResponse (withCredentials @e pc . peerHandShakeProto hshakeAdapter penv)
-                    , makeResponse (withCredentials @e pc . encryptionHandshakeProto encryptionHshakeAdapter penv)
+                    , makeResponse (withCredentials @e pc . encryptionHandshakeProto encryptionHshakeAdapter)
                    , makeResponse (peerExchangeProto pexFilt)
                    , makeResponse (refLogUpdateProto reflogAdapter)
                    , makeResponse (refLogRequestProto reflogReqAdapter)
--- a/hbs2-peer/app/PeerMain/DialogCliCommand.hs
+++ b/hbs2-peer/app/PeerMain/DialogCliCommand.hs
@ -2,81 +2,32 @@

 module PeerMain.DialogCliCommand where

-- import Data.Generics.Labels
-- import Data.Generics.Product.Fields
+import Data.Generics.Labels
+import Data.Generics.Product.Fields
 import HBS2.Actors.Peer
-import HBS2.Base58
-import HBS2.Clock
-import HBS2.Net.Proto.RefLog (RefLogKey(..))
-import HBS2.Defaults
-import HBS2.Events
-import HBS2.Hash
-import HBS2.Merkle
-import HBS2.Net.Auth.Credentials
 import HBS2.Net.IP.Addr
-import HBS2.Net.Messaging
-import HBS2.Net.Messaging.TCP
 import HBS2.Net.Messaging.UDP
-import HBS2.Net.PeerLocator
 import HBS2.Net.Proto
-import HBS2.Net.Proto.Definition
 import HBS2.Net.Proto.Dialog
-import HBS2.Net.Proto.Peer
-import HBS2.Net.Proto.PeerAnnounce
-import HBS2.Net.Proto.PeerExchange
-import HBS2.Net.Proto.PeerMeta
-import HBS2.Net.Proto.RefLog
-import HBS2.Net.Proto.Sessions
-import HBS2.Net.Proto.Types
 import HBS2.OrDie
 import HBS2.Prelude
-import HBS2.Prelude.Plated
-import HBS2.Storage.Simple
 import HBS2.System.Logger.Simple hiding (info)
-import HBS2.System.Logger.Simple qualified as Log

-import BlockDownload
-import BlockHttpDownload
-import Bootstrap
-import Brains
-import CheckMetrics
-import DownloadQ
-import HttpWorker
 import PeerConfig
-import PeerInfo
-import PeerMeta
-import PeerTypes
-import ProxyMessaging
-import RefLog (reflogWorker)
-import RefLog qualified
 import RPC

-import Control.Monad
-import Control.Monad.IO.Unlift
-import Control.Monad.Reader
 import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import Crypto.Saltine.Core.Box qualified as Encrypt
-import Data.ByteString qualified as BS
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString.Lazy (ByteString)
-import Data.ByteString.Lazy qualified as LBS
 import Data.Default
 import Data.Function
 import Data.Functor
+import Data.Kind
 import Data.List qualified as List
-import Data.Map.Strict qualified as Map
-import Data.Maybe
-import Data.Monoid qualified as Monoid
-import Data.Set qualified as Set
 import Data.String.Conversions as X (cs)
 import Data.Void (absurd, Void)
 import Lens.Micro.Platform
 import Network.Socket
 import Options.Applicative
-import Streaming as S
 import Streaming.Prelude qualified as S
-import System.Directory
 import UnliftIO.Async
 import UnliftIO.Concurrent
 import UnliftIO.Exception as U
@ -84,7 +35,6 @@ import UnliftIO.Resource

 -- import System.FilePath.Posix
 import System.IO
-import System.Exit


 pDialog :: Parser (IO ())
@ -95,16 +45,16 @@ pDialog = hsubparser $ mempty
 confOpt :: Parser FilePath
 confOpt = strOption ( long "config"  <> short 'c' <> help "config" )

-data OptInitial (f :: * -> *) a b = OptInitial { unOptInitial :: f a }
+newtype OptInitial (f :: Type -> Type) a b = OptInitial { unOptInitial :: f a }
  deriving (Generic, Show)

-data OptResolved (f :: * -> *) a b = OptResolved { unOptResolved :: b }
+newtype OptResolved (f :: Type -> Type) a b = OptResolved { unOptResolved :: b }
  deriving (Generic, Show)

 type DialOptInitial = DialOpt OptInitial
 type DialOptResolved = DialOpt OptResolved

-data DialOpt (f :: (* -> *) -> * -> * -> *) = DialOpt
+data DialOpt (f :: (Type -> Type) -> Type -> Type -> Type) = DialOpt
  { dialOptConf :: f Maybe FilePath PeerConfig
  , dialOptAddr :: f Maybe String (Peer L4Proto)
  }
@ -133,7 +83,7 @@ resolveDialOpt dopt = do
        `orDieM` "Dial endpoint not set"

    as <- parseAddrUDP (cs saddr) <&> fmap (fromSockAddr @'UDP . addrAddress)
-    peer <- (headMay $ List.sortBy (compare `on` addrPriority) as)
+    peer <- headMay (List.sortBy (compare `on` addrPriority) as)
        `orDieM` "Can't parse Dial endpoint"

    pure DialOpt
--- a/hbs2-peer/app/PeerMain/PeerDialog.hs
+++ b/hbs2-peer/app/PeerMain/PeerDialog.hs
@ -6,7 +6,7 @@ import Data.Bool
 import Data.ByteString qualified as BS
 import Data.Map qualified as Map

-import Dialog.Core
+import HBS2.Net.Dialog.Core
 import HBS2.Net.Proto.Types


--- a/hbs2-peer/app/PeerTypes.hs
+++ b/hbs2-peer/app/PeerTypes.hs
@ -415,15 +415,9 @@ mkPeerMeta conf penv = do
            . fromStringMay @(PeerAddr L4Proto)
          )
          =<< cfgValue @PeerListenTCPKey conf
-    -- let useEncryption = True  -- move to config
    annMetaFromPeerMeta . PeerMeta $ W.execWriter do
      mHttpPort `forM` \p -> elem "http-port" (TE.encodeUtf8 . Text.pack . show $ p)
      mTcpPort `forM` \p -> elem "listen-tcp" (TE.encodeUtf8 . Text.pack . show $ p)
-      -- when useEncryption do
-      --     elem "ekey" (TE.encodeUtf8 . Text.pack . show $
-      --         (Encrypt.publicKey . _envAsymmetricKeyPair) penv
-      --         -- mayby sign this pubkey by node key ?
-      --         )

  where
    elem k = W.tell . L.singleton . (k ,)
--- a/hbs2-peer/app/ProxyMessaging.hs
+++ b/hbs2-peer/app/ProxyMessaging.hs
@ -4,6 +4,9 @@ module ProxyMessaging
  , newProxyMessaging
  , runProxyMessaging
  , sendToPlainProxyMessaging
+  , getEncryptionKey
+  , setEncryptionKey
+  , encryptionKeyIDKeyFromPeerData
  ) where

 import HBS2.Prelude.Plated
@ -34,6 +37,7 @@ import Control.Monad.Trans.Maybe
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as LBS
+import Data.Hashable hiding (Hashed)
 import Data.Maybe
 import Data.String.Conversions (cs)
 import Data.List qualified as L
@ -41,6 +45,10 @@ import Data.Map (Map)
 import Data.Map qualified as Map
 import Lens.Micro.Platform as Lens
 import Control.Monad
+import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HashMap
+
+import HBS2.Data.Types.Peer

 -- TODO: protocol-encryption-goes-here

@ -54,6 +62,9 @@ data ProxyMessaging =
  , _proxy_clearEncryptionKey :: Peer L4Proto -> IO ()
  , _proxy_sendResetEncryptionKeys :: Peer L4Proto -> IO ()
  , _proxy_sendBeginEncryptionExchange :: Peer L4Proto -> IO ()
+
+  , _proxy_asymmetricKeyPair :: AsymmKeypair (Encryption L4Proto)
+  , _proxy_encryptionKeys :: TVar (HashMap (EncryptionKeyIDKey L4Proto) (CommonSecret (Encryption L4Proto)))
  }

 -- 1 нода X создаёт себе Encrypt.Keypair
@ -78,8 +89,36 @@ newProxyMessaging u t = liftIO do
    let _proxy_sendResetEncryptionKeys = const (pure ())
    let _proxy_sendBeginEncryptionExchange = const (pure ())

+    _proxy_asymmetricKeyPair <- asymmNewKeypair @(Encryption L4Proto)
+    _proxy_encryptionKeys <- liftIO (newTVarIO mempty)
+
    pure ProxyMessaging {..}

+---
+
+setEncryptionKey ::
+  ( Hashable (PubKey 'Sign (Encryption L4Proto))
+  , Hashable PeerNonce
+  , Show (PubKey 'Sign (Encryption L4Proto))
+  , Show PeerNonce
+  , Show (CommonSecret (Encryption L4Proto))
+  , Show (EncryptionKeyIDKey L4Proto)
+  ) => ProxyMessaging -> Peer L4Proto -> EncryptionKeyIDKey L4Proto -> Maybe (CommonSecret (Encryption L4Proto)) -> IO ()
+setEncryptionKey proxy peer pd msecret = do
+    atomically $ modifyTVar' (_proxy_encryptionKeys proxy) $ Lens.at pd .~ msecret
+    case msecret of
+        Nothing -> trace $ "ENCRYPTION delete key" <+> pretty peer <+> viaShow pd
+        Just k ->  trace $ "ENCRYPTION store key" <+> pretty peer <+> viaShow pd <+> viaShow k
+
+getEncryptionKey ::
+  ( Hashable (PubKey 'Sign (Encryption L4Proto))
+  , Hashable PeerNonce
+  ) => ProxyMessaging -> EncryptionKeyIDKey L4Proto -> IO (Maybe (CommonSecret (Encryption L4Proto)))
+getEncryptionKey proxy pd =
+    readTVarIO (_proxy_encryptionKeys proxy) <&> preview (Lens.ix pd)
+
+---
+
 runProxyMessaging :: forall m . MonadIO  m
                  => ProxyMessaging
                  -> m ()
@ -103,7 +142,6 @@ runProxyMessaging env = liftIO do

  liftIO $ mapM_ waitCatch [u,t]

-
 instance Messaging ProxyMessaging L4Proto LBS.ByteString where

  sendTo = sendToProxyMessaging