diff --git a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs index 38d717d4..4c235762 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/RefChan.hs @@ -102,10 +102,10 @@ refChanHeadProto self adapter msg = do auth <- find (KnownPeerKey peer) id <&> isJust - guard (auth || self) - void $ runMaybeT do + guard (auth || self) + case msg of RefChanHead pkt _ -> do trace $ "RefChanHead" <+> pretty self diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 6affe0fb..7cd85bc7 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -51,6 +51,7 @@ import HttpWorker import ProxyMessaging import PeerMeta import CLI.RefChan +import RefChan import Codec.Serialise -- import Control.Concurrent.Async @@ -782,6 +783,9 @@ runPeer opts = U.handle (\e -> myException e peerThread "reflogWorker" (reflogWorker @e conf rwa) + -- FIXME: reflogWorker-env + peerThread "refChanWorker" (refChanWorker @e) + peerThread "ping pong" $ forever $ do cmd <- liftIO $ atomically $ readTQueue rpcQ case cmd of diff --git a/hbs2-peer/app/RefChan.hs b/hbs2-peer/app/RefChan.hs new file mode 100644 index 00000000..a324fc50 --- /dev/null +++ b/hbs2-peer/app/RefChan.hs @@ -0,0 +1,34 @@ +{-# Language AllowAmbiguousTypes #-} +module RefChan where + +import HBS2.Prelude.Plated + +import HBS2.Actors.Peer +import HBS2.Base58 +import HBS2.Clock +import HBS2.Data.Types.Refs +import HBS2.Net.Auth.Credentials +import HBS2.Net.Proto.RefChan +import HBS2.Net.Proto.Types + +import HBS2.System.Logger.Simple + +import PeerTypes +import PeerConfig + +import Control.Monad + + +refChanWorker :: forall e s m . ( MonadIO m, MyPeer e + , HasStorage m + , Signatures s + , s ~ Encryption e + , IsRefPubKey s + , Pretty (AsBase58 (PubKey 'Sign s)) + ) + => m () + +refChanWorker = forever do + pause @'Seconds 10 + debug "I'm refchan worker" + diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index 981a70af..92da2b00 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/hbs2-peer/hbs2-peer.cabal @@ -127,6 +127,7 @@ executable hbs2-peer , PeerTypes , PeerConfig , RefLog + , RefChan , CheckMetrics , HttpWorker , Brains