From 9bad16656668812cb24438fe9daa2ad46aa81c92 Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Tue, 18 Jul 2023 21:37:02 +0400
Subject: [PATCH] Move types

---
 hbs2-core/hbs2-core.cabal                     |  2 ++
 hbs2-core/lib/HBS2/Actors/Peer.hs             |  3 ++
 hbs2-core/lib/HBS2/Data/Types.hs              |  8 ++---
 hbs2-core/lib/HBS2/Data/Types/Crypto.hs       | 25 ++++++++++++++++
 hbs2-core/lib/HBS2/Data/Types/Peer.hs         | 30 +++++++++++++++++++
 hbs2-core/lib/HBS2/Net/Proto/Definition.hs    | 19 ++----------
 .../lib/HBS2/Net/Proto/Event/PeerExpired.hs   |  1 +
 hbs2-core/lib/HBS2/Net/Proto/Peer.hs          | 18 -----------
 hbs2-core/lib/HBS2/Prelude.hs                 |  4 +++
 hbs2-peer/app/Bootstrap.hs                    |  1 +
 hbs2-peer/app/PeerInfo.hs                     |  1 +
 hbs2-peer/app/PeerMain.hs                     | 14 +++++++--
 hbs2-peer/app/PeerTypes.hs                    |  1 +
 hbs2-peer/hbs2-peer.cabal                     |  1 +
 14 files changed, 86 insertions(+), 42 deletions(-)
 create mode 100644 hbs2-core/lib/HBS2/Data/Types/Peer.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index 62036cb6..b98f106f 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@@ -59,6 +59,7 @@ common shared-properties
                      , TupleSections
                      , TypeApplications
                      , TypeFamilies
+                     , TemplateHaskell
 
 
 
@@ -74,6 +75,7 @@ library
                     , HBS2.Data.Detect
                     , HBS2.Data.Types
                     , HBS2.Data.Types.Crypto
+                    , HBS2.Data.Types.Peer
                     , HBS2.Data.Types.Refs
                     , HBS2.Defaults
                     , HBS2.Events
diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs
index 1c958aab..a03f3b02 100644
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@@ -7,6 +7,7 @@ module HBS2.Actors.Peer where
 
 import HBS2.Actors
 import HBS2.Clock
+import HBS2.Data.Types.Peer
 import HBS2.Defaults
 import HBS2.Events
 import HBS2.Hash
@@ -30,6 +31,7 @@ import Data.Cache (Cache)
 import Data.Cache qualified as Cache
 import Data.Dynamic
 import Data.Foldable hiding (find)
+import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe
 import GHC.TypeLits
@@ -155,6 +157,7 @@ data PeerEnv e =
   , _envReqMsgLimit   :: Cache (Peer e, Integer, Encoded e) ()
   , _envReqProtoLimit :: Cache (Peer e, Integer) ()
   , _envAsymmetricKeyPair :: AsymmKeypair (Encryption e)
+  , _envEncryptionKeys :: TVar (Map (PeerData L4Proto) (CommonSecret (Encryption L4Proto)))
   }
 
 newtype PeerM e m a = PeerM { fromPeerM :: ReaderT (PeerEnv e) m a }
diff --git a/hbs2-core/lib/HBS2/Data/Types.hs b/hbs2-core/lib/HBS2/Data/Types.hs
index 92206777..bab8c8e4 100644
--- a/hbs2-core/lib/HBS2/Data/Types.hs
+++ b/hbs2-core/lib/HBS2/Data/Types.hs
@@ -1,13 +1,13 @@
 module HBS2.Data.Types
