Add `known-peer` config option

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