Added encryptionHandshakeProto to PeerMain "all protos" thread

hbs2-core/lib/HBS2/Base58.hs

@@ -25,3 +25,6 @@ fromBase58 = decodeBase58 bitcoinAlphabet
 instance Pretty (AsBase58 ByteString) where
   pretty (AsBase58 bs) = pretty $ BS8.unpack $ toBase58 bs
 
+instance Show (AsBase58 ByteString) where
+  show (AsBase58 bs) = BS8.unpack $ toBase58 bs
+

hbs2-core/lib/HBS2/Net/Proto/Definition.hs

@@ -14,6 +14,7 @@ import HBS2.Net.Proto
 import HBS2.Net.Proto.BlockAnnounce
 import HBS2.Net.Proto.BlockChunks
 import HBS2.Net.Proto.BlockInfo
+import HBS2.Net.Proto.EncryptionHandshake
 import HBS2.Net.Proto.Peer
 import HBS2.Net.Proto.PeerAnnounce
 import HBS2.Net.Proto.PeerExchange
@@ -125,6 +126,14 @@ instance HasProtocol L4Proto (PeerMetaProto L4Proto) where
   -- FIXME: real-period
   requestPeriodLim = ReqLimPerMessage 0.25
 
+instance HasProtocol L4Proto (EncryptionHandshake L4Proto) where
+  type instance ProtocolId (EncryptionHandshake L4Proto) = 10
+  type instance Encoded L4Proto = ByteString
+  decode = deserialiseCustom
+  encode = serialise
+
+  requestPeriodLim = ReqLimPerProto 0.5
+
 instance Expires (SessionKey L4Proto (BlockInfo L4Proto)) where
   expiresIn _ = Just defCookieTimeoutSec
 
@@ -143,12 +152,18 @@ instance Expires (SessionKey L4Proto (KnownPeer L4Proto)) where
 instance Expires (SessionKey L4Proto (PeerHandshake L4Proto)) where
   expiresIn _ = Just 60
 
+instance Expires (SessionKey L4Proto (EncryptionHandshake L4Proto)) where
+  expiresIn _ = Just 60
+
 instance Expires (EventKey L4Proto (PeerAnnounce L4Proto)) where
   expiresIn _ = Nothing
 
 instance Expires (EventKey L4Proto (PeerMetaProto L4Proto)) where
   expiresIn _ = Just 600
 
+-- instance Expires (EventKey L4Proto (EncryptionHandshake L4Proto)) where
+--   expiresIn _ = Just 600
+
 -- instance MonadIO m => HasNonces () m where
 --   type instance Nonce (PeerHandshake L4Proto) = BS.ByteString
 --   newNonce = do

hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs

