voidlizard
/
hbs2
mirror of https://github.com/voidlizard/hbs2
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

wip, introduced typeclass for gossip

This commit is contained in:
Dmitry Zuikov 2023-07-17 12:34:18 +03:00
parent 3c10aad828
commit 07003409c3
4 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
hbs2-core/lib/HBS2/Actors/Peer/Types.hs
View File

@ -1,3 +1,4 @@
{-# Language AllowAmbiguousTypes #-}
module HBS2.Actors.Peer.Types where module HBS2.Actors.Peer.Types where
import HBS2.Storage import HBS2.Storage
@ -31,7 +32,7 @@ instance (Monad m, HasStorage m) => HasStorage (MaybeT m) where
getStorage = lift getStorage getStorage = lift getStorage
class HasProtocol e p => HasGossip p e m where class (Monad m, HasProtocol e p) => HasGossip e p m where
gossip :: p -> m () gossip :: p -> m ()

4
hbs2-core/lib/HBS2/Net/Proto/RefChan.hs
View File

@ -165,7 +165,7 @@ refChanHeadProto :: forall e s m . ( MonadIO m
, Pretty (Peer e) , Pretty (Peer e)
, Sessions e (KnownPeer e) m , Sessions e (KnownPeer e) m
, HasStorage m , HasStorage m
, HasGossip (RefChanHead e) e m -- , HasGossip (RefChanHead e) e m
, Signatures s , Signatures s
, IsRefPubKey s , IsRefPubKey s
, Pretty (AsBase58 (PubKey 'Sign s)) , Pretty (AsBase58 (PubKey 'Sign s))
@ -223,7 +223,7 @@ refChanUpdateProto :: forall e s m . ( MonadIO m
, Sessions e (KnownPeer e) m , Sessions e (KnownPeer e) m
, Sessions e (RefChanHeadBlock e) m , Sessions e (RefChanHeadBlock e) m
, HasStorage m , HasStorage m
, HasGossip (RefChanUpdate e) e m , HasGossip e (RefChanUpdate e) m
, Signatures s , Signatures s
, IsRefPubKey s , IsRefPubKey s
, Pretty (AsBase58 (PubKey 'Sign s)) , Pretty (AsBase58 (PubKey 'Sign s))

1
hbs2-core/lib/HBS2/Net/Proto/Sessions.hs
View File

@ -39,6 +39,7 @@ class ( Monad m
, Eq (SessionKey e p) , Eq (SessionKey e p)
, Hashable (SessionKey e p) , Hashable (SessionKey e p)
, Typeable (SessionData e p) , Typeable (SessionData e p)
, Typeable (SessionKey e p)
) => Sessions e p m where ) => Sessions e p m where

13
hbs2-peer/app/PeerTypes.hs
View File

@ -347,7 +347,7 @@ failedDownload p h = do
addDownload mzero h addDownload mzero h
-- FIXME: brains-download-fail -- FIXME: brains-download-fail
type ForGossip p e m = type ForGossip e p m =
( MonadIO m ( MonadIO m
, MyPeer e , MyPeer e
, HasPeerLocator e m , HasPeerLocator e m
@ -356,7 +356,7 @@ type ForGossip p e m =
, Sessions e (KnownPeer e) m , Sessions e (KnownPeer e) m
) )
broadCastMessage :: forall e p m . ( ForGossip p e m ) broadCastMessage :: forall e p m . ( ForGossip e p m )
=> p -> m () => p -> m ()
broadCastMessage msg = do broadCastMessage msg = do
@ -455,13 +455,10 @@ polling o listEntries action = do
) refs0 ) refs0
instance (ForGossip p e m, HasPeer e, Sessions e (KnownPeer e) m, HasPeerLocator e m) => HasGossip p e (PeerM e m) where instance (ForGossip e p (PeerM e IO)) => HasGossip e p (PeerM e IO) where
gossip msg = do gossip msg = do
pips <- getKnownPeers @e broadCastMessage msg
pure ()
instance (Monad m, HasGossip p e (PeerM e m)) => HasGossip p e (ResponseM e (PeerM e m)) where instance (ForGossip e p (ResponseM e m), HasGossip e p m) => HasGossip e p (ResponseM e m) where
gossip = lift . gossip gossip = lift . gossip