Make it deployable

author: Jasper Van der Jeugt 2020-08-03 17:26:45 +0200
committer: Jasper Van der Jeugt 2020-08-03 17:26:45 +0200
commit: 7e646e1676e08331598ae2b9518f2b1b5f999ba2 (patch)
tree: f2d25239230cfb711fbd26828e5698b94b876988
parent: 9ce21e70492ca82c5554e3fa523108755fa721e8 (diff)
5 files changed, 56 insertions, 32 deletions
diff --git a/Makefile b/Makefile
index 0f7a475..bca08c4 100644
--- a/Makefile
+++ b/Makefile
@@ -1,3 +1,5 @@
+include config.mk
+
 HS_SOURCES=$(shell find server/lib/ server/src -name '*.hs')
 ELM_SOURCES=$(shell find client/src -name '*.elm')
 ELM_MESSAGES_SOURCE=client/src/Messages.elm
@@ -9,8 +11,13 @@ build: server/assets/client.js \
 	server/assets/black.txt \
 	server/assets/white.txt
 
+.PHONY: server
 server: build
-	cd server && stack exec cafp-server
+	(cd server && \
+	    CAFP_HOSTNAME=$(CAFP_HOSTNAME) \
+	    CAFP_PORT=$(CAFP_PORT) \
+	    CAFP_BASE=$(CAFP_BASE) \
+	    stack exec cafp-server)
 
 .PHONY: stack_build
 stack_build: $(HS_SOURCES)
@@ -23,8 +30,8 @@ server/assets/client.js: $(ELM_MESSAGES_SOURCE) $(ELM_SOURCES)
 	mkdir -p server/assets
 	cd client && elm make src/Client.elm --output=../server/assets/client.js
 
-server/assets/client.html: client/index.html
-	cp client/index.html $@
+server/assets/client.html: client/index.html config.mk
+	sed "s@\$$CAFP_BASE@$(CAFP_BASE)@" $< >$@
 
 server/assets/style.css: client/style.css
 	cp $< $@
diff --git a/client/index.html b/client/index.html
index adc2ac8..8e1333d 100644
--- a/client/index.html
+++ b/client/index.html
@@ -1,19 +1,22 @@
 <!DOCTYPE HTML>
 <html>
-<head>
-  <meta charset="UTF-8">
-  <title>Client</title>
-  <link rel="stylesheet" type="text/css" href="/assets/style.css">
-</head>
+  <head>
+    <meta charset="UTF-8">
+    <title>Client</title>
+    <link rel="stylesheet" type="text/css" href="$CAFP_BASE/assets/style.css">
+  </head>
   <body>
     <div id="main"></div>
-    <script type="text/JavaScript" src="/assets/client.js"></script>
+    <script type="text/JavaScript" src="$CAFP_BASE/assets/client.js"></script>
     <script>
       var app = Elm.Client.init({node: document.querySelector("main")});
-
-      var roomId = document.location.pathname.split("/")[2];
+      var path = document.location.pathname;
+      if(path.startsWith("$CAFP_BASE")) {
+          path = path.substr("$CAFP_BASE".length);
+      }
+      var roomId = path.split("/")[2];
       var url = "ws://" + document.location.host +
