aboutsummaryrefslogtreecommitdiff
path: root/server/lib/Uplcg/Main
diff options
context:
space:
mode:
authorJasper Van der Jeugt2020-08-16 10:21:14 +0200
committerJasper Van der Jeugt2020-08-16 10:21:14 +0200
commit9f2d12f0b098a365d7b0d4cc00b03fd2e5284740 (patch)
treebab2b7de1ccdb4618640cc951490d51ed8c66938 /server/lib/Uplcg/Main
parent41622353bc3309921109f44bc0163e0987c20052 (diff)
WIP
Diffstat (limited to 'server/lib/Uplcg/Main')
-rw-r--r--server/lib/Uplcg/Main/Server.hs26
1 files changed, 14 insertions, 12 deletions
diff --git a/server/lib/Uplcg/Main/Server.hs b/server/lib/Uplcg/Main/Server.hs
index bd89540..72b9377 100644
--- a/server/lib/Uplcg/Main/Server.hs
+++ b/server/lib/Uplcg/Main/Server.hs
@@ -36,6 +36,8 @@ import System.Random (StdGen, newStdGen)
import Text.Blaze.Html.Renderer.Text (renderHtml)
import Uplcg.BaseUrl (BaseUrl)
import qualified Uplcg.BaseUrl as BaseUrl
+import Uplcg.Config (Config)
+import qualified Uplcg.Config as Config
import qualified Uplcg.CookieSocket as CookieSocket
import Uplcg.Game
import Uplcg.Messages
@@ -53,7 +55,7 @@ data Room = Room
}
data Server = Server
- { serverBaseUrl :: BaseUrl
+ { serverConfig :: Config
, serverLogger :: FL.FastLogger
, serverCookieSocket :: CookieSocket.Handle Player
, serverCards :: Cards
@@ -68,9 +70,9 @@ readCards = Cards
parseCards = V.fromList . filter (not . T.null) . map dropComment . T.lines
dropComment = T.strip . fst . T.break (== '#')
-withServer :: BaseUrl -> FL.FastLogger -> (Server -> IO a) -> IO a
-withServer base fl f = CookieSocket.withHandle 5 $ \cs -> do
- f =<< Server base fl cs <$> readCards <*> MVar.newMVar HMS.empty
+withServer :: Config -> FL.FastLogger -> (Server -> IO a) -> IO a
+withServer conf fl f = CookieSocket.withHandle 5 $ \cs -> do
+ f =<< Server conf fl cs <$> readCards <*> MVar.newMVar HMS.empty
newRoom :: RoomId -> Cards -> StdGen -> STM Room
newRoom rid cards gen = Room rid
@@ -95,11 +97,11 @@ scottyApp :: Server -> IO Wai.Application
scottyApp server = Scotty.scottyApp $ do
Scotty.get "/" $
Scotty.redirect $ TL.fromStrict $
- BaseUrl.render (serverBaseUrl server) <> "/rooms"
+ BaseUrl.render (Config.cBaseUrl $ serverConfig server) <> "/rooms"
Scotty.get "/rooms" $ do
views <- liftIO $ roomViews server
- Scotty.html . renderHtml $ Views.rooms (serverBaseUrl server) views
+ Scotty.html . renderHtml $ Views.rooms (serverConfig server) views
Scotty.get "/rooms/:id/" $ do
rid <- Scotty.param "id"
@@ -223,15 +225,15 @@ baseUrl base@(BaseUrl.BaseUrl prefix) application = \req ->
main :: IO ()
main = do
- host <- fromString <$> getEnv "UPLCG_HOSTNAME"
- port <- read <$> getEnv "UPLCG_PORT"
- base <- BaseUrl.parse . T.pack <$> getEnv "UPLCG_BASE"
- let settings = Warp.setPort port . Warp.setHost host $ Warp.defaultSettings
+ config <- Config.fromEnv
+ let settings = Warp.setPort (Config.cPort config) .
+ Warp.setHost (fromString $ Config.cHostname config) $
+ Warp.defaultSettings
timeCache <- FL.newTimeCache FL.simpleTimeFormat
FL.withTimedFastLogger timeCache
(FL.LogStderr FL.defaultBufSize) $ \tfl ->
let fl s = tfl (\time -> FL.toLogStr time <> " " <> s <> "\n") in
- withServer base fl $ \server -> do
+ withServer config fl $ \server -> do
sapp <- scottyApp server
- Warp.runSettings settings $ baseUrl base $
+ Warp.runSettings settings $ baseUrl (Config.cBaseUrl config) $
WaiWs.websocketsOr WS.defaultConnectionOptions (wsApp server) sapp