wip

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

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

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 = \h lvref -> liftIO $ tryUpdateLinearRef (st) h lvref
-    -- , tryUpdateLinearRefI = undefined
-    , tryUpdateLinearRefI = \h lvref -> liftIO $ tryUpdateLinearRef (_ st) h lvref
     }
 
 runPeer :: forall e . e ~ UDP => PeerOpts -> IO ()