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/Test.hs | |
| parent | 2f409a3ab30ff846bf0d6bf81084295ed0221075 (diff) | |
Manual peer drop
Diffstat (limited to 'main/Test.hs')
| -rw-r--r-- | main/Test.hs | 25 |
1 files changed, 25 insertions, 0 deletions
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 |