From 476ecddb6d39a9df4f9af649e4248458161c1f23 Mon Sep 17 00:00:00 2001
From: Dmitry Zuikov <dzuikov@gmail.com>
Date: Sat, 15 Jul 2023 05:30:56 +0300
Subject: [PATCH] wip

---
 hbs2-core/hbs2-core.cabal               |  1 +
 hbs2-core/lib/HBS2/Actors/Peer.hs       | 32 ++++++-------------------
 hbs2-core/lib/HBS2/Actors/Peer/Types.hs | 28 ++++++++++++++++++++++
 3 files changed, 36 insertions(+), 25 deletions(-)
 create mode 100644 hbs2-core/lib/HBS2/Actors/Peer/Types.hs

diff --git a/hbs2-core/hbs2-core.cabal b/hbs2-core/hbs2-core.cabal
index 42082057..2a8bdddb 100644
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@@ -67,6 +67,7 @@ library
     exposed-modules:
                       HBS2.Actors
                     , HBS2.Actors.Peer
+                    , HBS2.Actors.Peer.Types
                     , HBS2.Base58
                     , HBS2.Clock
                     , HBS2.Data.Detect
diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs
index 7a61b374..9d348941 100644
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@@ -3,9 +3,13 @@
 {-# Language UndecidableInstances #-}
 {-# Language FunctionalDependencies #-}
 {-# Language AllowAmbiguousTypes #-}
-module HBS2.Actors.Peer where
+module HBS2.Actors.Peer
+  ( module HBS2.Actors.Peer
+  , module HBS2.Actors.Peer.Types
+  ) where
 
 import HBS2.Actors
+import HBS2.Actors.Peer.Types
 import HBS2.Clock
 import HBS2.Defaults
 import HBS2.Events
@@ -22,7 +26,6 @@ import Control.Monad.Trans.Maybe
 import Control.Concurrent.Async
 import Control.Monad.Reader
 import Data.ByteString.Lazy (ByteString)
-import Data.ByteString qualified as BS
 import Data.Cache (Cache)
 import Data.Cache qualified as Cache
 import Data.Dynamic
@@ -35,39 +38,18 @@ import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
 import Control.Concurrent.STM.TVar
 import Control.Concurrent.STM
-import Data.Hashable (hash)
-import UnliftIO (MonadUnliftIO(..))
+import UnliftIO (MonadUnliftIO)
 
 import Codec.Serialise (serialise, deserialiseOrFail)
 
-import Prettyprinter hiding (pipe)
 
 
-
-data AnyStorage = forall zu . ( Block ByteString ~ ByteString
-                              , Storage zu HbSync ByteString IO
-                              ) => AnyStorage zu
-
-instance (IsKey HbSync, Key HbSync ~ Hash HbSync, Block ByteString ~ ByteString) => Storage AnyStorage HbSync ByteString IO where
-
-  putBlock (AnyStorage s) = putBlock s
-  enqueueBlock (AnyStorage s) = enqueueBlock s
-  getBlock (AnyStorage s) = getBlock s
-  getChunk (AnyStorage s) = getChunk s
-  hasBlock (AnyStorage s) = hasBlock s
-  updateRef (AnyStorage s) = updateRef s
-  getRef (AnyStorage s) = getRef s
-  delBlock (AnyStorage s) = delBlock s
-  delRef (AnyStorage s) = delRef s
-
 data AnyMessage enc e = AnyMessage !Integer !(Encoded e)
                        deriving stock (Generic)
 
 class Monad m => HasOwnPeer e m where
   ownPeer :: m (Peer e)
 
-class HasStorage m where
-  getStorage :: m AnyStorage
 
 data Fabriq e = forall bus . (Messaging bus e (Encoded e)) => Fabriq bus
 
@@ -168,8 +150,8 @@ newtype  ResponseM e m a = ResponseM { fromResponse :: ReaderT (ResponseEnv e) m
                                             , Monad
                                             , MonadReader (ResponseEnv e)
                                             , MonadIO
-                                            , MonadTrans
                                             , MonadUnliftIO
+                                            , MonadTrans
                                             )
 
 newtype ResponseEnv e =
diff --git a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
new file mode 100644
index 00000000..ba067fb4
--- /dev/null
+++ b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
@@ -0,0 +1,28 @@
+module HBS2.Actors.Peer.Types where
+
+import HBS2.Storage
+import HBS2.Hash
+
+import Data.ByteString.Lazy (ByteString)
+
+
+-- instance (IsKey HbSync, Key HbSync ~ Hash HbSync, Block ByteString ~ ByteString) => Storage AnyStorage HbSync ByteString IO where
+instance (IsKey HbSync) => Storage AnyStorage HbSync ByteString IO where
+  putBlock (AnyStorage s) = putBlock s
+  enqueueBlock (AnyStorage s) = enqueueBlock s
+  getBlock (AnyStorage s) = getBlock s
+  getChunk (AnyStorage s) = getChunk s
+  hasBlock (AnyStorage s) = hasBlock s
+  updateRef (AnyStorage s) = updateRef s
+  getRef (AnyStorage s) = getRef s
+  delBlock (AnyStorage s) = delBlock s
+  delRef (AnyStorage s) = delRef s
+
+data AnyStorage = forall zu . ( Block ByteString ~ ByteString
+                              , Storage zu HbSync ByteString IO
+                              ) => AnyStorage zu
+
+class HasStorage m where
+  getStorage :: m AnyStorage
+
+