@@ -2,28 +2,32 @@
 {-# Language UndecidableInstances #-}
 module HBS2.Net.Proto.EncryptionHandshake where
 
--- import HBS2.Base58
 import HBS2.Actors.Peer
+import HBS2.Base58
+import HBS2.Clock
 import HBS2.Data.Types
 import HBS2.Events
+import HBS2.Net.Auth.Credentials
 import HBS2.Net.Proto
-import HBS2.Clock
 import HBS2.Net.Proto.Sessions
 import HBS2.Prelude.Plated
-import HBS2.Net.Auth.Credentials
 import HBS2.System.Logger.Simple
 
-import Control.Monad
-import Crypto.Saltine.Core.Box qualified as Encrypt
-import Data.Maybe
 import Codec.Serialise()
+import Control.Monad
+import Crypto.Saltine.Class qualified as Crypto
+import Crypto.Saltine.Core.Box qualified as Encrypt
 import Data.ByteString qualified as BS
 import Data.Hashable
+import Data.Maybe
 import Data.String.Conversions (cs)
 import Lens.Micro.Platform
 import Type.Reflection (someTypeRep)
 
 newtype EENonce = EENonce { unEENonce :: BS.ByteString }
+  deriving stock (Generic)
+  deriving newtype (Eq, Serialise, Hashable)
+  deriving (Pretty, Show) via AsBase58 BS.ByteString
 
 data EncryptionHandshake e =
     BeginEncryptionExchange EENonce (PubKey 'Encrypt (Encryption e))
@@ -67,8 +71,7 @@ encryptionHandshakeProto :: forall e s m . ( MonadIO m
                    -> EncryptionHandshake e
                    -> m ()
 
-encryptionHandshakeProto penv =
-  \case
+encryptionHandshakeProto penv = \case
 
     BeginEncryptionExchange nonce theirpubkey -> do
       pip <- thatPeer proto
@@ -107,8 +110,7 @@ encryptionHandshakeProto penv =
 
 data PeerAsymmInfo e = PeerAsymmInfo
 
-data instance EventKey e (PeerAsymmInfo e) =
-  PeerAsymmInfoKey
+data instance EventKey e (PeerAsymmInfo e) = PeerAsymmInfoKey
   deriving stock (Generic)
 
 deriving stock instance (Eq (Peer e)) => Eq (EventKey e (PeerAsymmInfo e))
@@ -120,3 +122,35 @@ data instance Event e (PeerAsymmInfo e) =
 
 instance Expires (EventKey e (PeerAsymmInfo e)) where
   expiresIn _ = Nothing
+
+instance MonadIO m => HasNonces (EncryptionHandshake L4Proto) m where
+  type instance Nonce (EncryptionHandshake L4Proto) = EENonce
+  newNonce = EENonce . BS.take 32 . Crypto.encode <$> liftIO Encrypt.newNonce
+
+instance
+  ( Serialise (PubKey 'Sign (Encryption e))
+  , Serialise (PubKey 'Encrypt (Encryption e))
+  , Serialise (Signature (Encryption e))
+  )
+  => Serialise (EncryptionHandshake e)
+
+deriving instance
+  ( Show (PubKey 'Encrypt (Encryption e))
+  , Show (Signature (Encryption e))
+  )
+  => Show (EncryptionHandshake e)
+
+type instance SessionData e (EncryptionHandshake e) = ()
+
+newtype instance SessionKey e (EncryptionHandshake e) =
+  KnownPeerAsymmInfoKey (EENonce, Peer e)
+  deriving stock (Generic, Typeable)
+
+deriving instance Eq (Peer e) => Eq (SessionKey e (EncryptionHandshake e))
+instance Hashable (Peer e) => Hashable (SessionKey e (EncryptionHandshake e))
+
+data instance EventKey e (EncryptionHandshake e) =
+  AnyKnownPeerEncryptionHandshakeEventKey
+  deriving stock (Typeable, Eq,Generic)
+
+instance Hashable (EventKey e (EncryptionHandshake e))

hbs2-peer/app/PeerMain.hs

@@ -21,6 +21,7 @@ import HBS2.Net.Messaging.TCP
 import HBS2.Net.PeerLocator
 import HBS2.Net.Proto as Proto
 import HBS2.Net.Proto.Definition
+import HBS2.Net.Proto.EncryptionHandshake
 import HBS2.Net.Proto.Peer
 import HBS2.Net.Proto.PeerAnnounce
 import HBS2.Net.Proto.PeerExchange
@@ -908,6 +909,7 @@ runPeer opts = U.handle (\e -> myException e
                     , makeResponse (blockChunksProto adapter)
                     , makeResponse blockAnnounceProto
                     , makeResponse (withCredentials @e pc . peerHandShakeProto hshakeAdapter penv)
+                    , makeResponse (withCredentials @e pc . encryptionHandshakeProto penv)
                     , makeResponse (peerExchangeProto pexFilt)
                     , makeResponse (refLogUpdateProto reflogAdapter)
                     , makeResponse (refLogRequestProto reflogReqAdapter)