From 38d6ff2c0cde7bc1f1e6d1501ed033912d9da43d Mon Sep 17 00:00:00 2001
From: Sergey Ivanov <ivanovs-4@yandex.ru>
Date: Wed, 8 Mar 2023 19:00:13 +0400
Subject: [PATCH] wip

---
 hbs2-core/lib/HBS2/Actors/Peer.hs | 15 ---------------
 hbs2-core/lib/HBS2/Storage.hs     | 20 +++++++++++++++++++-
 hbs2-peer/app/PeerMain.hs         |  6 +-----
 3 files changed, 20 insertions(+), 21 deletions(-)

diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs
index 16895891..8b4a18bd 100644
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@@ -42,27 +42,12 @@ 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
-  writeLinkRaw (AnyStorage s) = writeLinkRaw s
-  readLinkRaw (AnyStorage s) = readLinkRaw 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
 
 class HasFabriq e m where
diff --git a/hbs2-core/lib/HBS2/Storage.hs b/hbs2-core/lib/HBS2/Storage.hs
index f0c6c729..3d852a53 100644
--- a/hbs2-core/lib/HBS2/Storage.hs
+++ b/hbs2-core/lib/HBS2/Storage.hs
@@ -4,8 +4,9 @@ module HBS2.Storage where
 import HBS2.Hash
 import HBS2.Prelude.Plated
 
-import Data.Kind
+import Data.ByteString (ByteString)
 import Data.Hashable hiding (Hashed)
+import Data.Kind
 import Lens.Micro.Platform
 import Prettyprinter
 
@@ -59,3 +60,20 @@ calcChunks :: forall a b . (Integral a, Integral b)
 calcChunks s1 s2 = fmap (over _1 fromIntegral . over _2 fromIntegral)  chu
   where
     chu = fmap (,s2) (takeWhile (<s1) $ iterate (+s2) 0)
+
+
+
+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
+  writeLinkRaw (AnyStorage s) = writeLinkRaw s
+  readLinkRaw (AnyStorage s) = readLinkRaw s
+
+class HasStorage m where
+  getStorage :: m AnyStorage
diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs
index 0621cf5f..3545af73 100644
--- a/hbs2-peer/app/PeerMain.hs
+++ b/hbs2-peer/app/PeerMain.hs
@@ -363,8 +363,6 @@ forKnownPeers m = do
 -- FIXME: implement mkLRefAdapter
 mkLRefAdapter :: forall e st block m .
     ( m ~ PeerM e IO
-    -- , e ~ [Hash HbSync]
-    -- , e ~ UDP
     , Signatures e
     , Serialise (Signature e)
     , Serialise (PubKey 'Sign e)
@@ -381,9 +379,7 @@ mkLRefAdapter = do
   pure $
     LRefI
     { getBlockI = liftIO . getBlock st
-    -- :: TryUpdateLinearRefI e HbSync m
-    -- , tryUpdateLinearRefI = undefined
-    , tryUpdateLinearRefI = \h lvref -> liftIO $ tryUpdateLinearRef (_ st) h lvref
+    , tryUpdateLinearRefI = \h lvref -> liftIO $ tryUpdateLinearRef (st) h lvref
     }
 
 runPeer :: forall e . e ~ UDP => PeerOpts -> IO ()