content: {-# LANGUAGE OverloadedStrings #-}
  module Main where
  
  import qualified Data.ByteString.Char8 as C8
  import Data.Maybe (fromMaybe)
  import qualified Data.List as List
  import qualified Data.Text as T
  import Data.Version (showVersion)
  import Network.Wai
  import qualified Network.Wai.Handler.WarpTLS as TLS
  import Network.Wai.Middleware.Static
  import Network.HTTP.Types (status404)
  import Network.Wai.Handler.Warp ( runSettings
                                  , defaultSettings
                                  , setPort
                                  , setFdCacheDuration
                                  , setFileInfoCacheDuration
                                  , setServerName
                                  )
  import System.Exit (die)
  import System.Environment (lookupEnv)
  import Text.Read (readMaybe)
  import Paths_hastatic (version)
  
  data TLS = Okay TLS.TLSSettings | Error String | None
  
  addSecureHeaders :: Middleware
  addSecureHeaders = modifyResponse $ mapResponseHeaders (++ secureHeaders)
    where
      secureHeaders = [ ("Referrer-Policy", "strict-origin-when-cross-origin")
                      , ("X-Frame-Options", "SAMEORIGIN")
                      , ("X-XSS-Protection", "1; mode=block")
                      ]
  
  indexHTML :: T.Text -> Middleware
  indexHTML indexFile app req respond =
    let path = pathInfo req
    in flip app respond $ req { pathInfo = fixPath path }
    where
      fixPath path = case path of
        []     -> [indexFile]
        [""]   -> [indexFile]
        [x]    -> if "." `T.isInfixOf` x then [x] else [x, indexFile]
        (x:xs) -> x : fixPath xs
  
  notFoundHandler :: FilePath -> Application
  notFoundHandler notFoundFile _ respond = respond $
    responseFile status404 [("Content-Type", "text/html")] notFoundFile Nothing
  
  getTLSSettings :: IO TLS
  getTLSSettings = do
    tlsCertFile <- lookupEnv "TLS_CERT_FILE"
    tlsKeyFile  <- lookupEnv "TLS_KEY_FILE"
  
    case (tlsCertFile, tlsKeyFile) of
      (Nothing, Nothing)    -> return None
      (Just cert, Just key) -> return $ Okay $ TLS.tlsSettings cert key
      _                     -> return $ Error "Certificate file or Key file is missing"
  
  application :: [FilePath] -> IO Application
  application excludedPaths = do
    notFoundFile <- fromMaybe "404.html" <$> lookupEnv "NF_FILE"
    indexFile    <- T.pack . fromMaybe "index.html" <$> lookupEnv "IDX_FILE"
    cache        <- initCaching PublicStaticCaching
    return
      . addSecureHeaders
      . indexHTML indexFile
      . staticPolicy' cache polcy
      . notFoundHandler
      $ notFoundFile
    where
      noDot = not . List.isPrefixOf "."
      polcy = predicate noDot >-> predicate (not . flip elem excludedPaths)
  
  main :: IO ()
  main = do
    mPort        <- lookupEnv "PORT"
    let port     = fromMaybe 3000 (readMaybe =<< mPort)
    tlsSettings  <- getTLSSettings
    let settings = setPort port
                   . setFdCacheDuration 10
                   . setFileInfoCacheDuration 10
                   . setServerName ("hastatic-" <> C8.pack (showVersion version))
                   $ defaultSettings
  
    case tlsSettings of
      Okay tls  -> do
        app <- application [TLS.certFile tls, TLS.keyFile tls]
        putStrLn $ "Starting HTTPS server on port: " <> show port
        TLS.runTLS tls settings app
      None      -> do
        app <- application []
        putStrLn $ "Starting HTTP server on port: " <> show port
        runSettings settings app
      Error msg ->
        die $ "Error starting server: " <> msg
  