-  ( module HBS2.Hash
-  , module HBS2.Data.Types.Refs
+  ( module X
   -- , module HBS2.Data.Types.Crypto
   , AsSyntax(..)
   )
   where
 
-import HBS2.Hash
-import HBS2.Data.Types.Refs
+import HBS2.Hash as X
+import HBS2.Data.Types.Refs as X
+import HBS2.Data.Types.Peer as X
 -- import HBS2.Data.Types.Crypto
 
 -- import Data.Config.Suckless
diff --git a/hbs2-core/lib/HBS2/Data/Types/Crypto.hs b/hbs2-core/lib/HBS2/Data/Types/Crypto.hs
index 6bca1764..f14e406a 100644
--- a/hbs2-core/lib/HBS2/Data/Types/Crypto.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/Crypto.hs
@@ -1,4 +1,29 @@
 module HBS2.Data.Types.Crypto where
 
+import Codec.Serialise
+import Crypto.Saltine.Core.Box qualified as Encrypt
+import Crypto.Saltine.Core.Sign qualified as Sign
+
+import HBS2.Net.Auth.Credentials
+import HBS2.Net.Proto.Types
+import HBS2.Prelude
+
 -- type SignPubKey    = ()
 -- type EncryptPubKey = ()
+
+type instance PubKey  'Sign HBS2Basic = Sign.PublicKey
+type instance PrivKey 'Sign HBS2Basic = Sign.SecretKey
+type instance PubKey  'Encrypt HBS2Basic = Encrypt.PublicKey
+type instance PrivKey 'Encrypt HBS2Basic = Encrypt.SecretKey
+
+instance Serialise Sign.PublicKey
+instance Serialise Encrypt.PublicKey
+instance Serialise Sign.SecretKey
+instance Serialise Encrypt.SecretKey
+
+instance Serialise Sign.Signature
+
+instance Signatures HBS2Basic where
+  type Signature HBS2Basic = Sign.Signature
+  makeSign = Sign.signDetached
+  verifySign = Sign.signVerifyDetached
diff --git a/hbs2-core/lib/HBS2/Data/Types/Peer.hs b/hbs2-core/lib/HBS2/Data/Types/Peer.hs
new file mode 100644
index 00000000..1e12b828
--- /dev/null
+++ b/hbs2-core/lib/HBS2/Data/Types/Peer.hs
@@ -0,0 +1,30 @@
+{-# Language UndecidableInstances #-}
+module HBS2.Data.Types.Peer where
+
+import Data.ByteString qualified as BS
+import Lens.Micro.Platform
+
+import HBS2.Prelude
+import HBS2.Data.Types.Crypto
+import HBS2.Net.Auth.Credentials
+import HBS2.Net.Proto.Types
+
+
+type PingSign e = Signature (Encryption e)
+type PingNonce = BS.ByteString
+
+data PeerData e =
+  PeerData
+  { _peerSignKey  :: PubKey 'Sign (Encryption e)
+  , _peerOwnNonce :: PeerNonce -- TODO: to use this field to detect if it's own peer to avoid loops
+  }
+  deriving stock (Typeable,Generic)
+
+deriving instance
+    ( Show (PubKey 'Sign (Encryption e))
+    , Show (Nonce ())
+    )
+    => Show (PeerData e)
+
+makeLenses 'PeerData
+
diff --git a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs
index 7d6f8451..b2e6d607 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Definition.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Definition.hs
@@ -7,6 +7,7 @@ module HBS2.Net.Proto.Definition
   where
 
 import HBS2.Clock
+import HBS2.Data.Types.Crypto
 import HBS2.Defaults
 import HBS2.Hash
 import HBS2.Net.Auth.Credentials
@@ -32,15 +33,11 @@ import Crypto.Saltine.Class qualified as Crypto
 import Crypto.Saltine.Core.Sign qualified as Sign
 import Crypto.Saltine.Core.Box qualified as Encrypt
 
+import HBS2.Data.Types.Crypto
 
 
 type instance Encryption L4Proto = HBS2Basic
 
-type instance PubKey  'Sign HBS2Basic = Sign.PublicKey
-type instance PrivKey 'Sign HBS2Basic = Sign.SecretKey
-type instance PubKey  'Encrypt HBS2Basic = Encrypt.PublicKey
-type instance PrivKey 'Encrypt HBS2Basic = Encrypt.SecretKey
-
 -- FIXME: proper-serialise-for-keys
 --   Возможно, нужно написать ручные инстансы Serialise
 --   использовать encode/decode для каждого инстанса ниже $(c:end + 4)
@@ -48,11 +45,6 @@ type instance PrivKey 'Encrypt HBS2Basic = Encrypt.SecretKey
 --   но возможно, будет работать и так, ведь ключи
 --   это же всего лишь байтстроки внутри.
 
-instance Serialise Sign.PublicKey
-instance Serialise Encrypt.PublicKey
-instance Serialise Sign.SecretKey
-instance Serialise Encrypt.SecretKey
-
 deserialiseCustom :: (Serialise a, MonadPlus m) => ByteString -> m a
 deserialiseCustom = either (const mzero) pure . deserialiseOrFail
 -- deserialiseCustom = either (\msg -> trace ("deserialiseCustom: " <> show msg) mzero) pure . deserialiseOrFail
@@ -194,13 +186,6 @@ instance MonadIO m => HasNonces () m where
     n <- liftIO ( Encrypt.newNonce <&> Crypto.encode )
     pure $ BS.take 32 n
 
-instance Serialise Sign.Signature
-
-instance Signatures HBS2Basic where
-  type Signature HBS2Basic = Sign.Signature
-  makeSign = Sign.signDetached
-  verifySign = Sign.signVerifyDetached
-
 instance Asymm HBS2Basic where
   type AsymmKeypair HBS2Basic = Encrypt.Keypair
   type AsymmPrivKey HBS2Basic = Encrypt.SecretKey
diff --git a/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs b/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs
index 8206f346..5ea4bd93 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs
@@ -1,6 +1,7 @@
 module HBS2.Net.Proto.Event.PeerExpired where
 
 import HBS2.Clock
+import HBS2.Data.Types.Peer
 import HBS2.Events
 import HBS2.Net.Proto
 import HBS2.Net.Proto.Peer
diff --git a/hbs2-core/lib/HBS2/Net/Proto/Peer.hs b/hbs2-core/lib/HBS2/Net/Proto/Peer.hs
index 1328900a..c9b6ac23 100644
--- a/hbs2-core/lib/HBS2/Net/Proto/Peer.hs
+++ b/hbs2-core/lib/HBS2/Net/Proto/Peer.hs
@@ -23,24 +23,6 @@ import Data.String.Conversions (cs)
 import Lens.Micro.Platform
 import Type.Reflection (someTypeRep)
 
-type PingSign e = Signature (Encryption e)
-type PingNonce = BS.ByteString
-
-data PeerData e =
-  PeerData
-  { _peerSignKey  :: PubKey 'Sign (Encryption e)
-  , _peerOwnNonce :: PeerNonce -- TODO: to use this field to detect if it's own peer to avoid loops
-  }
-  deriving stock (Typeable,Generic)
-
-deriving instance
-    ( Show (PubKey 'Sign (Encryption e))
-    , Show (Nonce ())
-    )
-    => Show (PeerData e)
-
-makeLenses 'PeerData
-
 data PeerHandshake e =
     PeerPing  PingNonce
   | PeerPong  PingNonce (Signature (Encryption e)) (PeerData e)
diff --git a/hbs2-core/lib/HBS2/Prelude.hs b/hbs2-core/lib/HBS2/Prelude.hs
index 9f0e1503..1273cd07 100644
--- a/hbs2-core/lib/HBS2/Prelude.hs
+++ b/hbs2-core/lib/HBS2/Prelude.hs
@@ -1,6 +1,7 @@
 module HBS2.Prelude
   ( module Data.String
   , module Safe
+  , module X
   , MonadIO(..)
   , void, guard, when, unless
   , maybe1
@@ -17,6 +18,9 @@ module HBS2.Prelude
   , Text.Text
   ) where
 
+import Data.Typeable as X
+import GHC.Generics as X (Generic)
+
 import Data.ByteString (ByteString)
 import Data.String (IsString(..))
 import Safe
diff --git a/hbs2-peer/app/Bootstrap.hs b/hbs2-peer/app/Bootstrap.hs
index 4b0a0ace..a1b17d09 100644
--- a/hbs2-peer/app/Bootstrap.hs
+++ b/hbs2-peer/app/Bootstrap.hs
@@ -1,6 +1,7 @@
 {-# Language AllowAmbiguousTypes #-}
 module Bootstrap where
 
+import HBS2.Data.Types.Peer
 import HBS2.Prelude
 import HBS2.Net.Proto.Types
 import HBS2.Net.Proto.Peer
diff --git a/hbs2-peer/app/PeerInfo.hs b/hbs2-peer/app/PeerInfo.hs
index 0c7d7fae..6fa165c7 100644
--- a/hbs2-peer/app/PeerInfo.hs
+++ b/hbs2-peer/app/PeerInfo.hs
@@ -4,6 +4,7 @@ module PeerInfo where
 
 import HBS2.Actors.Peer
 import HBS2.Clock
+import HBS2.Data.Types
 import HBS2.Events
 import HBS2.Net.Auth.Credentials
 import HBS2.Net.PeerLocator
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index fcb46d06..42df97a4 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -11,6 +11,7 @@ import HBS2.Clock
 import HBS2.Defaults
 import HBS2.Events
 import HBS2.Hash
+import HBS2.Data.Types
 import HBS2.Data.Types.Refs (RefLogKey(..))
 import HBS2.Merkle
 import HBS2.Net.Auth.Credentials
@@ -576,12 +577,19 @@ runPeer opts = U.handle (\e -> myException e
            void $ async $ runMessagingTCP tcpEnv
            pure $ Just tcpEnv
 
-  proxy <- newProxyMessaging mess tcp
+  (proxy, penv) <- mdo
+      proxy <- newProxyMessaging mess tcp >>= \p -> do
+          pure p
+            { _proxy_getEncryptionKey = undefined
+            , _proxy_clearEncryptionKey = undefined
+            , _proxy_sendResetEncryptionKeys = undefined
+            , _proxy_sendBeginEncryptionExchange = undefined
+          }
+      penv <- newPeerEnv (AnyStorage s) (Fabriq proxy) (getOwnPeer mess)
+      pure (proxy, penv)
 
   proxyThread <- async $ runProxyMessaging proxy
 
-  penv <- newPeerEnv (AnyStorage s) (Fabriq proxy) (getOwnPeer mess)
-
   let peerMeta = mkPeerMeta conf penv
 
   nbcache <- liftIO $ Cache.newCache (Just $ toTimeSpec ( 600 :: Timeout 'Seconds))
diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs
index 2d85344b..3b94fe0a 100644
--- a/hbs2-peer/app/PeerTypes.hs
+++ b/hbs2-peer/app/PeerTypes.hs
@@ -6,6 +6,7 @@ module PeerTypes where
 
 import HBS2.Actors.Peer
 import HBS2.Clock
+import HBS2.Data.Types.Peer
 import HBS2.Defaults
 import HBS2.Events
 import HBS2.Hash
diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal
index 73ad9b14..b7f8bec2 100644
--- a/hbs2-peer/hbs2-peer.cabal
+++ b/hbs2-peer/hbs2-peer.cabal
@@ -107,6 +107,7 @@ common shared-properties
                      , OverloadedStrings
                      , QuasiQuotes
                      , RecordWildCards
+                     , RecursiveDo
                      , ScopedTypeVariables
                      , StandaloneDeriving
                      , TupleSections