fixed issue with peer expiring

hbs2-core/lib/HBS2/Net/PeerLocator.hs

@@ -14,6 +14,6 @@ data AnyPeerLocator e = forall a . PeerLocator e a => AnyPeerLocator a
 instance HasPeer e => PeerLocator e (AnyPeerLocator e) where
   knownPeers (AnyPeerLocator l) = knownPeers  l
   addPeers (AnyPeerLocator l) = addPeers l
-  delPeers (AnyPeerLocator l) = addPeers l
+  delPeers (AnyPeerLocator l) = delPeers l
 
 

hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs

@@ -8,6 +8,8 @@ import Control.Concurrent.STM
 import Data.Set (Set)
 import Data.Set qualified as Set
 
+import Prettyprinter
+
 newtype StaticPeerLocator e =
   StaticPeerLocator (TVar (Set (Peer e)))
 
@@ -17,7 +19,7 @@ newStaticPeerLocator seeds = do
   tv <- liftIO $ newTVarIO (Set.fromList seeds)
   pure $ StaticPeerLocator tv
 
-instance Ord (Peer e) => PeerLocator  e (StaticPeerLocator e)  where
+instance (Ord (Peer e), Pretty (Peer e)) => PeerLocator  e (StaticPeerLocator e)  where
 
   knownPeers (StaticPeerLocator peers) = do
     ps <- liftIO $ readTVarIO  peers

hbs2-peer/app/PeerInfo.hs

@@ -66,12 +66,13 @@ peerPingLoop :: forall e m . ( HasPeerLocator e m
                              , Request e (PeerHandshake e) m
                              , Sessions e (PeerHandshake e) m
                              , Sessions e (PeerInfo e) m
+                             , Sessions e (KnownPeer e) m
                              , Pretty (Peer e)
                              , MonadIO m
                              )
              => m ()
 peerPingLoop = forever do
-  pause @'Minutes 2 -- FIXME: defaults
+  pause @'Seconds 120 -- FIXME: defaults
   debug "peerPingLoop"
 
   pl <- getPeerLocator @e
@@ -90,5 +91,5 @@ peerPingLoop = forever do
       warn $ "removing peer" <+> pretty p <+> "for not responding to our pings"
       delPeers pl [p]
       expire (PeerInfoKey p)
-
+      expire (KnownPeerKey p)