Start with haskell backend

backend/app/Main.hs

@@ -1,6 +1,7 @@
 module Main (main) where
 
-import Lib
+import ClassyPrelude
+import Lib (runBothServers)
 
 main :: IO ()
-main = someFunc
+main = runBothServers

backend/jitsi-rooms.cabal

@@ -26,13 +26,22 @@ source-repository head
 library
   exposed-modules:
       Lib
+      WebServer
+      WebSocket
   other-modules:
       Paths_jitsi_rooms
   hs-source-dirs:
       src
+  default-extensions:
+      NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
   build-depends:
       base >=4.7 && <5
+    , classy-prelude
+    , http-types
+    , wai
+    , warp
+    , websockets
   default-language: Haskell2010
 
 executable jitsi-rooms-exe
@@ -41,10 +50,17 @@ executable jitsi-rooms-exe
       Paths_jitsi_rooms
   hs-source-dirs:
       app
+  default-extensions:
+      NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , classy-prelude
+    , http-types
     , jitsi-rooms
+    , wai
+    , warp
+    , websockets
   default-language: Haskell2010
 
 test-suite jitsi-rooms-test
@@ -54,8 +70,15 @@ test-suite jitsi-rooms-test
       Paths_jitsi_rooms
   hs-source-dirs:
       test
+  default-extensions:
+      NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost
   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , classy-prelude
+    , http-types
     , jitsi-rooms
+    , wai
+    , warp
+    , websockets
   default-language: Haskell2010

backend/package.yaml

@@ -21,6 +21,11 @@ description:         Please see the README on GitHub at <https://github.com/gith
 
 dependencies:
   - base >= 4.7 && < 5
+  - classy-prelude
+  - wai
+  - http-types
+  - warp
+  - websockets
 
 ghc-options:
   - -Wall
@@ -57,3 +62,4 @@ tests:
       - -with-rtsopts=-N
     dependencies:
       - jitsi-rooms
+default-extensions: NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost

backend/src/Lib.hs

@@ -1,7 +1,14 @@
 module Lib
-    ( someFunc
+  ( runBothServers,
-    ) where
+  )
+where
 
-someFunc :: IO ()
+import ClassyPrelude
-someFunc = putS
+import WebServer (runWebServer)
+import WebSocket (initMVarState, runWebSocketServer)
 
+runBothServers :: IO ()
+runBothServers = do
+  mVarState <- initMVarState
+  _ <- concurrently (runWebSocketServer mVarState) (runWebServer mVarState)
+  return ()

backend/src/WebServer.hs

@@ -0,0 +1,24 @@
+module WebServer (runWebServer) where
+
+import ClassyPrelude
+import Network.HTTP.Types
+import Network.Wai
+import Network.Wai.Handler.Warp (run)
+import WebSocket (ServerState, broadcast)
+
+app :: MVar ServerState -> Application
+app state _ respond = do
+  putStrLn "I've done some IO here"
+  currentState <- takeMVar state
+  broadcast "dsa" currentState
+  putMVar state currentState
+  respond $
+    responseLBS
+      status200
+      [("Content-Type", "text/plain")]
+      "Hello, Web!"
+
+runWebServer :: MVar ServerState -> IO ()
+runWebServer state = do
+  putStrLn $ "http://localhost:8080/"
+  run 8080 $ app state

backend/src/WebSocket.hs

@@ -0,0 +1,52 @@
+module WebSocket (broadcast, initMVarState, runWebSocketServer, ServerState, Client) where
+
+import ClassyPrelude
+import Network.WebSockets qualified as WS
+
+type Client = (Text, WS.Connection)
+
+type ServerState = [Client]
+
+addClient :: Client -> ServerState -> ServerState
+addClient client clients = client : clients
+
+removeClient :: Client -> ServerState -> ServerState
+removeClient client = filter ((/= fst client) . fst)
+
+newServerState :: ServerState
+newServerState = []
+
+broadcast :: Text -> ServerState -> IO ()
+broadcast message clients = do
+  putStrLn message
+  forM_ clients $ \(_, conn) -> WS.sendTextData conn message
+
+initMVarState :: IO (MVar ServerState)
+initMVarState = newMVar newServerState
+
+runWebSocketServer :: MVar ServerState -> IO ()
+runWebSocketServer state = do
+  WS.runServer "127.0.0.1" 9160 $ webSocketApplication state
+
+webSocketApplication :: MVar ServerState -> WS.ServerApp
+webSocketApplication state pending = do
+  putStrLn "pending request"
+  conn <- WS.acceptRequest pending
+  WS.withPingThread conn 30 (return ()) $ do
+    msg <- WS.receiveData conn
+    putStrLn msg
+    let client = ("hall", conn)
+    flip finally (disconnect client) $ do
+      modifyMVar_ state $ \s -> do
+        let s' = addClient client s
+        return s'
+      forever $ do
+        currentMsg <- WS.receiveData conn
+        putStrLn currentMsg
+  where
+    disconnect client = do
+      putStrLn "disconnect"
+      modifyMVar state $ \s ->
+        let s' = removeClient client s
+         in return
+              (s', s')

backend/stack.yaml

@@ -53,7 +53,7 @@ packages:
 #
 # Require a specific version of stack, using version ranges
 # require-stack-version: -any # Default
-# require-stack-version: ">=2.7"
+# require-stack-version: ">=2.9"
 #
 # Override the architecture used by stack, especially useful on Windows
 # arch: i386