started refactor into seperate backend_files
This commit is contained in:
parent
0b1e9339e2
commit
04300a161e
6 changed files with 64 additions and 0 deletions
1
app/Backend/CGI.hs
Normal file
1
app/Backend/CGI.hs
Normal file
|
@ -0,0 +1 @@
|
|||
module Backend.CGI where
|
1
app/Backend/FastCGI.hs
Normal file
1
app/Backend/FastCGI.hs
Normal file
|
@ -0,0 +1 @@
|
|||
module Backend.FastCGI where
|
54
app/Backend/Http.hs
Normal file
54
app/Backend/Http.hs
Normal file
|
@ -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
|
||||
|
1
app/Backend/Https.hs
Normal file
1
app/Backend/Https.hs
Normal file
|
@ -0,0 +1 @@
|
|||
module Backend.Https where
|
|
@ -51,6 +51,7 @@ dependencies:
|
|||
- wai-websockets
|
||||
- http-types
|
||||
- tomland
|
||||
- validation-selective
|
||||
|
||||
when:
|
||||
- condition: flag(http)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue