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

@@ -1,14 +1,14 @@
-name:                jitsi-rooms
-version:             0.1.0.0
-github:              "githubuser/jitsi-rooms"
-license:             BSD3
-author:              "Author name here"
-maintainer:          "example@example.com"
-copyright:           "2023 Author name here"
+name: jitsi-rooms
+version: 0.1.0.0
+github: "githubuser/jitsi-rooms"
+license: BSD3
+author: "Author name here"
+maintainer: "example@example.com"
+copyright: "2023 Author name here"
 
 extra-source-files:
-- README.md
-- CHANGELOG.md
+  - README.md
+  - CHANGELOG.md
 
 # Metadata used when publishing your package
 # synopsis:            Short description of your package
@@ -17,43 +17,49 @@ extra-source-files:
 # To avoid duplicated efforts in documentation and dealing with the
 # complications of embedding Haddock markup inside cabal files, it is
 # common to point users to the README.md file.
-description:         Please see the README on GitHub at <https://github.com/githubuser/jitsi-rooms#readme>
+description: Please see the README on GitHub at <https://github.com/githubuser/jitsi-rooms#readme>
 
 dependencies:
-- base >= 4.7 && < 5
+  - base >= 4.7 && < 5
+  - classy-prelude
+  - wai
+  - http-types
+  - warp
+  - websockets
 
 ghc-options:
-- -Wall
-- -Wcompat
-- -Widentities
-- -Wincomplete-record-updates
-- -Wincomplete-uni-patterns
-- -Wmissing-export-lists
-- -Wmissing-home-modules
-- -Wpartial-fields
-- -Wredundant-constraints
+  - -Wall
+  - -Wcompat
+  - -Widentities
+  - -Wincomplete-record-updates
+  - -Wincomplete-uni-patterns
+  - -Wmissing-export-lists
+  - -Wmissing-home-modules
+  - -Wpartial-fields
+  - -Wredundant-constraints
 
 library:
   source-dirs: src
 
 executables:
   jitsi-rooms-exe:
-    main:                Main.hs
-    source-dirs:         app
+    main: Main.hs
+    source-dirs: app
     ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
+      - -threaded
+      - -rtsopts
+      - -with-rtsopts=-N
     dependencies:
-    - jitsi-rooms
+      - jitsi-rooms
 
 tests:
   jitsi-rooms-test:
-    main:                Spec.hs
-    source-dirs:         test
+    main: Spec.hs
+    source-dirs: test
     ghc-options:
-    - -threaded
-    - -rtsopts
-    - -with-rtsopts=-N
+      - -threaded
+      - -rtsopts
+      - -with-rtsopts=-N
     dependencies:
-    - jitsi-rooms
+      - jitsi-rooms
+default-extensions: NoImplicitPrelude,OverloadedStrings,ImportQualifiedPost

backend/src/Lib.hs

@@ -1,7 +1,14 @@
 module Lib
-    ( someFunc
-    ) where
+  ( runBothServers,
+  )
+where
 
-someFunc :: IO ()
-someFunc = putS
+import ClassyPrelude
+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