{-# 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)