summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-05-08 09:45:59 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-05-08 09:45:59 +0200
commit5afb63aced2a6c5ec2fd3604f1b898d803686d8d (patch)
treec6ddd88716b8478241db9599419b3f23f88aefb5 /src
parentebe2292bc4bd19ec68935c2135160ca6aa0dbae3 (diff)
Command to manually add peer
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs11
-rw-r--r--src/Test.hs13
2 files changed, 24 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
diff --git a/src/Test.hs b/src/Test.hs
index a7dd730..04a5c9c 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -21,6 +21,8 @@ import Data.Text.Encoding
import Data.Text.IO qualified as T
import Data.Typeable
+import Network.Socket
+
import System.IO
import System.IO.Error
@@ -230,6 +232,7 @@ commands = map (T.pack *** id)
, ("stored-set-list", cmdStoredSetList)
, ("create-identity", cmdCreateIdentity)
, ("start-server", cmdStartServer)
+ , ("peer-add", cmdPeerAdd)
, ("shared-state-get", cmdSharedStateGet)
, ("shared-state-wait", cmdSharedStateWait)
, ("watch-local-identity", cmdWatchLocalIdentity)
@@ -342,6 +345,16 @@ cmdStartServer = do
modify $ \s -> s { tsServer = Just server, tsPeers = Just peers }
+cmdPeerAdd :: Command
+cmdPeerAdd = do
+ Just server <- gets tsServer
+ host:rest <- map T.unpack <$> asks tiParams
+
+ let port = case rest of [] -> show discoveryPort
+ (p:_) -> p
+ addr:_ <- liftIO $ getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just host) (Just port)
+ void $ liftIO $ serverPeer server (addrAddress addr)
+
cmdSharedStateGet :: Command
cmdSharedStateGet = do
h <- getHead