Use TLS
This commit is contained in:
parent
9f0e3c902c
commit
868f80b5a1
@ -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
|
||||||
}
|
}
|
||||||
|
15
src/Main.hs
15
src/Main.hs
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user