api.R

# api.R
# EditR REST API - 使用 plumber 框架

library(plumber)
library(jsonlite)
library(parallel)

editrversion <- "2.0.0"

source("R/analysis.R")
source("R/data_processing.R")
source("R/database.R")
source("R/dailywork_curate.R")
source("R/archive_records.R")
source("R/merge_import.R")
# local = TRUE：把 handler 定义进 api.R 求值环境(E，plumber 的 router 环境)，
# 与 as_scalar_chr / upload_dir 等 api.R 顶部助手同处一环境，否则 handler 落到
# .GlobalEnv 后查找链到不了 E，运行期报 "could not find function as_scalar_chr"。
source("R/handlers_upload.R", local = TRUE)
source("R/handlers_analyze.R", local = TRUE)
source("R/handlers_archive.R", local = TRUE)
source("R/handlers_curate.R", local = TRUE)

db_ready <- check_db_ready()
sequence_db_path <- resolve_sequence_db_path()
db_init <- init_sequence_db(db_ready, sequence_db_path)

# 上传文件临时存储目录
upload_dir <- file.path(tempdir(), "editr_uploads")
dir.create(upload_dir, showWarnings = FALSE, recursive = TRUE)

# 持久化归档目录：与 SQLite 同数据目录下的 archive/，按 项目/批次 分层。
# sequence_db_path 为 NULL（无可写数据目录）时退回 tempdir。
archive_base <- if (!is.null(sequence_db_path)) {
  file.path(dirname(sequence_db_path), "archive")
} else {
  file.path(tempdir(), "editr_archive")
}
dir.create(archive_base, showWarnings = FALSE, recursive = TRUE)

# 文件名安全化（用于 项目/批次 目录名）
safe_path_segment <- function(x) {
  x <- as_scalar_chr(x)
  if (is.null(x) || !nzchar(x)) return("")
  gsub("[^A-Za-z0-9_.一-龥-]", "_", trimws(x))
}

# daily-work（FastAPI capture 管道）地址，同机默认 127.0.0.1:8762（APP_PORT）
dailywork_base_url <- Sys.getenv("DAILYWORK_BASE_URL", unset = "http://127.0.0.1:8762")
# daily-work 程序化 API 的 Bearer token（= daily-work APP_API_SECRET）。
# 优先读 env；缺失时读数据目录下的 dailywork_token 文件（避免写进 systemd/代码）。
dailywork_token <- local({
  t <- Sys.getenv("DAILYWORK_API_TOKEN", unset = "")
  if (!nzchar(t) && !is.null(sequence_db_path)) {
    tf <- file.path(dirname(sequence_db_path), "dailywork_token")
    if (file.exists(tf)) t <- trimws(readLines(tf, warn = FALSE)[1])
  }
  t
})
dailywork_auth_header <- function() {
  if (nzchar(dailywork_token)) httr::add_headers(Authorization = paste("Bearer", dailywork_token)) else httr::add_headers()
}

rename_presets <- list(
  strip_extension = list(pattern = "\\.ab1$", replacement = ""),
  strip_leading_index = list(pattern = "^[0-9]+_", replacement = ""),
  strip_tss_suffix = list(pattern = "_TSS[0-9-]+_[A-Z][0-9]{2}\\.ab1$", replacement = ""),
  keep_index_and_primer = list(pattern = "^([0-9]+_[^_]+).*$", replacement = "\\1"),
  combined_default = list(pattern = "^([0-9]+_[^_]+).*$", replacement = "\\1")
)

# 把可能被 JSON 解析成数组/list 的字段强制转成单个字符串标量。
# 前端会把 plumber 序列化出的 ["xxx"] 原样回传，若直接用作 env 的 key
# 会触发 "wrong args for environment subassignment"。
as_scalar_chr <- function(x) {
  if (is.null(x)) return(NULL)
  v <- as.character(unlist(x))
  if (length(v) == 0) NULL else v[[1]]
}

# session 结果缓存：session_id -> list(analysis=..., zip_path=...)
# 分析时把结果存进来，下载时直接复用，避免下载时再跑一遍分析。
session_results <- new.env(parent = emptyenv())