-        "/rooms/" + roomId + "/events";
+        "$CAFP_BASE/rooms/" + roomId + "/events";
       var socket = new WebSocket(url);
       app.ports.webSocketOut.subscribe(function(message) {
         socket.send(message);
diff --git a/client/src/Client.elm b/client/src/Client.elm
index 7cac663..6b65091 100644
--- a/client/src/Client.elm
+++ b/client/src/Client.elm
@@ -42,15 +42,8 @@ type alias GameState =
 type Model
     = Error String
     | Connecting
-        { roomId : String
-        }
     | Game GameState
 
-parseRoomId : Url -> Result String String
-parseRoomId url = case String.split "/" url.path of
-    _ :: "rooms" :: roomId :: _ -> Ok roomId
-    _ -> Err <| "Invalid path: " ++ url.path
-
 viewPlayer : Messages.PlayerView -> Html msg
 viewPlayer player = Html.div [] <|
     [ Html.text player.name
@@ -64,10 +57,7 @@ view model = case model of
         [ Html.h1 [] [Html.text "Error"]
         , Html.p [] [Html.text str]
         ]
-    Connecting state ->
-        [ Html.h1 []
-            [Html.text <| "Connecting to room " ++ state.roomId ++ "..."]
-        ]
+    Connecting -> [Html.h1 [] [Html.text "Connecting to room..."]]
     Game game ->
         [ Html.h1 [] [Html.text "Players"]
         , Html.ul [] <| List.map
@@ -305,9 +295,7 @@ update msg model = case msg of
 
 main : Program () Model Msg
 main = Browser.application
-    { init = \() url key -> case parseRoomId url of
-        Err str -> (Error <| "Could not parse room ID: " ++ str, Cmd.none)
-        Ok roomId -> (Connecting {roomId = roomId}, Cmd.none)
+    { init = \() url key -> (Connecting, Cmd.none)
     , update = update
     , subscriptions = subscriptions
     , view = \model -> {title = "Client", body = view model}
diff --git a/config.mk b/config.mk
new file mode 100644
index 0000000..add25a1
--- /dev/null
+++ b/config.mk
@@ -0,0 +1,3 @@
+CAFP_HOSTNAME=127.0.0.1
+CAFP_PORT=8002
+CAFP_BASE=/cafp
diff --git a/server/lib/Cafp/Main/Server.hs b/server/lib/Cafp/Main/Server.hs
index 21cdb6f..9ded571 100644
--- a/server/lib/Cafp/Main/Server.hs
+++ b/server/lib/Cafp/Main/Server.hs
@@ -13,9 +13,13 @@ import           Control.Exception              (bracket)
 import           Control.Lens                   ((^.))
 import           Control.Monad                  (forever, when)
 import qualified Data.Aeson                     as Aeson
+import qualified Data.ByteString                as B
 import qualified Data.ByteString.Lazy           as BL
 import           Data.Foldable                  (for_)
 import qualified Data.HashMap.Strict            as HMS
+import qualified Data.List                      as L
+import           Data.Maybe                     (fromMaybe)
+import           Data.String                    (fromString)
 import qualified Data.Text                      as T
 import qualified Data.Text.Encoding             as T
 import qualified Data.Text.IO                   as T
@@ -24,6 +28,7 @@ import qualified Network.Wai                    as Wai
 import qualified Network.Wai.Handler.Warp       as Warp
 import qualified Network.Wai.Handler.WebSockets as WaiWs
 import qualified Network.WebSockets             as WS
+import           System.Environment             (getEnv)
 import qualified System.IO                      as IO
 import           System.Random                  (StdGen, newStdGen)
 import qualified Web.Scotty                     as Scotty
@@ -61,6 +66,7 @@ newRoom server gen = Room
     <$> (STM.newTVar $ newGame (serverCards server) gen)
     <*> STM.newTVar HMS.empty
 
+
 scottyApp :: IO Wai.Application
 scottyApp = Scotty.scottyApp $ do
     Scotty.get "/rooms/:id/" $ do
@@ -81,9 +87,9 @@ scottyApp = Scotty.scottyApp $ do
 routePendingConnection :: WS.PendingConnection -> Maybe RoomId
 routePendingConnection pending =
     let path = T.decodeUtf8 . WS.requestPath $ WS.pendingRequest pending in
-    case T.split (== '/') path of
-        [_, "rooms", roomId, "events"] -> Just roomId
-        _                              -> Nothing
+    case splitPath path of
+        ["rooms", roomId, "events"] -> Just roomId
+        _                           -> Nothing
 
 getOrCreateRoom :: Server -> RoomId -> IO Room
 getOrCreateRoom server roomId = MVar.modifyMVar (serverRooms server) $ \rooms ->
@@ -146,11 +152,28 @@ wsApp server pc = case routePendingConnection pc of
             Nothing -> do
                 warning $ "Could not decode client message: " ++ show msg
 
+splitPath :: T.Text -> [T.Text]
+splitPath = filter (not . T.null) . T.split (== '/')
+
+baseUrl :: [T.Text] -> Wai.Middleware
+baseUrl prefix application = \req ->
+    case L.stripPrefix prefix (Wai.pathInfo req) of
+        Nothing   -> application req
+        Just path -> application req
+            { Wai.pathInfo = path
+            , Wai.rawPathInfo = fromMaybe (Wai.rawPathInfo req) .
+                B.stripPrefix bs $ Wai.rawPathInfo req
+            }
+  where
+    bs = T.encodeUtf8 $ "/" <> T.intercalate "/" prefix
+
 main :: IO ()
 main = do
-    let port = 3000
-        settings = Warp.setPort port Warp.defaultSettings
+    host <- fromString <$> getEnv "CAFP_HOSTNAME"
+    port <- read <$> getEnv "CAFP_PORT"
+    base <- splitPath . T.pack <$> getEnv "CAFP_BASE"
+    let settings = Warp.setPort port . Warp.setHost host $ Warp.defaultSettings
     server <- newServer
     sapp <- scottyApp
-    Warp.runSettings settings $
+    Warp.runSettings settings $ baseUrl base $
         WaiWs.websocketsOr WS.defaultConnectionOptions (wsApp server) sapp
author	Jasper Van der Jeugt	2020-08-03 17:26:45 +0200
committer	Jasper Van der Jeugt	2020-08-03 17:26:45 +0200
commit	7e646e1676e08331598ae2b9518f2b1b5f999ba2 (patch)
tree	f2d25239230cfb711fbd26828e5698b94b876988
parent	9ce21e70492ca82c5554e3fa523108755fa721e8 (diff)