breve-0.4.4.0: src/Main.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}

import Application
import Breve.Settings
import Breve.UrlTable

import Data.Text          (Text, unpack)
import Data.Maybe         (listToMaybe)
import Control.Concurrent (forkIO)
import Control.Monad
import System.Environment (getArgs)

import Web.Spock.Core
import Network.Wai.Handler.WarpTLS (runTLS, TLSSettings)
import Network.Wai.Handler.Warp    (run, defaultSettings, setPort)

runBreve :: TLSSettings -> Int -> SpockT IO () -> IO ()
runBreve tlsSettings port spock =
  spockAsApp (spockT id spock) >>= runTLS tlsSettings settings
  where settings = setPort port defaultSettings


runTLSRedirect :: Text -> IO ()
runTLSRedirect = spockAsApp . spockT id . toTLS >=> run 80


forkIO' :: IO () -> IO ()
forkIO' = fmap (const ()) . forkIO


main :: IO ()
main = do
  configPath       <- fmap listToMaybe getArgs
  AppSettings {..} <- settings configPath
  table            <- load urlTable

  when (bindPort == 443) (forkIO' $ runTLSRedirect bindHost)

  putStrLn ("Serving on " ++ unpack bindUrl)
  runBreve tlsSettings bindPort (app bindUrl table)