# 确保某个 session 的结果 ZIP 已生成并返回路径：
# 1) 已缓存 zip 直接复用；2) 有分析缓存则据此打包；3) 缓存失效则用 params 重分析后打包。
ensure_session_zip <- function(session_id, params = NULL, grouping = NULL, frontend_charts = NULL) {
  session_id <- as_scalar_chr(session_id)
  session_dir <- file.path(upload_dir, session_id)
  if (!dir.exists(session_dir)) stop("Session 不存在")

  grouping_df <- grouping_to_df(grouping)
  # 分组签名：分组变化时让缓存的 zip 失效，触发重新打包
  group_sig <- if (is.null(grouping_df)) "" else digest_grouping(grouping_df)
  cache_sig <- paste(group_sig, digest_params(params), charts_cache_digest(frontend_charts), sep = "||")

  cached <- session_results[[session_id]]
  cache_prev_sig <- if (is.null(cached)) NULL else (cached$cache_sig %||% "")
  if (!is.null(cached) && !is.null(cached$zip_path) && file.exists(cached$zip_path) &&
      identical(cache_prev_sig, cache_sig)) {
    return(cached$zip_path)
  }

  if (is.null(cached) || is.null(cached$analysis)) {
    if (is.null(params)) stop("结果缓存已失效，请重新分析。")
    analysis <- run_batch_analysis(
      session_dir, params$sequence, params$target_position,
      params$target_base, params$edited_base,
      params$rename_config %||% list(), rename_presets,
      params$guide_overrides %||% list(), params$ref_sequence %||% NULL,
      params$ref_target_pos %||% NULL
    )
    cached <- list(
      analysis = analysis,
      rename_config = params$rename_config %||% list(),
      template_name = params$template_name %||% "results",
      guide_overrides = params$guide_overrides %||% list(),
      ref_sequence = params$ref_sequence %||% NULL,
      zip_path = NULL
    )
  }

  a <- cached$analysis
  zip_path <- generate_results_zip(
    session_dir, a$summary_df, a$raw_df, a$errors, a$name_map,
    cached$template_name, grouping_df,
    frontend_charts = frontend_charts
  )
  cached$zip_path <- zip_path
  cached$cache_sig <- cache_sig
  session_results[[session_id]] <- cached
  zip_path
}

# 分组签名（用于缓存失效判定）：把分组拍平成稳定字符串
digest_grouping <- function(grouping_df) {
  if (is.null(grouping_df) || nrow(grouping_df) == 0) return("")
  ordered <- grouping_df[order(grouping_df$Table_Name), , drop = FALSE]
  paste(ordered$Table_Name, ordered$Condition, ordered$Replicate,
        sep = "
", collapse = "")
}

#* @apiTitle EditR API
#* @apiDescription Base editing analysis REST API for Sanger sequencing data

# ============================================================
# 健康检查
# ============================================================
#* 健康检查
#* @get /api/health
function() {
  list(
    status = "ok",
    version = editrversion,
    timestamp = format(Sys.time(), "%Y-%m-%d %H:%M:%S"),
    db_ready = db_ready
  )
}

# ============================================================
# 文件上传（独立端点，返回 session_id）
# ============================================================
#* 上传 .ab1 文件（multipart form-data）
#* @post /api/upload
#* @serializer json
#* @parser multi
function(req) {
  tryCatch({
    # 创建本次上传的会话目录
    session_id <- format(Sys.time(), "%Y%m%d%H%M%S_") |> paste0(sample(1000:9999, 1))
    session_dir <- file.path(upload_dir, session_id)
    dir.create(session_dir, showWarnings = FALSE, recursive = TRUE)

    # 从 multipart 请求中提取文件
    if (!is.null(req$postBody) && nchar(req$postBody) > 0) {
      # 解析 multipart boundary
      content_type <- req$HTTP_CONTENT_TYPE %||% req$headers[["content-type"]] %||% ""
      boundary_match <- regmatches(content_type, regexpr("boundary=[^;]+", content_type))
      if (length(boundary_match) == 0) {
        res$status <- 400
        return(list(success = FALSE, error = "无法解析上传请求。"))
      }
      boundary <- sub("boundary=", "", boundary_match)

      # 写入原始 body 到临时文件再解析
      body_raw <- req$postBodyRaw
      if (is.null(body_raw)) {
        body_raw <- chartr(" ", "\n", req$postBody)
        body_raw <- charToRaw(paste(body_raw, collapse = "\n"))
      }

      tmp_body <- tempfile("upload_body_")
      writeBin(body_raw, tmp_body)
      on.exit(unlink(tmp_body), add = TRUE)

      # 用 R 内置的 multipart 解析
      parsed <- tryCatch({
        # plumber 内部的 multipart 处理
        parts <- .parse_multipart(tmp_body, boundary)
        parts
      }, error = function(e) NULL)

      if (is.null(parsed)) {
        # 备选方案：用 curl 解析
        res$status <- 400
        return(list(success = FALSE, error = "文件解析失败，请使用 /api/upload/file 端点逐个上传。"))
      }

      raw_names <- vapply(names(parsed), function(part_name) {
        p <- parsed[[part_name]]
        if (!is.null(p$filename)) p$filename else ""
      }, character(1))
      keep <- raw_names != ""
      parts2 <- parsed[names(parsed)[keep]]
      stored <- dedup_basenames(raw_names[keep])
      uploaded_files <- character(0)
      for (j in seq_along(parts2)) {
        writeBin(parts2[[j]]$value, file.path(session_dir, stored[j]))
        uploaded_files <- c(uploaded_files, stored[j])
      }

      list(
        success = TRUE,
        session_id = session_id,
        files = uploaded_files,
        n_files = length(uploaded_files)
      )
    } else {
      res$status <- 400
      list(success = FALSE, error = "未接收到文件数据。")
    }
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("上传失败：", e$message))
  })
}

