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/Test.hs | 25 +++++++++++++++++++++++++
 1 file changed, 25 insertions(+)

(limited to 'main/Test.hs')

diff --git a/main/Test.hs b/main/Test.hs
index d16e141..cdc337e 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -246,6 +246,8 @@ commands = map (T.pack *** id)
     , ("start-server", cmdStartServer)
     , ("stop-server", cmdStopServer)
     , ("peer-add", cmdPeerAdd)
+    , ("peer-drop", cmdPeerDrop)
+    , ("peer-list", cmdPeerList)
     , ("test-message-send", cmdTestMessageSend)
     , ("shared-state-get", cmdSharedStateGet)
     , ("shared-state-wait", cmdSharedStateWait)
@@ -410,6 +412,29 @@ cmdPeerAdd = do
     addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just host) (Just port)
     void $ liftIO $ serverPeer rsServer (addrAddress addr)
 
+cmdPeerDrop :: Command
+cmdPeerDrop = do
+    [spidx] <- asks tiParams
+    peer <- getPeer spidx
+    liftIO $ dropPeer peer
+
+cmdPeerList :: Command
+cmdPeerList = do
+    Just RunningServer {..} <- gets tsServer
+    peers <- liftIO $ getCurrentPeerList rsServer
+    tpeers <- liftIO $ readMVar rsPeers
+    forM_ peers $ \peer -> do
+        Just (n, _) <- return $ find ((peer==).snd) . snd $ tpeers
+        mbpid <- peerIdentity peer
+        cmdOut $ unwords $ concat
+            [ [ "peer-list-item", show n ]
+            , [ "addr", show (peerAddress peer) ]
+            , case mbpid of PeerIdentityFull pid -> ("id":) $ map (maybe "<unnamed>" T.unpack . idName) (unfoldOwners pid)
+                            _ -> []
+            ]
+    cmdOut "peer-list-done"
+
+
 cmdTestMessageSend :: Command
 cmdTestMessageSend = do
     [spidx, tref] <- asks tiParams
-- 
cgit v1.2.3