summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--erebos.cabal28
-rw-r--r--main/Main.hs15
-rw-r--r--src/Erebos/Network.hs21
3 files changed, 55 insertions, 9 deletions
diff --git a/erebos.cabal b/erebos.cabal
index 3734f1f..d732385 100644
--- a/erebos.cabal
+++ b/erebos.cabal
@@ -30,6 +30,9 @@ Extra-Doc-Files:
Extra-Source-Files:
src/Erebos/ICE/pjproject.h
+Flag ice
+ Description: Enable peer discovery with ICE support using pjproject
+
source-repository head
type: git
location: git://erebosprotocol.net/erebos
@@ -61,12 +64,16 @@ common common
TypeFamilyDependencies
other-extensions:
+ CPP
ForeignFunctionInterface
OverloadedStrings
RecursiveDo
TemplateHaskell
UndecidableInstances
+ if flag(ice)
+ cpp-options: -DENABLE_ICE_SUPPORT
+
library
import: common
default-language: Haskell2010
@@ -76,8 +83,6 @@ library
Erebos.Attach
Erebos.Channel
Erebos.Contact
- Erebos.Discovery
- Erebos.ICE
Erebos.Identity
Erebos.Message
Erebos.Network
@@ -100,15 +105,22 @@ library
Erebos.Util
c-sources:
- src/Erebos/ICE/pjproject.c
src/Erebos/Network/ifaddrs.c
include-dirs:
- src/Erebos/ICE
src
- includes:
- src/Erebos/ICE/pjproject.h
- build-tool-depends: c2hs:c2hs
- pkgconfig-depends: libpjproject >= 2.9
+
+ if flag(ice)
+ exposed-modules:
+ Erebos.Discovery
+ Erebos.ICE
+ c-sources:
+ src/Erebos/ICE/pjproject.c
+ include-dirs:
+ src/Erebos/ICE
+ includes:
+ src/Erebos/ICE/pjproject.h
+ build-tool-depends: c2hs:c2hs
+ pkgconfig-depends: libpjproject >= 2.9
build-depends:
async >=2.2 && <2.3,
diff --git a/main/Main.hs b/main/Main.hs
index 3359598..90e4079 100644
--- a/main/Main.hs
+++ b/main/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
@@ -32,8 +33,10 @@ import System.Environment
import Erebos.Attach
import Erebos.Contact
+#ifdef ENABLE_ICE_SUPPORT
import Erebos.Discovery
import Erebos.ICE
+#endif
import Erebos.Identity
import Erebos.Message
import Erebos.Network
@@ -159,7 +162,9 @@ interactiveLoop st opts = runInputT defaultSettings $ do
, someService @SyncService Proxy
, someService @ContactService Proxy
, someService @DirectMessage Proxy
+#ifdef ENABLE_ICE_SUPPORT
, someService @DiscoveryService Proxy
+#endif
]
peers <- liftIO $ newMVar []
@@ -227,7 +232,9 @@ interactiveLoop st opts = runInputT defaultSettings $ do
loop $ Just $ CommandState
{ csHead = erebosHead
, csContext = NoContext
+#ifdef ENABLE_ICE_SUPPORT
, csIceSessions = []
+#endif
, csIcePeer = Nothing
}
@@ -244,7 +251,9 @@ data CommandInput = CommandInput
data CommandState = CommandState
{ csHead :: Head LocalState
, csContext :: CommandContext
+#ifdef ENABLE_ICE_SUPPORT
, csIceSessions :: [IceSession]
+#endif
, csIcePeer :: Maybe Peer
}
@@ -302,6 +311,7 @@ commands =
, ("contact-add", cmdContactAdd)
, ("contact-accept", cmdContactAccept)
, ("contact-reject", cmdContactReject)
+#ifdef ENABLE_ICE_SUPPORT
, ("discovery-init", cmdDiscoveryInit)
, ("discovery", cmdDiscovery)
, ("ice-create", cmdIceCreate)
@@ -309,6 +319,7 @@ commands =
, ("ice-show", cmdIceShow)
, ("ice-connect", cmdIceConnect)
, ("ice-send", cmdIceSend)
+#endif
]
cmdUnknown :: String -> Command
@@ -408,6 +419,8 @@ cmdContactAccept = contactAccept =<< getSelectedPeer
cmdContactReject :: Command
cmdContactReject = contactReject =<< getSelectedPeer
+#ifdef ENABLE_ICE_SUPPORT
+
cmdDiscoveryInit :: Command
cmdDiscoveryInit = void $ do
server <- asks ciServer
@@ -477,3 +490,5 @@ cmdIceSend = void $ do
s:_ <- gets csIceSessions
server <- asks ciServer
liftIO $ serverPeerIce server s
+
+#endif
diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs
index dc3df4b..b26ada5 100644
--- a/src/Erebos/Network.hs
+++ b/src/Erebos/Network.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
module Erebos.Network (
Server,
startServer,
@@ -10,7 +12,10 @@ module Erebos.Network (
PeerIdentity(..), peerIdentity,
WaitingRef, wrDigest,
Service(..),
- serverPeer, serverPeerIce,
+ serverPeer,
+#ifdef ENABLE_ICE_SUPPORT
+ serverPeerIce,
+#endif
sendToPeer, sendToPeerStored, sendToPeerWith,
runPeerService,
@@ -44,7 +49,9 @@ import Network.Socket hiding (ControlMessage)
import qualified Network.Socket.ByteString as S
import Erebos.Channel
+#ifdef ENABLE_ICE_SUPPORT
import Erebos.ICE
+#endif
import Erebos.Identity
import Erebos.Network.Protocol
import Erebos.PubKey
@@ -127,7 +134,9 @@ instance Eq Peer where
(==) = (==) `on` peerIdentityVar
data PeerAddress = DatagramAddress SockAddr
+#ifdef ENABLE_ICE_SUPPORT
| PeerIceSession IceSession
+#endif
instance Show PeerAddress where
show (DatagramAddress saddr) = unwords $ case IP.fromSockAddr saddr of
@@ -137,18 +146,24 @@ instance Show PeerAddress where
Just (addr, port)
-> [show addr, show port]
_ -> [show saddr]
+#ifdef ENABLE_ICE_SUPPORT
show (PeerIceSession ice) = show ice
+#endif
instance Eq PeerAddress where
DatagramAddress addr == DatagramAddress addr' = addr == addr'
+#ifdef ENABLE_ICE_SUPPORT
PeerIceSession ice == PeerIceSession ice' = ice == ice'
_ == _ = False
+#endif
instance Ord PeerAddress where
compare (DatagramAddress addr) (DatagramAddress addr') = compare addr addr'
+#ifdef ENABLE_ICE_SUPPORT
compare (DatagramAddress _ ) _ = LT
compare _ (DatagramAddress _ ) = GT
compare (PeerIceSession ice ) (PeerIceSession ice') = compare ice ice'
+#endif
data PeerIdentity = PeerIdentityUnknown (TVar [UnifiedIdentity -> ExceptT String IO ()])
@@ -261,7 +276,9 @@ startServer opt serverOrigHead logd' serverServices = do
(paddr, msg) <- readFlowIO serverRawPath
case paddr of
DatagramAddress addr -> void $ S.sendTo sock msg addr
+#ifdef ENABLE_ICE_SUPPORT
PeerIceSession ice -> iceSend ice msg
+#endif
forkServerThread server $ forever $ do
readFlowIO serverControlFlow >>= \case
@@ -655,12 +672,14 @@ serverPeer :: Server -> SockAddr -> IO Peer
serverPeer server paddr = do
serverPeer' server (DatagramAddress paddr)
+#ifdef ENABLE_ICE_SUPPORT
serverPeerIce :: Server -> IceSession -> IO Peer
serverPeerIce server@Server {..} ice = do
let paddr = PeerIceSession ice
peer <- serverPeer' server paddr
iceSetChan ice $ mapFlow undefined (paddr,) serverRawPath
return peer
+#endif
serverPeer' :: Server -> PeerAddress -> IO Peer
serverPeer' server paddr = do