summaryrefslogtreecommitdiff
path: root/src/Test.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Test.hs')
-rw-r--r--src/Test.hs13
1 files changed, 13 insertions, 0 deletions
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