Build discovery service without requiring ICE support

Changelog: Discovery service without requiring ICE support

3 files changed, 51 insertions, 12 deletions

diff --git a/erebos.cabal b/erebos.cabal
index fa000bd..97a95ec 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -98,6 +98,7 @@ library
         Erebos.Chatroom
         Erebos.Contact
         Erebos.Conversation
+        Erebos.Discovery
         Erebos.Identity
         Erebos.Message
         Erebos.Network
@@ -126,7 +127,6 @@ library
 
     if flag(ice)
         exposed-modules:
-            Erebos.Discovery
             Erebos.ICE
         c-sources:
             src/Erebos/ICE/pjproject.c
diff --git a/main/Main.hs b/main/Main.hs
index 73def51..000bbf9 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -40,8 +40,8 @@ import Erebos.Attach
 import Erebos.Contact
 import Erebos.Chatroom
 import Erebos.Conversation
-#ifdef ENABLE_ICE_SUPPORT
 import Erebos.Discovery
+#ifdef ENABLE_ICE_SUPPORT
 import Erebos.ICE
 #endif
 import Erebos.Identity
@@ -102,10 +102,8 @@ availableServices =
         True "create contacts with network peers"
     , ServiceOption "dm" (someService @DirectMessage Proxy)
         True "direct messages"
-#ifdef ENABLE_ICE_SUPPORT
     , ServiceOption "discovery" (someService @DiscoveryService Proxy)
         True "peer discovery"
-#endif
     ]
 
 options :: [OptDescr (Options -> Options)]
@@ -492,9 +490,9 @@ commands =
     , ("contact-reject", cmdContactReject)
     , ("conversations", cmdConversations)
     , ("details", cmdDetails)
-#ifdef ENABLE_ICE_SUPPORT
     , ("discovery-init", cmdDiscoveryInit)
     , ("discovery", cmdDiscovery)
+#ifdef ENABLE_ICE_SUPPORT
     , ("ice-create", cmdIceCreate)
     , ("ice-destroy", cmdIceDestroy)
     , ("ice-show", cmdIceShow)
@@ -838,8 +836,6 @@ cmdDetails = do
                 , map (BC.unpack . showRefDigest . refDigest . storedRef) $ idExtDataF cpid
                 ]
 
-#ifdef ENABLE_ICE_SUPPORT
-
 cmdDiscoveryInit :: Command
 cmdDiscoveryInit = void $ do
     server <- asks ciServer
@@ -867,6 +863,8 @@ cmdDiscovery = void $ do
                  Right _ -> return ()
                  Left err -> eprint err
 
+#ifdef ENABLE_ICE_SUPPORT
+
 cmdIceCreate :: Command
 cmdIceCreate = do
     role <- asks ciLine >>= return . \case
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