breve-0.4.2.0: src/Main.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}

import Application
import Breve.Settings
import Breve.UrlTable

import Data.Text          (Text, unpack)
import Control.Concurrent (forkIO)
import Control.Monad

import Web.Spock.Safe
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
  AppSettings {..} <- settings
  table            <- load urlTable

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

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