configuration parser for the http backend added

app/Config.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+module Config() where
+  
+import Toml (TomlCodec, (.=))
+import qualified Toml
+
+-- 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
+
+data Configuration = Configuration {
+#ifdef HTTP_SUPPORT
+  httpConf :: [HTTP.Settings]
+#endif
+#ifdef HTTPS_SUPPORT
+  httpsConf :: [(HTTP.Settings,HTTPS.TLSSettings)]
+#endif
+#ifdef FASTCGI_SUPPORT
+  fastCgiConf :: [FastCgiConfiguration]
+#endif
+#ifdef CGI_SUPPORT
+  cgiConf :: [CgiConfiguration]
+#endif
+  }
+
+#ifdef FASTCGI_SUPPORT
+data FastCgiConfiguration = FastCgiConfiguration
+#endif
+
+#ifdef CGI_SUPPORT
+data CgiConfiguration = CgiConfiguration
+#endif
+
+#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
+
+-- this should not need to exist!!! It is realy ugly crap, but the only we to construct and deconstruct
+-- this datatype is via fromString, read, show. And as we want the fromString syntax we want an inverse
+-- of it too, but we don't get something nice exposed. Also we don't get the constructors exposed so we
+-- pattern match on Strings, this is a hack!!!
+httpShowHostPreference :: HTTP.HostPreference -> String
+httpShowHostPreference pref = case show pref of
+  "HostAny" -> "*"
+  "HostIPv4" -> "*4"
+  "HostIPv4Only" -> "!4"
+  "HostIPv6" -> "*6"
+  "HostIPv6Only" -> "!6"
+  x -> drop 6 $ init x
+-- 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 HTTP.Settings
+httpConfigCodec = httpConfigConstructor
+  <$> Toml.int "Port"    .= HTTP.getPort
+  <*> Toml.string "Bind" .= (httpShowHostPreference . HTTP.getHost)
+#endif
+
+configurationCodec :: TomlCodec Configuration
+configurationCodec = pure Configuration
+#ifdef HTTP_SUPPORT
+  <*> Toml.list httpConfigCodec "http" .= httpConf
+#endif

app/Main.hs

@@ -10,6 +10,7 @@ module Main where
 
 import Control.Concurrent.MVar
 import WaiApp
+import Control.Concurrent
 
 #ifdef HTTP_SUPPORT
 import qualified Network.Wai.Handler.Warp as HTTP
@@ -28,6 +29,8 @@ 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)
 main :: IO ()
 main = do
   serverState <- newMVar newServerState

package.yaml

@@ -50,6 +50,7 @@ dependencies:
 - wai
 - wai-websockets
 - http-types
+- tomland
 
 when:
   - condition: flag(http)

stack.yaml

@@ -47,6 +47,9 @@ extra-deps:
 
 # Override default flag values for local packages and extra-deps
 # flags: {}
+flags:
+  tickLeisteServer:
+    http: true
 
 # Extra package databases containing global packages
 # extra-package-dbs: []

tickLeisteServer.cabal

@@ -46,6 +46,7 @@ flag https
 executable tickLeisteServer
   main-is: Main.hs
   other-modules:
+      Config
       WaiApp
       WebSocketApp
       Paths_tickLeisteServer
@@ -63,6 +64,7 @@ executable tickLeisteServer
     , text
     , tickLeiste
     , tickLeiste-aeson
+    , tomland
     , uuid
     , wai
     , wai-websockets
@@ -110,6 +112,7 @@ test-suite tickLeisteServer-test
     , tickLeiste
     , tickLeiste-aeson
     , tickLeisteServer
+    , tomland
     , uuid
     , wai
     , wai-websockets