diff --git a/app/Backend/CGI.hs b/app/Backend/CGI.hs new file mode 100644 index 0000000..9f8997f --- /dev/null +++ b/app/Backend/CGI.hs @@ -0,0 +1 @@ +module Backend.CGI where diff --git a/app/Backend/FastCGI.hs b/app/Backend/FastCGI.hs new file mode 100644 index 0000000..e51ba7d --- /dev/null +++ b/app/Backend/FastCGI.hs @@ -0,0 +1 @@ +module Backend.FastCGI where diff --git a/app/Backend/Http.hs b/app/Backend/Http.hs new file mode 100644 index 0000000..54e8de7 --- /dev/null +++ b/app/Backend/Http.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Backend.Http + ( HttpConfiguration (..), + httpDefaultSettings, + ) +where + +import Data.String +import qualified Data.Text as T +import Network.Wai.Handler.Warp as HTTP +import Toml (TomlCodec, (.=)) +import Control.Concurrent +import Control.Concurrent.MVar +import qualified Toml +import Validation + +-- 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 + +-- even though this is just a String alias, we leave the infrastructure in place. Maybe we want to change that +-- type at some point. Then we can redifne the stuff to work with our new type. +-- One can think about this as being accidantally a String, and not by design. +type BindPreference = String + +_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 "*" + +-- 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 + +forkHttpBackend :: Toml.TOML -> IO [MVar ()] +forkHttpBackend ast = undefined + diff --git a/app/Backend/Https.hs b/app/Backend/Https.hs new file mode 100644 index 0000000..86e00e0 --- /dev/null +++ b/app/Backend/Https.hs @@ -0,0 +1 @@ +module Backend.Https where diff --git a/package.yaml b/package.yaml index e0ab188..c3bdb37 100644 --- a/package.yaml +++ b/package.yaml @@ -51,6 +51,7 @@ dependencies: - wai-websockets - http-types - tomland +- validation-selective when: - condition: flag(http) diff --git a/tickLeisteServer.cabal b/tickLeisteServer.cabal index 7ea295a..8725117 100644 --- a/tickLeisteServer.cabal +++ b/tickLeisteServer.cabal @@ -46,6 +46,10 @@ flag https executable tickLeisteServer main-is: Main.hs other-modules: + Backend.CGI + Backend.FastCGI + Backend.Http + Backend.Https Config WaiApp WebSocketApp @@ -66,6 +70,7 @@ executable tickLeisteServer , tickLeiste-aeson , tomland , uuid + , validation-selective , wai , wai-websockets , websockets @@ -114,6 +119,7 @@ test-suite tickLeisteServer-test , tickLeisteServer , tomland , uuid + , validation-selective , wai , wai-websockets , websockets