{-# LANGUAGE OverloadedStrings #-}

module Backend.Http
  ( HttpConfiguration (..),
    httpDefaultSettings,
    httpDefaultSetting,
    forkHttpBackend,
    httpConfigCodec,
    httpConfigsCodec,
  )
where

import Config
import Control.Concurrent
import Control.Concurrent.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

-- We leave it as a Text here and defer the conversion to the warp type to the last possible moment.
-- At least we can touch and print a String. Excepet that we don't use it so we don't need it in another
-- form

-- even though this is just a String alias, we leave the infrastructure in place. Maybe we want to change that
-- type at some point. Then we can redifne the stuff to work with our new type.
-- One can think about this as being accidantally a String, and not by design.
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]

-- why a String? Why is the only way to generate a HostPreference by its IsString instance?
-- why does warp not expose its constructors??
httpConfigConstructor :: Int -> String -> HTTP.Settings
httpConfigConstructor port bind = HTTP.setPort port $ HTTP.setHost (fromString bind) HTTP.defaultSettings

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