diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 1f298db6..443860bc 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -84,6 +84,7 @@ data PeerBlackListKey data PeerStorageKey data PeerAcceptAnnounceKey data PeerTraceKey +data PeerKnownPeer data AcceptAnnounce = AcceptAnnounceAll | AcceptAnnounceFrom (Set (PubKey 'Sign UDP)) @@ -116,6 +117,9 @@ instance HasCfgKey PeerBlackListKey (Set String) where instance HasCfgKey PeerAcceptAnnounceKey AcceptAnnounce where key = "accept-block-announce" +instance HasCfgKey PeerKnownPeer [String] where + key = "known-peer" + instance HasCfgValue PeerAcceptAnnounceKey AcceptAnnounce where cfgValue (PeerConfig syn) = fromMaybe (AcceptAnnounceFrom lst) fromAll where @@ -388,6 +392,12 @@ runPeer opts = Exception.handle myException $ do let accptAnn = cfgValue @PeerAcceptAnnounceKey conf :: AcceptAnnounce + -- FIXME: add validation and error handling + let parseKnownPeers xs = fmap (PeerUDP . addrAddress) . catMaybes + <$> (fmap headMay . parseAddr . fromString) `mapM` xs + + knownPeers' <- parseKnownPeers $ cfgValue @PeerKnownPeer conf + print $ pretty accptAnn -- FIXME: move-peerBanned-somewhere @@ -636,6 +646,10 @@ runPeer opts = Exception.handle myException $ do , makeResponse peerExchangeProto ] + wo $ liftIO $ async $ withPeerM env $ forever do + forM_ knownPeers' (sendPing @e) + pause @'Minutes 20 + void $ liftIO $ waitAnyCatchCancel workers let pokeAction _ = do