master
rnhmjoj 2015-08-01 02:13:16 +02:00
parent 9f0e3c902c
commit 868f80b5a1
2 changed files with 21 additions and 14 deletions

View File

@ -6,12 +6,13 @@ import System.Environment (lookupEnv)
import System.Environment.XDG.BaseDir import System.Environment.XDG.BaseDir
import System.Directory (doesFileExist) import System.Directory (doesFileExist)
import Data.Configurator import Data.Configurator
import Data.Monoid import Network.Wai.Handler.WarpTLS (tlsSettings, TLSSettings)
data AppSettings = AppSettings data AppSettings = AppSettings
{ bindPort :: Int { bindPort :: Int
, bindUrl :: String , bindUrl :: String
, urlTable :: FilePath , urlTable :: FilePath
, tlsSetts :: TLSSettings
} }
@ -27,19 +28,22 @@ settings = do
configPath <- getUserConfigFile "breve" "" configPath <- getUserConfigFile "breve" ""
config <- load [Required configPath] config <- load [Required configPath]
host <- lookupDefault "localhost" config "hostname" host <- lookupDefault "localhost" config "hostname"
port <- lookupDefault 3000 config "port" port <- lookupDefault 3000 config "port"
urls <- lookupDefault urlsPath config "urltable" cert <- lookupDefault "/usr/share/tls/breve.crt" config "cert"
key <- lookupDefault "/usr/share/tls/breve.key" config "key"
urls <- lookupDefault urlsPath config "urltable"
createEmptyIfMissing urls createEmptyIfMissing urls
let base = "http://" <> host let base = "https://" ++ host
url = if port == 80 url = if port == 443
then base then base
else base <> ":" <> show port else base ++ ":" ++ show port
return AppSettings return AppSettings
{ bindPort = port { bindPort = port
, bindUrl = url <> "/" , bindUrl = url ++ "/"
, urlTable = urls , urlTable = urls
, tlsSetts = tlsSettings cert key
} }

View File

@ -5,18 +5,21 @@ import Breve.Settings
import Breve.UrlTable import Breve.UrlTable
import Web.Spock.Safe import Web.Spock.Safe
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.WarpTLS (runTLS, TLSSettings)
import Network.Wai.Handler.Warp (defaultSettings, setPort)
runBreve :: Int -> SpockT IO () -> IO ()
runBreve port app = spockAsApp (spockT id app) >>= run port
runBreve :: TLSSettings -> Int -> SpockT IO () -> IO ()
runBreve tls port spock =
spockAsApp (spockT id spock) >>= runTLS tls settings
where settings = setPort port defaultSettings
main :: IO () main :: IO ()
main = do main = do
AppSettings { bindUrl AppSettings { bindUrl
, bindPort , bindPort
, urlTable } <- settings , urlTable
, tlsSetts } <- settings
table <- load urlTable table <- load urlTable
putStrLn ("Serving on " ++ bindUrl) putStrLn ("Serving on " ++ bindUrl)
runBreve bindPort (app bindUrl table) runBreve tlsSetts bindPort (app bindUrl table)