# ============================================================
# 文件上传（二进制单文件，更可靠）
# ============================================================
#* 上传单个 .ab1 文件（二进制 body + 查询参数指定文件名）
#* @param filename 文件名
#* @post /api/upload/file
#* @serializer json
#* @parser octet
function(req, filename, res) {
  tryCatch({
    if (is.null(filename) || filename == "") {
      res$status <- 400
      return(list(success = FALSE, error = "请提供 filename 参数。"))
    }

    # 创建或复用会话
    session_id <- req$headers[["x-session-id"]] %||%
                  req$headers[["X-Session-Id"]] %||%
                  req$HTTP_X_SESSION_ID
    if (is.null(session_id) || session_id == "") {
      session_id <- format(Sys.time(), "%Y%m%d%H%M%S_") |> paste0(sample(1000:9999, 1))
    }
    session_dir <- file.path(upload_dir, session_id)
    dir.create(session_dir, showWarnings = FALSE, recursive = TRUE)

    # 写入文件（去重：同名追加 _i，避免覆盖；返回实际存储名）
    dest_name <- basename(filename)
    if (file.exists(file.path(session_dir, dest_name))) {
      base <- tools::file_path_sans_ext(dest_name)
      ext <- tools::file_ext(dest_name)
      i <- 1
      repeat {
        dest_name <- paste0(base, "_", i, if (nzchar(ext)) paste0(".", ext) else "")
        if (!file.exists(file.path(session_dir, dest_name))) break
        i <- i + 1
      }
    }
    dest <- file.path(session_dir, dest_name)
    body <- req$bodyRaw
    if (is.null(body)) {
      res$status <- 400
      return(list(success = FALSE, error = "未接收到文件数据。"))
    }
    writeBin(body, dest)

    list(
      success = TRUE,
      session_id = session_id,
      filename = dest_name,
      size = file.info(dest)$size
    )
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("上传失败：", e$message))
  })
}

# ============================================================
# ZIP 上传并解压提取 .ab1 文件
# ============================================================
#* 上传 ZIP 压缩包并解压提取 .ab1 文件
#* @post /api/upload/zip
#* @serializer json
#* @parser octet
function(req, res) handle_upload_zip(req, res)

# ============================================================
# 批量分析（基于已上传文件的 session_id）
# ============================================================
#* 批量分析已上传的 .ab1 文件
#* @param session_id 上传会话 ID
#* @param sequence 参考序列 (ACGT)
#* @param target_position 目标位置
#* @param target_base 目标碱基 (A/C/G/T)
#* @param edited_base 编辑后碱基 (A/C/G/T)
#* @post /api/analyze
#* @serializer json
function(req, res) handle_analyze(req, res)

# ============================================================
# 预生成结果 ZIP（分析完成后前端立即调用，下载时即可秒下）
# ============================================================
#* 预生成结果 ZIP 包
#* @post /api/results/prepare
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    session_id <- as_scalar_chr(body$session_id)
    if (is.null(session_id) || session_id == "") {
      res$status <- 400
      return(list(success = FALSE, error = "缺少 session_id"))
    }
    # 优先用分析缓存；缺失时用请求里的参数兜底重分析
    params <- if (!is.null(body$sequence)) {
      list(
        sequence = toupper(trimws(body$sequence)),
        target_position = as.integer(body$target_position),
        target_base = toupper(body$target_base),
        edited_base = toupper(body$edited_base),
        rename_config = if (!is.null(body$rename_config)) body$rename_config else list(),
        template_name = if (!is.null(body$template_name)) body$template_name else "results"
      )
    } else {
      NULL
    }
    zip_path <- ensure_session_zip(session_id, params, body$grouping, body$charts)
    list(success = TRUE, ready = TRUE, filename = basename(zip_path))
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("生成结果包失败：", e$message))
  })
}

