41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
{-# 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)
|