{-# LANGUAGE CPP #-}
#ifndef HTTP_SUPPORT
module Backend.Http
where


#else
{-# 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, -- key export
    httpConfigCodec,
    httpConfigsCodec,
    httpToWarpConfig,
  )
where

import qualified Config as Toml (configM,ConfigM)
import Config hiding (configM,ConfigM)
import Control.Concurrent.MVar(MVar)
import Data.String
import qualified Data.Text as T
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as HTTP
import Toml (TomlCodec, (.=))
import qualified Toml
import Data.Semigroup (getFirst, First(..))
import Data.Maybe(fromJust)
import Data.Coerce
import Environment
import Control.Monad.IO.Class

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 :: Toml.ConfigM T.Text,
    port :: Toml.ConfigM Int,
    bindPref :: Toml.ConfigM BindPreference
  } deriving (Show)

instance Monoid HttpConfiguration where
  mempty = HttpConfiguration mempty mempty mempty

instance Semigroup HttpConfiguration where
  a <> b = HttpConfiguration {
    instanceName = instanceName a <> instanceName b,
    port         = port a         <> port b,
    bindPref     = bindPref a     <> bindPref b
  }

httpDefaultSetting :: HttpConfiguration
httpDefaultSetting = HttpConfiguration (setConfigM ("http" :: T.Text)) (setConfigM (80 :: Int)) (setConfigM ("*" :: BindPreference))

httpDefaultSettings :: [HttpConfiguration]
httpDefaultSettings = [httpDefaultSetting]

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

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

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

httpToWarpConfig :: HttpConfiguration -> HTTP.Settings
httpToWarpConfig config' = HTTP.setPort confPort $ HTTP.setHost (fromString confBindPref) HTTP.defaultSettings
  where
    config = config' <> httpDefaultSetting
    confPort = getConfigM  $ port config
    confBindPref = getConfigM $ bindPref config


backend :: Wai.Application -> HttpConfiguration -> EnvM ()
backend app config = liftIO $ HTTP.runSettings (httpToWarpConfig config) app
#endif