# ============================================================
# 序列模板 CRUD
# ============================================================
#* 获取序列模板列表
#* @get /api/templates
#* @serializer json
function() {
  templates <- load_sequence_templates(db_ready, sequence_db_path)
  list(success = TRUE, data = templates)
}

#* 保存序列模板
#* @param name 模板名称
#* @param sequence 序列
#* @param target_position 目标位置
#* @post /api/templates
#* @serializer json
function(name, sequence, target_position, res) {
  tryCatch({
    sequence <- toupper(trimws(sequence))
    target_position <- as.integer(target_position)

    if (name == "") {
      res$status <- 400
      return(list(success = FALSE, error = "模板名称不能为空。"))
    }
    if (!grepl("^[ACGT]+$", sequence)) {
      res$status <- 400
      return(list(success = FALSE, error = "序列仅支持 A/C/G/T 字符。"))
    }
    if (target_position < 1 || target_position > nchar(sequence)) {
      res$status <- 400
      return(list(success = FALSE, error = "目标位置超出序列长度。"))
    }

    result <- save_sequence_template(db_ready, sequence_db_path, name, sequence, target_position)
    list(success = result$ok, message = result$msg, id = result$id)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("保存模板失败：", e$message))
  })
}

#* 删除序列模板
#* @param id 模板 ID
#* @delete /api/templates
#* @serializer json
function(id, res) {
  tryCatch({
    result <- delete_sequence_template(db_ready, sequence_db_path, as.integer(id))
    list(success = result$ok, message = result$msg)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("删除模板失败：", e$message))
  })
}

# ============================================================
# 正则预设 CRUD
# ============================================================
#* 获取正则预设列表
#* @get /api/regex
#* @serializer json
function() {
  presets <- load_regex_presets(db_ready, sequence_db_path)
  list(success = TRUE, data = presets)
}

#* 保存正则预设
#* @param name 预设名称
#* @param pattern 正则表达式
#* @param replacement 替换字符串
#* @post /api/regex
#* @serializer json
function(name, pattern, replacement, res) {
  tryCatch({
    if (name == "") {
      res$status <- 400
      return(list(success = FALSE, error = "预设名称不能为空。"))
    }
    if (pattern == "") {
      res$status <- 400
      return(list(success = FALSE, error = "正则表达式不能为空。"))
    }

    tryCatch(
      gsub(pattern, "", "test", perl = TRUE),
      error = function(e) {
        res$status <- 400
        stop(paste("正则表达式无效：", e$message))
      }
    )

    result <- save_regex_preset(db_ready, sequence_db_path, name, pattern, replacement)
    list(success = result$ok, message = result$msg, id = result$id)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("保存正则预设失败：", e$message))
  })
}

#* 删除正则预设
#* @param id 预设 ID
#* @delete /api/regex
#* @serializer json
function(id, res) {
  tryCatch({
    result <- delete_regex_preset(db_ready, sequence_db_path, as.integer(id))
    list(success = result$ok, message = result$msg)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("删除正则预设失败：", e$message))
  })
}

# ============================================================
# 文件重命名
# ============================================================
#* 预览文件重命名
#* @param file_names 文件名列表 (JSON array)
#* @param pattern 正则表达式
#* @param replacement 替换字符串
#* @param tag 标签
#* @post /api/rename/preview
#* @serializer json
function(file_names, pattern = NULL, replacement = NULL, tag = NULL, res) {
  tryCatch({
    file_names_parsed <- fromJSON(file_names)
    result <- compute_renamed_files(file_names_parsed, pattern, replacement, tag)
    list(success = TRUE, data = result)
  }, error = function(e) {
    res$status <- 400
    list(success = FALSE, error = paste("预览失败：", e$message))
  })
}

#* 获取预设正则规则列表
#* @get /api/rename/presets
#* @serializer json
function() {
  list(success = TRUE, data = rename_presets)
}

