{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import ChuSQL.Web.Api (AppEnv (..), Live (..), newAppEnv, setLive, webApp)
import ChuSQL.Web.Auth (SessionPolicy (..), newSessionStore)
import ChuSQL.Web.Backend (Backend, ipcBackend)
import ChuSQL.Web.Demo (SeedReport (..), seedDemo)
import ChuSQL.Web.Config (
    WebConfig (..),
    defaultPassword,
    defaultUser,
    loadWebConfig,
    resolveCredential,
    resolveStaticDir,
    staticDirCandidates,
    usingDefaultCredentials,
 )
import ChuSQL.Web.RateLimit (newRateLimiter)
import ChuSQL.Web.Settings (effectiveSettings)
import ChuSQL.Web.StorageProcess (
    StorageProcess (..),
    findStorageServer,
    startStorageProcess,
    stopStorageProcess,
    waitForStorage,
 )
import Control.Exception (IOException, bracket, try)
import Data.Char (toLower)
import Data.String (fromString)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Time.Clock (getCurrentTime)
import Network.Wai (Application)
import qualified Network.Wai.Handler.Warp as Warp
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)
import Text.Read (readMaybe)

-- Web 管理端入口：读配置、备凭据、拉起存储进程，最后起 Warp。

data Options = Options
    { optHost :: Maybe String
    , optPort :: Maybe Int
    , optStatic :: Maybe FilePath
    , optStorage :: Maybe FilePath
    , optUser :: Maybe Text
    , optCookieSecure :: Maybe Bool
    , optBodyLimit :: Maybe Int
    , optSessionIdle :: Maybe Int
    , optSessionMax :: Maybe Int
    , optLoginMaxAttempts :: Maybe Int
    , optLoginWindow :: Maybe Int
    , optPageSize :: Maybe Int
    , optMaxPageSize :: Maybe Int
    , optMaxRows :: Maybe Int
    , optMaxSqlLength :: Maybe Int
    , optSeedDemo :: Maybe Bool
    , optHelp :: Bool
    }

-- | 一个开关都没给
emptyOptions :: Options
emptyOptions =
    Options
        { optHost = Nothing
        , optPort = Nothing
        , optStatic = Nothing
        , optStorage = Nothing
        , optUser = Nothing
        , optCookieSecure = Nothing
        , optBodyLimit = Nothing
        , optSessionIdle = Nothing
        , optSessionMax = Nothing
        , optLoginMaxAttempts = Nothing
        , optLoginWindow = Nothing
        , optPageSize = Nothing
        , optMaxPageSize = Nothing
        , optMaxRows = Nothing
        , optMaxSqlLength = Nothing
        , optSeedDemo = Nothing
        , optHelp = False
        }

-- | 解析参数
parseArgs :: [String] -> Either String Options
parseArgs = go emptyOptions
  where
    go opts [] = Right opts
    go opts ("--help" : rest) = go opts{optHelp = True} rest
    go opts ("-h" : rest) = go opts{optHelp = True} rest
    go opts ("--host" : v : rest) = go opts{optHost = Just v} rest
    go opts ("--static" : v : rest) = go opts{optStatic = Just v} rest
    go opts ("--storage" : v : rest) = go opts{optStorage = Just v} rest
    go opts ("--user" : v : rest) = go opts{optUser = Just (T.pack v)} rest
    go opts ("--port" : v : rest) = withInt "--port" v (\n -> go opts{optPort = Just n} rest)
    go opts ("--body-limit" : v : rest) = withInt "--body-limit" v (\n -> go opts{optBodyLimit = Just n} rest)
    go opts ("--session-idle" : v : rest) = withInt "--session-idle" v (\n -> go opts{optSessionIdle = Just n} rest)
    go opts ("--session-max" : v : rest) = withInt "--session-max" v (\n -> go opts{optSessionMax = Just n} rest)
    go opts ("--login-max-attempts" : v : rest) = withInt "--login-max-attempts" v (\n -> go opts{optLoginMaxAttempts = Just n} rest)
    go opts ("--login-window" : v : rest) = withInt "--login-window" v (\n -> go opts{optLoginWindow = Just n} rest)
    go opts ("--page-size" : v : rest) = withInt "--page-size" v (\n -> go opts{optPageSize = Just n} rest)
    go opts ("--max-page-size" : v : rest) = withInt "--max-page-size" v (\n -> go opts{optMaxPageSize = Just n} rest)
    go opts ("--max-rows" : v : rest) = withInt "--max-rows" v (\n -> go opts{optMaxRows = Just n} rest)
    go opts ("--max-sql-length" : v : rest) = withInt "--max-sql-length" v (\n -> go opts{optMaxSqlLength = Just n} rest)
    go opts ("--seed" : v : rest) = go opts{optSeedDemo = Just (isTrue v)} rest
    go opts ("--cookie-secure" : v : rest) = go opts{optCookieSecure = Just (isTrue v)} rest
    go _ (a : _) = Left ("unrecognized argument or missing value: " ++ a)

    -- | 读一个整数开关
    withInt :: String -> String -> (Int -> Either String Options) -> Either String Options
    withInt name v k = maybe (Left (name ++ " needs an integer, got: " ++ v)) k (readMaybe v)

    -- | 布尔开关认 1/true/yes/on
    isTrue :: String -> Bool
    isTrue s = map toLower s `elem` ["1", "true", "yes", "on"]

