diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Erebos/ICE.chs | 29 | ||||
| -rw-r--r-- | src/Erebos/Network.hs | 36 |
2 files changed, 19 insertions, 46 deletions
diff --git a/src/Erebos/ICE.chs b/src/Erebos/ICE.chs index 15bb078..bed186b 100644 --- a/src/Erebos/ICE.chs +++ b/src/Erebos/ICE.chs @@ -16,7 +16,7 @@ module Erebos.ICE ( iceConnect, iceSend, - iceSetChan, + serverPeerIce, ) where import Control.Arrow @@ -32,7 +32,6 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T import Data.Text.Read qualified as T -import Data.Void import Data.Word import Foreign.C.String @@ -43,7 +42,7 @@ import Foreign.Marshal.Array import Foreign.Ptr import Foreign.StablePtr -import Erebos.Flow +import Erebos.Network import Erebos.Object import Erebos.Storable import Erebos.Storage @@ -53,7 +52,7 @@ import Erebos.Storage data IceSession = IceSession { isStrans :: PjIceStrans , _isConfig :: IceConfig - , isChan :: MVar (Either [ByteString] (Flow Void ByteString)) + , isChan :: MVar (Either [ ByteString ] (ByteString -> IO ())) } instance Eq IceSession where @@ -65,6 +64,9 @@ instance Ord IceSession where instance Show IceSession where show _ = "<ICE>" +instance PeerAddressType IceSession where + sendBytesToAddress = iceSend + data IceRemoteInfo = IceRemoteInfo { iriUsernameFrament :: Text @@ -224,13 +226,13 @@ foreign export ccall ice_call_cb :: StablePtr (IO ()) -> IO () ice_call_cb :: StablePtr (IO ()) -> IO () ice_call_cb = join . deRefStablePtr -iceSetChan :: IceSession -> Flow Void ByteString -> IO () -iceSetChan sess chan = do +iceSetServer :: IceSession -> Server -> IO () +iceSetServer sess server = do modifyMVar_ (isChan sess) $ \orig -> do case orig of - Left buf -> mapM_ (writeFlowIO chan) $ reverse buf + Left buf -> mapM_ (receivedFromCustomAddress server sess) $ reverse buf Right _ -> return () - return $ Right chan + return $ Right $ receivedFromCustomAddress server sess foreign export ccall ice_rx_data :: StablePtr IceSession -> Ptr CChar -> Int -> IO () ice_rx_data :: StablePtr IceSession -> Ptr CChar -> Int -> IO () @@ -238,5 +240,12 @@ ice_rx_data sptr buf len = do sess <- deRefStablePtr sptr bs <- packCStringLen (buf, len) modifyMVar_ (isChan sess) $ \case - mc@(Right chan) -> writeFlowIO chan bs >> return mc - Left bss -> return $ Left (bs:bss) + mc@(Right sendToServer) -> sendToServer bs >> return mc + Left bss -> return $ Left (bs : bss) + + +serverPeerIce :: Server -> IceSession -> IO Peer +serverPeerIce server ice = do + peer <- serverPeerCustom server ice + iceSetServer ice server + return peer diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index 955af55..60d4f00 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE CPP #-} - module Erebos.Network ( Server, startServer, @@ -20,9 +18,6 @@ module Erebos.Network ( serverPeer, serverPeerCustom, -#ifdef ENABLE_ICE_SUPPORT - serverPeerIce, -#endif findPeer, dropPeer, isPeerDropped, @@ -67,9 +62,6 @@ import Network.Socket hiding (ControlMessage) import Network.Socket.ByteString qualified as S import Erebos.Error -#ifdef ENABLE_ICE_SUPPORT -import Erebos.ICE -#endif import Erebos.Identity import Erebos.Network.Channel import Erebos.Network.Protocol @@ -171,9 +163,6 @@ class (Eq addr, Ord addr, Show addr, Typeable addr) => PeerAddressType addr wher data PeerAddress = forall addr. PeerAddressType addr => CustomPeerAddress addr | DatagramAddress SockAddr -#ifdef ENABLE_ICE_SUPPORT - | PeerIceSession IceSession -#endif instance Show PeerAddress where show (CustomPeerAddress addr) = show addr @@ -186,17 +175,10 @@ instance Show PeerAddress where -> [show addr, show port] _ -> [show saddr] -#ifdef ENABLE_ICE_SUPPORT - show (PeerIceSession ice) = show ice -#endif - instance Eq PeerAddress where CustomPeerAddress addr == CustomPeerAddress addr' | Just addr'' <- cast addr' = addr == addr'' DatagramAddress addr == DatagramAddress addr' = addr == addr' -#ifdef ENABLE_ICE_SUPPORT - PeerIceSession ice == PeerIceSession ice' = ice == ice' -#endif _ == _ = False instance Ord PeerAddress where @@ -207,12 +189,6 @@ instance Ord PeerAddress where compare _ (CustomPeerAddress _ ) = GT 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 ErebosError IO ()]) @@ -351,9 +327,6 @@ startServer serverOptions serverOrigHead logd' serverServices = do case paddr of CustomPeerAddress addr -> sendBytesToAddress addr msg 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 @@ -859,15 +832,6 @@ serverPeer server paddr = do serverPeerCustom :: PeerAddressType addr => Server -> addr -> IO Peer serverPeerCustom server addr = serverPeer' server (CustomPeerAddress addr) -#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 (peer, hello) <- modifyMVar (serverPeers server) $ \pvalue -> do |