58 lines
1.5 KiB
Haskell
58 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
-- Breve modules
|
|
import Application
|
|
import Breve.Settings
|
|
import Breve.UrlTable
|
|
import Paths_breve (getDataFileName)
|
|
|
|
-- Data conversions
|
|
import Data.Text (Text, unpack)
|
|
import Data.String (IsString(..))
|
|
import Data.Maybe (listToMaybe)
|
|
|
|
-- IO
|
|
import System.Environment (getArgs)
|
|
import Data.Text.IO as T
|
|
|
|
-- Web server
|
|
import Servant (Application)
|
|
import Network.Wai.Handler.Warp (defaultSettings, setPort, setHost)
|
|
import Network.Wai.Handler.WarpTLS (runTLS, TLSSettings)
|
|
|
|
-- Middlewares
|
|
import Network.Wai.Middleware.ForceSSL (forceSSL)
|
|
import Network.Wai.Middleware.RequestLogger (logStdout)
|
|
|
|
|
|
-- * Helpers
|
|
|
|
-- | Runs Breve on the Warp webserver
|
|
run :: AppSettings -> Application -> IO ()
|
|
run (AppSettings{..}) =
|
|
runTLS tlsSettings warpSettings
|
|
where
|
|
host = unpack bindHost
|
|
warpSettings = setPort bindPort $
|
|
setHost (fromString host) defaultSettings
|
|
|
|
-- | Main
|
|
--
|
|
-- Reads the config (given as the unique argument)
|
|
-- and runs the breve web app
|
|
main :: IO ()
|
|
main = do
|
|
configPath <- fmap listToMaybe getArgs
|
|
config@(AppSettings{..}) <- settings configPath
|
|
table <- load urlTable
|
|
static <- getDataFileName "static/"
|
|
|
|
let
|
|
middlewares =
|
|
logStdout .
|
|
(if bindPort == 433 then forceSSL else id)
|
|
|
|
T.putStrLn ("Serving on " <> bindUrl)
|
|
run config (middlewares $ breve static bindUrl table)
|