From 9a401324f20334ca06c77ea09ab005f9ab7e80dc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Mon, 30 Dec 2024 22:40:39 +0100
Subject: Build discovery service without requiring ICE support

Changelog: Discovery service without requiring ICE support
---
 src/Erebos/Discovery.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 46 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/Erebos/Discovery.hs b/src/Erebos/Discovery.hs
index 48df9c3..e6b5f48 100644
--- a/src/Erebos/Discovery.hs
+++ b/src/Erebos/Discovery.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module Erebos.Discovery (
     DiscoveryService(..),
     DiscoveryConnection(..)
@@ -16,7 +18,9 @@ import qualified Data.Text as T
 
 import Network.Socket
 
+#ifdef ENABLE_ICE_SUPPORT
 import Erebos.ICE
+#endif
 import Erebos.Identity
 import Erebos.Network
 import Erebos.Service
@@ -38,11 +42,18 @@ data DiscoveryConnection = DiscoveryConnection
     { dconnSource :: Ref
     , dconnTarget :: Ref
     , dconnAddress :: Maybe Text
+#ifdef ENABLE_ICE_SUPPORT
     , dconnIceSession :: Maybe IceRemoteInfo
+#endif
     }
 
 emptyConnection :: Ref -> Ref -> DiscoveryConnection
-emptyConnection source target = DiscoveryConnection source target Nothing Nothing
+emptyConnection dconnSource dconnTarget = DiscoveryConnection {..}
+  where
+    dconnAddress = Nothing
+#ifdef ENABLE_ICE_SUPPORT
+    dconnIceSession = Nothing
+#endif
 
 instance Storable DiscoveryService where
     store' x = storeRec $ do
@@ -64,7 +75,9 @@ instance Storable DiscoveryService where
                   storeRawRef "source" $ dconnSource conn
                   storeRawRef "target" $ dconnTarget conn
                   storeMbText "address" $ dconnAddress conn
+#ifdef ENABLE_ICE_SUPPORT
                   storeMbRef "ice-session" $ dconnIceSession conn
+#endif
 
     load' = loadRec $ msum
             [ DiscoverySelf
@@ -86,13 +99,17 @@ instance Storable DiscoveryService where
                       <$> loadRawRef "source"
                       <*> loadRawRef "target"
                       <*> loadMbText "address"
+#ifdef ENABLE_ICE_SUPPORT
                       <*> loadMbRef "ice-session"
+#endif
 
 data DiscoveryPeer = DiscoveryPeer
     { dpPriority :: Int
     , dpPeer :: Maybe Peer
     , dpAddress :: Maybe Text
+#ifdef ENABLE_ICE_SUPPORT
     , dpIceSession :: Maybe IceSession
+#endif
     }
 
 instance Service DiscoveryService where
@@ -115,8 +132,14 @@ instance Service DiscoveryService where
                                 else Nothing
                 _ -> return Nothing
             forM_ (idDataF =<< unfoldOwners pid) $ \s ->
-                svcModifyGlobal $ M.insertWith insertHelper (refDigest $ storedRef s) $
-                    DiscoveryPeer priority (Just peer) mbaddr Nothing
+                svcModifyGlobal $ M.insertWith insertHelper (refDigest $ storedRef s) DiscoveryPeer
+                    { dpPriority = priority
+                    , dpPeer = Just peer
+                    , dpAddress = mbaddr
+#ifdef ENABLE_ICE_SUPPORT
+                    , dpIceSession = Nothing
+#endif
+                    }
             replyPacket $ DiscoveryAcknowledged $ fromMaybe (T.pack "ICE") mbaddr
 
         DiscoveryAcknowledged addr -> do
@@ -142,6 +165,7 @@ instance Service DiscoveryService where
             server <- asks svcServer
             if addr == T.pack "ICE"
                then do
+#ifdef ENABLE_ICE_SUPPORT
                     self <- svcSelf
                     peer <- asks svcPeer
                     ice <- liftIO $ iceCreate PjIceSessRoleControlling $ \ice -> do
@@ -154,18 +178,28 @@ instance Service DiscoveryService where
 
                     svcModifyGlobal $ M.insert (refDigest ref) $
                         DiscoveryPeer 0 Nothing Nothing (Just ice)
+#else
+                    return ()
+#endif
                else do
                     case words (T.unpack addr) of
                         [ipaddr, port] -> do
                             saddr <- liftIO $ head <$>
                                 getAddrInfo (Just $ defaultHints { addrSocketType = Datagram }) (Just ipaddr) (Just port)
                             peer <- liftIO $ serverPeer server (addrAddress saddr)
-                            svcModifyGlobal $ M.insert (refDigest ref) $
-                                DiscoveryPeer 0 (Just peer) Nothing Nothing
+                            svcModifyGlobal $ M.insert (refDigest ref) DiscoveryPeer
+                                { dpPriority = 0
+                                , dpPeer = Just peer
+                                , dpAddress = Nothing
+#ifdef ENABLE_ICE_SUPPORT
+                                , dpIceSession = Nothing
+#endif
+                                }
 
                         _ -> svcPrint $ "Discovery: invalid address in result: " ++ T.unpack addr
 
         DiscoveryConnectionRequest conn -> do
+#ifdef ENABLE_ICE_SUPPORT
             self <- svcSelf
             let rconn = emptyConnection (dconnSource conn) (dconnTarget conn)
             if refDigest (dconnTarget conn) `elem` (map (refDigest . storedRef) $ idDataF =<< unfoldOwners self)
@@ -193,8 +227,12 @@ instance Service DiscoveryService where
                                 | Just dpeer <- dpPeer dp -> do
                                     sendToPeer dpeer $ DiscoveryConnectionRequest conn
                                 | otherwise -> svcPrint $ "Discovery: failed to relay connection request"
+#else
+            return ()
+#endif
 
         DiscoveryConnectionResponse conn -> do
+#ifdef ENABLE_ICE_SUPPORT
             self <- svcSelf
             dpeers <- svcGetGlobal
             if refDigest (dconnSource conn) `elem` (map (refDigest . storedRef) $ idDataF =<< unfoldOwners self)
@@ -221,3 +259,6 @@ instance Service DiscoveryService where
                         Just dp | Just dpeer <- dpPeer dp -> do
                             sendToPeer dpeer $ DiscoveryConnectionResponse conn
                         _ -> svcPrint $ "Discovery: failed to relay connection response"
+#else
+            return ()
+#endif
-- 
cgit v1.2.3