-- | 帮助
usage :: IO ()
usage = do
    putStrLn "usage: chusql-web [options]"
    putStrLn ""
    putStrLn "  --host H               listen address              (CHUSQL_WEB_HOST, default 127.0.0.1)"
    putStrLn "  --port N               listen port                 (CHUSQL_WEB_PORT, default 7777)"
    putStrLn "  --static DIR           static asset directory      (CHUSQL_WEB_STATIC, default static)"
    putStrLn "  --user NAME            account name                (CHUSQL_WEB_USER, default admin)"
    putStrLn "  --storage SERVER       Rust storage exe to spawn   (CHUSQL_STORAGE_SERVER)"
    putStrLn "  --cookie-secure BOOL   add Secure to the cookie    (CHUSQL_WEB_COOKIE_SECURE, default false)"
    putStrLn "  --body-limit N         max request body bytes      (CHUSQL_WEB_BODY_LIMIT, default 65536)"
    putStrLn "  --session-idle N       session idle timeout, sec   (CHUSQL_WEB_SESSION_IDLE, default 28800)"
    putStrLn "  --session-max N        session max age, sec        (CHUSQL_WEB_SESSION_MAX, default 86400)"
    putStrLn "  --login-max-attempts N failed logins before 429    (CHUSQL_WEB_LOGIN_MAX_ATTEMPTS, default 5)"
    putStrLn "  --login-window N       lockout window, sec         (CHUSQL_WEB_LOGIN_WINDOW, default 300)"
    putStrLn "  --page-size N          rows per page by default    (CHUSQL_WEB_PAGE_SIZE, default 25)"
    putStrLn "  --max-page-size N      rows per page ceiling       (CHUSQL_WEB_MAX_PAGE_SIZE, default 500)"
    putStrLn "  --max-rows N           rows returned per query     (CHUSQL_WEB_MAX_ROWS, default 1000)"
    putStrLn "  --max-sql-length N     max SQL characters          (CHUSQL_WEB_MAX_SQL_LENGTH, default 20000)"
    putStrLn "  --seed BOOL            load demo data when the db is empty (CHUSQL_WEB_SEED, default false)"
    putStrLn ""
    putStrLn "password: CHUSQL_WEB_PASSWORD_HASH > CHUSQL_WEB_PASSWORD > built-in demo password"
    putStrLn ("without any of them the demo account is " ++ T.unpack defaultUser ++ " / " ++ T.unpack defaultPassword)
    putStrLn "storage knobs for the spawned process: CHUSQL_PAGE_SIZE / CHUSQL_BTREE_ORDER /"
    putStrLn "  CHUSQL_BUFFER_POOL_SIZE / CHUSQL_LOG / CHUSQL_PIPE / CHUSQL_DATA_DIR"