# ============================================================
# Excel 下载
# ============================================================
#* 生成 Excel 下载
#* @param summary 摘要数据 (JSON)
#* @param per_position 位点数据 (JSON)
#* @param raw 原始数据 (JSON)
#* @param tag 标签
#* @post /api/download/excel
#* @serializer json
function(summary, per_position, raw, tag = NULL, res) {
  tryCatch({
    if (!requireNamespace("writexl", quietly = TRUE)) {
      res$status <- 500
      return(list(success = FALSE, error = "请先安装 writexl 包。"))
    }

    summary_df <- fromJSON(summary, simplifyDataFrame = TRUE)
    per_position_df <- fromJSON(per_position, simplifyDataFrame = TRUE)
    raw_df <- fromJSON(raw, simplifyDataFrame = TRUE)

    tag_value <- normalize_tag(tag)
    base_name <- if (tag_value == "") "output" else tag_value

    tmp_file <- tempfile(pattern = "editr_", fileext = ".xlsx")
    writexl::write_xlsx(
      list(
        summary = summary_df,
        per_position_edit_rate = per_position_df,
        raw = raw_df
      ),
      path = tmp_file
    )

    bin <- readBin(tmp_file, "raw", file.info(tmp_file)$size)
    res$setHeader("Content-Type", "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet")
    res$setHeader("Content-Disposition", paste0("attachment; filename=", base_name, ".xlsx"))
    res$body <- bin
    res
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("生成 Excel 失败：", e$message))
  })
}

# ============================================================
# 完整结果 ZIP 下载 (Excel + 图表 + 重命名文件)
# ============================================================
#* 下载完整结果 ZIP 包 (Excel + 图表 + 重命名文件)
#* @post /api/download/results
#* @serializer json
function(req, res) {
  tryCatch({
    body <- tryCatch(fromJSON(req$postBody, simplifyVector = FALSE), error = function(e) NULL)
    if (is.null(body) || is.null(body$session_id)) {
      res$status <- 400
      return(list(success = FALSE, error = "缺少必要参数"))
    }
    session_id <- as_scalar_chr(body$session_id)

    # 兜底参数：若分析缓存已失效（如服务重启），用请求里的参数重新分析
    params <- if (!is.null(body$sequence)) {
      list(
        sequence = toupper(trimws(body$sequence)),
        target_position = as.integer(body$target_position),
        target_base = toupper(body$target_base),
        edited_base = toupper(body$edited_base),
        rename_config = if (!is.null(body$rename_config)) body$rename_config else list(),
        template_name = if (!is.null(body$template_name)) body$template_name else "results"
      )
    } else {
      NULL
    }

    zip_path <- ensure_session_zip(session_id, params, body$grouping, body$charts)
    if (is.null(zip_path) || !file.exists(zip_path)) {
      res$status <- 500
      return(list(success = FALSE, error = "生成结果包失败"))
    }

    bin <- readBin(zip_path, "raw", file.size(zip_path))
    res$setHeader("Content-Type", "application/zip")
    res$setHeader("Content-Disposition", paste0("attachment; filename=", basename(zip_path)))
    res$body <- bin
    res
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("下载失败：", e$message))
  })
}

# ============================================================
# 归档：把某 session 的原始 AB1 + 完整结果包 + manifest 持久化到 archive/<项目>/<批次>/
# ============================================================
#* 归档当前会话
#* @post /api/archive
#* @serializer json
function(req, res) handle_archive(req, res)

#* 列出归档批次
#* @get /api/archive/list
#* @serializer json
function(project = "", include_hidden = "") {
  df <- list_archived_batches(db_ready, sequence_db_path,
                              if (nzchar(project)) project else NULL,
                              include_hidden = nzchar(include_hidden) && include_hidden != "0")
  list(success = TRUE, data = df)
}

