{-# LANGUAGE RecordWildCards #-} {-| This is the main module, which actually run the Breve webserver. -} module Main where -- Breve modules import Application (AppEnv(..), breve, emptyApp) import Breve.Settings (AppSettings(..), settings) import Breve.UrlTable -- Data conversions import Data.String (IsString(..)) import Data.Maybe (listToMaybe) import Data.Text (unpack) -- IO import Data.Text.IO as T import Control.Exception as E import Control.Monad (when, void) import Control.Concurrent (forkIO) import System.Environment (getArgs) -- Web server import Servant (Application) import Network.Wai.Handler.Warp (run, defaultSettings, setPort, setHost) import Network.Wai.Handler.WarpTLS (runTLS) -- Middlewares import Network.Wai.Middleware.RequestLogger (logStdout) import Network.Wai.Middleware.ForceSSL (forceSSL) -- * Helpers -- | Runs Breve on the Warp webserver runApp :: AppSettings -> Application -> IO () runApp (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 -- Redirect from HTTP to HTTPS when listening -- on the standard port when (bindPort == 443) $ void $ forkIO (run 80 $ forceSSL emptyApp) -- Save the table just before exiting let exit E.UserInterrupt = save table urlTable exit e = throwIO e -- Middlewares are functions (Application -> Application). -- We use one here to add requests let middlewares = logStdout -- The environment needed while running let env = AppEnv bindUrl table staticDir handle exit $ do T.putStrLn ("Serving on " <> bindUrl) runApp config (middlewares $ breve env)