-- | 命令行覆盖配置
applyOptions :: WebConfig -> Options -> WebConfig
applyOptions cfg opts =
    cfg
        { wcHost = orElse (optHost opts) (wcHost cfg)
        , wcPort = orElse (optPort opts) (wcPort cfg)
        , wcStaticDir = orElse (optStatic opts) (wcStaticDir cfg)
        , wcStorageServer = case optStorage opts of
            Just p -> Just p
            Nothing -> wcStorageServer cfg
        , wcUser = orElse (optUser opts) (wcUser cfg)
        , wcCookieSecure = orElse (optCookieSecure opts) (wcCookieSecure cfg)
        , wcBodyLimit = orElse (optBodyLimit opts) (wcBodyLimit cfg)
        , wcSessionIdle = orElse (optSessionIdle opts) (wcSessionIdle cfg)
        , wcSessionMax = orElse (optSessionMax opts) (wcSessionMax cfg)
        , wcLoginMaxAttempts = orElse (optLoginMaxAttempts opts) (wcLoginMaxAttempts cfg)
        , wcLoginWindow = orElse (optLoginWindow opts) (wcLoginWindow cfg)
        , wcPageSize = orElse (optPageSize opts) (wcPageSize cfg)
        , wcMaxPageSize = orElse (optMaxPageSize opts) (wcMaxPageSize cfg)
        , wcMaxRows = orElse (optMaxRows opts) (wcMaxRows cfg)
        , wcMaxSqlLength = orElse (optMaxSqlLength opts) (wcMaxSqlLength cfg)
        , wcSeedDemo = orElse (optSeedDemo opts) (wcSeedDemo cfg)
        }
  where
    -- | 开关给了用开关的，否则保留原值
    orElse :: Maybe a -> a -> a
    orElse (Just x) _ = x
    orElse Nothing y = y

-- | 配了存储进程路径就拉起来，没配就假设外面已经跑着
startStorageIfWanted :: WebConfig -> IO (Either String (Maybe StorageProcess))
startStorageIfWanted cfg = case wcStorageServer cfg of
    Nothing -> pure (Right Nothing)
    Just given -> do
        found <- findStorageServer (Just given)
        case found of
            Left e -> pure (Left e)
            Right bin -> fmap (fmap Just) (startStorageProcess bin)

-- | 入口
main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    args <- getArgs
    case parseArgs args of
        Left err -> do
            putStrLn ("bad arguments: " ++ err)
            usage
            exitFailure
        Right opts
            | optHelp opts -> usage
            | otherwise -> run opts

-- | 起服务
run :: Options -> IO ()
run opts = do
    base <- loadWebConfig
    let cfg = applyOptions base opts
    foundStatic <- resolveStaticDir (wcStaticDir cfg)
    case foundStatic of
        Nothing -> do
            putStrLn ("static directory not found; looked in: " ++ unwords (staticDirCandidates (wcStaticDir cfg)))
            exitFailure
        Just staticDir -> do
            cred <- resolveCredential cfg
            storage <- startStorageIfWanted cfg
            case storage of
                Left err -> do
                    putStrLn err
                    exitFailure
                Right maybeStorage -> do
                    backend <- ipcBackend
                    let policy =
                            SessionPolicy
                                (fromIntegral (wcSessionIdle cfg))
                                (fromIntegral (wcSessionMax cfg))
                    sessions <- newSessionStore getCurrentTime policy
                    limiter <-
                        newRateLimiter
                            getCurrentTime
                            (wcLoginMaxAttempts cfg)
                            (fromIntegral (wcLoginWindow cfg))
                    env0 <- newAppEnv backend sessions cred limiter staticDir
                    let env =
                            env0
                                { aeCookieSecure = wcCookieSecure cfg
                                , aeEffective = effectiveSettings cfg
                                , aeLog = \msg -> TIO.putStrLn ("[web] " <> msg)
                                }
                    setLive env (liveFromConfig cfg)
                    app <- webApp env
                    printBanner cfg staticDir maybeStorage
                    reportCredential cfg
                    waitForStorageReport
                    seedIfWanted cfg backend
                    let settings =
                            Warp.setPort (wcPort cfg) (Warp.setHost (fromString (wcHost cfg)) Warp.defaultSettings)
                    case maybeStorage of
                        Nothing -> serve settings app
                        Just sp -> bracket (pure sp) stopStorageProcess (const (serve settings app))

