redone backend handling and config parsing
This commit is contained in:
Dennis Frieberg
parent
4733c3e3e2
commit
c4a1a442f3
9 changed files with 177 additions and 166 deletions
39
app/Backend/Backend.hs
Normal file
39
app/Backend/Backend.hs
Normal file
|
|
@ -0,0 +1,39 @@
|
|||
module Backend.Backend where
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import qualified Network.Wai as Wai
|
||||
|
||||
#ifdef HTTP_SUPPORT
|
||||
import qualified Backend.Http as HTTP
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
import qualified Backend.Https as HTTPS
|
||||
#endif
|
||||
|
||||
-- maybe we want a String instead of T.Text depends on
|
||||
-- the argument parser
|
||||
|
||||
-- A backend consists of three things, The backend action, a Text to be
|
||||
-- used as the command line option Flag, and a Bool if it has a config file.
|
||||
--
|
||||
-- The backend action must be non blocking and fork the backend, the returned
|
||||
-- list of MVar is there to communicate the termination of the backend. (The main
|
||||
-- threat will wait till all MVar are present (not neccesarry at once)).
|
||||
-- The action takes two parameter, the application the backend should run and
|
||||
-- the path of the config File. If the Bool is False there are no guarantees on the FilePath
|
||||
-- and the action should not try to evaluate the FilePath.
|
||||
-- type Backend = (Wai.Application -> FilePath -> IO [MVar ()],T.Text,Bool)
|
||||
|
||||
data Backend =
|
||||
BackendWithConfig (Wai.Application -> FilePath -> IO [MVar ()]) String String
|
||||
| BackendWithoutConfig (Wai.Application -> IO [MVar ()]) String String
|
||||
|
||||
backends :: [Backend]
|
||||
backends =
|
||||
#ifdef HTTP_SUPPORT
|
||||
BackendWithConfig HTTP.forkHttpBackend "http" "Host as a simple http server, using Warp" :
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
BackendWithConfig HTTPS.forkHttpsBackend "https" "Host as as simple https server, using Warp" :
|
||||
#endif
|
||||
[]
|
||||
|
|
@ -1 +1,4 @@
|
|||
module Backend.CGI where
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -5,21 +5,25 @@ module Backend.Http
|
|||
( HttpConfiguration (..),
|
||||
httpDefaultSettings,
|
||||
httpDefaultSetting,
|
||||
forkHttpBackend,
|
||||
forkHttpBackend, -- key export
|
||||
httpConfigCodec,
|
||||
httpConfigsCodec,
|
||||
httpToWarpConfig,
|
||||
)
|
||||
where
|
||||
|
||||
import Config
|
||||
import qualified Config as Toml (configM,ConfigM)
|
||||
import Config hiding (configM,ConfigM)
|
||||
import Control.Concurrent.MVar(MVar)
|
||||
import Data.String
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.Wai as Wai
|
||||
import Network.Wai.Handler.Warp as HTTP
|
||||
import qualified Network.Wai.Handler.Warp as HTTP
|
||||
import Toml (TomlCodec, (.=))
|
||||
import qualified Toml
|
||||
import Data.Semigroup (getFirst, First(..))
|
||||
import Data.Maybe(fromJust)
|
||||
import Data.Coerce
|
||||
|
||||
type BindPreference = String
|
||||
|
||||
|
|
@ -30,13 +34,23 @@ bindPreference :: Toml.Key -> TomlCodec BindPreference
|
|||
bindPreference = Toml.match _BindPreference
|
||||
|
||||
data HttpConfiguration = HttpConfiguration
|
||||
{ instanceName :: T.Text,
|
||||
port :: Int,
|
||||
bindPref :: BindPreference
|
||||
{ instanceName :: Toml.ConfigM T.Text,
|
||||
port :: Toml.ConfigM Int,
|
||||
bindPref :: Toml.ConfigM BindPreference
|
||||
} deriving (Show)
|
||||
|
||||
instance Monoid HttpConfiguration where
|
||||
mempty = HttpConfiguration mempty mempty mempty
|
||||
|
||||
instance Semigroup HttpConfiguration where
|
||||
a <> b = HttpConfiguration {
|
||||
instanceName = instanceName a <> instanceName b,
|
||||
port = port a <> port b,
|
||||
bindPref = bindPref a <> bindPref b
|
||||
}
|
||||
|
||||
httpDefaultSetting :: HttpConfiguration
|
||||
httpDefaultSetting = HttpConfiguration "http" 80 "*"
|
||||
httpDefaultSetting = HttpConfiguration (setConfigM ("http" :: T.Text)) (setConfigM (80 :: Int)) (setConfigM ("*" :: BindPreference))
|
||||
|
||||
httpDefaultSettings :: [HttpConfiguration]
|
||||
httpDefaultSettings = [httpDefaultSetting]
|
||||
|
|
@ -44,9 +58,9 @@ httpDefaultSettings = [httpDefaultSetting]
|
|||
httpConfigCodec :: TomlCodec HttpConfiguration
|
||||
httpConfigCodec =
|
||||
HttpConfiguration
|
||||
<$> Toml.text "InstanceName" .= instanceName
|
||||
<*> Toml.int "Port" .= port
|
||||
<*> bindPreference "Bind" .= bindPref
|
||||
<$> Toml.configM Toml.text "InstanceName" .= instanceName
|
||||
<*> Toml.configM Toml.int "Port" .= port
|
||||
<*> Toml.configM bindPreference "Bind" .= bindPref
|
||||
|
||||
httpConfigsCodec :: TomlCodec [HttpConfiguration]
|
||||
httpConfigsCodec = Toml.list httpConfigCodec "http"
|
||||
|
|
@ -55,7 +69,12 @@ forkHttpBackend :: Wai.Application -> FilePath -> IO [MVar ()]
|
|||
forkHttpBackend app configFile = forkWithConfigs (backend app) httpConfigsCodec configFile
|
||||
|
||||
httpToWarpConfig :: HttpConfiguration -> HTTP.Settings
|
||||
httpToWarpConfig config = HTTP.setPort (port config) $ HTTP.setHost (fromString $ bindPref config) $ HTTP.defaultSettings
|
||||
httpToWarpConfig config' = HTTP.setPort confPort $ HTTP.setHost (fromString confBindPref) HTTP.defaultSettings
|
||||
where
|
||||
config = config' <> httpDefaultSetting
|
||||
confPort = getConfigM $ port config
|
||||
confBindPref = getConfigM $ bindPref config
|
||||
|
||||
|
||||
backend :: Wai.Application -> HttpConfiguration -> IO ()
|
||||
backend app config = HTTP.runSettings (httpToWarpConfig config) $ app
|
||||
backend app config = HTTP.runSettings (httpToWarpConfig config) app
|
||||
|
|
|
|||
|
|
@ -3,7 +3,8 @@
|
|||
module Backend.Https (forkHttpsBackend, httpsDefaultSettings) where
|
||||
|
||||
import Backend.Http
|
||||
import Config
|
||||
import Config hiding (ConfigM,configM)
|
||||
import qualified Config as Toml (configM,ConfigM)
|
||||
import Control.Concurrent.MVar (MVar)
|
||||
import Data.Text () -- we only need the isString instance to generate literals
|
||||
import qualified Network.Wai as Wai
|
||||
|
|
@ -15,16 +16,30 @@ import qualified Toml
|
|||
type HttpsConfiguration = (HttpConfiguration, TLSConfiguration)
|
||||
|
||||
data TLSConfiguration = TLSConfiguration
|
||||
{ certFile :: FilePath,
|
||||
certChain :: [FilePath],
|
||||
keyFile :: FilePath
|
||||
{ certFile :: Toml.ConfigM FilePath,
|
||||
certChain :: Toml.ConfigM [FilePath],
|
||||
keyFile :: Toml.ConfigM FilePath
|
||||
}
|
||||
|
||||
instance Semigroup TLSConfiguration where
|
||||
a <> b = TLSConfiguration {
|
||||
certFile = certFile a <> certFile b,
|
||||
certChain = certChain a <> certChain b,
|
||||
keyFile = keyFile a <> keyFile b
|
||||
}
|
||||
|
||||
instance Monoid TLSConfiguration where
|
||||
mempty = TLSConfiguration mempty mempty mempty
|
||||
|
||||
tlsDefaultSetting :: TLSConfiguration
|
||||
tlsDefaultSetting = TLSConfiguration "certificate.pem" [] "key.pem"
|
||||
tlsDefaultSetting = TLSConfiguration {
|
||||
certFile = setConfigM "certificate.pem",
|
||||
certChain = setConfigM [],
|
||||
keyFile = setConfigM "key.pem"
|
||||
}
|
||||
|
||||
httpsDefaultSetting :: HttpsConfiguration
|
||||
httpsDefaultSetting = (HttpConfiguration "https" 443 "*", tlsDefaultSetting)
|
||||
httpsDefaultSetting = (HttpConfiguration (setConfigM "https") (setConfigM 443) (setConfigM "*"), tlsDefaultSetting)
|
||||
|
||||
httpsDefaultSettings :: [HttpsConfiguration]
|
||||
httpsDefaultSettings = [httpsDefaultSetting]
|
||||
|
|
@ -32,9 +47,9 @@ httpsDefaultSettings = [httpsDefaultSetting]
|
|||
httpsConfigCodec' :: TomlCodec TLSConfiguration
|
||||
httpsConfigCodec' =
|
||||
TLSConfiguration
|
||||
<$> Toml.string "Certificate" .= certFile
|
||||
<*> Toml.arrayOf Toml._String "CertChain" .= certChain
|
||||
<*> Toml.string "KeyFile" .= keyFile
|
||||
<$> Toml.configM Toml.string "Certificate" .= certFile
|
||||
<*> Toml.configM (Toml.arrayOf Toml._String) "CertChain" .= certChain
|
||||
<*> Toml.configM Toml.string "KeyFile" .= keyFile
|
||||
|
||||
httpsConfigCodec :: TomlCodec HttpsConfiguration
|
||||
httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
|
||||
|
|
@ -46,7 +61,13 @@ forkHttpsBackend :: Wai.Application -> FilePath -> IO [MVar ()]
|
|||
forkHttpsBackend app configFile = forkWithConfigs (backend app) httpsConfigsCodec configFile
|
||||
|
||||
httpsToWarpTLSConfig :: HttpsConfiguration -> HTTPS.TLSSettings
|
||||
httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain (certFile tlsConfig) (certChain tlsConfig) (keyFile tlsConfig)
|
||||
httpsToWarpTLSConfig (_, tlsConfig) = HTTPS.tlsSettingsChain confCerfFile confCertChain confKeyFile
|
||||
where
|
||||
-- this has always all options set so getConfigM is safe
|
||||
config = tlsConfig <> tlsDefaultSetting
|
||||
confCerfFile = getConfigM $ certFile config
|
||||
confCertChain = getConfigM $ certChain config
|
||||
confKeyFile = getConfigM $ keyFile config
|
||||
|
||||
httpsToWarpConfig :: HttpsConfiguration -> HTTP.Settings
|
||||
httpsToWarpConfig = httpToWarpConfig . fst
|
||||
|
|
|
|||
145
app/Config.hs
145
app/Config.hs
|
|
@ -1,6 +1,9 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
module Config(Configuration(..),forkBackend,withConfigs,forkWithConfigs) where
|
||||
|
||||
module Config(forkBackend,withConfigs,forkWithConfigs,ConfigM,configM,getConfigM,setConfigM) where
|
||||
|
||||
import Data.Semigroup
|
||||
|
||||
|
||||
import Toml (TomlCodec, (.=))
|
||||
import qualified Toml
|
||||
import System.IO
|
||||
|
|
@ -8,138 +11,26 @@ import qualified Data.Text as T
|
|||
import Control.Concurrent.MVar
|
||||
import Control.Concurrent
|
||||
import WaiApp
|
||||
import Data.Maybe(fromJust)
|
||||
import Data.Coerce
|
||||
|
||||
-- this module should handle everything connected to our TOML config
|
||||
#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
|
||||
import Data.String
|
||||
import qualified Network.Wai.Handler.Warp as HTTP
|
||||
#endif
|
||||
|
||||
#ifdef HTTPS_SUPPORT
|
||||
import qualified Network.Wai.Handler.WarpTLS as HTTPS
|
||||
#endif
|
||||
-- This Type is here to replace Toml.Codec.Monoid.First as the First Monoid
|
||||
-- will be replaced with Maybe First with the First Semigroup
|
||||
type ConfigM a = Maybe (First a)
|
||||
|
||||
data Configuration = Configuration
|
||||
{ cppDummy :: () -- this is a hack to get around the , rules of haskell records and the preprocessor
|
||||
#ifdef HTTP_SUPPORT
|
||||
, httpConf :: [HttpConfiguration]
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
, httpsConf :: [(HttpConfiguration,HttpsConfiguration)]
|
||||
#endif
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
, fastCgiConf :: [FastCgiConfiguration]
|
||||
#endif
|
||||
#ifdef CGI_SUPPORT
|
||||
, cgiConf :: [CgiConfiguration]
|
||||
#endif
|
||||
}
|
||||
-- WARNING this function IS NOT total be sure the option is given!
|
||||
getConfigM :: ConfigM a -> a
|
||||
getConfigM = coerce . fromJust
|
||||
|
||||
#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
|
||||
-- We leave it as a Text here and defer the conversion to the warp type to the last possible moment.
|
||||
-- At least we can touch and print a String. Excepet that we don't use it so we don't need it in another
|
||||
-- form
|
||||
type BindPreference = String
|
||||
setConfigM :: a -> ConfigM a
|
||||
setConfigM = Just . coerce
|
||||
|
||||
_BindPreference :: Toml.TomlBiMap BindPreference Toml.AnyValue
|
||||
_BindPreference = Toml._String
|
||||
|
||||
bindPreference :: Toml.Key -> TomlCodec BindPreference
|
||||
bindPreference = Toml.match _BindPreference
|
||||
|
||||
data HttpConfiguration = HttpConfiguration
|
||||
{ port :: Int
|
||||
, bindPref :: BindPreference
|
||||
}
|
||||
httpDefaultSettings :: HttpConfiguration
|
||||
httpDefaultSettings = HttpConfiguration 80 "*"
|
||||
#endif
|
||||
|
||||
#ifdef HTTPS_SUPPORT
|
||||
data HttpsConfiguration = HttpsConfiguration
|
||||
{ certFile :: FilePath
|
||||
, certChain :: [FilePath]
|
||||
, keyFile :: FilePath
|
||||
}
|
||||
httpsDefaultSettings :: HttpsConfiguration
|
||||
httpsDefaultSettings = HttpsConfiguration "certificate.pem" [] "key.pem"
|
||||
#endif
|
||||
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
data FastCgiConfiguration = FastCgiConfiguration
|
||||
#endif
|
||||
|
||||
#ifdef CGI_SUPPORT
|
||||
data CgiConfiguration = CgiConfiguration
|
||||
#endif
|
||||
|
||||
defaultConfiguration :: Configuration
|
||||
defaultConfiguration = Configuration ()
|
||||
#ifdef HTTP_SUPPORT
|
||||
[httpDefaultSettings]
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
[(httpDefaultSettings,httpsDefaultSettings)]
|
||||
#endif
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
[FastCgiConfiguration]
|
||||
#endif
|
||||
#ifdef CGI_SUPPORT
|
||||
[CgiConfiguration]
|
||||
#endif
|
||||
|
||||
#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
|
||||
-- why a String? Why is the only way to generate a HostPreference by its IsString instance?
|
||||
-- why does warp not expose its constructors??
|
||||
httpConfigConstructor :: Int -> String -> HTTP.Settings
|
||||
httpConfigConstructor port bind = HTTP.setPort port $ HTTP.setHost (fromString bind) HTTP.defaultSettings
|
||||
httpConfigCodec :: TomlCodec HttpConfiguration
|
||||
httpConfigCodec = HttpConfiguration
|
||||
<$> Toml.int "Port" .= port
|
||||
<*> bindPreference "Bind" .= bindPref
|
||||
#endif
|
||||
|
||||
#ifdef HTTPS_SUPPORT
|
||||
httpsConfigCodec :: TomlCodec (HttpConfiguration,HttpsConfiguration)
|
||||
httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
|
||||
|
||||
httpsConfigCodec' :: TomlCodec HttpsConfiguration
|
||||
httpsConfigCodec' = HttpsConfiguration
|
||||
-- the hardcoded strings are a bloody hack, but we can't extract the values back out of a config (they are there
|
||||
-- warp just doesn't export the neccesarry types). So we hardcode default values, which is kind of realy bad, but
|
||||
-- we don't need it in our usecase
|
||||
<$> Toml.string "Certificate" .= certFile
|
||||
<*> Toml.arrayOf Toml._String "CertChain" .= certChain
|
||||
<*> Toml.string "KeyFile" .= keyFile
|
||||
#endif
|
||||
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
fastCgiConfigCodec :: TomlCodec FastCgiConfiguration
|
||||
fastCgiConfigCodec = pure FastCgiConfiguration
|
||||
#endif
|
||||
|
||||
#ifdef CGI_SUPPORT
|
||||
cgiConfigCodec :: TomlCodec CgiConfiguration
|
||||
cgiConfigCodec = pure CgiConfiguration
|
||||
#endif
|
||||
|
||||
configurationCodec :: TomlCodec Configuration
|
||||
configurationCodec = pure (Configuration ())
|
||||
#ifdef HTTP_SUPPORT
|
||||
<*> Toml.list httpConfigCodec "http" .= httpConf
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
<*> Toml.list httpsConfigCodec "https" .= httpsConf
|
||||
#endif
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
<*> Toml.list fastCgiConfigCodec "fast-cgi" .= fastCgiConf
|
||||
#endif
|
||||
#ifdef CGI_SUPPORT
|
||||
<*> Toml.list cgiConfigCodec "cgi" .= cgiConf
|
||||
#endif
|
||||
configM :: (Toml.Key -> TomlCodec a) -> Toml.Key -> TomlCodec (ConfigM a)
|
||||
configM codec = Toml.diwrap . Toml.dioptional . codec
|
||||
|
||||
forkWithConfigs :: (a -> IO ()) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
|
||||
forkWithConfigs f = withConfigs (\conf -> forkBackend $ f conf)
|
||||
forkWithConfigs f = withConfigs (forkBackend . f)
|
||||
|
||||
withConfigs :: (a -> IO (MVar ())) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
|
||||
withConfigs f codec configFile = do
|
||||
|
|
|
|||
63
app/Main.hs
63
app/Main.hs
|
|
@ -9,8 +9,11 @@ module Main where
|
|||
-- see Network.Wai.Handler.Warp.Settings and Network.Wai.Handler.Warp.runSettings
|
||||
|
||||
import Control.Concurrent.MVar
|
||||
import qualified Network.Wai as Wai
|
||||
import WaiApp
|
||||
import Control.Concurrent
|
||||
import Backend.Backend
|
||||
import Options.Applicative
|
||||
|
||||
#ifdef HTTP_SUPPORT
|
||||
import qualified Network.Wai.Handler.Warp as HTTP
|
||||
|
|
@ -29,21 +32,51 @@ import qualified Network.Wai.Handler.FastCGI as FastCGI
|
|||
import qualified Network.Wai.Handler.CGI as CGI
|
||||
#endif
|
||||
|
||||
-- we should add support for multiple backends (so we should fork them and
|
||||
-- then wait till all of them terminated)
|
||||
-- maybe we should use Control.Concurrent.ParallelIO but right
|
||||
-- now we just rely that the backends fork and don't block
|
||||
main :: IO ()
|
||||
main = do
|
||||
options <- execParser commandLineParser
|
||||
serverState <- newMVar newServerState
|
||||
#ifdef HTTP_SUPPORT
|
||||
HTTP.runSettings HTTP.defaultSettings $ waiApplication serverState
|
||||
#endif
|
||||
#ifdef HTTPS_SUPPORT
|
||||
HTTPS.runTLS HTTPS.defaultTlsSettings HTTP.defaultSettings $ waiApplication serverState
|
||||
#endif
|
||||
#ifdef FASTCGI_SUPPORT
|
||||
FastCGI.run $ waiApplication serverState
|
||||
#endif
|
||||
#ifdef CGI_SUPPORT
|
||||
CGI.run $ waiApplication serverState
|
||||
#endif
|
||||
return ()
|
||||
let backs = zipWith (runBackend $ waiApplication serverState) options backends
|
||||
waitFor' <- sequence backs
|
||||
let waitFor = concat waitFor'
|
||||
blockBackends waitFor
|
||||
|
||||
blockBackends :: [MVar ()] -> IO ()
|
||||
blockBackends = mapM_ takeMVar
|
||||
|
||||
runBackend :: Wai.Application -> Either (Maybe String) Bool -> Backend -> IO [MVar ()]
|
||||
runBackend app (Left (Just conf)) (BackendWithConfig b _ _) = b app conf
|
||||
runBackend _ (Left Nothing) (BackendWithConfig _ _ _) = return []
|
||||
runBackend app (Right True) (BackendWithoutConfig b _ _) = b app
|
||||
runBackend _ (Right False) (BackendWithoutConfig _ _ _) = return []
|
||||
runBackend _ _ _ = error "Backend and parser type don't match! THIS IS A BUG"
|
||||
|
||||
commandLineParser :: ParserInfo [Either (Maybe String) Bool]
|
||||
commandLineParser = info (combineParser ( fmap backendToParser backends) <**> helper)
|
||||
( fullDesc
|
||||
<> progDesc "a small tickLeiste Server to play Splittermond with your crew" )
|
||||
|
||||
backendToParser :: Backend -> ParserType
|
||||
backendToParser (BackendWithConfig _ name desc) = Left $ optional (strOption (long name <> help desc <> metavar "ConfigFile"))
|
||||
backendToParser (BackendWithoutConfig _ name desc) = Right $ switch (long name <> help desc)
|
||||
|
||||
type ParserType = Either (Parser (Maybe String)) (Parser Bool)
|
||||
|
||||
combineParser :: [ParserType] -> Parser [Either (Maybe String) Bool]
|
||||
combineParser = combineApplicativeList . fmap swapFunctorEither
|
||||
|
||||
-- TODO swap is a bad name, as the reversal of those operations is unclear
|
||||
-- at best (and that means impossible, if you want it to do something sensible)
|
||||
-- TODO this feels like the Left and the Right case could be handled
|
||||
-- in one case, but I don't know how to write that
|
||||
-- (except with ||| from the Arrow lib but that feels like a stupid dependency
|
||||
-- for one line) But Maybe there is a better solution using Arrow altogether
|
||||
-- (optparse has arrow instances)
|
||||
swapFunctorEither :: Functor f => Either (f a) (f b) -> f (Either a b)
|
||||
swapFunctorEither (Left p) = fmap Left p
|
||||
swapFunctorEither (Right p) = fmap Right p
|
||||
|
||||
combineApplicativeList :: Applicative f => [f a] -> f [a]
|
||||
combineApplicativeList = foldr ((<*>) . fmap (:)) (pure [])
|
||||
|
|
|
|||
|
|
@ -77,6 +77,7 @@ clientLogic conn sessionStateMVar = do
|
|||
hPrint stderr msg
|
||||
)
|
||||
-- the next line is a bit ugly, maybe there is a better way?
|
||||
-- maybe refactor, so that the request Handler can choose to lock or not. -- TODO
|
||||
(\request -> modifyMVar_ sessionStateMVar (\sessionState -> requestHandler conn sessionState request))
|
||||
(decodeStrict msg :: Maybe TL.JSONRequest)
|
||||
clientLogic conn sessionStateMVar
|
||||
|
|
@ -102,7 +103,7 @@ requestHandler conn (tl, pl, cls, sem) (TL.InitializeTickLeisteR preTickLeiste)
|
|||
|
||||
-- TODO
|
||||
-- Also TickLeisteR must be inside the modifyMVar, because we use the MVar also as a lock, and we can't
|
||||
-- have changes between reading the TickLeiste and sending it.
|
||||
-- have changes between reading the TickLeiste and sending the information.
|
||||
requestHandler conn ss@(tl, pl, cls, sem) TL.TickLeisteR = do
|
||||
sendClientEvent (TL.InitializeTickLeisteE $ tickLeisteToPlayerList pl tl) conn
|
||||
return ss
|
||||
|
|
|
|||
|
|
@ -52,6 +52,7 @@ dependencies:
|
|||
- http-types
|
||||
- tomland
|
||||
- validation-selective
|
||||
- optparse-applicative
|
||||
|
||||
when:
|
||||
- condition: flag(http)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
cabal-version: 1.12
|
||||
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.2.
|
||||
-- This file has been generated from package.yaml by hpack version 0.34.4.
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
|
||||
|
|
@ -46,6 +46,7 @@ flag https
|
|||
executable tickLeisteServer
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
Backend.Backend
|
||||
Backend.CGI
|
||||
Backend.FastCGI
|
||||
Backend.Http
|
||||
|
|
@ -65,6 +66,7 @@ executable tickLeisteServer
|
|||
, bytestring
|
||||
, containers
|
||||
, http-types
|
||||
, optparse-applicative
|
||||
, text
|
||||
, tickLeiste
|
||||
, tickLeiste-aeson
|
||||
|
|
@ -113,6 +115,7 @@ test-suite tickLeisteServer-test
|
|||
, bytestring
|
||||
, containers
|
||||
, http-types
|
||||
, optparse-applicative
|
||||
, text
|
||||
, tickLeiste
|
||||
, tickLeiste-aeson
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue