ChuSQL/chusql-web/test/Spec.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import ChuSQL.Model (Column (..), Database, Table (..), Value (..))
import ChuSQL.Storage.IPC (SchemaColumn (..), TableInfo (..))
import ChuSQL.Syntax.AST (Expr (..), FromClause (..), Statement (..))
import ChuSQL.Web.Actions (
    ColumnSpec (..),
    CreateTableSpec (..),
    coerceValue,
    columnTypeOf,
    createIndexSql,
    createTableSql,
    deleteRowSql,
    dropIndexSql,
    dropTableSql,
    insertRowSql,
    insertRowsSql,
    isIdentifier,
    selectRowsSql,
    sqlLiteral,
    updateRowSql,
 )
import ChuSQL.Web.Api (
    AppEnv (..),
    Live (..),
    defaultLive,
    newAppEnv,
    parseCookieHeader,
    readLive,
    renderRow,
    setLive,
    webApp,
 )
import ChuSQL.Web.Auth (
    Credential (..),
    SessionPolicy (..),
    createSession,
    defaultSessionPolicy,
    deleteOtherSessions,
    deleteSession,
    hashLooksValid,
    hashPasswordWith,
    lookupSession,
    newSessionStore,
    sessionPolicy,
    sessionToken,
    setSessionPolicy,
    verifyPassword,
 )
import ChuSQL.Web.Backend (columnsFromStatement, ipcBackend, memoryBackend, tableInfoOf)
import ChuSQL.Web.Config (
    WebConfig (..),
    defaultPassword,
    defaultUser,
    defaultWebConfig,
    loadWebConfig,
    resolveCredential,
    usingDefaultCredentials,
 )
import ChuSQL.Web.RateLimit (newRateLimiter, rateLimitBlock, rateLimitRecord, setRateLimit)
import ChuSQL.Web.Settings (
    SettingItem (..),
    applySettings,
    defaultOf,
    effectiveSettings,
    findItem,
    isRestartRequired,
    isRootOnly,
    liveKeys,
    readSettingsFile,
    resolveSettingsFile,
    settingCatalogue,
    writeSettingsFile,
 )
import ChuSQL.Web.Static (contentTypeOf, readStatic, safeRelative)
import ChuSQL.Web.StorageProcess (StorageProcess (..), startStorageProcess, stopStorageProcess)
import ChuSQL.Web.UiSettings (
    readUiSettings,
    resolveUiSettingsFile,
    uiSettingsFileCandidates,
    validateUiSettings,
    writeUiSettings,
 )
import Control.Concurrent.MVar (newMVar)
import Control.Exception (IOException, bracket, finally, try)
import Data.Aeson (decode)
import qualified Data.Aeson as A
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (isInfixOf, isSuffixOf, nub, sort)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..), addUTCTime, getCurrentTime)
import qualified Data.Vector as V
import Network.HTTP.Client (
    Manager,
    Request (method, requestBody, requestHeaders),
    RequestBody (..),
    Response (responseBody, responseHeaders, responseStatus),
    defaultManagerSettings,
    httpLbs,
    newManager,
    parseRequest,
 )
import Network.HTTP.Types (Header, Method, methodGet, methodPost, statusCode)
import Network.Wai (Application)
import qualified Network.Wai.Handler.Warp as Warp
import qualified Network.Wai.Test as WT
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getTemporaryDirectory)
import qualified System.Directory
import System.Environment (lookupEnv, setEnv, unsetEnv)
import System.Exit (ExitCode (..))
import System.FilePath ((</>))
import System.IO (Handle)
import System.Process (
    CreateProcess (cwd, std_err, std_out),
    ProcessHandle,
    StdStream (..),
    createProcess,
    proc,
    waitForProcess,
 )
import Test.Hspec
import Test.Hspec.Wai hiding (pendingWith)

-- ChuSQL Web 测试，覆盖三层：
-- 纯函数、路由级（内存后端）、端到端（真 Rust 存储进程）。

-- | users 5 行 + orders 1 行
testDb :: Database
testDb =
    [ ( "users"
      , Table
            "users"
            [("id", TInt), ("name", TStr), ("age", TInt)]
            [ [("id", VInt i), ("name", VStr ("user" ++ show i)), ("age", VInt (20 + i))]
            | i <- [1 .. 5]
            ]
      )
    , ( "orders"
      , Table
            "orders"
            [("id", TInt), ("user_id", TInt)]
            [[("id", VInt 1), ("user_id", VInt 1)]]
      )
    ]

-- | 测试账号：迭代次数压低（跑得快），口令 `s3cret`
testCredential :: Credential
testCredential = Credential "admin" (hashPasswordWith 1000 (BS.replicate 16 7) "s3cret")

-- | 可控时钟的起点
epoch :: UTCTime
epoch = UTCTime (fromGregorian 2026 1 1) 0

-- | 默认会话策略
policy :: SessionPolicy
policy = SessionPolicy (8 * 3600) (24 * 3600)

-- | 造一条 `SELECT *`
selectStar :: FromClause -> Statement
selectStar from = Select ["*"] from Nothing [] Nothing

-- | 造一条显式列名的 SELECT
selectThese :: [String] -> FromClause -> Statement
selectThese cols from = Select cols from Nothing [] Nothing

-- | with 块里的会话类型别名
type TestSession a = WaiSession () a

-- | 每个用例组一套：内存后端 + 可控时钟 + 临时静态目录
freshWorld :: FilePath -> IO AppEnv
freshWorld staticDir = do
    db <- newMVar testDb
    clock <- newIORef epoch
    sessions <- newSessionStore (readIORef clock) policy
    limiter <- newRateLimiter (readIORef clock) 5 (5 * 60)
    env <- newAppEnv (memoryBackend db) sessions testCredential limiter staticDir
    path <- tempSettingsPath "default"
    removeIfExists path
    uiPath <- tempUiSettingsPath "default"
    removeIfExists uiPath
    pure env{aeSettingsFile = path, aeUiSettingsFile = uiPath, aeEffective = Map.empty}

-- | 临时设置文件（每个用例组一个名字，互不干扰）
tempSettingsPath :: String -> IO FilePath
tempSettingsPath name = do
    tmp <- getTemporaryDirectory
    pure (tmp </> ("chusql-web-test-" ++ name ++ "-settings.json"))

-- | 临时 IDE 设置文件（同样按用例组取名）
tempUiSettingsPath :: String -> IO FilePath
tempUiSettingsPath name = do
    tmp <- getTemporaryDirectory
    pure (tmp </> ("chusql-web-test-" ++ name ++ "-ui-settings.json"))

-- | 文件不存在也算成功
removeIfExists :: FilePath -> IO ()
removeIfExists path = do
    there <- doesFileExist path
    if there then removeFileSafe path else pure ()
  where
    removeFileSafe p = do
        _ <- try (System.Directory.removeFile p) :: IO (Either IOException ())
        pure ()

-- | 带自己的设置文件的用例组
freshWorldAt :: FilePath -> String -> IO AppEnv
freshWorldAt staticDir name = do
    env <- freshWorld staticDir
    path <- tempSettingsPath name
    removeIfExists path
    uiPath <- tempUiSettingsPath name
    removeIfExists uiPath
    pure env{aeSettingsFile = path, aeUiSettingsFile = uiPath}

-- | 临时静态目录，内容固定便于断言
makeStaticDir :: IO FilePath
makeStaticDir = do
    tmp <- getTemporaryDirectory
    let dir = tmp </> "chusql-web-static-test"
    createDirectoryIfMissing True dir
    BS.writeFile (dir </> "index.html") "<!DOCTYPE html><html lang=\"zh-CN\"><head></head><body>ChuSQL Console</body></html>"
    BS.writeFile (dir </> "app.js") "// test bundle\n"
    BS.writeFile (dir </> "style.css") "body{}\n"
    BS.writeFile (dir </> "secret.token") "do-not-serve\n"
    pure dir

-- | 一个用例组一套环境
withWorld :: FilePath -> (AppEnv -> SpecWith ((), Application)) -> Spec
withWorld staticDir body = do
    appEnv <- runIO (freshWorld staticDir)
    with (webApp appEnv) (body appEnv)

-- | 同上，但带着自己的设置文件（改设置/改口令的用例不互相串）
withWorldAt :: FilePath -> String -> (AppEnv -> SpecWith ((), Application)) -> Spec
withWorldAt staticDir name body = do
    appEnv <- runIO (freshWorldAt staticDir name)
    with (webApp appEnv) (body appEnv)

-- | 响应体解成 JSON
jsonBody :: WT.SResponse -> A.Value
jsonBody res = fromMaybe A.Null (decode (WT.simpleBody res))

-- | 取字段
field :: Text -> A.Value -> Maybe A.Value
field name (A.Object o) = KM.lookup (K.fromText name) o
field _ _ = Nothing

-- | 取字段（没有给 Null）
at :: Text -> A.Value -> A.Value
at name value = fromMaybe A.Null (field name value)

-- | 当数组看
items :: A.Value -> [A.Value]
items (A.Array xs) = V.toList xs
items _ = []

-- | 当文本看
asText :: A.Value -> Text
asText (A.String t) = t
asText _ = ""

-- | 当整数看
asInt :: A.Value -> Int
asInt (A.Number n) = round n
asInt _ = -1

-- | 第 i 个元素（越界给 Nothing，不用 `!!`）
nth :: Int -> [a] -> Maybe a
nth i xs = case drop i xs of
    (x : _) -> Just x
    [] -> Nothing

-- | 取 Set-Cookie 里的会话令牌
sessionCookieOf :: WT.SResponse -> Maybe Text
sessionCookieOf res = do
    raw <- lookup "Set-Cookie" (WT.simpleHeaders res)
    parseCookieHeader "chusql_session" (TE.decodeUtf8 raw)

-- | 会话令牌变请求头
cookieHeaders :: WT.SResponse -> [Header]
cookieHeaders res = case sessionCookieOf res of
    Nothing -> []
    Just token -> [("Cookie", TE.encodeUtf8 ("chusql_session=" <> token))]

-- | 带 JSON 体的请求
jsonRequest :: Method -> BS.ByteString -> BL.ByteString -> TestSession WT.SResponse
jsonRequest httpMethod urlPath payload =
    request httpMethod urlPath [("Content-Type", "application/json")] payload

-- | 登录请求体
loginBody :: Text -> Text -> BL.ByteString
loginBody user password =
    BL.fromStrict . TE.encodeUtf8 $
        T.concat ["{\"user\":\"", user, "\",\"password\":\"", password, "\"}"]

-- | 登录
loginAs :: Text -> Text -> TestSession WT.SResponse
loginAs user password = jsonRequest methodPost "/api/login" (loginBody user password)

-- | 带请求头的 GET
getWith :: [Header] -> BS.ByteString -> TestSession WT.SResponse
getWith headers path = request methodGet path headers ""

-- | 带请求头的 JSON POST
postWith :: [Header] -> BS.ByteString -> BL.ByteString -> TestSession WT.SResponse
postWith headers path payload =
    request methodPost path (("Content-Type", "application/json") : headers) payload

-- | 带请求头的 JSON PUT（改设置用的是 PUT）
putWith :: [Header] -> BS.ByteString -> BL.ByteString -> TestSession WT.SResponse
putWith headers path payload =
    request "PUT" path (("Content-Type", "application/json") : headers) payload

-- | 在 items 数组里按键找一项（找不到给 Null）
headEntry :: Text -> [A.Value] -> A.Value
headEntry key entries = case [e | e <- entries, asText (at "key" e) == key] of
    (e : _) -> e
    [] -> A.Null

-- | 纯断言抬进 WaiSession
check :: IO () -> TestSession ()
check = liftIO

-- | 已经拿到响应对象时的状态码断言
hasStatus :: WT.SResponse -> Int -> IO ()
hasStatus res code = statusCode (WT.simpleStatus res) `shouldBe` code

-- | 临时设几个环境变量跑一段，跑完恢复原样（原来没有就删掉）
withEnv :: [(String, String)] -> IO a -> IO a
withEnv kvs act = do
    saved <- mapM (\(k, _) -> fmap ((,) k) (lookupEnv k)) kvs
    mapM_ (uncurry setEnv) kvs
    act `finally` mapM_ restore saved
  where
    restore (k, mv) = maybe (unsetEnv k) (setEnv k) mv

-- | 按 UTF-8 读文件（避免解码错）
readUtf8 :: FilePath -> IO Text
readUtf8 path = TE.decodeUtf8 <$> BS.readFile path

-- | Either 判空
isLeftE :: Either a b -> Bool
isLeftE (Left _) = True
isLeftE (Right _) = False

-- | Either 判成
isRightE :: Either a b -> Bool
isRightE = either (const False) (const True)

-- | 响应体里第一行（表格数据）
firstRow :: WT.SResponse -> [A.Value]
firstRow res = case items (at "rows" (jsonBody res)) of
    (r : _) -> case r of
        A.Array xs -> V.toList xs
        _ -> []
    [] -> []

-- | 数组字段的长度
arrayLen :: A.Value -> Int
arrayLen = length . items

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
    staticDir <- runIO makeStaticDir
    unitSpec
    actionsSpec
    staticSpec staticDir
    frontendBundleSpec
    authSpec staticDir
    catalogSpec staticDir
    limitsSpec staticDir
    oneClickSpec staticDir
    sqlSpec staticDir
    settingsSpec staticDir
    uiSettingsSpec staticDir
    sortSpec staticDir
    securitySpec staticDir
    e2eSpec staticDir

unitSpec :: Spec
unitSpec = do
    describe "Password hashing" $ do
        it "accepts the correct password" $
            verifyPassword (hashPasswordWith 1000 (BS.replicate 16 1) "s3cret") "s3cret" `shouldBe` True
        it "rejects a wrong password" $
            verifyPassword (hashPasswordWith 1000 (BS.replicate 16 1) "s3cret") "wrong" `shouldBe` False
        it "treats a broken encoded hash as mismatch instead of throwing" $
            verifyPassword "garbage" "s3cret" `shouldBe` False
        it "same password with different salts yields different hashes" $
            hashPasswordWith 1000 (BS.replicate 16 1) "s3cret"
                `shouldNotBe` hashPasswordWith 1000 (BS.replicate 16 2) "s3cret"
        it "encoded hash has four parts: algo$iterations$salt$hash" $
            T.splitOn "$" (hashPasswordWith 1000 (BS.replicate 16 3) "s3cret")
                `shouldSatisfy` ((== 4) . length)

    describe "Sessions" $ do
        it "token is 64 hex chars and differs between calls" $ do
            a <- sessionToken
            b <- sessionToken
            T.length a `shouldBe` 64
            T.all (`elem` ("0123456789abcdef" :: String)) a `shouldBe` True
            a `shouldNotBe` b
        it "idle timeout drops the session" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) policy
            token <- createSession store "admin"
            fresh <- lookupSession store token
            fresh `shouldBe` Just "admin"
            writeIORef clock (addUTCTime (9 * 3600) epoch)
            stale <- lookupSession store token
            stale `shouldBe` Nothing
        it "activity refreshes the idle timer but the absolute limit still expires" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) policy
            token <- createSession store "admin"
            writeIORef clock (addUTCTime (7 * 3600) epoch)
            seen <- lookupSession store token
            seen `shouldBe` Just "admin"
            writeIORef clock (addUTCTime (13 * 3600) epoch)
            seenAgain <- lookupSession store token
            seenAgain `shouldBe` Just "admin"
            writeIORef clock (addUTCTime (25 * 3600) epoch)
            gone <- lookupSession store token
            gone `shouldBe` Nothing
        it "deleted session is no longer found" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) policy
            token <- createSession store "admin"
            deleteSession store token
            found <- lookupSession store token
            found `shouldBe` Nothing
        it "a new expiry policy takes effect immediately (settings hot reload path)" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) (SessionPolicy (8 * 3600) (24 * 3600))
            token <- createSession store "admin"
            setSessionPolicy store (SessionPolicy 10 20)
            now <- sessionPolicy store
            spIdleSeconds now `shouldBe` 10
            writeIORef clock (addUTCTime 11 epoch)
            gone <- lookupSession store token
            gone `shouldBe` Nothing
        it "password change drops other sessions but keeps the current one" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) policy
            keep <- createSession store "admin"
            other <- createSession store "admin"
            removed <- deleteOtherSessions store keep
            kept <- lookupSession store keep
            dropped <- lookupSession store other
            removed `shouldBe` 1
            kept `shouldBe` Just "admin"
            dropped `shouldBe` Nothing
        it "no other sessions means zero removed (visible in logs)" $ do
            clock <- newIORef epoch
            store <- newSessionStore (readIORef clock) policy
            keep <- createSession store "admin"
            removed <- deleteOtherSessions store keep
            removed `shouldBe` 0
            stillThere <- lookupSession store keep
            stillThere `shouldBe` Just "admin"

    describe "Login rate limiting" $ do
        it "below the limit is not blocked" $ do
            clock <- newIORef epoch
            rl <- newRateLimiter (readIORef clock) 3 60
            rateLimitRecord rl "admin"
            rateLimitRecord rl "admin"
            open <- rateLimitBlock rl "admin"
            open `shouldBe` Nothing
        it "hitting the limit blocks and returns seconds to wait" $ do
            clock <- newIORef epoch
            rl <- newRateLimiter (readIORef clock) 3 60
            mapM_ (const (rateLimitRecord rl "admin")) [1 :: Int, 2, 3]
            blocked <- rateLimitBlock rl "admin"
            blocked `shouldSatisfy` maybe False (> 0)
        it "window expiry allows retries again" $ do
            clock <- newIORef epoch
            rl <- newRateLimiter (readIORef clock) 3 60
            mapM_ (const (rateLimitRecord rl "admin")) [1 :: Int, 2, 3]
            writeIORef clock (addUTCTime 61 epoch)
            open <- rateLimitBlock rl "admin"
            open `shouldBe` Nothing
        it "raising the threshold unlocks immediately (settings hot reload)" $ do
            clock <- newIORef epoch
            rl <- newRateLimiter (readIORef clock) 3 60
            mapM_ (const (rateLimitRecord rl "admin")) [1 :: Int, 2, 3]
            blocked <- rateLimitBlock rl "admin"
            blocked `shouldSatisfy` maybe False (> 0)
            setRateLimit rl 10 60
            unlocked <- rateLimitBlock rl "admin"
            unlocked `shouldBe` Nothing
        it "shortening the window allows immediately (settings hot reload)" $ do
            clock <- newIORef epoch
            rl <- newRateLimiter (readIORef clock) 3 3600
            mapM_ (const (rateLimitRecord rl "admin")) [1 :: Int, 2, 3]
            setRateLimit rl 3 1
            writeIORef clock (addUTCTime 2 epoch)
            open <- rateLimitBlock rl "admin"
            open `shouldBe` Nothing

    describe "Cookie parsing" $ do
        it "picks the session token out of many cookies" $
            parseCookieHeader "chusql_session" "a=1; chusql_session=abc123; b=2" `shouldBe` Just "abc123"
        it "missing key yields Nothing" $
            parseCookieHeader "chusql_session" "a=1; b=2" `shouldBe` Nothing
        it "empty value does not count as a value" $
            parseCookieHeader "chusql_session" "chusql_session=" `shouldBe` Nothing

    describe "Password hash validation (checked before changing the password)" $ do
        it "self-computed hash is valid" $
            hashLooksValid (hashPasswordWith 1000 (BS.replicate 16 5) "s3cret") `shouldBe` True
        it "broken hashes are invalid (bad length/algo/parts)" $ do
            hashLooksValid "garbage" `shouldBe` False
            hashLooksValid "pbkdf2-sha256$1000$00$00" `shouldBe` False
            hashLooksValid "md5$1000$00$00" `shouldBe` False

    describe "Settings catalogue (shared by the settings page and the server)" $ do
        it "keys are unique and kind/default are filled" $ do
            let keys = map siKey settingCatalogue
            length keys `shouldBe` length (nub keys)
            all (not . T.null . siKey) settingCatalogue `shouldBe` True
            all (not . T.null . siLabel) settingCatalogue `shouldBe` True
            all (\i -> siKind i `elem` ["text", "int", "bool", "secret"]) settingCatalogue `shouldBe` True
            let machineReadable = [i | i <- settingCatalogue, siKind i `elem` ["int", "bool"]]
            machineReadable `shouldSatisfy` (not . null)
            all (not . T.null . siDefault) machineReadable `shouldBe` True
            [siDefault i | i <- settingCatalogue, siKind i == "secret"] `shouldSatisfy` all T.null
            let envs = map siEnv settingCatalogue
            all (not . T.null) envs `shouldBe` True
            length envs `shouldBe` length (nub envs)
        it "every item has an env var and can be found by key" $ do
            all (not . T.null . siEnv) settingCatalogue `shouldBe` True
            map (fmap siKey . findItem . siKey) settingCatalogue `shouldBe` map (Just . siKey) settingCatalogue
        it "critical settings are root-only, tuning ones are not" $ do
            isRootOnly "port" `shouldBe` True
            isRootOnly "host" `shouldBe` True
            isRootOnly "user" `shouldBe` True
            isRootOnly "password-hash" `shouldBe` True
            isRootOnly "rows-per-page" `shouldBe` False
            isRootOnly "body-limit" `shouldBe` False
        it "live keys exist in the catalogue and are all integers" $ do
            liveKeys `shouldNotSatisfy` null
            map findItem liveKeys `shouldSatisfy` all (/= Nothing)
            [siKind i | Just i <- map findItem liveKeys] `shouldSatisfy` all (== "int")
        it "restart and live flags do not conflict: port needs a restart, page size does not" $ do
            isRestartRequired "port" `shouldBe` True
            isRestartRequired "static-dir" `shouldBe` True
            isRestartRequired "rows-per-page" `shouldBe` False
            filter isRestartRequired liveKeys `shouldBe` []
        it "defaults are found, an unknown key gives an empty string" $ do
            defaultOf "port" `shouldBe` "7777"
            defaultOf "rows-per-page" `shouldBe` "25"
            defaultOf "nope" `shouldBe` ""
        it "the flattened startup config carries the real port/account" $ do
            let flat = effectiveSettings defaultWebConfig
            Map.lookup "port" flat `shouldBe` Just "7777"
            Map.lookup "user" flat `shouldBe` Just defaultUser
            Map.lookup "rows-per-page" flat `shouldBe` Just "25"
            Map.member "password" flat `shouldBe` False
            Map.member "password-hash" flat `shouldBe` False
        it "merge settings: known keys applied, unknown rejected, empty clears" $ do
            let merged = applySettings Map.empty (Map.fromList [("rows-per-page", "50"), ("port", "9000")])
            fmap (Map.lookup "rows-per-page") merged `shouldBe` Right (Just "50")
            applySettings Map.empty (Map.fromList [("nope", "1")]) `shouldSatisfy` isLeftE
            fmap (Map.lookup "port") (applySettings (Map.fromList [("port", "9000")]) (Map.fromList [("port", "")]))
                `shouldBe` Right (Just "")
        it "type validation: ints reject letters, bools accept only known spellings" $ do
            applySettings Map.empty (Map.fromList [("rows-per-page", "abc")]) `shouldSatisfy` isLeftE
            applySettings Map.empty (Map.fromList [("rows-per-page", "10")]) `shouldSatisfy` isRightE
            applySettings Map.empty (Map.fromList [("seed", "maybe")]) `shouldSatisfy` isLeftE
            applySettings Map.empty (Map.fromList [("seed", "on")]) `shouldSatisfy` isRightE
        it "write settings file: empty values are not stored and reads come back" $ do
            tmp <- getTemporaryDirectory
            let path = tmp </> "chusql-web-test-write-settings.json"
            removeIfExists path
            written <- writeSettingsFile path (Map.fromList [("port", "9000"), ("host", "")])
            written `shouldBe` Right ()
            stored <- readSettingsFile path
            Map.lookup "port" stored `shouldBe` Just "9000"
            Map.member "host" stored `shouldBe` False
        it "write settings file: reports failure when the directory cannot be created" $ do
            tmp <- getTemporaryDirectory
            let blocker = tmp </> "chusql-web-test-blocker"
            removeIfExists blocker
            BS.writeFile blocker "not a directory"
            failed <- writeSettingsFile (blocker </> "settings.json") (Map.fromList [("port", "1")])
            failed `shouldSatisfy` isLeftE
            removeIfExists blocker
        it "an unreadable file counts as empty config (not a crash)" $ do
            tmp <- getTemporaryDirectory
            missing <- readSettingsFile (tmp </> "chusql-web-test-does-not-exist.json")
            missing `shouldBe` Map.empty
        it "settings file lookup: uses an existing file" $ do
            tmp <- getTemporaryDirectory
            let web = tmp </> "chusql-web-test-resolve"
            createDirectoryIfMissing True (web </> "script")
            BS.writeFile (web </> "script" </> "chusql.settings.json") "{\"port\":\"9000\"}"
            System.Directory.withCurrentDirectory web $ do
                found <- resolveSettingsFile
                found `shouldBe` ("script" </> "chusql.settings.json")
        it "settings file lookup: picks the candidate in an existing dir when none exists" $ do
            tmp <- getTemporaryDirectory
            let root = tmp </> "chusql-web-test-resolve-root"
            let web = root </> "chusql-web"
            createDirectoryIfMissing True (root </> "script")
            createDirectoryIfMissing True web
            System.Directory.withCurrentDirectory web $ do
                found <- resolveSettingsFile
                found `shouldBe` (".." </> "script" </> "chusql.settings.json")

    describe "Browsing SELECTs (column header click / WHERE filter cells)" $ do
        it "no sort and no filter yields a plain SELECT" $
            selectRowsSql "users" Nothing [] `shouldBe` Right "SELECT * FROM users"
        it "column and direction produce ORDER BY" $ do
            selectRowsSql "users" (Just ("age", True)) [] `shouldBe` Right "SELECT * FROM users ORDER BY age ASC"
            selectRowsSql "users" (Just ("age", False)) [] `shouldBe` Right "SELECT * FROM users ORDER BY age DESC"
        it "equality filters become WHERE with AND, placed before ORDER BY" $ do
            selectRowsSql "users" Nothing [("name", VStr "Ann"), ("age", VInt 30)]
                `shouldBe` Right "SELECT * FROM users WHERE name = 'Ann' AND age = 30"
            selectRowsSql "users" (Just ("age", False)) [("name", VStr "O'Brien")]
                `shouldBe` Right "SELECT * FROM users WHERE name = 'O''Brien' ORDER BY age DESC"
            selectRowsSql "users" Nothing [("vip", VBool True)]
                `shouldBe` Right "SELECT * FROM users WHERE vip = TRUE"
        it "table and column names go through the whitelist (including filter columns)" $ do
            selectRowsSql "users; DROP TABLE users" Nothing [] `shouldSatisfy` isLeftE
            selectRowsSql "users" (Just ("age; DROP TABLE users", True)) [] `shouldSatisfy` isLeftE
            selectRowsSql "users" Nothing [("age; DROP TABLE users", VInt 1)] `shouldSatisfy` isLeftE

    describe "Identifier whitelist" $ do
        it "normal table names pass" $ do
            isIdentifier "users" `shouldBe` True
            isIdentifier "user_1" `shouldBe` True
            isIdentifier "_tmp" `shouldBe` True
        it "leading digit / space / semicolon / empty string are rejected" $ do
            isIdentifier "1users" `shouldBe` False
            isIdentifier "user name" `shouldBe` False
            isIdentifier "users;DROP TABLE users" `shouldBe` False
            isIdentifier "" `shouldBe` False
        it "over 64 characters is rejected" $
            isIdentifier (T.replicate 65 "a") `shouldBe` False

    describe "Static file name whitelist" $ do
        it "normal file names pass" $ do
            safeRelative "app.js" `shouldBe` Just "app.js"
            safeRelative "style.css" `shouldBe` Just "style.css"
            safeRelative "codicon.ttf" `shouldBe` Just "codicon.ttf"
            safeRelative "editor.worker-a1.js" `shouldBe` Just "editor.worker-a1.js"
        it "traversal / subdirectory / empty string are all rejected" $ do
            safeRelative "../secret" `shouldBe` Nothing
            safeRelative "sub/app.js" `shouldBe` Nothing
            safeRelative "a\\b" `shouldBe` Nothing
            safeRelative "" `shouldBe` Nothing
            safeRelative "a b.js" `shouldBe` Nothing
        it "disallowed extensions fail (.token / .db / no extension)" $ do
            safeRelative "secret.token" `shouldBe` Nothing
            safeRelative "catalog.json" `shouldBe` Nothing
            safeRelative "data.db" `shouldBe` Nothing
            safeRelative "README" `shouldBe` Nothing

    describe "Content-Type" $ do
        it "chosen by extension (case-insensitive)" $ do
            contentTypeOf "index.html" `shouldBe` "text/html; charset=utf-8"
            contentTypeOf "app.JS" `shouldBe` "text/javascript; charset=utf-8"
            contentTypeOf "style.css" `shouldBe` "text/css; charset=utf-8"
            contentTypeOf "codicon.ttf" `shouldBe` "font/ttf"
            contentTypeOf "x.bin" `shouldBe` "application/octet-stream"

    describe "Column inference (headers even for empty results)" $ do
        it "SELECT * expands to the table columns" $
            columnsFromStatement testDb (selectStar (FromTable Nothing "users"))
                `shouldBe` ["id", "name", "age"]
        it "aliased SELECT * prefixes the alias" $
            columnsFromStatement testDb (selectStar (FromTable (Just "u") "users"))
                `shouldBe` ["u.id", "u.name", "u.age"]
        it "JOIN SELECT * puts the left table first" $
            columnsFromStatement
                testDb
                (selectStar (FromJoin (FromTable Nothing "users") (Just "o") "orders" (Eq (Col "id") (Col "user_id"))))
                `shouldBe` ["id", "name", "age", "o.id", "o.user_id"]
        it "explicit column names are kept as-is" $
            columnsFromStatement testDb (selectThese ["name"] (FromTable Nothing "users")) `shouldBe` ["name"]
        it "write statements have no result columns" $
            columnsFromStatement testDb (DropTable "users") `shouldBe` []

    describe "Row rendering" $ do
        it "values follow the given column order, missing columns give null" $
            renderRow ["name", "id", "age"] [("id", VInt 1), ("name", VStr "a")]
                `shouldBe` [A.String "a", A.Number 1, A.Null]

    describe "In-memory backend catalogue" $ do
        it "row count, columns and stats all match" $ do
            case lookup "users" testDb of
                Nothing -> expectationFailure "testDb has no users"
                Just tbl -> do
                    let info = tableInfoOf ("users", tbl)
                    tiTable info `shouldBe` "users"
                    tiRows info `shouldBe` 5
                    map scName (tiColumns info) `shouldBe` ["id", "name", "age"]
                    tiStats info `shouldBe` [("id", 5, False), ("name", 5, False), ("age", 5, False)]

    describe "Default account and credential source" $ do
        it "the default account is root and uses the built-in demo password" $ do
            let cfg = defaultWebConfig
            defaultUser `shouldBe` "root"
            wcUser cfg `shouldBe` "root"
            usingDefaultCredentials cfg `shouldBe` True
            cred <- resolveCredential cfg
            credUser cred `shouldBe` defaultUser
            verifyPassword (credEncoded cred) defaultPassword `shouldBe` True
        it "a plain password wins and the default stops working" $ do
            let cfg = defaultWebConfig{wcPassword = Just "s3cret"}
            usingDefaultCredentials cfg `shouldBe` False
            cred <- resolveCredential cfg
            verifyPassword (credEncoded cred) "s3cret" `shouldBe` True
            verifyPassword (credEncoded cred) defaultPassword `shouldBe` False
        it "a provided hash is used directly (not re-hashed)" $ do
            let encoded = hashPasswordWith 1000 (BS.replicate 16 9) "from-hash"
            cred <- resolveCredential defaultWebConfig{wcPasswordHash = Just encoded}
            credEncoded cred `shouldBe` encoded
        it "the account name can be changed" $ do
            cred <- resolveCredential defaultWebConfig{wcUser = "tester"}
            credUser cred `shouldBe` "tester"

    describe "Config: built-in defaults" $ do
        it "port defaults to 7777, account defaults to admin/chusql" $ do
            wcPort defaultWebConfig `shouldBe` 7777
            wcHost defaultWebConfig `shouldBe` "127.0.0.1"
            wcUser defaultWebConfig `shouldBe` defaultUser
            wcCookieSecure defaultWebConfig `shouldBe` False
        it "session / rate limit / paging / row limits all have explicit defaults" $ do
            wcSessionIdle defaultWebConfig `shouldBe` 8 * 3600
            wcSessionMax defaultWebConfig `shouldBe` 24 * 3600
            wcLoginMaxAttempts defaultWebConfig `shouldBe` 5
            wcLoginWindow defaultWebConfig `shouldBe` 5 * 60
            wcPageSize defaultWebConfig `shouldBe` 25
            wcMaxPageSize defaultWebConfig `shouldBe` 500
            wcMaxRows defaultWebConfig `shouldBe` 1000
            wcMaxSqlLength defaultWebConfig `shouldBe` 20000
            wcBodyLimit defaultWebConfig `shouldBe` 65536

    describe "Config: environment variables override defaults" $ do
        it "port / host / static dir / account" $ do
            withEnv
                [ ("CHUSQL_WEB_PORT", "8123")
                , ("CHUSQL_WEB_HOST", "0.0.0.0")
                , ("CHUSQL_WEB_STATIC", "mysite")
                , ("CHUSQL_WEB_USER", "tester")
                ]
                $ do
                    cfg <- loadWebConfig
                    wcPort cfg `shouldBe` 8123
                    wcHost cfg `shouldBe` "0.0.0.0"
                    wcStaticDir cfg `shouldBe` "mysite"
                    wcUser cfg `shouldBe` "tester"
        it "session / rate limit / paging / rows / body limit" $ do
            withEnv
                [ ("CHUSQL_WEB_SESSION_IDLE", "60")
                , ("CHUSQL_WEB_SESSION_MAX", "120")
                , ("CHUSQL_WEB_LOGIN_MAX_ATTEMPTS", "3")
                , ("CHUSQL_WEB_LOGIN_WINDOW", "30")
                , ("CHUSQL_WEB_PAGE_SIZE", "7")
                , ("CHUSQL_WEB_MAX_PAGE_SIZE", "70")
                , ("CHUSQL_WEB_MAX_ROWS", "9")
                , ("CHUSQL_WEB_MAX_SQL_LENGTH", "1234")
                , ("CHUSQL_WEB_BODY_LIMIT", "2048")
                , ("CHUSQL_WEB_COOKIE_SECURE", "1")
                ]
                $ do
                    cfg <- loadWebConfig
                    wcSessionIdle cfg `shouldBe` 60
                    wcSessionMax cfg `shouldBe` 120
                    wcLoginMaxAttempts cfg `shouldBe` 3
                    wcLoginWindow cfg `shouldBe` 30
                    wcPageSize cfg `shouldBe` 7
                    wcMaxPageSize cfg `shouldBe` 70
                    wcMaxRows cfg `shouldBe` 9
                    wcMaxSqlLength cfg `shouldBe` 1234
                    wcBodyLimit cfg `shouldBe` 2048
                    wcCookieSecure cfg `shouldBe` True
        it "unsetting the env var restores the default port 7777" $ do
            withEnv [("CHUSQL_WEB_PORT", "8123")] $ do
                tuned <- loadWebConfig
                wcPort tuned `shouldBe` 8123
            restored <- loadWebConfig
            wcPort restored `shouldBe` 7777

    describe "Launcher script (script/chusql.ps1)" $ do
        it "script/ has chusql.ps1 / chusql.cmd, default port 7777, covering all three modules" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            batch <- readUtf8 (".." </> "script" </> "chusql.cmd")
            batch `shouldSatisfy` T.isInfixOf "chusql.ps1"
            script `shouldSatisfy` T.isInfixOf "chusql-storage"
            script `shouldSatisfy` T.isInfixOf "chusql-web.exe"
            script `shouldSatisfy` T.isInfixOf "/api/status"
            script `shouldSatisfy` T.isInfixOf "7777"
        it "has web / cli / config commands, cli is a placeholder (dev notice + still starts web)" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            script `shouldSatisfy` T.isInfixOf "CLI interface is under development."
            script `shouldSatisfy` T.isInfixOf "'web'"
            script `shouldSatisfy` T.isInfixOf "'cli'"
            script `shouldSatisfy` T.isInfixOf "config set"
        it "settings persist to a file (config set/unset/reset + precedence note)" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            script `shouldSatisfy` T.isInfixOf "chusql.settings.json"
            script `shouldSatisfy` T.isInfixOf "command line > settings file > environment > default"
            script `shouldSatisfy` T.isInfixOf "Save-SavedSettings"
        it "child window hidden + logs flow back to the launcher window" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            script `shouldSatisfy` T.isInfixOf "-WindowStyle Hidden"
            script `shouldSatisfy` T.isInfixOf "Show-NewLogLines"
            script `shouldSatisfy` T.isInfixOf "RedirectStandardOutput"
        it "the script exposes settings as switches (port/session/paging/storage tuning)" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            script `shouldSatisfy` T.isInfixOf "CHUSQL_WEB_SESSION_IDLE"
            script `shouldSatisfy` T.isInfixOf "CHUSQL_WEB_MAX_ROWS"
            script `shouldSatisfy` T.isInfixOf "CHUSQL_BUFFER_POOL_SIZE"
            script `shouldSatisfy` T.isInfixOf "CHUSQL_PAGE_SIZE"
        it "the Rust artifact is named chusql-storage (no longer server)" $ do
            script <- readUtf8 (".." </> "script" </> "chusql.ps1")
            script `shouldSatisfy` T.isInfixOf "target\\release\\chusql-storage.exe"
            script `shouldSatisfy` (not . T.isInfixOf "target\\release\\server.exe")

staticSpec :: FilePath -> Spec
staticSpec staticDir = describe "Static files" $ do
    it "reads index.html from the temp dir" $ do
        content <- readStatic staticDir "index.html"
        content `shouldSatisfy` maybe False (not . BS.null)
    it "an unreadable file gives Nothing" $
        readStatic staticDir "nope.js" `shouldReturn` Nothing
    it "a traversal path is unreadable" $
        readStatic staticDir "../secret.token" `shouldReturn` Nothing

frontendBundleSpec :: Spec
frontendBundleSpec = describe "React frontend build artifacts" $ do
    present <- runIO (doesDirectoryExist "static")
    let asset name = "static" </> name
        readAsset name = readUtf8 (asset name)
        -- | static/ 是构建产物，没构建就跳过
        check body
            | present = body
            | otherwise = pendingWith "static/ is not built; run npm run build under chusql-web/frontend"
    it "entry HTML exists and is non-empty" $ check $ do
        html <- BS.readFile (asset "index.html")
        html `shouldSatisfy` (not . BS.null)
    it "entry declares the Chinese page language" $ check $ do
        html <- readAsset "index.html"
        html `shouldSatisfy` T.isInfixOf "lang=\"zh-CN\""
    it "entry loads the app script only from /static/" $ check $ do
        html <- readAsset "index.html"
        html `shouldSatisfy` T.isInfixOf "src=\"/static/app.js\""
    it "entry loads styles only from /static/" $ check $ do
        html <- readAsset "index.html"
        html `shouldSatisfy` T.isInfixOf "href=\"/static/style.css\""
    it "entry has no inline script" $ check $ do
        html <- readAsset "index.html"
        html `shouldSatisfy` (not . T.isInfixOf "<script>")
    it "entry has no inline style" $ check $ do
        html <- readAsset "index.html"
        html `shouldSatisfy` (not . T.isInfixOf "style=")
        html `shouldSatisfy` (not . T.isInfixOf "<style")
    it "app script exists and is non-empty" $ check $ do
        js <- BS.readFile (asset "app.js")
        js `shouldSatisfy` (not . BS.null)
    it "app script contains the centrally maintained Chinese UI copy" $ check $ do
        js <- readAsset "app.js"
        js `shouldSatisfy` T.isInfixOf "ChuSQL 数据库终端"
        js `shouldSatisfy` T.isInfixOf "待提交变更"
    it "main stylesheet uses the agreed Dark+ three-layer background" $ check $ do
        css <- readAsset "style.css"
        css `shouldSatisfy` T.isInfixOf "--bg-base:#1e1e1e"
        css `shouldSatisfy` T.isInfixOf "--bg-elevated:#252526"
        css `shouldSatisfy` T.isInfixOf "--bg-statusbar:#007acc"
    it "own styles have no gradients or shadows" $ check $ do
        css <- readAsset "style.css"
        css `shouldSatisfy` (not . T.isInfixOf "gradient(")
        css `shouldSatisfy` (not . T.isInfixOf "box-shadow")
    it "SQL language pack exists and is non-empty" $ check $ do
        sql <- BS.readFile (asset "sql.js")
        sql `shouldSatisfy` (not . BS.null)
    it "Monaco font exists and is non-empty" $ check $ do
        font <- BS.readFile (asset "codicon.ttf")
        font `shouldSatisfy` (not . BS.null)
    it "Monaco worker exists and is non-empty" $ check $ do
        names <- System.Directory.listDirectory "static"
        let workers = filter (\name -> "editor.worker-" `isInfixOf` name && ".js" `isSuffixOf` name) names
        workers `shouldSatisfy` (not . null)
        mapM_ (\name -> BS.readFile (asset name) >>= (`shouldSatisfy` (not . BS.null))) workers
    it "all build files pass the static file name whitelist" $ check $ do
        names <- System.Directory.listDirectory "static"
        mapM_ (\name -> safeRelative (T.pack name) `shouldBe` Just name) names

actionsSpec :: Spec
actionsSpec = describe "One-click actions -> one SQL statement (ChuSQL.Web.Actions)" $ do
    it "create table: column types and identifiers are validated" $ do
        createTableSql (CreateTableSpec "customers" [ColumnSpec "id" "int", ColumnSpec "name" "str"])
            `shouldBe` Right "CREATE TABLE customers (id int, name str)"
        createTableSql (CreateTableSpec "bad name" [ColumnSpec "id" "int"]) `shouldSatisfy` isLeftE
        createTableSql (CreateTableSpec "t" []) `shouldSatisfy` isLeftE
        createTableSql (CreateTableSpec "t" [ColumnSpec "id" "blob"]) `shouldSatisfy` isLeftE
        createTableSql (CreateTableSpec "t" [ColumnSpec "1bad" "int"]) `shouldSatisfy` isLeftE
        createTableSql (CreateTableSpec "t" [ColumnSpec "id" "BOOL"]) `shouldSatisfy` isRightE
    it "string literal escaping: single quotes doubled, the rest unchanged" $ do
        sqlLiteral (VStr "O'Brien") `shouldBe` "'O''Brien'"
        sqlLiteral (VStr "a\\b") `shouldBe` "'a\\b'"
        sqlLiteral (VInt 7) `shouldBe` "7"
        sqlLiteral (VBool True) `shouldBe` "TRUE"
        sqlLiteral (VBool False) `shouldBe` "FALSE"
    it "statement shapes for insert / update / delete / index" $ do
        insertRowSql "t" [("id", VInt 1), ("name", VStr "a")]
            `shouldBe` Right "INSERT INTO t (id, name) VALUES (1, 'a')"
        insertRowsSql "t" [[("id", VInt 1)], [("id", VInt 2)]]
            `shouldBe` Right "INSERT INTO t (id) VALUES (1), (2)"
        updateRowSql "t" 3 [("age", VInt 9)]
            `shouldBe` Right "UPDATE t SET age = 9 WHERE id = 3"
        deleteRowSql "t" 3 `shouldBe` Right "DELETE FROM t WHERE id = 3"
        createIndexSql "t" "sku" `shouldBe` Right "CREATE INDEX ON t (sku)"
        dropIndexSql "t" "sku" `shouldBe` Right "DROP INDEX ON t (sku)"
        dropTableSql "t" `shouldBe` Right "DROP TABLE t"
    it "injection shapes cannot get in (the whitelist runs before SQL is built)" $ do
        dropTableSql "users; DROP TABLE users" `shouldSatisfy` isLeftE
        createIndexSql "t" "c) --" `shouldSatisfy` isLeftE
        insertRowSql "t" [("id; DROP", VInt 1)] `shouldSatisfy` isLeftE
        insertRowSql "t" [] `shouldSatisfy` isLeftE
    it "JSON values coerce by column type: int takes numbers/numeric strings, str takes strings, bool takes booleans/true|false" $ do
        coerceValue TInt (A.Number 3) `shouldBe` Right (VInt 3)
        coerceValue TInt (A.String "42") `shouldBe` Right (VInt 42)
        coerceValue TInt (A.String "x") `shouldSatisfy` isLeftE
        coerceValue TStr (A.String "hi") `shouldBe` Right (VStr "hi")
        coerceValue TStr (A.Number 1) `shouldSatisfy` isLeftE
        coerceValue TBool (A.Bool True) `shouldBe` Right (VBool True)
        coerceValue TBool (A.String "false") `shouldBe` Right (VBool False)
        coerceValue TBool (A.String "maybe") `shouldSatisfy` isLeftE
    it "column type parsing: int/integer/str/text/varchar/bool/boolean are recognised" $ do
        map columnTypeOf ["int", "INTEGER", "str", "text", "varchar", "bool", "boolean"]
            `shouldBe` map Just [TInt, TInt, TStr, TStr, TStr, TBool, TBool]
        columnTypeOf "blob" `shouldBe` Nothing

oneClickSpec :: FilePath -> Spec
oneClickSpec staticDir = describe "One-click action endpoints" $
    withWorld staticDir $ \_ -> do
        it "create -> insert -> update -> delete -> drop through the structured endpoints (incl. bool columns and quote escaping)" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            created <-
                postWith
                    hs
                    "/api/tables"
                    "{\"name\":\"customers\",\"columns\":[{\"name\":\"id\",\"type\":\"int\"},{\"name\":\"name\",\"type\":\"str\"},{\"name\":\"vip\",\"type\":\"bool\"}]}"
            check (hasStatus created 200)
            inserted <- postWith hs "/api/tables/customers/rows" "{\"values\":{\"id\":1,\"name\":\"O'Brien\",\"vip\":true}}"
            check (hasStatus inserted 200)
            page <- getWith hs "/api/tables/customers/rows"
            check (asInt (at "total" (jsonBody page)) `shouldBe` 1)
            check (firstRow page `shouldBe` [A.Number 1, A.String "O'Brien", A.Bool True])
            patched <-
                request
                    "PATCH"
                    "/api/tables/customers/rows/1"
                    (("Content-Type", "application/json") : hs)
                    "{\"values\":{\"vip\":false,\"name\":\"O''Brien\"}}"
            check (hasStatus patched 200)
            afterEdit <- getWith hs "/api/tables/customers/rows"
            check (firstRow afterEdit `shouldBe` [A.Number 1, A.String "O''Brien", A.Bool False])
            removed <- request "DELETE" "/api/tables/customers/rows/1" hs ""
            check (hasStatus removed 200)
            empty <- getWith hs "/api/tables/customers/rows"
            check (asInt (at "total" (jsonBody empty)) `shouldBe` 0)
            dropped <- request "DELETE" "/api/tables/customers" hs ""
            check (hasStatus dropped 200)
            gone <- getWith hs "/api/tables/customers"
            check (hasStatus gone 404)
        it "bad input always gives 400/404, never a half-built SQL" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            badName <- postWith hs "/api/tables" "{\"name\":\"bad name\",\"columns\":[{\"name\":\"id\",\"type\":\"int\"}]}"
            check (hasStatus badName 400)
            unknownColumn <- postWith hs "/api/tables/users/rows" "{\"values\":{\"nope\":1}}"
            check (hasStatus unknownColumn 400)
            missingColumns <- postWith hs "/api/tables/users/rows" "{\"values\":{\"id\":99}}"
            check (hasStatus missingColumns 400)
            badBody <- postWith hs "/api/tables/users/rows" "not json"
            check (hasStatus badBody 400)
            badId <- request "PATCH" "/api/tables/users/rows/abc" (("Content-Type", "application/json") : hs) "{\"values\":{\"age\":1}}"
            check (hasStatus badId 400)
            noTable <- postWith hs "/api/tables/nope/rows" "{\"values\":{\"id\":1}}"
            check (hasStatus noTable 404)
            badType <- postWith hs "/api/tables/users/rows" "{\"values\":{\"id\":1,\"name\":\"x\",\"age\":\"old\"}}"
            check (hasStatus badType 400)
        it "index: integer columns work, string columns are rejected by the API (duplicate rejection is up to real storage, see e2e)" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            okIndex <- postWith hs "/api/tables/users/indexes" "{\"column\":\"age\"}"
            check (hasStatus okIndex 200)
            stringIndex <- postWith hs "/api/tables/users/indexes" "{\"column\":\"name\"}"
            check (hasStatus stringIndex 400)
            dropped <- request "DELETE" "/api/tables/users/indexes/age" hs ""
            check (hasStatus dropped 200)
            builtIn <- request "DELETE" "/api/tables/users/indexes/id" hs ""
            check (hasStatus builtIn 400)
        it "drop column: the column is gone but rows stay; built-in id and unknown column/table are rejected" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            created <- postWith hs "/api/tables" "{\"name\":\"drop_col_t\",\"columns\":[{\"name\":\"id\",\"type\":\"int\"},{\"name\":\"code\",\"type\":\"int\"},{\"name\":\"note\",\"type\":\"str\"}]}"
            check (hasStatus created 200)
            inserted <- postWith hs "/api/tables/drop_col_t/rows" "{\"values\":{\"id\":1,\"code\":7,\"note\":\"a\"}}"
            check (hasStatus inserted 200)
            droppedColumn <- request "DELETE" "/api/tables/drop_col_t/columns/code" hs ""
            check (hasStatus droppedColumn 200)
            info <- getWith hs "/api/tables/drop_col_t"
            check $ do
                let names = map (asText . at "name") (items (at "columns" (jsonBody info)))
                names `shouldBe` ["id", "note"]
            page <- getWith hs "/api/tables/drop_col_t/rows"
            check (hasStatus page 200)
            check (map asText (items (at "columns" (jsonBody page))) `shouldBe` ["id", "note"])
            check (firstRow page `shouldBe` [A.Number 1, A.String "a"])
            builtInColumn <- request "DELETE" "/api/tables/drop_col_t/columns/id" hs ""
            check (hasStatus builtInColumn 400)
            unknownColumn <- request "DELETE" "/api/tables/drop_col_t/columns/nope" hs ""
            check (hasStatus unknownColumn 400)
            unknownTable <- request "DELETE" "/api/tables/nope/columns/code" hs ""
            check (hasStatus unknownTable 404)
        it "demo data: fills what is missing, repeated clicks do not re-seed (users/orders already exist in memory)" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            first <- postWith hs "/api/demo-data" "{}"
            check (hasStatus first 200)
            check (arrayLen (at "created" (jsonBody first)) + arrayLen (at "skipped" (jsonBody first)) `shouldBe` 3)
            products <- getWith hs "/api/tables/products/rows?limit=100"
            check (asInt (at "total" (jsonBody products)) `shouldBe` 8)
            users <- getWith hs "/api/tables/users/rows?limit=100"
            check (asInt (at "total" (jsonBody users)) `shouldBe` 5)
            again <- postWith hs "/api/demo-data" "{}"
            check (hasStatus again 200)
            check (arrayLen (at "created" (jsonBody again)) `shouldBe` 0)
            check (arrayLen (at "skipped" (jsonBody again)) `shouldBe` 3)
            usersAgain <- getWith hs "/api/tables/users/rows?limit=100"
            check (asInt (at "total" (jsonBody usersAgain)) `shouldBe` 5)

authSpec :: FilePath -> Spec
authSpec staticDir = do
    describe "Auth: not logged in" $
        withWorld staticDir $ \_ -> do
            it "health check needs no login" $
                get "/api/health" `shouldRespondWith` 200
            it "table list gives 401" $
                get "/api/tables" `shouldRespondWith` 401
            it "table rows give 401" $
                get "/api/tables/users/rows" `shouldRespondWith` 401
            it "SQL console gives 401" $
                jsonRequest methodPost "/api/query" "{\"sql\":\"SELECT * FROM users\"}" `shouldRespondWith` 401
            it "session lookup gives 401" $
                get "/api/session" `shouldRespondWith` 401
            it "status needs no login and reports storage up (the memory backend is always up)" $ do
                res <- get "/api/status"
                check (hasStatus res 200)
                check (asText (at "storage" (jsonBody res)) `shouldBe` "up")
            it "the home page needs no login (the frontend switches to the login view)" $
                get "/" `shouldRespondWith` 200

    describe "Auth: login" $
        withWorld staticDir $ \_ -> do
            it "correct password: 204 + session cookie (HttpOnly / SameSite=Strict)" $ do
                res <- loginAs "admin" "s3cret"
                check (hasStatus res 204)
                let rawCookie = fmap TE.decodeUtf8 (lookup "Set-Cookie" (WT.simpleHeaders res))
                check (rawCookie `shouldSatisfy` maybe False (T.isInfixOf "HttpOnly"))
                check (rawCookie `shouldSatisfy` maybe False (T.isInfixOf "SameSite=Strict"))
                check (sessionCookieOf res `shouldSatisfy` maybe False (not . T.null))
            it "wrong password gives 401" $
                loginAs "admin" "nope" `shouldRespondWith` 401
            it "the username is case-insensitive but the password must match" $
                loginAs "ADMIN" "s3cret" `shouldRespondWith` 204
            it "non-JSON body gives 400" $
                jsonRequest methodPost "/api/login" "{not json" `shouldRespondWith` 400
            it "missing field gives 400" $
                jsonRequest methodPost "/api/login" "{\"user\":\"admin\"}" `shouldRespondWith` 400
            it "empty password gives 400" $
                jsonRequest methodPost "/api/login" "{\"user\":\"admin\",\"password\":\"\"}" `shouldRespondWith` 400
            it "a cookie allows session lookup" $ do
                res <- loginAs "admin" "s3cret"
                cs <- getWith (cookieHeaders res) "/api/session"
                check (hasStatus cs 200)
                check (asText (at "user" (jsonBody cs)) `shouldBe` "admin")
            it "logout invalidates the session immediately" $ do
                res <- loginAs "admin" "s3cret"
                out <- postWith (cookieHeaders res) "/api/logout" "{}"
                check (hasStatus out 204)
                gone <- getWith (cookieHeaders res) "/api/tables"
                check (hasStatus gone 401)
            it "a forged token gets nothing" $
                getWith [("Cookie", "chusql_session=deadbeef")] "/api/tables" `shouldRespondWith` 401

    describe "Auth: login failure rate limiting" $
        withWorld staticDir $ \_ -> do
            it "after 5 failures the 6th is 429 (even with the right password)" $ do
                mapM_ (const (loginAs "admin" "wrong")) [1 :: Int, 2, 3, 4, 5]
                blocked <- loginAs "admin" "s3cret"
                check (hasStatus blocked 429)
                check (lookup "Retry-After" (WT.simpleHeaders blocked) `shouldSatisfy` maybe False (not . BS.null))

catalogSpec :: FilePath -> Spec
catalogSpec staticDir = describe "Catalogue and paged browsing" $
    withWorld staticDir $ \_ -> do
        it "table list carries row counts, columns, indexes and stats" $ do
            res <- loginAs "admin" "s3cret"
            list <- getWith (cookieHeaders res) "/api/tables"
            check (hasStatus list 200)
            check $ do
                let tables = items (jsonBody list)
                map (asText . at "table") tables `shouldBe` ["users", "orders"]
                case tables of
                    [] -> expectationFailure "the table list is empty"
                    (usersInfo : _) -> do
                        asInt (at "rowCount" usersInfo) `shouldBe` 5
                        map (asText . at "name") (items (at "columns" usersInfo)) `shouldBe` ["id", "name", "age"]
                        let cols = items (at "columns" usersInfo)
                        case cols of
                            (firstCol : secondCol : _) -> do
                                at "primaryKey" firstCol `shouldBe` A.Bool True
                                at "prime" firstCol `shouldBe` A.Bool True
                                asInt (at "distinct" firstCol) `shouldBe` 5
                                at "primaryKey" secondCol `shouldBe` A.Bool False
                                at "prime" secondCol `shouldBe` A.Bool False
                                at "indexed" secondCol `shouldBe` A.Bool False
                            _ -> expectationFailure "users should have three columns"
        it "single table structure" $ do
            res <- loginAs "admin" "s3cret"
            info <- getWith (cookieHeaders res) "/api/tables/users"
            check (hasStatus info 200)
            check (asText (at "table" (jsonBody info)) `shouldBe` "users")
        it "missing table gives 404" $ do
            res <- loginAs "admin" "s3cret"
            missing <- getWith (cookieHeaders res) "/api/tables/nope"
            check (hasStatus missing 404)
        it "invalid table name gives 400 (never built into SQL)" $ do
            res <- loginAs "admin" "s3cret"
            bad <- getWith (cookieHeaders res) "/api/tables/1bad/rows"
            check (hasStatus bad 400)
        it "paging: limit/offset apply and total is the full row count" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?limit=2&offset=1"
            check (hasStatus page 200)
            check $ do
                let body = jsonBody page
                asInt (at "total" body) `shouldBe` 5
                asInt (at "limit" body) `shouldBe` 2
                asInt (at "offset" body) `shouldBe` 1
                let rows = items (at "rows" body)
                length rows `shouldBe` 2
                nth 0 rows `shouldBe` Just (A.Array (V.fromList [A.Number 2, A.String "user2", A.Number 22]))
        it "an out-of-range limit is clamped to the cap of 500" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?limit=99999"
            check (asInt (at "limit" (jsonBody page)) `shouldBe` 500)
        it "non-integer limit gives 400" $ do
            res <- loginAs "admin" "s3cret"
            bad <- getWith (cookieHeaders res) "/api/tables/users/rows?limit=abc"
            check (hasStatus bad 400)
        it "empty tables are browsable too (columns come from the catalogue)" $ do
            res <- loginAs "admin" "s3cret"
            created <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"CREATE TABLE empty_t (id int, name str)\"}"
            check (hasStatus created 200)
            emptyPage <- getWith (cookieHeaders res) "/api/tables/empty_t/rows"
            check (hasStatus emptyPage 200)
            check $ do
                asInt (at "total" (jsonBody emptyPage)) `shouldBe` 0
                map asText (items (at "columns" (jsonBody emptyPage))) `shouldBe` ["id", "name"]
        it "filter param: equality per column, multiple conditions are AND (the WHERE row above the data grid)" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            one <- getWith hs "/api/tables/users/rows?filter=%5B%7B%22column%22%3A%22name%22%2C%22value%22%3A%22user2%22%7D%5D"
            check (hasStatus one 200)
            check $ do
                asInt (at "total" (jsonBody one)) `shouldBe` 1
                firstRow one `shouldBe` [A.Number 2, A.String "user2", A.Number 22]
            two <-
                getWith
                    hs
                    "/api/tables/users/rows?filter=%5B%7B%22column%22%3A%22age%22%2C%22value%22%3A%2223%22%7D%2C%7B%22column%22%3A%22id%22%2C%22value%22%3A%223%22%7D%5D"
            check $ do
                asInt (at "total" (jsonBody two)) `shouldBe` 1
                firstRow two `shouldBe` [A.Number 3, A.String "user3", A.Number 23]
        it "filter param: a blank cell counts as unfilled; unknown column / uncoercible value / non-JSON give 400" $ do
            res <- loginAs "admin" "s3cret"
            let hs = cookieHeaders res
            blank <- getWith hs "/api/tables/users/rows?filter=%5B%7B%22column%22%3A%22name%22%2C%22value%22%3A%22%22%7D%5D"
            check (asInt (at "total" (jsonBody blank)) `shouldBe` 5)
            unknown <- getWith hs "/api/tables/users/rows?filter=%5B%7B%22column%22%3A%22nope%22%2C%22value%22%3A%22x%22%7D%5D"
            check (hasStatus unknown 400)
            badType <- getWith hs "/api/tables/users/rows?filter=%5B%7B%22column%22%3A%22age%22%2C%22value%22%3A%22old%22%7D%5D"
            check (hasStatus badType 400)
            notJson <- getWith hs "/api/tables/users/rows?filter=oops"
            check (hasStatus notJson 400)

-- | 换一组更小的上限再跑
limitsSpec :: FilePath -> Spec
limitsSpec staticDir = describe "Paging and row limits follow the config" $ do
    appEnv <- runIO (freshWorld staticDir)
    runIO (setLive appEnv (defaultLive{lvPageSize = 1, lvMaxPageSize = 2, lvMaxRows = 2}))
    with (webApp appEnv) $ do
        it "a missing limit uses the configured page size" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows"
            check (hasStatus page 200)
            check (asInt (at "limit" (jsonBody page)) `shouldBe` 1)
        it "a limit above the cap is clamped to maxPageSize" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?limit=99"
            check (asInt (at "limit" (jsonBody page)) `shouldBe` 2)
        it "query results cap at maxRows rows and set truncated" $ do
            res <- loginAs "admin" "s3cret"
            out <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT * FROM users\"}"
            check (hasStatus out 200)
            check (length (items (at "rows" (jsonBody out))) `shouldBe` 2)
            check (at "truncated" (jsonBody out) `shouldBe` A.Bool True)

sqlSpec :: FilePath -> Spec
sqlSpec staticDir = describe "SQL console" $
    withWorld staticDir $ \_ -> do
        it "SELECT returns columns and rows" $ do
            res <- loginAs "admin" "s3cret"
            out <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT name, age FROM users WHERE age > 22 ORDER BY age\"}"
            check (hasStatus out 200)
            check $ do
                let body = jsonBody out
                map asText (items (at "columns" body)) `shouldBe` ["name", "age"]
                length (items (at "rows" body)) `shouldBe` 3
                asInt (at "rowCount" body) `shouldBe` 3
        it "inserted rows can be queried back" $ do
            res <- loginAs "admin" "s3cret"
            _ <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"INSERT INTO users (id, name, age) VALUES (9, 'newbie', 31)\"}"
            out <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT * FROM users WHERE id = 9\"}"
            check (length (items (at "rows" (jsonBody out))) `shouldBe` 1)
        it "multi-row INSERT is supported" $ do
            res <- loginAs "admin" "s3cret"
            _ <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"INSERT INTO users (id, name, age) VALUES (11, 'a', 1), (12, 'b', 2)\"}"
            out <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT * FROM users WHERE id > 10\"}"
            check (length (items (at "rows" (jsonBody out))) `shouldBe` 2)
        it "CREATE TABLE / DROP TABLE end-to-end" $ do
            res <- loginAs "admin" "s3cret"
            created <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"CREATE TABLE demo_t (id int, note str)\"}"
            check (hasStatus created 200)
            dropped <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"DROP TABLE demo_t\"}"
            check (hasStatus dropped 200)
        it "syntax error: 400 + the original message" $ do
            res <- loginAs "admin" "s3cret"
            bad <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT FROM WHERE\"}"
            check (hasStatus bad 400)
            check $ do
                asText (at "error" (jsonBody bad)) `shouldBe` "query_error"
                asText (at "message" (jsonBody bad)) `shouldSatisfy` (not . T.null)
        it "missing table gives 404" $ do
            res <- loginAs "admin" "s3cret"
            missing <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT * FROM nope\"}"
            check (hasStatus missing 404)
        it "empty sql gives 400" $ do
            res <- loginAs "admin" "s3cret"
            bad <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"   \"}"
            check (hasStatus bad 400)
        it "non-JSON body gives 400" $ do
            res <- loginAs "admin" "s3cret"
            bad <- postWith (cookieHeaders res) "/api/query" "oops"
            check (hasStatus bad 400)

-- | 设置接口：读写配置与改口令
settingsSpec :: FilePath -> Spec
settingsSpec staticDir = do
    describe "Settings endpoints" $
        withWorldAt staticDir "settings" $ \appEnv -> do
            it "not logged in gives 401" $
                get "/api/settings" `shouldRespondWith` 401
            it "read settings: every catalogue key is present and secrets only report whether set" $ do
                res <- loginAs "admin" "s3cret"
                body <- getWith (cookieHeaders res) "/api/settings"
                check (hasStatus body 200)
                check $ do
                    let payload = jsonBody body
                        entries = items (at "items" payload)
                    at "owner" payload `shouldBe` A.Bool True
                    T.null (asText (at "file" payload)) `shouldBe` False
                    length entries `shouldBe` length settingCatalogue
                    map (asText . at "key") entries `shouldBe` map siKey settingCatalogue
                    let secrets = [i | i <- entries, asText (at "kind" i) == "secret"]
                    secrets `shouldSatisfy` (not . null)
                    map (asText . at "value") secrets `shouldSatisfy` all T.null
                    let port = headEntry "port" entries
                    asText (at "source" port) `shouldBe` "default"
                    asText (at "value" port) `shouldBe` "7777"
                    at "rootOnly" port `shouldBe` A.Bool True
                    at "editable" port `shouldBe` A.Bool True
                    at "restart" port `shouldBe` A.Bool True
                    at "live" port `shouldBe` A.Bool False
                    let rows = headEntry "rows-per-page" entries
                    at "live" rows `shouldBe` A.Bool True
                    at "restart" rows `shouldBe` A.Bool False
            it "write settings: only catalogue keys are accepted and ints reject letters" $ do
                res <- loginAs "admin" "s3cret"
                unknown <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"nope\":\"1\"}}"
                check (hasStatus unknown 400)
                badType <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"rows-per-page\":\"abc\"}}"
                check (hasStatus badType 400)
                empty <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{}}"
                check (hasStatus empty 400)
            it "write settings: live keys apply at once (page size + body limit)" $ do
                res <- loginAs "admin" "s3cret"
                saved <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"rows-per-page\":\"2\",\"body-limit\":\"200\"}}"
                check (hasStatus saved 200)
                check (map asText (items (at "applied" (jsonBody saved))) `shouldMatchList` ["rows-per-page", "body-limit"])
                page <- getWith (cookieHeaders res) "/api/tables/users/rows"
                check (asInt (at "limit" (jsonBody page)) `shouldBe` 2)
                live <- liftIO (readLive appEnv)
                check (lvPageSize live `shouldBe` 2)
                check (lvBodyLimit live `shouldBe` 200)
                big <- jsonRequest methodPost "/api/query" (BL.fromStrict (BS.replicate 400 97))
                check (hasStatus big 413)
            it "write settings: restart-only keys are named" $ do
                res <- loginAs "admin" "s3cret"
                saved <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"static-dir\":\"static\"}}"
                check (hasStatus saved 200)
                check (map asText (items (at "restartRequired" (jsonBody saved))) `shouldContain` ["static-dir"])
            it "write settings: persisted values survive the next start (read back) and are sourced as settings file" $ do
                res <- loginAs "admin" "s3cret"
                _ <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"max-rows\":\"77\"}}"
                stored <- liftIO (readSettingsFile (aeSettingsFile appEnv))
                check (Map.lookup "max-rows" stored `shouldBe` Just "77")
                body <- getWith (cookieHeaders res) "/api/settings"
                check $ do
                    let entries = items (at "items" (jsonBody body))
                    asText (at "source" (headEntry "max-rows" entries)) `shouldBe` "settings file"
                    asText (at "value" (headEntry "max-rows" entries)) `shouldBe` "77"
            it "changing the max-rows setting truncates query results" $ do
                res <- loginAs "admin" "s3cret"
                _ <- putWith (cookieHeaders res) "/api/settings" "{\"values\":{\"max-rows\":\"2\"}}"
                out <- postWith (cookieHeaders res) "/api/query" "{\"sql\":\"SELECT * FROM users\"}"
                check (hasStatus out 200)
                check (length (items (at "rows" (jsonBody out))) `shouldBe` 2)
                check (at "truncated" (jsonBody out) `shouldBe` A.Bool True)
            it "non-config account: critical settings give 403, normal ones pass" $ do
                guest <- liftIO (createSession (aeSessions appEnv) "guest")
                let guestHeaders = [("Cookie", TE.encodeUtf8 ("chusql_session=" <> guest))]
                forbidden <- putWith guestHeaders "/api/settings" "{\"values\":{\"port\":\"9999\"}}"
                check (hasStatus forbidden 403)
                check (asText (at "error" (jsonBody forbidden)) `shouldBe` "forbidden")
                allowed <- putWith guestHeaders "/api/settings" "{\"values\":{\"rows-per-page\":\"4\"}}"
                check (hasStatus allowed 200)
                reloaded <- getWith guestHeaders "/api/settings"
                check $ do
                    let entries = items (at "items" (jsonBody reloaded))
                        port = headEntry "port" entries
                    asText (at "value" port) `shouldBe` "7777"
                    at "editable" port `shouldBe` A.Bool False
                    at "editable" (headEntry "rows-per-page" entries) `shouldBe` A.Bool True

    describe "Account: change password" $
        withWorldAt staticDir "password" $ \appEnv -> do
            it "not logged in gives 401" $
                postWith [] "/api/account/password" "{\"current\":\"s3cret\",\"next\":\"longenough\"}"
                    `shouldRespondWith` 401
            it "wrong current password: 400 bad_password" $ do
                res <- loginAs "admin" "s3cret"
                bad <- postWith (cookieHeaders res) "/api/account/password" "{\"current\":\"nope\",\"next\":\"longenough\"}"
                check (hasStatus bad 400)
                check (asText (at "error" (jsonBody bad)) `shouldBe` "bad_password")
            it "new password too short / same as the old one: 400" $ do
                res <- loginAs "admin" "s3cret"
                short <- postWith (cookieHeaders res) "/api/account/password" "{\"current\":\"s3cret\",\"next\":\"tiny\"}"
                check (hasStatus short 400)
                same <- postWith (cookieHeaders res) "/api/account/password" "{\"current\":\"s3cret\",\"next\":\"s3cret\"}"
                check (hasStatus same 400)
            it "after success: the new password logs in, the old one fails, other sessions are kicked and the hash is persisted" $ do
                tokenA <- liftIO (createSession (aeSessions appEnv) "admin")
                tokenB <- liftIO (createSession (aeSessions appEnv) "admin")
                let hdrs token = [("Cookie", TE.encodeUtf8 ("chusql_session=" <> token))]
                changed <- postWith (hdrs tokenA) "/api/account/password" "{\"current\":\"s3cret\",\"next\":\"brand-new-pass\"}"
                check (hasStatus changed 204)
                stillThere <- getWith (hdrs tokenA) "/api/session"
                check (hasStatus stillThere 200)
                kicked <- getWith (hdrs tokenB) "/api/session"
                check (hasStatus kicked 401)
                fresh <- loginAs "admin" "brand-new-pass"
                check (hasStatus fresh 204)
                stale <- loginAs "admin" "s3cret"
                check (hasStatus stale 401)
                stored <- liftIO (readSettingsFile (aeSettingsFile appEnv))
                check (Map.lookup "password-hash" stored `shouldSatisfy` maybe False hashLooksValid)
                check (Map.member "password" stored `shouldBe` False)

-- | 一份完整的合法 IDE 设置请求体
uiSettingsBody :: BL.ByteString
uiSettingsBody = "{\"uiFonts\":[\"JetBrains Mono\",\"Consolas\"],\"gridFonts\":[\"Consolas\"],\"sqlFonts\":[\"Mono\"],\"uiFontSize\":13,\"gridFontSize\":12,\"gridRowHeight\":24,\"sqlFontSize\":13,\"sqlLineHeight\":20,\"sqlTabSize\":2,\"pageSize\":200,\"nullText\":\"NULL\",\"sqlLineNumbers\":true,\"autocomplete\":true,\"minimap\":false,\"confirmBeforeCommit\":true}"

-- | 上面那份设置解出来的值
fullUiSettings :: A.Value
fullUiSettings = fromMaybe A.Null (A.decode uiSettingsBody)

-- | 在合法设置上换掉一个字段（试坏值用）
withUiField :: Text -> A.Value -> A.Value
withUiField key value = case fullUiSettings of
    A.Object o -> A.Object (KM.insert (K.fromText key) value o)
    other -> other

-- | n 项字体链
fontChainValue :: Int -> A.Value
fontChainValue n = A.Array (V.fromList (replicate n (A.String "Mono")))

uiSettingsSpec :: FilePath -> Spec
uiSettingsSpec staticDir = do
    describe "IDE settings validation" $ do
        it "accepts a complete valid object" $
            validateUiSettings fullUiSettings `shouldSatisfy` isRightE
        it "rejects an unknown key" $
            validateUiSettings (withUiField "nope" (A.Bool True)) `shouldSatisfy` isLeftE
        it "rejects a string where an integer is expected" $
            validateUiSettings (withUiField "uiFontSize" (A.String "13")) `shouldSatisfy` isLeftE
        it "rejects an integer outside its range" $ do
            validateUiSettings (withUiField "uiFontSize" (A.Number 10)) `shouldSatisfy` isLeftE
            validateUiSettings (withUiField "uiFontSize" (A.Number 17)) `shouldSatisfy` isLeftE
        it "rejects a font chain longer than ten entries" $
            validateUiSettings (withUiField "uiFonts" (fontChainValue 11)) `shouldSatisfy` isLeftE
        it "rejects a blank font name" $
            validateUiSettings (withUiField "gridFonts" (A.Array (V.fromList [A.String "  "]))) `shouldSatisfy` isLeftE
        it "rejects a number where a boolean is expected" $
            validateUiSettings (withUiField "minimap" (A.Number 1)) `shouldSatisfy` isLeftE
        it "names the offending key in the error" $
            case validateUiSettings (withUiField "pageSize" (A.Number 5)) of
                Left err -> err `shouldSatisfy` isInfixOf "pageSize"
                Right _ -> expectationFailure "expected a range error"

    describe "IDE settings file" $ do
        it "candidates look for the file in script/ first" $
            uiSettingsFileCandidates
                `shouldBe` [ "script" </> "chusql.ui.settings.json"
                           , ".." </> "script" </> "chusql.ui.settings.json"
                           , "chusql.ui.settings.json"
                           ]
        it "resolution picks one of the candidates" $ do
            path <- resolveUiSettingsFile
            path `shouldSatisfy` (`elem` uiSettingsFileCandidates)
        it "a missing file reads back as an empty object" $ do
            path <- tempUiSettingsPath "missing"
            removeIfExists path
            readUiSettings path `shouldReturn` A.Object KM.empty
        it "writing then reading round-trips the map and creates the directory" $ do
            tmp <- getTemporaryDirectory
            let dir = tmp </> "chusql-web-test-ui-file" </> "nested"
                path = dir </> "chusql.ui.settings.json"
                stored = Map.fromList [("minimap", A.Bool True), ("uiFontSize", A.Number 13)]
            removeIfExists path
            written <- writeUiSettings path stored
            written `shouldBe` Right ()
            readUiSettings path `shouldReturn` A.Object (KM.fromList [("minimap", A.Bool True), ("uiFontSize", A.Number 13)])

    describe "IDE settings endpoints" $
        withWorldAt staticDir "ui-settings" $ \appEnv -> do
            it "not logged in: GET and PUT both give 401" $ do
                get "/api/ui-settings" `shouldRespondWith` 401
                putWith [] "/api/ui-settings" uiSettingsBody `shouldRespondWith` 401
            it "a missing file reads back as an empty object" $ do
                res <- loginAs "admin" "s3cret"
                body <- getWith (cookieHeaders res) "/api/ui-settings"
                check (hasStatus body 200)
                check (jsonBody body `shouldBe` A.Object KM.empty)
            it "a valid body is stored whole and read back unchanged" $ do
                res <- loginAs "admin" "s3cret"
                saved <- putWith (cookieHeaders res) "/api/ui-settings" uiSettingsBody
                check (hasStatus saved 204)
                body <- getWith (cookieHeaders res) "/api/ui-settings"
                check (hasStatus body 200)
                check (jsonBody body `shouldBe` fullUiSettings)
            it "an unknown key gives 400 bad_request" $ do
                res <- loginAs "admin" "s3cret"
                bad <- putWith (cookieHeaders res) "/api/ui-settings" "{\"nope\":1}"
                check (hasStatus bad 400)
                check (asText (at "error" (jsonBody bad)) `shouldBe` "bad_request")
            it "a non-object JSON body gives 400" $ do
                res <- loginAs "admin" "s3cret"
                bad <- putWith (cookieHeaders res) "/api/ui-settings" "[]"
                check (hasStatus bad 400)
            it "a body over the live limit gives 413" $ do
                res <- loginAs "admin" "s3cret"
                check $ do
                    live <- readLive appEnv
                    setLive appEnv live{lvBodyLimit = 16}
                big <- putWith (cookieHeaders res) "/api/ui-settings" uiSettingsBody
                check (hasStatus big 413)

sortSpec :: FilePath -> Spec
sortSpec staticDir = describe "Sorting while browsing a table" $
    withWorld staticDir $ \_ -> do
        it "asc: the first row has the smallest age" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?sort=age&dir=asc"
            check (hasStatus page 200)
            check $ do
                asText (at "sort" (jsonBody page)) `shouldBe` "age"
                asText (at "dir" (jsonBody page)) `shouldBe` "asc"
                firstRow page `shouldBe` [A.Number 1, A.String "user1", A.Number 21]
        it "desc: the first row has the largest age" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?sort=age&dir=desc"
            check (hasStatus page 200)
            check (firstRow page `shouldBe` [A.Number 5, A.String "user5", A.Number 25])
        it "unknown column / invalid column name: 400" $ do
            res <- loginAs "admin" "s3cret"
            missing <- getWith (cookieHeaders res) "/api/tables/users/rows?sort=nope"
            check (hasStatus missing 400)
            invalid <- getWith (cookieHeaders res) "/api/tables/users/rows?sort=age%3B%20DROP%20TABLE%20users"
            check (hasStatus invalid 400)
        it "the direction accepts only asc/desc, anything else is asc" $ do
            res <- loginAs "admin" "s3cret"
            page <- getWith (cookieHeaders res) "/api/tables/users/rows?sort=age&dir=sideways"
            check (hasStatus page 200)
            check (asText (at "dir" (jsonBody page)) `shouldBe` "asc")

securitySpec :: FilePath -> Spec
securitySpec staticDir = do
    describe "Security: response headers and static files" $
        withWorld staticDir $ \_ -> do
            it "the per-page style nonce differs each time and matches the CSP" $ do
                first <- get "/"
                second <- get "/static/index.html"
                let responsePolicy res = fromMaybe "" (lookup "Content-Security-Policy" (WT.simpleHeaders res))
                    nonce res = BSC.takeWhile (/= '\'') (BSC.drop 7 (snd (BSC.breakSubstring "'nonce-" (responsePolicy res))))
                check $ do
                    BS.length (nonce first) `shouldBe` 64
                    nonce first `shouldNotBe` nonce second
                    BL.toStrict (WT.simpleBody first) `shouldSatisfy` BS.isInfixOf (nonce first)
                    BL.toStrict (WT.simpleBody second) `shouldSatisfy` BS.isInfixOf (nonce second)
                    responsePolicy first `shouldSatisfy` (not . BS.isInfixOf "unsafe-inline")
                    responsePolicy first `shouldSatisfy` BS.isInfixOf "script-src 'self';"
                    length (filter ((== "Content-Security-Policy") . fst) (WT.simpleHeaders first)) `shouldBe` 1
            it "every response carries CSP / nosniff / DENY / no-store" $ do
                res <- get "/api/health"
                let headerNames = map fst (WT.simpleHeaders res)
                check $ do
                    headerNames `shouldContain` ["Content-Security-Policy"]
                    headerNames `shouldContain` ["X-Content-Type-Options"]
                    headerNames `shouldContain` ["X-Frame-Options"]
                    headerNames `shouldContain` ["Cache-Control"]
            it "static JS uses the right Content-Type" $ do
                res <- get "/static/app.js"
                check (hasStatus res 200)
                check (lookup "Content-Type" (WT.simpleHeaders res) `shouldBe` Just "text/javascript; charset=utf-8")
            it "a missing static file gives 404" $
                get "/static/nope.js" `shouldRespondWith` 404
            it "URL-encoded traversal is rejected" $
                get "/static/%2e%2e%2fsecret.token" `shouldRespondWith` 404
            it "files outside the whitelist are unreadable" $
                get "/static/secret.token" `shouldRespondWith` 404
            it "an unmatched path gives 404 (JSON)" $ do
                res <- get "/api/nope"
                check (hasStatus res 404)
                check (asText (at "error" (jsonBody res)) `shouldBe` "not_found")
    describe "Security: cross-site and body size" $
        withWorld staticDir $ \_ -> do
            it "a cross-site Origin POST gives 403" $
                postWith
                    [("Origin", "http://evil.example"), ("Host", "127.0.0.1:8080")]
                    "/api/login"
                    (loginBody "admin" "s3cret")
                    `shouldRespondWith` 403
            it "a same-origin Origin POST works as usual (204 with the right password)" $ do
                res <-
                    postWith
                        [("Origin", "http://127.0.0.1:8080"), ("Host", "127.0.0.1:8080")]
                        "/api/login"
                        (loginBody "admin" "s3cret")
                check (hasStatus res 204)
            it "an oversized request with Content-Length gives 413" $
                postWith [("Content-Length", "999999")] "/api/login" (loginBody "admin" "s3cret")
                    `shouldRespondWith` 413
            it "a genuinely large body gives 413" $
                jsonRequest methodPost "/api/login" (BL.fromStrict (BS.replicate 70000 97))
                    `shouldRespondWith` 413

