WebSocketChat backend route and server fix. working!

backend/backend.cabal

@@ -12,6 +12,7 @@ library
                , frontend
                , obelisk-backend
                , obelisk-route
+               , websockets-snap
   exposed-modules:
     Backend
   ghc-options: -Wall

backend/src/Backend.hs

@@ -7,9 +7,21 @@ module Backend where
 
 import Common.Route
 import Obelisk.Backend
+import Data.Dependent.Sum (DSum (..))
+import Data.Functor.Identity
+import Control.Concurrent
+import Network.WebSockets.Snap
+
+import qualified Backend.Examples.WebSocketChat.Server as WebSocketChat
 
 backend :: Backend BackendRoute FrontendRoute
 backend = Backend
-  { _backend_run = \serve -> serve $ const $ return ()
+  { _backend_run = \serve -> do
+      state <- newMVar WebSocketChat.newServerState
+      serve $ \case
+        BackendRoute_Missing :=> Identity () -> return ()
+        BackendRoute_WebSocketChat :=> Identity () -> do
+          runWebSocketsSnap (WebSocketChat.application state)
+
   , _backend_routeEncoder = backendRouteEncoder
   }

backend/src/Common/Examples/WebSocketChat/Server.hs → backend/src/Backend/Examples/WebSocketChat/Server.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Main where
+module Backend.Examples.WebSocketChat.Server where
 
 import           Control.Concurrent (MVar, modifyMVar, modifyMVar_, newMVar,
                                      readMVar)
@@ -17,7 +17,7 @@ import qualified Data.Text.IO       as T
 import qualified Network.WebSockets as WS
 
 --------------------------------------------------------------------------------
-import           CommonWsChat
+import           Common.Examples.WebSocketChat.Message
 --------------------------------------------------------------------------------
 
 type Client = (Text, WS.Connection)
@@ -46,11 +46,6 @@ broadcast message clients = do
     forM_ clients $ \(_, conn) -> WS.sendTextData conn $
         (toStrict . encode . S2Cbroadcast) message
 
-main :: IO ()
-main = do
-    state <- newMVar newServerState
-    WS.runServer "127.0.0.1" 8000 $ application state
-
 application :: MVar ServerState -> WS.ServerApp
 application state pending = do
     conn <- WS.acceptRequest pending

common/src/Common/Route.hs

@@ -32,6 +32,7 @@ import Obelisk.Route.TH
 data BackendRoute :: * -> * where
   -- | Used to handle unparseable routes.
   BackendRoute_Missing :: BackendRoute ()
+  BackendRoute_WebSocketChat :: BackendRoute ()
   -- You can define any routes that will be handled specially by the backend here.
   -- i.e. These do not serve the frontend, but do something different, such as serving static files.
 
@@ -57,6 +58,7 @@ backendRouteEncoder = handleEncoder (const (InL BackendRoute_Missing :/ ())) $
   pathComponentEncoder $ \case
     InL backendRoute -> case backendRoute of
       BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty
+      BackendRoute_WebSocketChat -> PathSegment "websocketchat" $ unitEncoder mempty
     InR obeliskRoute -> obeliskRouteSegment obeliskRoute $ \case
       -- The encoder given to PathEnd determines how to parse query parameters,
       -- in this example, we have none, so we insist on it.

frontend/src/Frontend/Examples/WebSocketChat/Main.hs

@@ -54,7 +54,7 @@ app = do
       loggedInEv = fmapMaybe loginEv msgRecEv
     wsRespEv <- prerender (return never) $ do
       let sendEv = fmap ((:[]) . toStrict . encode) msgSendEv
-      ws <- webSocket "ws://localhost:8000" $ def & webSocketConfig_send .~ sendEv
+      ws <- webSocket "ws://localhost:8000/websocketchat" $ def & webSocketConfig_send .~ sendEv
       return (_webSocket_recv ws)
     receivedMessages <- foldDyn (\m ms -> ms ++ [m]) [] eRecRespTxt
     el "div" $ do