From 82b6180030d3aaa19c1291f64e58f78060542807 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 10 Oct 2026 09:49:37 +0200
Subject: Test: option to limit discovery tunnel based on IP address

---
 main/Test.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/main/Test.hs b/main/Test.hs
index bb3bcba..39d7353 100644
--- a/main/Test.hs
+++ b/main/Test.hs
@@ -19,6 +19,7 @@ import Data.ByteString qualified as B
 import Data.ByteString.Char8 qualified as BC
 import Data.ByteString.Lazy qualified as BL
 import Data.ByteString.Lazy.Char8 qualified as BL
+import Data.Char
 import Data.Foldable
 import Data.Ord
 import Data.Text (Text)
@@ -668,7 +669,11 @@ cmdStartServer = do
         ( "chatroom", _ ) -> return $ someService @ChatroomService Proxy
         ( "contact", _ ) -> return $ someServiceAttr $ pairingAttributes (Proxy @ContactService) out rsPeers "contact"
         ( "discovery", params ) -> return $ someServiceAttr $ discoveryAttributes
-            { discoveryProvideTunnel = \_ _ -> "tunnel" `elem` params
+            { discoveryProvideTunnel
+                = \_ paddr -> or
+                    [ "tunnel" `elem` params
+                    , ("tunnel-" <> T.pack (takeWhile (not . isSpace) $ show paddr)) `elem` params
+                    ]
             }
         ( "dm", _ ) -> return $ someServiceAttr $ directMessageAttributes out
         ( "invite", _ ) -> return $ someServiceAttr $ inviteAttributes out
-- 
cgit v1.2.3