-- | 端到端：真 HTTP + 真 Rust 存储进程
e2eSpec :: FilePath -> Spec
e2eSpec staticDir = describe "End-to-end: browser -> Haskell -> Rust" $ do
    it "login -> create table -> insert -> query -> logout all the way through" $ do
        serverBin <- locateServerOrSkip
        started <- startStorageProcess serverBin
        running <- case started of
            Left err -> do
                expectationFailure err
                fail "the storage process did not start"
            Right ok -> pure ok
        bracket (pure running) stopStorageProcess $ \sp -> do
            backend <- ipcBackend
            clock <- newIORef =<< getCurrentTime
            sessions <- newSessionStore (readIORef clock) defaultSessionPolicy
            limiter <- newRateLimiter (readIORef clock) 50 300
            appEnv <- newAppEnv backend sessions testCredential limiter staticDir
            app <- webApp appEnv
            Warp.testWithApplication (pure app) $ \boundPort -> do
                mgr <- newManager defaultManagerSettings
                anon <- e2eGet mgr boundPort "/api/tables" []
                statusCode (responseStatus anon) `shouldBe` 401
                signedIn <- e2ePost mgr boundPort "/api/login" (loginBody "admin" "s3cret") []
                statusCode (responseStatus signedIn) `shouldBe` 204
                let cookie = e2eCookie signedIn
                cookie `shouldSatisfy` maybe False (not . BS.null)
                let auth = [("Cookie", fromMaybe "" cookie)]
                created <- e2ePost mgr boundPort "/api/query" "{\"sql\":\"CREATE TABLE web_e2e (id int, name str)\"}" auth
                statusCode (responseStatus created) `shouldBe` 200
                inserted <-
                    e2ePost
                        mgr
                        boundPort
                        "/api/query"
                        "{\"sql\":\"INSERT INTO web_e2e (id, name) VALUES (1, 'a'), (2, 'b'), (3, 'c')\"}"
                        auth
                statusCode (responseStatus inserted) `shouldBe` 200
                selected <- e2ePost mgr boundPort "/api/query" "{\"sql\":\"SELECT id, name FROM web_e2e ORDER BY id\"}" auth
                statusCode (responseStatus selected) `shouldBe` 200
                let body = fromMaybe A.Null (decode (responseBody selected))
                asInt (at "rowCount" body) `shouldBe` 3
                nth 2 (items (at "rows" body)) `shouldBe` Just (A.Array (V.fromList [A.Number 3, A.String "c"]))
                listed <- e2eGet mgr boundPort "/api/tables" auth
                statusCode (responseStatus listed) `shouldBe` 200
                let tableNames = map (asText . at "table") (items (fromMaybe A.Null (decode (responseBody listed))))
                tableNames `shouldContain` ["web_e2e"]
                home <- e2eGet mgr boundPort "/" []
                statusCode (responseStatus home) `shouldBe` 200
                BL.toStrict (responseBody home) `shouldSatisfy` BS.isInfixOf "ChuSQL"
                browsed <- e2eGet mgr boundPort "/api/tables/web_e2e/rows?limit=2" auth
                statusCode (responseStatus browsed) `shouldBe` 200
                asInt (at "total" (fromMaybe A.Null (decode (responseBody browsed)))) `shouldBe` 3
                uiCreated <- e2ePost mgr boundPort "/api/tables" "{\"name\":\"web_ui\",\"columns\":[{\"name\":\"id\",\"type\":\"int\"},{\"name\":\"code\",\"type\":\"int\"}]}" auth
                statusCode (responseStatus uiCreated) `shouldBe` 200
                uiIns <- e2ePost mgr boundPort "/api/tables/web_ui/rows" "{\"values\":{\"id\":1,\"code\":5}}" auth
                statusCode (responseStatus uiIns) `shouldBe` 200
                uiIdx <- e2ePost mgr boundPort "/api/tables/web_ui/indexes" "{\"column\":\"code\"}" auth
                statusCode (responseStatus uiIdx) `shouldBe` 200
                uiInfo <- e2eGet mgr boundPort "/api/tables/web_ui" auth
                let uiJson = fromMaybe A.Null (decode (responseBody uiInfo))
                sort (map (asText . at "column") (items (at "indexes" uiJson))) `shouldBe` ["code", "id"]
                map (at "builtIn") (items (at "indexes" uiJson)) `shouldSatisfy` elem (A.Bool True)
                _ <- e2ePost mgr boundPort "/api/tables/web_ui/rows" "{\"values\":{\"id\":2,\"code\":5}}" auth
                dupIdx <- e2ePost mgr boundPort "/api/tables/web_ui/indexes" "{\"column\":\"code\"}" auth
                statusCode (responseStatus dupIdx) `shouldBe` 400
                uiDel <- e2eSend mgr boundPort "DELETE" "/api/tables/web_ui/rows/2" "" auth
                statusCode (responseStatus uiDel) `shouldBe` 200
                uiRows <- e2eGet mgr boundPort "/api/tables/web_ui/rows" auth
                asInt (at "total" (fromMaybe A.Null (decode (responseBody uiRows)))) `shouldBe` 1
                droppedCol <- e2eSend mgr boundPort "DELETE" "/api/tables/web_ui/columns/code" "" auth
                statusCode (responseStatus droppedCol) `shouldBe` 200
                afterDrop <- e2eGet mgr boundPort "/api/tables/web_ui" auth
                let afterJson = fromMaybe A.Null (decode (responseBody afterDrop))
                map (asText . at "name") (items (at "columns" afterJson)) `shouldBe` ["id"]
                map (asText . at "column") (items (at "indexes" afterJson)) `shouldBe` ["id"]
                afterRows <- e2eGet mgr boundPort "/api/tables/web_ui/rows" auth
                let afterRowsJson = fromMaybe A.Null (decode (responseBody afterRows))
                asInt (at "total" afterRowsJson) `shouldBe` 1
                map asText (items (at "columns" afterRowsJson)) `shouldBe` ["id"]
                dropId <- e2eSend mgr boundPort "DELETE" "/api/tables/web_ui/columns/id" "" auth
                statusCode (responseStatus dropId) `shouldBe` 400
                demo <- e2ePost mgr boundPort "/api/demo-data" "{}" auth
                statusCode (responseStatus demo) `shouldBe` 200
                let demoJson = fromMaybe A.Null (decode (responseBody demo))
                arrayLen (at "created" demoJson) `shouldBe` 3
                demoProducts <- e2eGet mgr boundPort "/api/tables/products" auth
                let prodJson = fromMaybe A.Null (decode (responseBody demoProducts))
                map (asText . at "column") (items (at "indexes" prodJson)) `shouldContain` ["sku"]
                demoUsers <- e2eGet mgr boundPort "/api/tables/users/rows?limit=100" auth
                asInt (at "total" (fromMaybe A.Null (decode (responseBody demoUsers)))) `shouldBe` 10
                out <- e2ePost mgr boundPort "/api/logout" "{}" auth
                statusCode (responseStatus out) `shouldBe` 204
                afterLogout <- e2eGet mgr boundPort "/api/tables" auth
                statusCode (responseStatus afterLogout) `shouldBe` 401
                exists <- doesDirectoryExist (spDataDir sp)
                exists `shouldBe` True

-- | 找存储进程，cargo 不可用则 pending
locateServerOrSkip :: IO FilePath
locateServerOrSkip = do
    found <- firstDir [".." </> "chusql-storage", "chusql-storage"]
    case found of
        Nothing -> do
            expectationFailure "cannot find the chusql-storage directory (tests must run inside the repository)"
            pure ""
        Just storageDir -> do
            built <- buildServer storageDir
            case built of
                Left err
                    | "cannot run cargo" `isInfixOf` err -> do
                        pendingWith err
                        pure ""
                    | otherwise -> do
                        expectationFailure err
                        pure ""
                Right bin -> pure bin

-- | 编译 Rust 存储并找可执行文件
buildServer :: FilePath -> IO (Either String FilePath)
buildServer storageDir = do
    built <-
        try (createProcess (proc "cargo" ["build", "--bin", "chusql-storage"]){cwd = Just storageDir, std_out = NoStream, std_err = NoStream}) ::
            IO (Either IOException (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
    case built of
        Left e -> pure (Left ("cannot run cargo (Rust is required for the IPC tests): " ++ show e))
        Right (_, _, _, ph) -> do
            code <- waitForProcess ph
            case code of
                ExitFailure n -> pure (Left ("cargo build --bin chusql-storage failed with exit code " ++ show n))
                ExitSuccess -> do
                    found <-
                        firstFile
                            [ storageDir </> "target" </> "debug" </> "chusql-storage.exe"
                            , storageDir </> "target" </> "debug" </> "chusql-storage"
                            ]
                    pure (maybe (Left "cargo build finished but no storage executable was found") Right found)

-- | 找第一个存在的目录
firstDir :: [FilePath] -> IO (Maybe FilePath)
firstDir [] = pure Nothing
firstDir (d : ds) = do
    ok <- doesDirectoryExist d
    if ok then pure (Just d) else firstDir ds

-- | 找第一个存在的文件
firstFile :: [FilePath] -> IO (Maybe FilePath)
firstFile [] = pure Nothing
firstFile (p : ps) = do
    ok <- doesFileExist p
    if ok then pure (Just p) else firstFile ps

-- | 从响应头里取会话 Cookie
e2eCookie :: Response BL.ByteString -> Maybe BS.ByteString
e2eCookie resp = case lookup "Set-Cookie" (responseHeaders resp) of
    Nothing -> Nothing
    Just raw -> Just (BSC.takeWhile (/= ';') raw)

-- | 端到端：任意方法的 JSON 请求
e2eSend :: Manager -> Int -> BS.ByteString -> BS.ByteString -> BL.ByteString -> [Header] -> IO (Response BL.ByteString)
e2eSend mgr port httpMethod path payload headers = do
    base <- parseRequest ("http://127.0.0.1:" ++ show port ++ BSC.unpack path)
    httpLbs
        base
            { method = httpMethod
            , requestBody = RequestBodyLBS payload
            , requestHeaders = ("Content-Type", "application/json") : headers
            }
        mgr

-- | 端到端 POST
e2ePost :: Manager -> Int -> BS.ByteString -> BL.ByteString -> [Header] -> IO (Response BL.ByteString)
e2ePost mgr port path payload headers = e2eSend mgr port "POST" path payload headers

-- | 端到端 GET
e2eGet :: Manager -> Int -> BS.ByteString -> [Header] -> IO (Response BL.ByteString)
e2eGet mgr port path headers = do
    base <- parseRequest ("http://127.0.0.1:" ++ show port ++ BSC.unpack path)
    httpLbs base{requestHeaders = headers} mgr