Command to manually add peer

1 files changed, 11 insertions, 0 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 4a2d910..cdaa9ae 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -232,6 +232,7 @@ commands :: [(String, Command)]
 commands =
     [ ("history", cmdHistory)
     , ("peers", cmdPeers)
+    , ("peer-add", cmdPeerAdd)
     , ("send", cmdSend)
     , ("update-identity", cmdUpdateIdentity)
     , ("attach", cmdAttach)
@@ -259,6 +260,16 @@ cmdPeers = do
     forM_ (zip [1..] peers) $ \(i :: Int, (_, name)) -> do
         liftIO $ putStrLn $ show i ++ ": " ++ name
 
+cmdPeerAdd :: Command
+cmdPeerAdd = void $ do
+    server <- asks ciServer
+    (hostname, port) <- (words <$> asks ciLine) >>= \case
+        hostname:p:_ -> return (hostname, p)
+        [hostname] -> return (hostname, show discoveryPort)
+        [] -> throwError "missing peer address"
+    addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just hostname) (Just port)
+    liftIO $ serverPeer server (addrAddress addr)
+
 showPeer :: PeerIdentity -> PeerAddress -> String
 showPeer pidentity paddr =
     let name = case pidentity of