diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 7cd85bc7..01b14495 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -559,6 +559,8 @@ runPeer opts = U.handle (\e -> myException e pause @'Seconds 600 liftIO $ Cache.purgeExpired nbcache + rce <- refChanWorkerEnv conf + let refChanHeadAdapter = RefChanHeadAdapter { _refChanHeadOnHead = dontHandle } @@ -784,7 +786,7 @@ runPeer opts = U.handle (\e -> myException e peerThread "reflogWorker" (reflogWorker @e conf rwa) -- FIXME: reflogWorker-env - peerThread "refChanWorker" (refChanWorker @e) + peerThread "refChanWorker" (refChanWorker @e rce) peerThread "ping pong" $ forever $ do cmd <- liftIO $ atomically $ readTQueue rpcQ diff --git a/hbs2-peer/app/RefChan.hs b/hbs2-peer/app/RefChan.hs index a324fc50..c6758e53 100644 --- a/hbs2-peer/app/RefChan.hs +++ b/hbs2-peer/app/RefChan.hs @@ -19,6 +19,14 @@ import PeerConfig import Control.Monad +data RefChanWorkerEnv e = RefChanWorkerEnv + +refChanWorkerEnv :: forall m e . MonadIO m + => PeerConfig + -> m (RefChanWorkerEnv e) + +refChanWorkerEnv _ = pure $ RefChanWorkerEnv @e + refChanWorker :: forall e s m . ( MonadIO m, MyPeer e , HasStorage m , Signatures s @@ -26,9 +34,10 @@ refChanWorker :: forall e s m . ( MonadIO m, MyPeer e , IsRefPubKey s , Pretty (AsBase58 (PubKey 'Sign s)) ) - => m () + => RefChanWorkerEnv e + -> m () -refChanWorker = forever do +refChanWorker _ = forever do pause @'Seconds 10 debug "I'm refchan worker"