diff options
| author | Roman Smrž <roman.smrz@seznam.cz> | 2024-05-26 14:04:09 +0200 |
|---|---|---|
| committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-06-01 13:19:06 +0200 |
| commit | d0f1ce6171ccb59fce7534a19e827352b35686a0 (patch) | |
| tree | 0205dc6792598173502fdef78a1cf5af6152f947 /main/Main.hs | |
| parent | 2f409a3ab30ff846bf0d6bf81084295ed0221075 (diff) | |
Manual peer drop
Diffstat (limited to 'main/Main.hs')
| -rw-r--r-- | main/Main.hs | 10 |
1 files changed, 9 insertions, 1 deletions
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 |