diff options
| -rw-r--r-- | erebos-webapp.cabal | 2 | ||||
| -rw-r--r-- | src/Main.hs | 21 | ||||
| -rw-r--r-- | src/WebSocket.hs | 24 |
3 files changed, 41 insertions, 6 deletions
diff --git a/erebos-webapp.cabal b/erebos-webapp.cabal index 5da31ee..7648849 100644 --- a/erebos-webapp.cabal +++ b/erebos-webapp.cabal @@ -25,8 +25,6 @@ executable erebos-webapp -optl-Wl,--export=hs_init,--export=setup -fdefer-typed-holes - extra-libraries: blake2b-ref - main-is: Main.hs other-modules: JavaScript 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 {..} |