From fb074d4decf6a1406ad39737741a061e1b5bc2d1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 1 Jun 2024 20:36:54 +0200
Subject: Drop peer on packet delivery failure
---
main/Main.hs | 14 +++++++++-----
1 file changed, 9 insertions(+), 5 deletions(-)
(limited to 'main')
diff --git a/main/Main.hs b/main/Main.hs
index 44e2f7b..df904a2 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -236,17 +236,21 @@ interactiveLoop st opts = runInputT inputSettings $ do
peer <- getNextPeerChange server
peerIdentity peer >>= \case
pid@(PeerIdentityFull _) -> do
+ dropped <- isPeerDropped peer
let shown = showPeer pid $ peerAddress peer
- let update [] = ([(peer, shown)], Nothing)
- update ((p,s):ps) | p == peer = ((peer, shown) : ps, Just s)
- | otherwise = first ((p,s):) $ update ps
+ let update [] = ([(peer, shown)], (Nothing, "NEW"))
+ update ((p,s):ps)
+ | p == peer && dropped = (ps, (Nothing, "DEL"))
+ | p == peer = ((peer, shown) : ps, (Just s, "UPD"))
+ | otherwise = first ((p,s):) $ update ps
let ctxUpdate n [] = ([SelectedPeer peer], n)
ctxUpdate n (ctx:ctxs)
| SelectedPeer p <- ctx, p == peer = (ctx:ctxs, n)
| otherwise = first (ctx:) $ ctxUpdate (n + 1) ctxs
- op <- modifyMVar peers (return . update)
+ (op, updateType) <- modifyMVar peers (return . update)
+ let updateType' = if dropped then "DEL" else updateType
idx <- modifyMVar contextOptions (return . ctxUpdate (1 :: Int))
- when (Just shown /= op) $ extPrint $ "[" <> show idx <> "] PEER " <> shown
+ when (Just shown /= op) $ extPrint $ "[" <> show idx <> "] PEER " <> updateType' <> " " <> shown
_ -> return ()
let getInputLines prompt = do
--
cgit v1.2.3