From 5afb63aced2a6c5ec2fd3604f1b898d803686d8d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 8 May 2023 09:45:59 +0200
Subject: Command to manually add peer

---
 src/Test.hs | 13 +++++++++++++
 1 file changed, 13 insertions(+)

(limited to 'src/Test.hs')

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
-- 
cgit v1.2.3