#* 从归档载入原始 AB1 到新会话，供重分析
#* @post /api/archive/reanalyze
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    archive_id <- as_scalar_chr(body$id)
    if (is.null(archive_id)) {
      res$status <- 400; return(list(success = FALSE, error = "缺少归档 id"))
    }
    rec <- get_archived_batch(db_ready, sequence_db_path, archive_id)
    if (is.null(rec)) {
      res$status <- 404; return(list(success = FALSE, error = "未找到归档记录"))
    }
    raw_dir <- file.path(archive_base, rec$rel_path, "raw_ab1")
    if (!dir.exists(raw_dir)) {
      res$status <- 404; return(list(success = FALSE, error = "归档原始文件缺失"))
    }
    ab1_files <- list.files(raw_dir, pattern = "\\.ab1$", full.names = TRUE)
    if (length(ab1_files) == 0) {
      res$status <- 404; return(list(success = FALSE, error = "归档中无 AB1 文件"))
    }
    # 建新 session 目录并拷入文件
    new_sid <- format(Sys.time(), "%Y%m%d%H%M%S_") |> paste0(sample(1000:9999, 1))
    new_dir <- file.path(upload_dir, new_sid)
    dir.create(new_dir, showWarnings = FALSE, recursive = TRUE)
    for (f in ab1_files) file.copy(f, file.path(new_dir, basename(f)), overwrite = TRUE)

    list(success = TRUE, session_id = new_sid,
         n_files = length(ab1_files),
         files = basename(ab1_files),
         manifest = tryCatch(fromJSON(rec$params_json), error = function(e) NULL))
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("载入归档失败：", e$message))
  })
}

#* 合并多条归档记录的原始 AB1 进同一新 session，供多序列聚合重分析
#* @post /api/archive/reanalyze-merge
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    recs_in <- body$records
    if (is.null(recs_in) || length(recs_in) == 0) {
      res$status <- 400; return(list(success = FALSE, error = "缺少 records"))
    }
    # 收集每条记录的 orig_names / rename_config / manifest
    metas <- list(); records_out <- list(); raw_dirs <- list()
    for (r in recs_in) {
      id <- as_scalar_chr(r$id); label <- as_scalar_chr(r$label) %||% ""
      rec <- get_archived_batch(db_ready, sequence_db_path, id)
      if (is.null(rec)) { res$status <- 404; return(list(success = FALSE, error = paste("未找到记录", id))) }
      raw_dir <- file.path(archive_base, rec$rel_path, "raw_ab1")
      ab1 <- list.files(raw_dir, pattern = "\\.ab1$", full.names = FALSE)
      if (length(ab1) == 0) { res$status <- 404; return(list(success = FALSE, error = paste("记录无 AB1", id))) }
      manifest <- tryCatch(fromJSON(rec$params_json, simplifyVector = FALSE), error = function(e) list())
      metas[[length(metas) + 1]] <- list(id = id, label = label, orig_names = ab1,
                                          rename_config = manifest$rename_config %||% list())
      raw_dirs[[id]] <- raw_dir
      records_out[[length(records_out) + 1]] <- list(id = id, label = label, manifest = manifest)
    }
    mapping <- build_merge_mapping(metas, rename_presets)
    # 建新 session 并按 mapping 拷贝物理文件
    new_sid <- format(Sys.time(), "%Y%m%d%H%M%S_") |> paste0(sample(1000:9999, 1))
    new_dir <- file.path(upload_dir, new_sid)
    dir.create(new_dir, showWarnings = FALSE, recursive = TRUE)
    for (mp in mapping) {
      src <- file.path(raw_dirs[[mp$recordId]], mp$originalName)
      ok <- file.copy(src, file.path(new_dir, mp$storedName), overwrite = FALSE)
      if (!isTRUE(ok)) stop(paste0("文件拷贝失败: ", mp$originalName, "（记录 ", mp$recordId, "）"))
    }
    list(success = TRUE, session_id = new_sid, mapping = mapping, records = records_out)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("合并载入失败：", e$message))
  })
}

#* 下载归档完整包
#* @get /api/archive/download
#* @serializer json
function(id, res) {
  tryCatch({
    rec <- get_archived_batch(db_ready, sequence_db_path, id)
    if (is.null(rec)) { res$status <- 404; return(list(success = FALSE, error = "未找到归档记录")) }
    zip_path <- file.path(archive_base, rec$rel_path, "results_package.zip")
    if (!file.exists(zip_path)) {
      res$status <- 404; return(list(success = FALSE, error = "该归档没有结果包"))
    }
    bin <- readBin(zip_path, "raw", file.size(zip_path))
    fname <- paste0(safe_path_segment(rec$project), "_", safe_path_segment(rec$batch), ".zip")
    res$setHeader("Content-Type", "application/zip")
    res$setHeader("Content-Disposition", paste0("attachment; filename=", fname))
    res$body <- bin
    res
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("下载归档失败：", e$message))
  })
}

