OCaml 教程 / Web 开发（Dream/Opium）
Web 开发（Dream/Opium）
OCaml 有两个主流 Web 框架：Dream 和 Opium。Dream 设计简洁、功能全面；Opium 更接近 Sinatra 风格。
Dream 框架概述
Dream 是一个现代化的 OCaml Web 框架，内置模板、WebSocket、CSRF 保护等功能。
# 安装
opam install dream
# 创建项目
mkdir my_webapp && cd my_webapp
opam exec -- dune init project my_webapp
| 特性 | Dream | Opium |
|---|---|---|
| 设计理念 | 全栈、简洁 | 轻量、灵活 |
| 模板引擎 | 内置 | 需集成 |
| WebSocket | 内置 | 需插件 |
| 会话管理 | 内置 | 需插件 |
| 学习曲线 | 低 | 中 |
| 社区活跃度 | 高 | 中 |
(* 最小 Dream 应用 *)
let () =
Dream.run
@@ Dream.logger
@@ Dream.router [
Dream.get "/" (fun _ ->
Dream.html "Hello, World!");
]
💡 提示：Dream 使用中间件链（@@ 运算符）组织应用，每个中间件可以修改请求或响应。
路由与处理函数
let () =
Dream.run
@@ Dream.logger
@@ Dream.router [
(* GET 请求 *)
Dream.get "/" (fun _request ->
Dream.html "首页");
(* 带路径参数 *)
Dream.get "/user/:id" (fun request ->
let id = Dream.param request "id" in
Dream.html (Printf.sprintf "用户 ID: %s" id));
(* 多个参数 *)
Dream.get "/post/:year/:month/:id" (fun request ->
let year = Dream.param request "year" in
let month = Dream.param request "month" in
let id = Dream.param request "id" in
Dream.html (Printf.sprintf "文章 %s-%s-%s" year month id));
(* POST 请求 *)
Dream.post "/api/users" (fun request ->
let%lwt body = Dream.body request in
Dream.html (Printf.sprintf "收到: %s" body));
(* PUT 请求 *)
Dream.put "/api/users/:id" (fun request ->
let id = Dream.param request "id" in
let%lwt body = Dream.body request in
Dream.html (Printf.sprintf "更新用户 %s: %s" id body));
(* DELETE 请求 *)
Dream.delete "/api/users/:id" (fun request ->
let id = Dream.param request "id" in
Dream.html (Printf.sprintf "删除用户 %s" id));
(* 通配符路由 *)
Dream.get "/static/**" (fun request ->
let path = Dream.path request |> String.concat "/" in
Dream.html (Printf.sprintf "静态资源: %s" path));
(* 带前缀的路由组 *)
Dream.scope "/api/v1" [] [
Dream.get "/users" (fun _ -> Dream.json {|[{"id":1}]|});
Dream.get "/posts" (fun _ -> Dream.json {|[{"id":1}]|});
];
]
⚠️ 注意：路由参数不能包含 /。如果需要匹配包含 / 的路径，使用 ** 通配符。
中间件
(* 自定义日志中间件 *)
let my_logger inner_handler request =
let start = Unix.gettimeofday () in
let%lwt response = inner_handler request in
let elapsed = Unix.gettimeofday () -. start in
Dream.info (fun log ->
log "%s %s -> %d (%.3fms)"
(Dream.method_to_string (Dream.method_ request))
(Dream.target request)
(Dream.status response |> Dream.status_to_int)
(elapsed *. 1000.0));
Lwt.return response
(* CORS 中间件 *)
let cors_middleware inner_handler request =
let%lwt response = inner_handler request in
Dream.add_header response "Access-Control-Allow-Origin" "*";
Dream.add_header response "Access-Control-Allow-Methods" "GET, POST, PUT, DELETE, OPTIONS";
Dream.add_header response "Access-Control-Allow-Headers" "Content-Type, Authorization";
Lwt.return response
(* 认证中间件 *)
let auth_middleware inner_handler request =
match Dream.header request "Authorization" with
| Some token when String.length token > 7 ->
let token = String.sub token 7 (String.length token - 7) in
(* 验证 token *)
if verify_token token then
inner_handler request
else
Dream.json ~status:`Unauthorized {|{"error": "invalid token"}|}
| _ ->
Dream.json ~status:`Unauthorized {|{"error": "missing token"}|}
(* 速率限制中间件 *)
let rate_limit_middleware =
let table = Hashtbl.create 256 in
fun inner_handler request ->
let ip = Dream.client request in
let count = Hashtbl.find_opt table ip |> Option.value ~default:0 in
if count > 100 then
Dream.json ~status:`Too_many_requests {|{"error": "rate limit exceeded"}|}
else begin
Hashtbl.replace table ip (count + 1);
inner_handler request
end
(* 组合中间件 *)
let () =
Dream.run
@@ Dream.logger
@@ my_logger
@@ cors_middleware
@@ Dream.router [
Dream.get "/" (fun _ -> Dream.html "Hello");
]
| 中间件 | 作用 | 应用位置 |
|---|---|---|
Dream.logger | 请求日志 | 最外层 |
my_logger | 自定义计时 | 日志之后 |
cors_middleware | CORS 头 | API 之前 |
auth_middleware | 身份验证 | 受保护路由 |
rate_limit | 速率限制 | 公共 API |
模板渲染
Dream 内置了 .eml 模板引擎：
(* templates/base.eml *)
let base_template ~title ~content = {|
<!DOCTYPE html>
<html>
<head>
<title><%s title %></title>
<style>
body { font-family: sans-serif; max-width: 800px; margin: 0 auto; }
.nav { background: #333; padding: 10px; }
.nav a { color: white; margin-right: 15px; }
</style>
</head>
<body>
<div class="nav">
<a href="/">首页</a>
<a href="/about">关于</a>
</div>
<main>
<%s! content %>
</main>
</body>
</html>
|}
(* templates/user_list.eml *)
let user_list_template users = {|
<h1>用户列表</h1>
<ul>
<% List.iter (fun user -> %>
<li><%s user.name %> (<%s user.email %>)</li>
<% ) users; %>
</ul>
|}
(* 在处理函数中使用 *)
let user_list_handler request =
let%lwt users = get_all_users () in
let content = user_list_template users in
Dream.html (base_template ~title:"用户管理" ~content)
💡 提示：Dream 模板使用 <%s expr %> 输出字符串，<%s! expr %> 输出原始 HTML（不转义），<% ... %> 执行 OCaml 代码。
JSON API
(* 安装 Yojson *)
(* opam install yojson ppx_deriving_yojson *)
open Yojson.Safe
(* 数据模型 *)
type user = {
id: int;
name: string;
email: string;
age: int;
} [@@deriving yojson]
type api_response = {
success: bool;
data: user list;
message: string option;
} [@@deriving yojson]
(* 序列化 *)
let user_to_json user =
user_to_yojson user |> Yojson.Safe.to_string
let response_to_json ~success ~data ~message () =
{ success; data; message }
|> api_response_to_yojson
|> Yojson.Safe.to_string
(* 反序列化 *)
let user_of_json json_str =
try
let json = Yojson.Safe.from_string json_str in
user_of_yojson json
with
| Yojson.Json_error msg -> Error msg
(* JSON API 路由 *)
let () =
Dream.run
@@ Dream.logger
@@ cors_middleware
@@ Dream.router [
(* 获取所有用户 *)
Dream.get "/api/users" (fun _request ->
let%lwt users = get_all_users () in
let response = response_to_json ~success:true ~data:users ~message:None () in
Dream.json response);
(* 获取单个用户 *)
Dream.get "/api/users/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
match%lwt get_user id with
| Some user ->
Dream.json (user_to_json user)
| None ->
Dream.json ~status:`Not_found
{|{"success": false, "message": "用户不存在"}|});
(* 创建用户 *)
Dream.post "/api/users" (fun request ->
let%lwt body = Dream.body request in
match user_of_json body with
| Ok user ->
let%lwt created = create_user user in
Dream.json ~status:`Created (user_to_json created)
| Error msg ->
Dream.json ~status:`Bad_request
(Printf.sprintf {|{"success": false, "message": "%s"}|} msg));
(* 更新用户 *)
Dream.put "/api/users/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
let%lwt body = Dream.body request in
match user_of_json body with
| Ok user ->
let%lwt updated = update_user id user in
Dream.json (user_to_json updated)
| Error msg ->
Dream.json ~status:`Bad_request
(Printf.sprintf {|{"success": false, "message": "%s"}|} msg));
(* 删除用户 *)
Dream.delete "/api/users/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
let%lwt () = delete_user id in
Dream.json {|{"success": true, "message": "删除成功"}|});
]
⚠️ 注意：JSON API 应该始终返回一致的响应格式，并包含适当的 HTTP 状态码。
静态文件
let () =
Dream.run
@@ Dream.logger
@@ Dream.router [
(* 服务静态文件 *)
Dream.get "/static/**" (Dream.static "static");
(* 带缓存控制 *)
Dream.get "/assets/**" (fun request ->
let path = Dream.path request |> String.concat "/" in
let file_path = Filename.concat "static" path in
if Sys.file_exists file_path then begin
let%lwt content = Lwt_io.with_file ~mode:Lwt_io.Input file_path
(fun ic -> Lwt_io.read ic) in
let content_type = match Filename.extension path with
| ".css" -> "text/css"
| ".js" -> "application/javascript"
| ".png" -> "image/png"
| ".jpg" -> "image/jpeg"
| ".svg" -> "image/svg+xml"
| _ -> "application/octet-stream"
in
let response = Dream.response content in
Dream.add_header response "Content-Type" content_type;
Dream.add_header response "Cache-Control" "public, max-age=31536000";
Lwt.return response
end else
Dream.html ~status:`Not_found "Not Found");
Dream.get "/" (fun _ ->
Dream.html {|
<html>
<head>
<link rel="stylesheet" href="/static/css/style.css">
<script src="/static/js/app.js"></script>
</head>
<body><h1>Hello</h1></body>
</html>
|});
]
会话管理
(* Dream 内置会话支持 *)
let () =
Dream.run
@@ Dream.logger
@@ Dream.sql "sqlite3:db.sqlite"
@@ Dream.sessions
@@ Dream.router [
Dream.post "/login" (fun request ->
let%lwt body = Dream.body request in
let credentials = parse_credentials body in
let%lwt user = authenticate credentials in
match user with
| Some user ->
Dream.set_session_field request "user_id" (string_of_int user.id);
Dream.json {|{"success": true}|}
| None ->
Dream.json ~status:`Unauthorized {|{"success": false}|});
Dream.post "/logout" (fun request ->
Dream.set_session_field request "user_id" "";
Dream.json {|{"success": true}|});
Dream.get "/profile" (fun request ->
match Dream.session_field request "user_id" with
| Some id when id <> "" ->
let%lwt user = get_user (int_of_string id) in
Dream.json (user_to_json (Option.get user))
| _ ->
Dream.json ~status:`Unauthorized {|{"error": "未登录"}|});
]
数据库集成
(* 使用 Caqti 连接数据库 *)
open Caqti_request.Infix
open Caqti_type.Std
(* 数据库连接 *)
let connection_pool =
let uri = Uri.of_string "postgresql://user:pass@localhost/mydb" in
Caqti_lwt.connect_pool uri
|> function
| Ok pool -> pool
| Error err -> failwith (Caqti_error.show err)
(* 定义查询 *)
let find_user_query =
Caqti_type.(int ->! user_type)
"SELECT id, name, email FROM users WHERE id = ?"
let find_all_users_query =
Caqti_type.(unit ->* user_type)
"SELECT id, name, email FROM users ORDER BY id"
let insert_user_query =
Caqti_type.(tup3 string string int ->! user_type)
"INSERT INTO users (name, email, age) VALUES (?, ?, ?) RETURNING id, name, email"
(* 执行查询 *)
let find_user id =
Caqti_lwt.Pool.use (fun (module Db) ->
Db.find find_user_query id) connection_pool
let find_all_users () =
Caqti_lwt.Pool.use (fun (module Db) ->
Db.collect find_all_users_query ()) connection_pool
let create_user user =
Caqti_lwt.Pool.use (fun (module Db) ->
Db.find insert_user_query (user.name, user.email, user.age)) connection_pool
(* 在路由中使用 *)
let () =
Dream.run
@@ Dream.logger
@@ Dream.router [
Dream.get "/api/users" (fun _ ->
let%lwt users = find_all_users () in
let users_json = List.map user_to_yojson users in
Dream.json (Yojson.Safe.to_string (`List users_json)));
]
💡 提示：使用连接池（Caqti_lwt.connect_pool）避免每次请求都创建新连接，显著提升性能。
部署
(* dune 文件配置 *)
(*
(executable
(name server)
(libraries dream caqti caqti-driver-postgresql lwt))
*)
(* 生产环境配置 *)
let () =
let port = try int_of_string (Sys.getenv "PORT") with _ -> 8080 in
let interface = try Sys.getenv "HOST" with _ -> "0.0.0.0" in
Dream.run ~port ~interface
@@ Dream.logger
@@ Dream.router [ (* ... *) ]
# 构建
dune build
# 运行
PORT=8080 HOST=0.0.0.0 ./_build/default/server.exe
# Docker 部署
cat > Dockerfile << 'EOF'
FROM ocaml/opam:alpine
WORKDIR /app
COPY . .
RUN opam install . --deps-only
RUN dune build
EXPOSE 8080
CMD ["./_build/default/server.exe"]
EOF
docker build -t my_webapp .
docker run -p 8080:8080 my_webapp
Opium 框架对比
(* Opium 示例 *)
open Opium
let () =
App.empty
|> App.get "/" (fun _req -> Response.of_plain_text "Hello" |> Lwt.return)
|> App.get "/user/:id" (fun req ->
let id = Router.param req "id" in
Response.of_plain_text (Printf.sprintf "User: %s" id) |> Lwt.return)
|> App.post "/users" (fun req ->
let%lwt body = Request.to_string req in
Response.of_plain_text body |> Lwt.return)
|> App.run_command
| 功能 | Dream | Opium |
|---|---|---|
| 路由语法 | Dream.get "/path" | App.get "/path" |
| 中间件 | @@ 链 | App.middleware |
| 模板 | 内置 .eml | 无，需集成 |
| 会话 | 内置 | 需插件 |
| 数据库 | 内置 SQL | 需自行集成 |
RESTful API 设计实战
(* 完整 RESTful API *)
type todo = {
id: int;
title: string;
completed: bool;
created_at: string;
} [@@deriving yojson]
(* 服务层 *)
module TodoService = struct
let todos = Hashtbl.create 64
let next_id = ref 1
let create title =
let id = !next_id in
incr next_id;
let todo = {
id;
title;
completed = false;
created_at = Ptime.to_rfc3339 (Ptime_clock.now ());
} in
Hashtbl.add todos id todo;
todo
let find_all () =
Hashtbl.fold (fun _ todo acc -> todo :: acc) todos []
|> List.sort (fun a b -> compare b.id a.id)
let find id = Hashtbl.find_opt todos id
let update id ~title ~completed =
match Hashtbl.find_opt todos id with
| Some todo ->
let updated = { todo with title; completed } in
Hashtbl.replace todos id updated;
Some updated
| None -> None
let delete id =
Hashtbl.remove todos id
end
(* 路由处理 *)
let () =
Dream.run
@@ Dream.logger
@@ cors_middleware
@@ Dream.router [
(* GET /api/todos *)
Dream.get "/api/todos" (fun _request ->
let todos = TodoService.find_all () in
let json = `List (List.map todo_to_yojson todos) in
Dream.json (Yojson.Safe.to_string json));
(* POST /api/todos *)
Dream.post "/api/todos" (fun request ->
let%lwt body = Dream.body request in
match Yojson.Safe.from_string body with
| `Assoc [("title", `String title)] ->
let todo = TodoService.create title in
Dream.json ~status:`Created (todo_to_yojson todo |> Yojson.Safe.to_string)
| _ ->
Dream.json ~status:`Bad_request {|{"error": "需要 title 字段"}|});
(* GET /api/todos/:id *)
Dream.get "/api/todos/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
match TodoService.find id with
| Some todo ->
Dream.json (todo_to_yojson todo |> Yojson.Safe.to_string)
| None ->
Dream.json ~status:`Not_found {|{"error": "Todo 不存在"}|});
(* PUT /api/todos/:id *)
Dream.put "/api/todos/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
let%lwt body = Dream.body request in
match Yojson.Safe.from_string body with
| `Assoc [("title", `String title); ("completed", `Bool completed)] ->
(match TodoService.update id ~title ~completed with
| Some todo ->
Dream.json (todo_to_yojson todo |> Yojson.Safe.to_string)
| None ->
Dream.json ~status:`Not_found {|{"error": "Todo 不存在"}|})
| _ ->
Dream.json ~status:`Bad_request {|{"error": "需要 title 和 completed 字段"}|});
(* DELETE /api/todos/:id *)
Dream.delete "/api/todos/:id" (fun request ->
let id = Dream.param request "id" |> int_of_string in
TodoService.delete id;
Dream.json {|{"success": true}|});
]
⚠️ 注意：实际项目中应使用数据库而非内存存储。Hashtbl 仅适用于演示和单实例部署。