Implement ICE session as custom network address

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