# ============================================================
# daily-work 联动（二期）：项目列表回填 + 推送归档到 capture 管道
# ============================================================
#* 代理 daily-work 项目列表（供归档表单项目下拉）
#* @get /api/dailywork/projects
#* @serializer json
function(res) {
  tryCatch({
    if (!nzchar(dailywork_token)) {
      res$status <- 503
      return(list(success = FALSE, error = "未配置 daily-work API token（DAILYWORK_API_TOKEN 或 dailywork_token 文件）"))
    }
    resp <- httr::GET(paste0(dailywork_base_url, "/api/webhook/projects"),
                      dailywork_auth_header(), httr::timeout(10))
    if (httr::status_code(resp) >= 400) {
      res$status <- 502
      return(list(success = FALSE, error = paste0("daily-work 返回 ", httr::status_code(resp))))
    }
    data <- httr::content(resp, as = "parsed", type = "application/json")
    list(success = TRUE, data = data)
  }, error = function(e) {
    res$status <- 502
    list(success = FALSE, error = paste("无法连接 daily-work：", e$message))
  })
}

#* 代理 daily-work eLab 分类列表（供规整推送表单分类下拉）
#* @get /api/dailywork/elab-categories
#* @serializer json
function(res) {
  tryCatch({
    if (!nzchar(dailywork_token)) {
      res$status <- 503
      return(list(success = FALSE, error = "未配置 daily-work API token（DAILYWORK_API_TOKEN 或 dailywork_token 文件）"))
    }
    resp <- httr::GET(paste0(dailywork_base_url, "/api/webhook/elab-categories"),
                      dailywork_auth_header(), httr::timeout(10))
    if (httr::status_code(resp) >= 400) {
      res$status <- 502
      return(list(success = FALSE, error = paste0("daily-work 返回 ", httr::status_code(resp))))
    }
    data <- httr::content(resp, as = "parsed", type = "application/json")
    list(success = TRUE, data = data)
  }, error = function(e) {
    res$status <- 502
    list(success = FALSE, error = paste("无法连接 daily-work：", e$message))
  })
}

#* 把归档结果包 + 注释推送到 daily-work 的 capture 管道（Bearer token，base64 附件）
#* @post /api/archive/push-dailywork
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    archive_id <- as_scalar_chr(body$id)
    comment <- as_scalar_chr(body$comment) %||% ""
    if (is.null(archive_id)) {
      res$status <- 400; return(list(success = FALSE, error = "缺少归档 id"))
    }
    if (!nzchar(dailywork_token)) {
      res$status <- 503; return(list(success = FALSE, error = "未配置 daily-work API token"))
    }
    rec <- get_archived_batch(db_ready, sequence_db_path, archive_id)
    if (is.null(rec)) {
      res$status <- 404; return(list(success = FALSE, error = "未找到归档记录"))
    }
    zip_path <- file.path(archive_base, rec$rel_path, "results_package.zip")
    if (!file.exists(zip_path)) {
      res$status <- 404; return(list(success = FALSE, error = "该归档没有结果包，无法推送"))
    }

    # 标题/正文：确定性进 experiment_log 审核队列（不经 LLM），项目名写明便于审核时选对项目
    title <- sprintf("EditR 归档：%s / %s", rec$project, rec$batch)
    raw_text <- sprintf(
      "项目：%s\n批次：%s\n样品数：%s\nEditR 归档结果包（含重命名 AB1、图表、Excel）见附件。\n%s",
      rec$project, rec$batch, rec$n_files, comment
    )
    zip_b64 <- base64enc::base64encode(zip_path)
    fname <- paste0(safe_path_segment(rec$project), "_", safe_path_segment(rec$batch), ".zip")

    payload <- list(
      text = raw_text,
      title = title,
      metadata = list(project = rec$project, batch = rec$batch, n_files = rec$n_files),
      attachments = list(list(filename = fname, content_type = "application/zip", data_base64 = zip_b64))
    )
    resp <- httr::POST(
      paste0(dailywork_base_url, "/api/webhook/elabftw-archive"),
      dailywork_auth_header(),
      body = payload, encode = "json", httr::timeout(60)
    )
    sc <- httr::status_code(resp)
    if (sc >= 400) {
      res$status <- 502
      msg <- tryCatch(httr::content(resp, as = "text", encoding = "UTF-8"), error = function(e) "")
      return(list(success = FALSE, error = paste0("daily-work 返回 ", sc, "：", substr(msg, 1, 200))))
    }
    out <- tryCatch(httr::content(resp, as = "parsed", type = "application/json"), error = function(e) NULL)
    list(success = TRUE, message = "已提交到 daily-work（capture 队列）",
         capture_id = out$capture_id %||% NULL,
         project = rec$project, batch = rec$batch)
  }, error = function(e) {
    res$status <- 502
    list(success = FALSE, error = paste("推送 daily-work 失败：", e$message))
  })
}

