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

View File

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