Move types

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

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 }

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

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

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
+

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

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

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)

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

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

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

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))

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

hbs2-peer/hbs2-peer.cabal

@@ -107,6 +107,7 @@ common shared-properties
                      , OverloadedStrings
                      , QuasiQuotes
                      , RecordWildCards
+                     , RecursiveDo
                      , ScopedTypeVariables
                      , StandaloneDeriving
                      , TupleSections