67 lines
1.8 KiB
Haskell
67 lines
1.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
{-|
|
|
This is the main module, which actually
|
|
run the Breve webserver.
|
|
-}
|
|
module Main where
|
|
|
|
-- 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 configuration (given as the unique cli argument),
|
|
-- sets things accordingly and runs the webserver.
|
|
main :: IO ()
|
|
main = do
|
|
configPath <- fmap listToMaybe getArgs
|
|
config@(AppSettings{..}) <- settings configPath
|
|
table <- load urlTable
|
|
static <- getDataFileName "static/"
|
|
|
|
-- Middlewares are just functions of type
|
|
-- (Application -> Application). We use a couple here
|
|
-- to add requests logging and HTTPS redirection.
|
|
let
|
|
middlewares =
|
|
logStdout .
|
|
(if bindPort == 433 then forceSSL else id)
|
|
|
|
T.putStrLn ("Serving on " <> bindUrl)
|
|
run config (middlewares $ breve static bindUrl table)
|