{-# LANGUAGE OverloadedStrings #-}

-- we export a bit more than we have to, because the https module can reuse these things.
module Backend.Http
  ( HttpConfiguration (..),
    httpDefaultSettings,
    httpDefaultSetting,
    forkHttpBackend,
    httpConfigCodec,
    httpConfigsCodec,
    httpToWarpConfig,
  )
where

import Config
import Control.Concurrent.MVar(MVar)
import Data.String
import qualified Data.Text as T
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp as HTTP
import Toml (TomlCodec, (.=))
import qualified Toml

type BindPreference = String

_BindPreference :: Toml.TomlBiMap BindPreference Toml.AnyValue
_BindPreference = Toml._String

bindPreference :: Toml.Key -> TomlCodec BindPreference
bindPreference = Toml.match _BindPreference

data HttpConfiguration = HttpConfiguration
  { instanceName :: T.Text,
    port :: Int,
    bindPref :: BindPreference
  }

httpDefaultSetting :: HttpConfiguration
httpDefaultSetting = HttpConfiguration "http" 80 "*"

httpDefaultSettings :: [HttpConfiguration]
httpDefaultSettings = [httpDefaultSetting]

httpConfigCodec :: TomlCodec HttpConfiguration
httpConfigCodec =
  HttpConfiguration
    <$> Toml.text "InstanceName" .= instanceName
    <*> Toml.int "Port" .= port
    <*> bindPreference "Bind" .= bindPref

httpConfigsCodec :: TomlCodec [HttpConfiguration]
httpConfigsCodec = Toml.list httpConfigCodec "http"

forkHttpBackend :: Wai.Application -> FilePath -> IO [MVar ()]
forkHttpBackend app configFile = forkWithConfigs (backend app) httpConfigsCodec configFile

httpToWarpConfig :: HttpConfiguration -> HTTP.Settings
httpToWarpConfig config = HTTP.setPort (port config) $ HTTP.setHost (fromString $ bindPref config) $ HTTP.defaultSettings

backend :: Wai.Application -> HttpConfiguration -> IO ()
backend app config = HTTP.runSettings (httpToWarpConfig config) $ app