#* 规整推送：把归档的结论 + summary + 结果包按契约推给 dailywork 的 editr-curate 管道
#* @post /api/curate/push
#* @serializer json
function(req, res) handle_curate_push(req, res)

#* 更新归档记录的展示字段（重命名 / 改 dailywork 项目 / 隐藏）
#* @post /api/archive/update
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    id <- as_scalar_chr(body$id)
    if (is.null(id) || !nzchar(id)) { res$status <- 400; return(list(success = FALSE, error = "缺少归档 id")) }
    upd <- update_archived_batch(
      db_ready, sequence_db_path, id,
      batch = as_scalar_chr(body$batch),
      comment = as_scalar_chr(body$comment),
      dw_project = as_scalar_chr(body$dw_project),
      hidden = if (is.null(body$hidden)) NULL else as.integer(as_scalar_chr(body$hidden))
    )
    if (!isTRUE(upd$ok)) { res$status <- 400; return(list(success = FALSE, error = upd$msg)) }
    list(success = TRUE, message = upd$msg)
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("更新归档失败：", e$message))
  })
}

#* 删除存储记录（删 SQLite 行 + 删记录目录）
#* @post /api/archive/delete
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    id <- as_scalar_chr(body$id)
    if (is.null(id) || !nzchar(id)) {
      res$status <- 400; return(list(success = FALSE, error = "缺少记录 id"))
    }
    rec <- get_archived_batch(db_ready, sequence_db_path, id)
    if (is.null(rec)) {
      res$status <- 404; return(list(success = FALSE, error = "未找到记录"))
    }
    delete_record_files(archive_base, rec$rel_path)   # 删盘上文件（越界自我保护）
    del <- delete_archived_batch(db_ready, sequence_db_path, id)
    if (!isTRUE(del$ok)) { res$status <- 500; return(list(success = FALSE, error = del$msg)) }
    list(success = TRUE, message = "记录已删除")
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("删除失败：", e$message))
  })
}

#* 写回记录的分组标注（持久化到 manifest）
#* @post /api/archive/annotations
#* @serializer json
function(req, res) {
  tryCatch({
    body <- fromJSON(req$postBody, simplifyVector = FALSE)
    id <- as_scalar_chr(body$id)
    if (is.null(id) || !nzchar(id)) {
      res$status <- 400; return(list(success = FALSE, error = "缺少记录 id"))
    }
    rec <- get_archived_batch(db_ready, sequence_db_path, id)
    if (is.null(rec)) {
      res$status <- 404; return(list(success = FALSE, error = "未找到记录"))
    }
    manifest <- tryCatch(fromJSON(rec$params_json, simplifyVector = FALSE),
                         error = function(e) list())
    manifest <- merge_record_annotations(manifest, body$grouping)
    params_json <- toJSON(manifest, auto_unbox = TRUE, null = "null")
    manifest_path <- file.path(archive_base, rec$rel_path, "manifest.json")
    writeLines(params_json, manifest_path)
    list(success = TRUE, message = "分组/guide 已保存")
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("保存标注失败：", e$message))
  })
}

#* 取单条记录的对比出图数据（summary+heatmap+grouping+guide+ref）
#* @get /api/archive/data
#* @serializer json
function(id = "", res) {
  tryCatch({
    if (!nzchar(id)) { res$status <- 400; return(list(success = FALSE, error = "缺少记录 id")) }
    rec <- get_archived_batch(db_ready, sequence_db_path, id)
    if (is.null(rec)) { res$status <- 404; return(list(success = FALSE, error = "未找到记录")) }
    # simplifyVector=TRUE 让 summary/heatmap/grouping/msg_guides 成 data.frame，
    # plumber 序列化为干净的对象数组（标量字段不被数组包裹，与 /api/analyze 一致）。
    # ref_sequence/target_position 仍是长度 1 向量，会被 plumber 包成 ["x"]/[n]，前端 unwrap。
    manifest <- tryCatch(fromJSON(rec$params_json, simplifyVector = TRUE),
                         error = function(e) list())
    list(success = TRUE, data = record_chart_data(manifest))
  }, error = function(e) {
    res$status <- 500
    list(success = FALSE, error = paste("取记录数据失败：", e$message))
  })
}