From 6ebd09e596ade0fc4af7d2adaeab1a91f33f166a Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Wed, 13 Mar 2024 06:41:27 +0300 Subject: [PATCH] lwwref polling --- hbs2-peer/app/Brains.hs | 2 +- hbs2-peer/app/LWWRef.hs | 22 ++++++++++++++-------- 2 files changed, 15 insertions(+), 9 deletions(-) diff --git a/hbs2-peer/app/Brains.hs b/hbs2-peer/app/Brains.hs index 739c8fc1..92807160 100644 --- a/hbs2-peer/app/Brains.hs +++ b/hbs2-peer/app/Brains.hs @@ -248,7 +248,7 @@ instance ( Hashable (Peer e) query_ conn [qc|select ref, type, interval from {poll_table}|] Just tp -> postprocess <$> - query conn [qc|select ref, type, interval from statedb.poll where type = ?|] (Only tp) + query conn [qc|select ref, type, interval from {poll_table} where type = ?|] (Only tp) where postprocess = mapMaybe (\(r,t,i) -> (,t,i) <$> fromStringMay r ) diff --git a/hbs2-peer/app/LWWRef.hs b/hbs2-peer/app/LWWRef.hs index eaac7a3e..3a737df7 100644 --- a/hbs2-peer/app/LWWRef.hs +++ b/hbs2-peer/app/LWWRef.hs @@ -1,20 +1,16 @@ module LWWRef where import HBS2.Prelude.Plated -import HBS2.Clock import HBS2.Actors.Peer -import HBS2.Events import HBS2.Data.Types.Refs -import HBS2.Data.Detect -import HBS2.Net.PeerLocator import HBS2.Net.Proto import HBS2.Base58 import HBS2.Storage import HBS2.Storage.Operations.Missed import HBS2.Hash import HBS2.Peer.Proto +import HBS2.Peer.Proto.LWWRef import HBS2.Net.Auth.Credentials -import HBS2.Merkle import HBS2.Misc.PrettyStuff @@ -24,12 +20,16 @@ import PeerTypes import Control.Monad import UnliftIO +import Lens.Micro.Platform + +{- HLINT ignore "Functor law" -} lwwRefWorker :: forall e s m . ( MonadIO m , MonadUnliftIO m , MyPeer e , HasStorage m , Sessions e (KnownPeer e) m + , HasGossip e (LWWRefProto e) m , Signatures s , s ~ Encryption e , IsRefPubKey s @@ -39,8 +39,14 @@ lwwRefWorker :: forall e s m . ( MonadIO m -> m () lwwRefWorker conf brains = do - forever do - debug $ yellow "lwwRefWorker" - pause @'Seconds 20 + + let listRefs = listPolledRefs @e brains (Just "lwwref") + <&> fmap (\(a,_,b) -> (a,b)) + <&> fmap (over _2 ( (*60) . fromIntegral) ) + + polling (Polling 5 5) listRefs $ \ref -> do + debug $ yellow "POLLING LWWREF" <+> pretty (AsBase58 ref) + gossip (LWWRefProto1 @e (LWWProtoGet (LWWRefKey ref))) +