From d0f1ce6171ccb59fce7534a19e827352b35686a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 26 May 2024 14:04:09 +0200
Subject: Manual peer drop

---
 main/Main.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

(limited to 'main/Main.hs')

diff --git a/main/Main.hs b/main/Main.hs
index 0857191..44e2f7b 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -281,7 +281,9 @@ interactiveLoop st opts = runInputT inputSettings $ do
                 { ciServer = server
                 , ciLine = line
                 , ciPrint = extPrintLn
-                , ciPeers = liftIO $ readMVar peers
+                , ciPeers = liftIO $ modifyMVar peers $ \ps -> do
+                    ps' <- filterM (fmap not . isPeerDropped . fst) ps
+                    return (ps', ps')
                 , ciContextOptions = liftIO $ readMVar contextOptions
                 , ciSetContextOptions = \ctxs -> liftIO $ modifyMVar_ contextOptions $ const $ return ctxs
                 }
@@ -372,6 +374,7 @@ commands =
     [ ("history", cmdHistory)
     , ("peers", cmdPeers)
     , ("peer-add", cmdPeerAdd)
+    , ("peer-drop", cmdPeerDrop)
     , ("send", cmdSend)
     , ("update-identity", cmdUpdateIdentity)
     , ("attach", cmdAttach)
@@ -423,6 +426,11 @@ cmdPeerAdd = void $ do
     addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)
     liftIO $ serverPeer server (addrAddress addr)
 
+cmdPeerDrop :: Command
+cmdPeerDrop = do
+    dropPeer =<< getSelectedPeer
+    modify $ \s -> s { csContext = NoContext }
+
 showPeer :: PeerIdentity -> PeerAddress -> String
 showPeer pidentity paddr =
     let name = case pidentity of
-- 
cgit v1.2.3