diff options
| -rw-r--r-- | erebos.cabal | 28 | ||||
| -rw-r--r-- | main/Main.hs | 15 | ||||
| -rw-r--r-- | src/Erebos/Network.hs | 21 |
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 |