Erebos network connection via WebSocket

2 files changed, 41 insertions, 4 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 83d2d8a..183b038 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,18 +1,25 @@
 module Main (main, setup) where
 
+import Control.Concurrent
+import Control.Monad
 import Control.Monad.Reader
 
-import Data.ByteString qualified as B
 import Data.Maybe
 import Data.Proxy
 import Data.Text qualified as T
 
 import GHC.Wasm.Prim
 
+import Erebos.Chatroom
+import Erebos.DirectMessage
+import Erebos.Discovery
 import Erebos.Identity
+import Erebos.Network
+import Erebos.Service
 import Erebos.State
 import Erebos.Storable
 import Erebos.Storage
+import Erebos.Sync
 
 import System.IO.Unsafe
 
@@ -71,8 +78,18 @@ setup = do
                 , lsOther = []
                 }
 
+    server <- startServer defaultServerOptions globalHead JS.consoleLog
+        [ someService @ChatroomService Proxy
+        , someService @DiscoveryService Proxy
+        , someService @DirectMessage Proxy
+        , someService @SyncService Proxy
+        ]
+
     startClient "localhost" 9160 "" $ \conn -> do
-        sendMessage conn $ B.pack [ 98 .. 107 ]
+        void $ serverPeerCustom server conn
+        void $ forkIO $ forever $ do
+            msg <- receiveMessage conn
+            receivedFromCustomAddress server conn msg
 
     return ()
 
diff --git a/src/WebSocket.hs b/src/WebSocket.hs
index 273be85..19d30c4 100644
--- a/src/WebSocket.hs
+++ b/src/WebSocket.hs
@@ -9,8 +9,12 @@ import Control.Concurrent.Chan
 
 import Data.ByteString (ByteString)
 import Data.ByteString.Unsafe
+import Data.Function
+import Data.Unique
 import Data.Word
 
+import Erebos.Network
+
 import Foreign.Marshal.Alloc
 import Foreign.Ptr
 
@@ -20,13 +24,29 @@ import JavaScript qualified as JS
 
 
 data Connection = Connection
-    { connJS :: JSVal
+    { connUnique :: Unique
+    , connAddress :: String
+    , connJS :: JSVal
     , connInQueue :: Chan ByteString
     }
 
+instance Eq Connection where
+    (==) = (==) `on` connUnique
+
+instance Ord Connection where
+    compare = compare `on` connUnique
+
+instance Show Connection where
+    show = connAddress
+
+instance PeerAddressType Connection where
+    sendBytesToAddress = sendMessage
+
 startClient :: String -> Int -> String -> (Connection -> IO ()) -> IO ()
 startClient addr port path fun = do
-    connJS <- js_initWebSocket (toJSString $ "ws://" <> addr <> ":" <> show port <> "/" <> path)
+    connUnique <- newUnique
+    let connAddress = "ws://" <> addr <> ":" <> show port <> "/" <> path
+    connJS <- js_initWebSocket (toJSString connAddress)
     connInQueue <- newChan
     let conn = Connection {..}