From d1318c6fd143dd358e3ed4b3884b6d154e3137b4 Mon Sep 17 00:00:00 2001 From: Sergey Ivanov Date: Tue, 4 Jul 2023 23:46:52 +0400 Subject: [PATCH] Added encryptionHandshakeProto to PeerMain "all protos" thread --- hbs2-core/lib/HBS2/Base58.hs | 3 ++ hbs2-core/lib/HBS2/Net/Proto/Definition.hs | 15 ++++++ .../lib/HBS2/Net/Proto/EncryptionHandshake.hs | 54 +++++++++++++++---- hbs2-peer/app/PeerMain.hs | 2 + 4 files changed, 64 insertions(+), 10 deletions(-) diff --git a/hbs2-core/lib/HBS2/Base58.hs b/hbs2-core/lib/HBS2/Base58.hs index 060ea813..0251965f 100644 --- a/hbs2-core/lib/HBS2/Base58.hs +++ b/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 + diff --git a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs index 1f0276df..7d6f8451 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs +++ b/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 diff --git a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs b/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs index 309bfa9e..49d3f6f0 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/EncryptionHandshake.hs +++ b/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)) diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index f060e00c..8f340ab2 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/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)