-- | 本次启动的配置摊成热改参数
liveFromConfig :: WebConfig -> Live
liveFromConfig cfg =
    Live
        { lvBodyLimit = wcBodyLimit cfg
        , lvSessionIdle = wcSessionIdle cfg
        , lvSessionMax = wcSessionMax cfg
        , lvLoginMaxAttempts = wcLoginMaxAttempts cfg
        , lvLoginWindow = wcLoginWindow cfg
        , lvPageSize = wcPageSize cfg
        , lvMaxPageSize = wcMaxPageSize cfg
        , lvMaxRows = wcMaxRows cfg
        , lvMaxSqlLength = wcMaxSqlLength cfg
        }

-- | 起 HTTP 服务，绑不上端口给人话
serve :: Warp.Settings -> Application -> IO ()
serve settings app = do
    result <- try (Warp.runSettings settings app) :: IO (Either IOException ())
    case result of
        Right () -> pure ()
        Left e -> do
            putStrLn ("failed to serve HTTP: " ++ show e)
            putStrLn "  the port is probably taken or reserved by the system; try another one: --port 7778"
            putStrLn "  on Windows: netsh interface ipv4 show excludedportrange protocol=tcp"
            exitFailure

-- | 口令是从哪来的（用了内置默认口令就明确警告）
reportCredential :: WebConfig -> IO ()
reportCredential cfg
    | usingDefaultCredentials cfg = do
        putStrLn ""
        putStrLn "  !! DEMO CREDENTIALS IN USE:"
        putStrLn ("  !!   user " ++ T.unpack (wcUser cfg) ++ " / password " ++ T.unpack defaultPassword)
        putStrLn "  !!   set CHUSQL_WEB_PASSWORD (or CHUSQL_WEB_PASSWORD_HASH) before exposing this server."
        putStrLn ""
    | otherwise = putStrLn ("password:     from CHUSQL_WEB_PASSWORD(_HASH)   (user " ++ T.unpack (wcUser cfg) ++ ")")

-- | 配了 seed 就补一份演示数据
seedIfWanted :: WebConfig -> Backend -> IO ()
seedIfWanted cfg backend
    | not (wcSeedDemo cfg) = pure ()
    | otherwise = do
        result <- seedDemo backend
        case result of
            Left e -> TIO.putStrLn ("[web] demo data skipped: " <> T.pack e)
            Right report ->
                TIO.putStrLn
                    ( "[web] demo data: "
                        <> (if null (srCreated report) then "already present" else "created " <> T.pack (unwords (srCreated report)))
                        <> (if null (srSkipped report) then "" else ", kept " <> T.pack (unwords (srSkipped report)))
                        <> (if null (srIndexes report) then "" else ", index on " <> T.pack (unwords (srIndexes report)))
                    )

-- | 报一下存储进程通不通
waitForStorageReport :: IO ()
waitForStorageReport = do
    up <- waitForStorage 20
    putStrLn
        ( if up
            then "storage:      up (named pipe answered ping)"
            else "storage:      DOWN (no ping reply; start the Rust storage process or pass --storage)"
        )

-- | 启动横幅
printBanner :: WebConfig -> FilePath -> Maybe StorageProcess -> IO ()
printBanner cfg staticDir maybeStorage = do
    putStrLn "==================== ChuSQL Web ===================="
    putStrLn ("url:          http://" ++ wcHost cfg ++ ":" ++ show (wcPort cfg) ++ "/")
    putStrLn ("static dir:   " ++ staticDir)
    putStrLn
        ( "limits:       body "
            ++ show (wcBodyLimit cfg)
            ++ "B, page "
            ++ show (wcPageSize cfg)
            ++ "/"
            ++ show (wcMaxPageSize cfg)
            ++ " rows, query rows "
            ++ show (wcMaxRows cfg)
            ++ ", sql "
            ++ show (wcMaxSqlLength cfg)
            ++ " chars"
        )
    putStrLn
        ( "auth:         session idle "
            ++ show (wcSessionIdle cfg)
            ++ "s / max "
            ++ show (wcSessionMax cfg)
            ++ "s, lockout after "
            ++ show (wcLoginMaxAttempts cfg)
            ++ " failures in "
            ++ show (wcLoginWindow cfg)
            ++ "s"
        )
    case maybeStorage of
        Just sp -> putStrLn ("storage proc: " ++ spPipe sp ++ "  data dir " ++ spDataDir sp)
        Nothing -> putStrLn "storage proc: assumed to run elsewhere (pipe name from CHUSQL_PIPE)"