summaryrefslogtreecommitdiff
path: root/main
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-06-01 20:36:54 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-06-01 21:07:01 +0200
commitfb074d4decf6a1406ad39737741a061e1b5bc2d1 (patch)
tree729c04bfb3eacecb770a18a0fdbe3d3ecd027cd7 /main
parentd0f1ce6171ccb59fce7534a19e827352b35686a0 (diff)
Drop peer on packet delivery failure
Diffstat (limited to 'main')
-rw-r--r--main/Main.hs14
1 files changed, 9 insertions, 5 deletions
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