removed bytestring pinning from Peer

flake.nix

@@ -33,8 +33,8 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
 
 
    packagePostOverrides = { pkgs }: with pkgs; with haskell.lib; [
-    enableExecutableProfiling
+    disableExecutableProfiling
-    enableLibraryProfiling
+    disableLibraryProfiling
     dontBenchmark
     dontCoverage
     dontDistribute

hbs2-core/lib/HBS2/Actors/Peer.hs

@@ -17,7 +17,6 @@ import HBS2.Prelude.Plated
 import HBS2.Storage
 
 import Control.Monad.Trans.Maybe
-import Codec.Serialise hiding (encode,decode)
 import Control.Concurrent.Async
 import Control.Monad.Reader
 import Data.ByteString.Lazy (ByteString)
@@ -47,6 +46,9 @@ instance (IsKey HbSync, Key HbSync ~ Hash HbSync, Block ByteString ~ ByteString)
   getChunk (AnyStorage s) = getChunk s
   hasBlock (AnyStorage s) = hasBlock s
 
+data AnyMessage e = AnyMessage Integer (Encoded e)
+                    deriving stock (Generic)
+
 class Monad m => HasOwnPeer e m where
   ownPeer :: m (Peer e)
 
@@ -56,20 +58,15 @@ class Monad m => HasPeerLocator e m where
 class HasStorage m where
   getStorage :: m AnyStorage
 
-data Fabriq e = forall bus . (Serialise (Encoded e), Messaging bus e ByteString) => Fabriq bus
+data Fabriq e = forall bus . (Messaging bus e (AnyMessage e)) => Fabriq bus
 
 class HasFabriq e m where
   getFabriq :: m (Fabriq e)
 
-instance HasPeer e => Messaging (Fabriq e) e ByteString where
+instance (HasPeer e) => Messaging (Fabriq e) e (AnyMessage e) where
   sendTo (Fabriq bus) = sendTo bus
   receive (Fabriq bus) = receive bus
 
-data AnyMessage e = AnyMessage Integer (Encoded e)
-                    deriving stock (Generic)
-
-instance Serialise (Encoded e) => Serialise (AnyMessage e)
-
 
 data AnyProtocol e m = forall p  . ( HasProtocol e p
                                    , Response e p m
@@ -197,14 +194,13 @@ instance ( MonadIO m
 instance ( MonadIO m
          , HasProtocol e p
          , HasFabriq e (PeerM e m)
-         , Serialise (Encoded e)
          ) => Request e p (PeerM e m) where
   request p msg = do
     let proto = protoId @e @p (Proxy @p)
     pipe <- getFabriq @e
     me <- ownPeer @e
-    let bs = serialise (AnyMessage @e proto (encode msg))
+    sendTo pipe (To p) (From me) (AnyMessage @e proto (encode msg))
-    sendTo pipe (To p) (From me) bs
+
 
 instance ( HasProtocol e p
          , Typeable (EventHandler e p (PeerM e IO))
@@ -320,7 +316,6 @@ runProto :: forall e m  . ( MonadIO m
                           , HasOwnPeer e m
                           , HasFabriq e m
                           , HasPeer e
-                          , Serialise (Encoded e)
                           )
         => [AnyProtocol e (ResponseM e m)]
         -> m ()
@@ -337,23 +332,16 @@ runProto hh = do
 
     messages <- receive pipe (To me)
 
-    for_ messages $ \(From pip, bs) -> do
+    for_ messages $ \(From pip, AnyMessage n msg) -> do
 
-      case deserialiseOrFail @(AnyMessage e) bs of
+      case Map.lookup n disp of
+        Nothing -> pure ()
 
-        Left _-> pure ()
+        Just (AnyProtocol { protoDecode = decoder
-
+                          , handle = h
-        Right (AnyMessage n msg) -> do
+                          }) -> maybe (pure ()) (runResponseM pip . h) (decoder msg)
-
-          case Map.lookup n disp of
-            Nothing -> pure ()
-
-            Just (AnyProtocol { protoDecode = decoder
-                              , handle = h
-                              }) -> maybe (pure ()) (runResponseM pip . h) (decoder msg)
 
 instance ( HasProtocol e p
-         , Serialise (Encoded e)
          , MonadTrans (ResponseM e)
          , HasStorage (PeerM e IO)
          , Pretty (Peer e)
@@ -372,9 +360,7 @@ instance ( HasProtocol e p
     who <- asks (view answTo)
     self <- lift $ ownPeer @e
     fab  <- lift $ getFabriq @e
-    let bs = serialise (AnyMessage @e proto (encode msg))
+    sendTo fab (To who) (From self) (AnyMessage @e proto (encode msg))
-    sendTo fab (To who) (From self) bs
-
 
 instance ( MonadIO m
          , HasProtocol e p

hbs2-core/lib/HBS2/Net/Messaging/Fake.hs

@@ -52,7 +52,7 @@ instance ( (HasPeer proto, Hashable (Peer proto))
     atomically $ Chan.writeTChan chan (who, msg)
 
   receive bus (To me) = liftIO do
-    readChan =<< getChan bus me -- Cache.fetchWithCache (fakeP2p bus) me (const newTChanIO)
+    readChan =<< getChan bus me
 
     where
       readChan | blocking bus = atomically . (List.singleton <$>) . Chan.readTChan

hbs2-tests/test/Peer2Main.hs

@@ -55,6 +55,8 @@ import Data.Hashable
 import Type.Reflection
 import Data.Fixed
 
+import Data.Dynamic
+
 import System.Random.MWC
 import qualified Data.Vector.Unboxed as U
 
@@ -93,9 +95,9 @@ instance Pretty (Peer Fake) where
 
 instance HasProtocol Fake (BlockInfo Fake) where
   type instance ProtocolId (BlockInfo Fake) = 1
-  type instance Encoded Fake = ByteString
+  type instance Encoded Fake = Dynamic
-  decode = either (const Nothing) Just . deserialiseOrFail
+  decode = fromDynamic
-  encode = serialise
+  encode = toDyn
 
 -- FIXME: 3 is for debug only!
 instance Expires (EventKey Fake (BlockInfo Fake)) where
@@ -109,16 +111,15 @@ instance Expires (EventKey Fake (BlockAnnounce Fake)) where
 
 instance HasProtocol Fake (BlockChunks Fake) where
   type instance ProtocolId (BlockChunks Fake) = 2
-  type instance Encoded Fake = ByteString
+  type instance Encoded Fake = Dynamic
-  decode = either (const Nothing) Just . deserialiseOrFail
+  decode = fromDynamic
-  encode = serialise
+  encode = toDyn
 
 instance HasProtocol Fake (BlockAnnounce Fake) where
   type instance ProtocolId (BlockAnnounce Fake) = 3
-  type instance Encoded Fake = ByteString
+  type instance Encoded Fake = Dynamic
-  decode = either (const Nothing) Just . deserialiseOrFail
+  decode = fromDynamic
-  encode = serialise
+  encode = toDyn
-
 
 type instance SessionData e (BlockInfo e) = BlockSizeSession e
 type instance SessionData e (BlockChunks e) = BlockDownload
@@ -223,9 +224,9 @@ instance Typeable (SessionKey e (Stats e)) => Hashable (SessionKey e (Stats e))
 
 instance HasProtocol Fake (Stats Fake) where
   type instance ProtocolId (Stats Fake) = 0xFFFFFFFE
-  type instance Encoded Fake = ByteString
+  type instance Encoded Fake = Dynamic
-  decode = either (const Nothing) Just . deserialiseOrFail
+  decode = fromDynamic
-  encode = serialise
+  encode = toDyn
 
 newtype Speed = Speed (Fixed E1)
                 deriving newtype (Ord, Eq, Num, Real, Fractional, Show)
@@ -265,7 +266,7 @@ updateStats updTime blknum = do
 
 blockDownloadLoop :: forall e  m . ( m ~ PeerM e IO
                                  -- , e ~ Fake
-                                 , Serialise (Encoded e)
+                                 -- , Serialise (Encoded e)
                                  , MonadIO m
                                  , Request e (BlockInfo e) m
                                  , Request e (BlockAnnounce e) m
@@ -283,6 +284,7 @@ blockDownloadLoop :: forall e  m . ( m ~ PeerM e IO
                                  , Num (Peer e)
                                  , Pretty (Peer e)
                                  , Block ByteString ~ ByteString
+                                 -- , Encoded e ~ ByteString
                                  -- , Key HbSync ~ Hash HbSync
                                  )
                   =>  ChunkWriter HbSync IO -> m ()