From 5a3fc14c1a92b28423d1b64b64e12d0502a90219 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt
Date: Sun, 16 Aug 2020 12:29:31 +0200
Subject: Move client to server
---
Makefile | 6 ---
client/index.html | 51 ------------------------
config.mk | 1 -
server/lib/Uplcg/Config.hs | 3 --
server/lib/Uplcg/Main/Server.hs | 11 ++----
server/lib/Uplcg/Version.hs | 17 ++++++++
server/lib/Uplcg/Views.hs | 88 ++++++++++++++++++++---------------------
server/uplcg.cabal | 4 ++
8 files changed, 67 insertions(+), 114 deletions(-)
delete mode 100644 client/index.html
create mode 100644 server/lib/Uplcg/Version.hs
diff --git a/Makefile b/Makefile
index e3e7947..921d0eb 100644
--- a/Makefile
+++ b/Makefile
@@ -7,7 +7,6 @@ STACK_BIN=$(shell cd server && stack path --local-install-root)/bin
.PHONY: build
build: server/assets/client.js \
- server/assets/client.html \
server/assets/style.css \
server/assets/black.txt \
server/assets/white.txt
@@ -36,11 +35,6 @@ server/assets/client.js: $(ELM_MESSAGES_SOURCE) $(ELM_SOURCES)
mkdir -p server/assets
cd client && elm make src/Client.elm --optimize --output=../$@
-.PHONY: server/assets/client.html # Depends on git hash.
-server/assets/client.html: client/index.html config.mk
- sed "s@\$$UPLCG_BASE@$(UPLCG_BASE)@" $< | \
- sed "s@\$$UPLCG_VERSION@$(UPLCG_VERSION)@" >$@
-
server/assets/style.css: client/style.css
cp $< $@
diff --git a/client/index.html b/client/index.html
deleted file mode 100644
index a03d777..0000000
--- a/client/index.html
+++ /dev/null
@@ -1,51 +0,0 @@
-
-
-
-
- Client
-
-
-
-
-
-
-
-
-
-
diff --git a/config.mk b/config.mk
index 5fd098d..ddec45c 100644
--- a/config.mk
+++ b/config.mk
@@ -1,4 +1,3 @@
UPLCG_HOSTNAME=0.0.0.0
UPLCG_PORT=8002
UPLCG_BASE=/uplcg
-UPLCG_VERSION=$(shell git rev-parse HEAD | head -c8)
diff --git a/server/lib/Uplcg/Config.hs b/server/lib/Uplcg/Config.hs
index 627a829..9197d97 100644
--- a/server/lib/Uplcg/Config.hs
+++ b/server/lib/Uplcg/Config.hs
@@ -3,7 +3,6 @@ module Uplcg.Config
, fromEnv
) where
-import Data.String (fromString)
import qualified Data.Text as T
import System.Environment (getEnv)
import Uplcg.BaseUrl (BaseUrl)
@@ -13,7 +12,6 @@ data Config = Config
{ cHostname :: String
, cPort :: Int
, cBaseUrl :: BaseUrl
- , cVersion :: String
} deriving (Show)
fromEnv :: IO Config
@@ -21,4 +19,3 @@ fromEnv = Config
<$> getEnv "UPLCG_HOSTNAME"
<*> (read <$> getEnv "UPLCG_PORT")
<*> (BaseUrl.parse . T.pack <$> getEnv "UPLCG_BASE")
- <*> getEnv "UPLCG_VERSION"
diff --git a/server/lib/Uplcg/Main/Server.hs b/server/lib/Uplcg/Main/Server.hs
index 72b9377..acf2931 100644
--- a/server/lib/Uplcg/Main/Server.hs
+++ b/server/lib/Uplcg/Main/Server.hs
@@ -9,7 +9,7 @@ import Control.Concurrent.STM (STM, TVar, atomically)
import qualified Control.Concurrent.STM as STM
import Control.Exception (bracket)
import Control.Lens ((&), (.~), (^.))
-import Control.Monad (forever, when)
+import Control.Monad (forever)
import Control.Monad.Trans (liftIO)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString as B
@@ -30,7 +30,6 @@ 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.Log.FastLogger as FL
import System.Random (StdGen, newStdGen)
import Text.Blaze.Html.Renderer.Text (renderHtml)
@@ -104,11 +103,9 @@ scottyApp server = Scotty.scottyApp $ do
Scotty.html . renderHtml $ Views.rooms (serverConfig server) views
Scotty.get "/rooms/:id/" $ do
- rid <- Scotty.param "id"
- when (T.length rid < 6) $
- Scotty.raise "Room ID should be at least 6 characters"
- Scotty.setHeader "Content-Type" "text/html"
- Scotty.file "assets/client.html"
+ rid <- Scotty.param "id" >>=
+ either (Scotty.raise . TL.pack) pure . parseRoomId
+ Scotty.html . renderHtml $ Views.client (serverConfig server) rid
Scotty.get "/assets/client.js" $ do
Scotty.setHeader "Content-Type" "application/JavaScript"
diff --git a/server/lib/Uplcg/Version.hs b/server/lib/Uplcg/Version.hs
new file mode 100644
index 0000000..b718a10
--- /dev/null
+++ b/server/lib/Uplcg/Version.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Uplcg.Version
+ ( version
+ ) where
+
+import Control.Monad.Trans (liftIO)
+import Data.Version (showVersion)
+import qualified Language.Haskell.TH as TH
+import qualified Paths_uplcg
+import System.Process (readProcess)
+
+version :: String
+version = showVersion Paths_uplcg.version ++ " (" ++
+ $(do
+ hash <- liftIO $ readProcess "git" ["rev-parse", "HEAD"] ""
+ pure . TH.LitE . TH.StringL $ take 8 hash) ++
+ ")"
diff --git a/server/lib/Uplcg/Views.hs b/server/lib/Uplcg/Views.hs
index 3cb9ebe..772c83b 100644
--- a/server/lib/Uplcg/Views.hs
+++ b/server/lib/Uplcg/Views.hs
@@ -2,15 +2,18 @@
module Uplcg.Views
( RoomView (..)
, rooms
+ , client
) where
-import Data.Foldable (for_)
-import Data.Text (Text)
-import qualified Text.Blaze.Html5 as H
-import qualified Text.Blaze.Html5.Attributes as A
import qualified Data.ByteString.Lazy.Builder as BLB
-import qualified Uplcg.BaseUrl as BaseUrl
+import Data.Foldable (for_)
+import Data.Text (Text)
+import qualified Data.Text.Encoding as T
+import qualified Text.Blaze.Html5 as H
+import qualified Text.Blaze.Html5.Attributes as A
+import qualified Uplcg.BaseUrl as BaseUrl
import Uplcg.Config
+import Uplcg.Version (version)
data RoomView = RoomView Text Int
@@ -25,7 +28,7 @@ template conf title body = H.docTypeHtml $ do
H.meta H.! A.name "viewport" H.! A.content "width=device-width"
H.body $ do
body
- H.footer $ "Untitled PL Card Game version " <> H.toHtml (cVersion conf)
+ H.footer $ "Untitled PL Card Game version " <> H.toHtml version
rooms :: Config -> [RoomView] -> H.Html
rooms conf rids = template conf "Untitled PL Card Game" $ do
@@ -43,44 +46,37 @@ client conf roomId = template conf "Untitled PL Card Game" $ do
H.div H.! A.id "main" $ ""
H.script H.! A.type_ "text/JavaScript"
H.! A.src (H.toValue $
- BaseUrl.render (cBaseUrl conf) <> "/assets/client.js")
- H.script $ H.unsafeLazyByteString $ clientScript $ BLB.toLazyByteString $
- var app = Elm.Client.init({node: document.querySelector("main")});
+ BaseUrl.render (cBaseUrl conf) <> "/assets/client.js") $ ""
+ H.script H.! A.type_ "text/JavaScript" $ H.unsafeLazyByteString entryPoint
+ where
+ t2b = BLB.byteString . T.encodeUtf8
+ entryPoint = BLB.toLazyByteString $
+ "var app = Elm.Client.init({node: document.querySelector('main')});" <>
- function connect() {
- var protocol = "ws:";
- if(document.location.protocol == "https:") {
- protocol = "wss:"
- }
- var path = document.location.pathname;
- if(path.startsWith("$UPLCG_BASE")) {
- path = path.substr("$UPLCG_BASE".length);
- }
- var roomId = path.split("/")[2];
- var url = protocol + "//" + document.location.host +
- "$UPLCG_BASE/rooms/" + roomId + "/events";
-
- var socket = new WebSocket(url);
- var socketSend = function(message) {
- socket.send(message);
- };
- app.ports.webSocketOut.subscribe(socketSend);
- socket.onmessage = function(event) {
- app.ports.webSocketIn.send(event.data);
- };
- socket.onclose = function(event) {
- app.ports.webSocketOut.unsubscribe(socketSend);
- setTimeout(function() {
- connect();
- }, 1000);
- };
- socket.onerror = function(event) {
- socket.close();
- };
- }
-
- connect();
-
-
-
-