{-# LANGUAGE RecordWildCards #-}

{-|
This is the main module, which actually
run the Breve webserver.
-}
module Main where

-- Breve modules
import Application     (breve, emptyApp)
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 Control.Monad      (when, void)
import Control.Exception  as E 
import Control.Concurrent (forkIO)
import System.Environment (getArgs)
import Data.Text.IO       as T

-- Web server
import Servant                      (Application)
import Network.Wai.Handler.Warp     (run, defaultSettings, setPort, setHost)
import Network.Wai.Handler.WarpTLS  (runTLS, TLSSettings)

-- 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
  static                   <- getDataFileName "static/"

  -- 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

  handle exit $ do
    T.putStrLn ("Serving on " <> bindUrl)
    runApp config (middlewares $ breve static bindUrl table)