OCaml 5 สำหรับการพัฒนาระบบ IT: Memory Safety, Concurrency และ Multicore

Part 6 — Patterns for Production Systems

บทความส่วนที่ 6 ว่าด้วยรูปแบบการออกแบบ (patterns) ที่จำเป็นเมื่อนำ OCaml 5 ไปใช้งานจริงใน production systems ครอบคลุม Structured Concurrency, Resource Management, Testing และ Deployment เน้นโค้ดตัวอย่างที่พร้อมใช้งานจริง พร้อมแนวคิดเชิงวิศวกรรมระบบแบบครบวงจร

25. Structured Concurrency และ Supervision Trees

25.1 แนวคิดของ Structured Concurrency

Structured Concurrency คือหลักการที่ว่า "อายุของ concurrent task ต้องถูกจำกัดอยู่ภายใน lexical scope" เหมือน structured programming ที่ควบคุม control flow ผ่าน block scope (if/while/for) แทน goto

หลักการสำคัญมี 3 ข้อ:

1. Lifetime Containment — ทุก fiber ที่ spawn ต้องจบก่อนที่ parent scope จะ return
2. Error Propagation — หาก fiber ตัวใดตัวหนึ่ง fail error ต้องถูกส่งต่อไปยัง parent
3. Cooperative Cancellation — เมื่อ parent ถูก cancel child ทุกตัวต้องถูก cancel ด้วย

เปรียบเทียบกับ Unstructured Concurrency (เช่น Thread.create แบบเก่า หรือ go func() ใน Go) ซึ่ง goroutine/thread มีอายุเป็นอิสระจากผู้สร้าง ทำให้เกิดปัญหา orphan tasks และ resource leaks ได้ง่าย

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','secondaryColor':'#504945','tertiaryColor':'#282828',
  'background':'#282828','mainBkg':'#3c3836','secondBkg':'#504945',
  'textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart TB
    subgraph Unstructured["แบบดั้งเดิม (Unstructured)"]
        U1[Parent
spawn thread] --> U2[Thread A
อายุอิสระ]
        U1 --> U3[Thread B
อายุอิสระ]
        U1 -.->|return ก่อน
child จบ| U4[Orphan!
Resource Leak]
    end
    subgraph Structured["Structured Concurrency (Eio Switch)"]
        S1[Switch.run] --> S2[Fiber A]
        S1 --> S3[Fiber B]
        S2 --> S4[Auto Cleanup
ทำความสะอาดอัตโนมัติ]
        S3 --> S4
        S4 --> S5[Switch จบ
Parent return]
    end
    style U4 fill:#cc241d,color:#ebdbb2
    style S4 fill:#98971a,color:#282828
    style S5 fill:#b8bb26,color:#282828

25.2 Switches ใน Eio — เครื่องมือหลักของ Structured Concurrency

Eio.Switch คือ construct ที่ทำหน้าที่เป็น scope ของ fiber ทั้งหมดที่ spawn อยู่ภายใน เมื่อ Switch.run return fiber ทุกตัวที่ยังทำงานอยู่จะถูก cancel โดยอัตโนมัติ

25.2.1 Basic Switch Pattern

(* file: examples/switch_basic.ml *)
(* ตัวอย่างพื้นฐานของ Structured Concurrency ด้วย Eio.Switch *)

open Eio

(* งานที่ทำซ้ำ ๆ แล้ว log ผลลัพธ์ *)
let worker ~name ~clock n =
  for i = 1 to n do
    Time.sleep clock 0.2;
    traceln "[%s] iteration %d" name i
  done;
  traceln "[%s] finished normally" name

let main ~clock =
  (* Switch.run สร้าง scope ใหม่ — fiber ทุกตัวที่ fork ใน sw จะผูกกับ scope นี้ *)
  Switch.run @@ fun sw ->
    traceln ">>> entering switch scope";
    (* fork fiber สองตัวแบบ concurrent *)
    Fiber.fork ~sw (fun () -> worker ~name:"A" ~clock 5);
    Fiber.fork ~sw (fun () -> worker ~name:"B" ~clock 3);
    traceln ">>> main fiber continues while children run";
    Time.sleep clock 0.5;
    traceln ">>> main fiber done, Switch.run จะรอ child ทั้งหมดจบ"
    (* ออกจาก scope ที่นี่: Switch.run จะรอ fiber ทุกตัวจบก่อน return *)

(* ตัวอย่างการใช้งาน: รันด้วย dune exec *)
let () =
  Eio_main.run @@ fun env ->
  main ~clock:(Stdenv.clock env)

(* ผลลัพธ์ที่คาดหวัง (ลำดับอาจสลับกันได้ตาม scheduler):
   >>> entering switch scope
   >>> main fiber continues while children run
   [A] iteration 1
   [B] iteration 1
   [A] iteration 2
   [B] iteration 2
   ...
   [B] finished normally
   [A] finished normally
*)

25.2.2 Switch กับ Early Failure

หาก fiber ใดใน Switch raise exception fiber ตัวอื่นจะถูก cancel อัตโนมัติ และ exception จะถูก propagate ออกจาก Switch.run

(* file: examples/switch_failure.ml *)
(* ทดลอง: เมื่อ fiber ตัวหนึ่ง fail ตัวอื่นจะถูก cancel *)

open Eio

exception Worker_failed of string

let long_running ~clock ~name =
  (* งานที่ทำนาน 10 วินาที *)
  for i = 1 to 10 do
    Time.sleep clock 1.0;
    traceln "[%s] still alive at %d" name i
  done

let buggy_worker ~clock =
  Time.sleep clock 1.5;
  traceln "[buggy] ❌ ราฟ exception!";
  raise (Worker_failed "intentional crash")

let main ~clock =
  try
    Switch.run @@ fun sw ->
      Fiber.fork ~sw (fun () -> long_running ~clock ~name:"A");
      Fiber.fork ~sw (fun () -> long_running ~clock ~name:"B");
      Fiber.fork ~sw (fun () -> buggy_worker ~clock);
      (* Switch จะรอจน buggy_worker raise — A และ B จะถูก cancel *)
  with Worker_failed msg ->
    traceln "✅ caught at parent: %s" msg

let () =
  Eio_main.run @@ fun env ->
  main ~clock:(Stdenv.clock env)

(* ผลลัพธ์:
   [A] still alive at 1
   [B] still alive at 1
   [buggy] ❌ ราฟ exception!
   ✅ caught at parent: intentional crash
   (A และ B หยุดที่ iteration 1 เพราะถูก cancel)
*)

25.3 Error Propagation ใน Concurrent Code

เมื่อมี fiber หลายตัว failure อาจเกิดขึ้นพร้อมกันได้ Eio จัดการโดยใช้ Exn.Multiple ซึ่งรวม exception ทั้งหมดเป็น list

25.3.1 Parallel Failures

(* file: examples/parallel_failures.ml *)
(* การจัดการเมื่อ fiber หลายตัว fail พร้อมกัน *)

open Eio

let flaky_worker ~clock id =
  Time.sleep clock (0.1 *. float_of_int id);
  if id mod 2 = 0 then
    failwith (Printf.sprintf "worker %d crashed" id)
  else
    traceln "worker %d succeeded" id

let run_all ~clock =
  try
    Switch.run @@ fun sw ->
      for i = 1 to 6 do
        Fiber.fork ~sw (fun () -> flaky_worker ~clock i)
      done
  with
  | Exn.Io _ as e ->
    traceln "I/O error: %a" Exn.pp e
  | Failure msg ->
    traceln "single failure: %s" msg
  | exn ->
    (* Eio.Exn.Multiple wrapper *)
    traceln "multiple failures: %s" (Printexc.to_string exn)

let () =
  Eio_main.run @@ fun env ->
  run_all ~clock:(Stdenv.clock env)

25.3.2 การเลือกระหว่าง Fail-Fast vs Collect-All

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','secondaryColor':'#504945','background':'#282828',
  'textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart LR
    A[Fork N Fibers] --> B{Error
Strategy?}
    B -->|Fail-Fast| C[Switch.run
default behavior
cancel siblings]
    B -->|Collect All| D[Fiber.all
รอทุกตัวจบ
รวม errors]
    B -->|Best Effort| E[try/with ใน
แต่ละ fiber]
    C --> F[Low Latency
เหมาะกับ critical path]
    D --> G[Full Visibility
เหมาะกับ batch jobs]
    E --> H[Partial Success
เหมาะกับ fan-out]
    style C fill:#fabd2f,color:#282828
    style D fill:#b8bb26,color:#282828
    style E fill:#83a598,color:#282828

ตารางเปรียบเทียบกลยุทธ์:

(* file: examples/best_effort.ml *)
(* Pattern แบบ Best Effort — ไม่มี fiber ใดทำให้ตัวอื่นล้ม *)

open Eio

type result = Ok_ of int | Err of string

let safe_fetch ~clock url_id =
  try
    Time.sleep clock 0.1;
    if url_id = 3 then failwith "network timeout";
    Ok_ (url_id * 100)
  with Failure msg ->
    Err (Printf.sprintf "url %d: %s" url_id msg)

let fan_out ~clock urls =
  (* ใช้ Fiber.List.map — รวมผล return จากทุก fiber *)
  Fiber.List.map (fun url -> safe_fetch ~clock url) urls

let () =
  Eio_main.run @@ fun env ->
  let clock = Stdenv.clock env in
  let urls = [1; 2; 3; 4; 5] in
  let results = fan_out ~clock urls in
  List.iter (function
    | Ok_ n -> traceln "✅ got %d" n
    | Err m -> traceln "⚠️ %s" m
  ) results

25.4 เปรียบเทียบกับ Erlang/OTP Supervisor Model

Erlang/OTP เป็นผู้ริเริ่มแนวคิด Supervision Tree ที่ influential ในวงการ systems programming มาก

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','secondaryColor':'#504945','background':'#282828',
  'textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart TB
    Root[Root Supervisor
ผู้ดูแลสูงสุด]
    Root --> DbSup[Database
Supervisor]
    Root --> WebSup[Web
Supervisor]
    Root --> WorkerSup[Worker Pool
Supervisor]
    DbSup --> Conn1[Conn Worker 1]
    DbSup --> Conn2[Conn Worker 2]
    WebSup --> Http[HTTP Listener]
    WebSup --> WS[WebSocket Handler]
    WorkerSup --> W1[Job Worker 1]
    WorkerSup --> W2[Job Worker 2]
    WorkerSup --> W3[Job Worker 3]
    style Root fill:#fb4934,color:#282828
    style DbSup fill:#fabd2f,color:#282828
    style WebSup fill:#fabd2f,color:#282828
    style WorkerSup fill:#fabd2f,color:#282828

ตารางเปรียบเทียบ Erlang Supervisor vs Eio Switch:

25.4.1 การจำลอง Supervisor Pattern ใน OCaml 5

(* file: examples/supervisor.ml *)
(* Supervisor pattern แบบพื้นฐานด้วย Eio + Effects *)

open Eio

(* กลยุทธ์การ restart *)
type restart_strategy =
  | One_for_one      (* restart เฉพาะ worker ที่ล้ม *)
  | One_for_all      (* restart ทุก worker ใน supervisor *)
  | Rest_for_one     (* restart worker ที่ล้มและตัวที่เริ่มหลังจากนั้น *)

type child_spec = {
  name : string;
  start : clock:float Time.clock_ty r -> sw:Switch.t -> unit -> unit;
  max_restarts : int;
}

(* สถิติการ restart *)
type stats = {
  mutable restarts : int;
  mutable last_error : string option;
}

let make_stats () = { restarts = 0; last_error = None }

(* รัน worker พร้อม restart logic *)
let supervise ~clock ~sw ~strategy ~children =
  let all_stats = List.map (fun c -> (c, make_stats ())) children in
  let rec run_child (spec, stats) =
    if stats.restarts >= spec.max_restarts then begin
      traceln "[supervisor] 🛑 %s exhausted max restarts (%d)"
        spec.name spec.max_restarts;
      ()
    end else begin
      try
        traceln "[supervisor] 🚀 starting %s (attempt %d)"
          spec.name (stats.restarts + 1);
        spec.start ~clock ~sw ()
      with exn ->
        let msg = Printexc.to_string exn in
        stats.restarts <- stats.restarts + 1;
        stats.last_error <- Some msg;
        traceln "[supervisor] ⚠️  %s crashed: %s" spec.name msg;
        (match strategy with
         | One_for_one ->
           Time.sleep clock 0.5;
           run_child (spec, stats)
         | One_for_all ->
           traceln "[supervisor] 🔄 one_for_all: restarting all";
           Time.sleep clock 0.5;
           List.iter (fun cs ->
             Fiber.fork ~sw (fun () -> run_child cs)
           ) all_stats
         | Rest_for_one ->
           traceln "[supervisor] 🔄 rest_for_one: restart this + following";
           Time.sleep clock 0.5;
           run_child (spec, stats))
    end
  in
  List.iter (fun cs ->
    Fiber.fork ~sw (fun () -> run_child cs)
  ) all_stats

(* ตัวอย่าง child: worker ที่ crash ครั้งแรกแล้วรันปกติ *)
let flaky_worker ~name ~crash_times =
  let counter = ref 0 in
  fun ~clock ~sw:_ () ->
    incr counter;
    if !counter <= crash_times then begin
      Time.sleep clock 0.3;
      failwith (Printf.sprintf "%s crash #%d" name !counter)
    end else begin
      for i = 1 to 3 do
        Time.sleep clock 0.3;
        traceln "[%s] working... %d" name i
      done
    end

let () =
  Eio_main.run @@ fun env ->
  let clock = Stdenv.clock env in
  Switch.run @@ fun sw ->
    let children = [
      { name = "db_conn";
        start = flaky_worker ~name:"db_conn" ~crash_times:2;
        max_restarts = 5 };
      { name = "http_server";
        start = flaky_worker ~name:"http_server" ~crash_times:1;
        max_restarts = 5 };
      { name = "background_job";
        start = flaky_worker ~name:"background_job" ~crash_times:0;
        max_restarts = 3 };
    ] in
    supervise ~clock ~sw ~strategy:One_for_one ~children

25.5 Restart Strategies — รายละเอียดและการเลือกใช้

สมการพื้นฐานของ Exponential Backoff สำหรับ restart delay:

โดย:

• $T_n$ คือ delay ก่อน restart ครั้งที่ n (วินาที)
• $T_0$ คือ base delay เริ่มต้น (ค่าทั่วไป 0.1–1.0 วินาที)
• $k$ คือ growth factor (ค่าทั่วไป 2.0)
• $T_{\max }$ คือ delay สูงสุด (cap)
• $J\left(n\right)$ คือ jitter (random noise) เพื่อป้องกัน thundering herd

(* file: examples/backoff.ml *)
(* Exponential backoff with jitter — ใช้ร่วมกับ supervisor *)

let exponential_backoff ~base ~max_delay ~attempt =
  let t = base *. (2.0 ** float_of_int attempt) in
  let capped = Float.min t max_delay in
  let jitter = Random.float (capped *. 0.3) in  (* jitter 0-30% *)
  capped +. jitter

(* ตัวอย่าง: backoff ครั้งที่ 0..5 *)
let () =
  Random.self_init ();
  for n = 0 to 5 do
    let d = exponential_backoff ~base:0.1 ~max_delay:10.0 ~attempt:n in
    Printf.printf "attempt %d → delay = %.3fs\n" n d
  done
(* ผลลัพธ์ตัวอย่าง:
   attempt 0 → delay = 0.123s
   attempt 1 → delay = 0.234s
   attempt 2 → delay = 0.498s
   attempt 3 → delay = 0.921s
   attempt 4 → delay = 2.012s
   attempt 5 → delay = 3.456s *)

26. Resource Management และ Safety

26.1 ทำไม Resource Management ถึงยากใน Concurrent Code

ใน concurrent systems resource มีหลายประเภท:

• File Descriptors — มี limit ต่อ process (ulimit -n)
• Network Connections — ต้อง close เพื่อคืน port และ memory
• Database Connections — pool มีขนาดจำกัด
• Memory Buffers — ต้อง free เพื่อไม่ให้ OOM
• Locks — ต้อง release เพื่อไม่ให้ deadlock

ปัญหาคลาสสิกที่ต้องป้องกัน:

1. Resource Leak — ไม่ได้ close เมื่อ error
2. Double Free — close ซ้ำ → undefined behavior
3. Use After Free — ใช้ resource ที่ปิดไปแล้ว
4. Cancellation Race — fiber ถูก cancel ระหว่าง acquire

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','background':'#282828','textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart TD
    A[Acquire Resource
เปิด file/conn] --> B{Operation
Success?}
    B -->|Yes| C[Normal Flow
ใช้ resource]
    B -->|No, Exception| D[Cleanup
ทำความสะอาด]
    B -->|Cancelled| D
    C --> D
    D --> E[Release
คืน resource]
    E --> F[Continue /
Rethrow]
    style A fill:#fabd2f,color:#282828
    style D fill:#fb4934,color:#282828
    style E fill:#b8bb26,color:#282828

26.2 Fun.protect — Try-Finally ของ OCaml

OCaml มี Fun.protect ใน stdlib สำหรับ ensure cleanup คล้าย try/finally ในภาษาอื่น

26.2.1 Anatomy ของ Fun.protect

(* signature ของ Fun.protect *)
val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a
(* รัน finally ทุกกรณี ไม่ว่า f จะจบปกติหรือ raise *)

(* file: examples/fun_protect_basic.ml *)
(* การใช้ Fun.protect พื้นฐาน *)

let read_config path =
  let ic = open_in path in
  Fun.protect
    ~finally:(fun () ->
      Printf.eprintf "[cleanup] closing %s\n" path;
      close_in_noerr ic)
    (fun () ->
      let line1 = input_line ic in
      let line2 = input_line ic in
      Printf.sprintf "%s | %s" line1 line2)

(* ตัวอย่างการใช้งาน *)
let () =
  (* สร้างไฟล์ทดลอง *)
  let oc = open_out "/tmp/config.txt" in
  output_string oc "server=localhost\nport=8080\n";
  close_out oc;

  (* อ่านปลอดภัย *)
  try
    let s = read_config "/tmp/config.txt" in
    print_endline s
  with e ->
    Printf.eprintf "error: %s\n" (Printexc.to_string e)

26.2.2 ข้อควรระวังเมื่อ Finally เอง Raise

หาก finally raise exception ระหว่างที่ main body ก็ raise อยู่แล้ว OCaml จะ raise Fun.Finally_raised wrap exception ของ finally

(* file: examples/fun_protect_double.ml *)
(* กรณีที่ finally เอง raise exception *)

let tricky () =
  Fun.protect
    ~finally:(fun () -> failwith "cleanup failed!")
    (fun () -> failwith "main failed!")

let () =
  try tricky ()
  with
  | Failure "main failed!" ->
    print_endline "caught main"
  | Fun.Finally_raised exn ->
    Printf.printf "cleanup exn: %s\n" (Printexc.to_string exn)
  | e ->
    Printf.printf "other: %s\n" (Printexc.to_string e)

(* Output: cleanup exn: Failure("cleanup failed!")
   แสดงว่า exception ของ main body ถูกกลบด้วย finally — ต้องระวัง! *)

26.3 Bracket Pattern — Acquire/Use/Release

Bracket pattern คือการ wrap resource acquisition + release ไว้ในฟังก์ชันเดียวที่รับ callback เป็น "use" — เป็นรูปแบบมาตรฐานในภาษา functional

โดย:

• $R$ คือ ชนิดของ resource เช่น file handle, connection
• $A$ คือ ชนิดของผลลัพธ์จากการใช้ resource
• parameter ทั้งสามคือ: acquire, release, use ตามลำดับ

(* file: lib/bracket.ml *)
(* Generic bracket combinator *)

(* [bracket ~acquire ~release use] รัน acquire → use → release เสมอ *)
let bracket ~acquire ~release ~use =
  let resource = acquire () in
  Fun.protect
    ~finally:(fun () -> release resource)
    (fun () -> use resource)

(* Specialization สำหรับ file handle *)
let with_input_file path ~use =
  bracket
    ~acquire:(fun () -> open_in path)
    ~release:(fun ic -> close_in_noerr ic)
    ~use

let with_output_file path ~use =
  bracket
    ~acquire:(fun () -> open_out path)
    ~release:(fun oc -> close_out_noerr oc)
    ~use

(* ตัวอย่างใช้: นับบรรทัดในไฟล์ *)
let count_lines path =
  with_input_file path ~use:(fun ic ->
    let n = ref 0 in
    try
      while true do
        let _ = input_line ic in
        incr n
      done;
      !n
    with End_of_file -> !n)

let () =
  let oc = open_out "/tmp/sample.txt" in
  output_string oc "line1\nline2\nline3\nline4\n";
  close_out oc;
  Printf.printf "lines: %d\n" (count_lines "/tmp/sample.txt")
(* Output: lines: 4 *)

26.3.1 Bracket กับ Result Type

(* file: lib/bracket_result.ml *)
(* Bracket ที่ return Result แทน raise exception *)

let bracket_r ~acquire ~release ~use =
  match acquire () with
  | exception exn -> Error (`Acquire exn)
  | r ->
    let result =
      try Ok (use r)
      with exn -> Error (`Use exn)
    in
    (try release r
     with exn ->
       match result with
       | Ok _ -> () (* ignore release error if use succeeded?
                       หรือควร report — ขึ้นกับ policy *)
       | Error _ -> () (* ไม่ override error ของ use *)
       |> ignore;
       Printf.eprintf "release error: %s\n" (Printexc.to_string exn));
    result

(* ตัวอย่างใช้งาน *)
let safe_read path =
  bracket_r
    ~acquire:(fun () -> open_in path)
    ~release:(fun ic -> close_in ic)
    ~use:(fun ic -> input_line ic)

let () =
  match safe_read "/tmp/sample.txt" with
  | Ok line -> Printf.printf "first line: %s\n" line
  | Error (`Acquire e) ->
    Printf.eprintf "cannot open: %s\n" (Printexc.to_string e)
  | Error (`Use e) ->
    Printf.eprintf "read failed: %s\n" (Printexc.to_string e)

26.4 Eio.Switch สำหรับ Scoped Resource Lifetime

ใน Eio ทรัพยากรที่ต้อง cleanup ผูกกับ Switch โดยเรียก Switch.on_release — cleanup จะรันเมื่อ Switch จบ (ไม่ว่าจบปกติหรือ error)

(* file: examples/eio_scoped_resource.ml *)
(* Resource ผูกกับ Switch lifetime *)

open Eio

(* Abstract resource: "connection" สมมติ *)
type conn = {
  id : int;
  mutable closed : bool;
}

let next_id = Atomic.make 0

let open_conn () =
  let id = Atomic.fetch_and_add next_id 1 in
  traceln "🔌 open conn #%d" id;
  { id; closed = false }

let close_conn c =
  if not c.closed then begin
    c.closed <- true;
    traceln "🔒 close conn #%d" c.id
  end

(* bracket style ผ่าน Switch *)
let with_conn ~sw f =
  let c = open_conn () in
  Switch.on_release sw (fun () -> close_conn c);
  f c

let main ~clock =
  Switch.run @@ fun sw ->
    (* conn หลายตัวใน scope เดียว *)
    let c1 = with_conn ~sw Fun.id in
    let c2 = with_conn ~sw Fun.id in
    traceln "working with conn %d and %d" c1.id c2.id;
    Time.sleep clock 0.5
    (* ออกจาก Switch.run: c1, c2 จะถูก close อัตโนมัติ
       ตามลำดับ LIFO (c2 ก่อน c1) *)

let () =
  Eio_main.run @@ fun env ->
  main ~clock:(Stdenv.clock env)

(* Output:
   🔌 open conn #0
   🔌 open conn #1
   working with conn 0 and 1
   🔒 close conn #1
   🔒 close conn #0
*)

26.4.1 Nested Switches และ Resource Scoping

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','background':'#282828','textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart TB
    subgraph Outer["Outer Switch — อายุยาว"]
        DB[DB Pool
long-lived]
        subgraph Inner1["Inner Switch 1 — per-request"]
            R1[Request Handler 1]
            C1[Temp Buffer]
        end
        subgraph Inner2["Inner Switch 2 — per-request"]
            R2[Request Handler 2]
            C2[Temp Buffer]
        end
    end
    DB -.->|borrowed| R1
    DB -.->|borrowed| R2
    style DB fill:#fabd2f,color:#282828
    style C1 fill:#83a598,color:#282828
    style C2 fill:#83a598,color:#282828

(* file: examples/nested_switches.ml *)
(* Nested switches: outer มีอายุยาว inner สั้น *)

open Eio

type db_pool = { name : string; mutable requests : int }

let open_pool name =
  traceln "📦 opening pool %s" name;
  { name; requests = 0 }

let close_pool p =
  traceln "📦 closing pool %s (handled %d reqs)" p.name p.requests

let with_pool ~sw name f =
  let p = open_pool name in
  Switch.on_release sw (fun () -> close_pool p);
  f p

let handle_request ~clock ~pool req_id =
  Switch.run @@ fun req_sw ->
    (* per-request resources *)
    let buf = Bytes.create 1024 in
    Switch.on_release req_sw (fun () ->
      traceln "🧹 cleaning buffer for req %d" req_id);
    pool.requests <- pool.requests + 1;
    traceln "⚙️  req %d using pool %s (buf size=%d)"
      req_id pool.name (Bytes.length buf);
    Time.sleep clock 0.1

let main ~clock =
  (* outer switch: pool lives here *)
  Switch.run @@ fun outer_sw ->
    let pool = with_pool ~sw:outer_sw "postgres" Fun.id in
    (* handle 3 requests *)
    Fiber.all (List.init 3 (fun i ->
      fun () -> handle_request ~clock ~pool i))

let () =
  Eio_main.run @@ fun env ->
  main ~clock:(Stdenv.clock env)

26.5 ป้องกัน Resource Leaks ใน Concurrent Code

26.5.1 Connection Pool Pattern

(* file: lib/conn_pool.ml *)
(* Bounded connection pool ที่ thread-safe สำหรับ Eio *)

open Eio

module Make (R : sig
  type t
  val create : unit -> t
  val close : t -> unit
  val is_valid : t -> bool
end) = struct

  type t = {
    max_size : int;
    mutable current : int;
    available : R.t Queue.t;
    mutex : Mutex.t;
    cond : Condition.t;
  }

  let create ~max_size = {
    max_size;
    current = 0;
    available = Queue.create ();
    mutex = Mutex.create ();
    cond = Condition.create ();
  }

  (* ขอ connection แบบ blocking จนกว่าจะมีว่าง *)
  let acquire pool =
    Mutex.lock pool.mutex;
    Fun.protect
      ~finally:(fun () -> Mutex.unlock pool.mutex)
      (fun () ->
        (* รอจน (มีของใน queue) หรือ (ยังสร้างใหม่ได้) *)
        while Queue.is_empty pool.available
              && pool.current >= pool.max_size do
          Condition.wait pool.cond pool.mutex
        done;
        match Queue.take_opt pool.available with
        | Some r when R.is_valid r -> r
        | Some r ->
          R.close r;
          pool.current <- pool.current - 1;
          let fresh = R.create () in
          pool.current <- pool.current + 1;
          fresh
        | None ->
          let fresh = R.create () in
          pool.current <- pool.current + 1;
          fresh)

  let release pool r =
    Mutex.lock pool.mutex;
    if R.is_valid r then
      Queue.add r pool.available
    else begin
      R.close r;
      pool.current <- pool.current - 1
    end;
    Condition.signal pool.cond;
    Mutex.unlock pool.mutex

  (* safe wrapper: ensure release แม้ use จะ raise *)
  let with_conn pool ~use =
    let r = acquire pool in
    Fun.protect
      ~finally:(fun () -> release pool r)
      (fun () -> use r)

  let shutdown pool =
    Mutex.lock pool.mutex;
    Queue.iter R.close pool.available;
    Queue.clear pool.available;
    pool.current <- 0;
    Mutex.unlock pool.mutex
end

(* ตัวอย่างการ instantiate *)
module Fake_db = struct
  type t = { id : int; mutable alive : bool }
  let counter = Atomic.make 0
  let create () =
    let id = Atomic.fetch_and_add counter 1 in
    Printf.printf "[db] opened #%d\n" id;
    { id; alive = true }
  let close t =
    Printf.printf "[db] closed #%d\n" t.id;
    t.alive <- false
  let is_valid t = t.alive
end

module Pool = Make(Fake_db)

let () =
  let pool = Pool.create ~max_size:3 in
  (* simulation การใช้งาน *)
  for i = 1 to 5 do
    Pool.with_conn pool ~use:(fun conn ->
      Printf.printf "job %d using conn #%d\n" i conn.Fake_db.id)
  done;
  Pool.shutdown pool

26.5.2 Cancellation-Safe Acquire

ปัญหา: หาก fiber ถูก cancel ระหว่าง acquire แต่ก่อน Switch.on_release → resource leak!

แก้: ใช้ Switch.on_release ก่อน operation ที่อาจ yield หรือ ใช้ helper ที่ atomic

(* file: examples/cancel_safe.ml *)
(* Pattern ที่ cancel-safe — register cleanup ก่อน yield *)

open Eio

type socket = { fd : int; mutable open_ : bool }
let fake_socket_open () =
  traceln "🌐 socket open";
  { fd = 42; open_ = true }
let fake_socket_close s =
  if s.open_ then begin
    s.open_ <- false;
    traceln "🌐 socket close"
  end

(* ❌ UNSAFE: หาก cancel เกิดระหว่าง sleep → leak *)
let unsafe_connect ~sw ~clock =
  let s = fake_socket_open () in
  Time.sleep clock 0.5; (* <-- cancellation point! *)
  Switch.on_release sw (fun () -> fake_socket_close s);
  s

(* ✅ SAFE: register cleanup ทันที *)
let safe_connect ~sw ~clock =
  let s = fake_socket_open () in
  Switch.on_release sw (fun () -> fake_socket_close s);
  (* แม้ cancel เกิดตรงนี้ socket จะถูก close *)
  Time.sleep clock 0.5;
  s

let () =
  Eio_main.run @@ fun env ->
  let clock = Stdenv.clock env in
  try
    Switch.run @@ fun sw ->
      Fiber.fork ~sw (fun () ->
        let _s = safe_connect ~sw ~clock in
        traceln "connected!");
      (* ยกเลิกหลัง 0.1 วินาที — ก่อน sleep จบ *)
      Time.sleep clock 0.1;
      failwith "simulated abort"
  with Failure _ ->
    traceln "switch closed — socket ได้รับการ close แล้ว"

26.5.3 Checklist การป้องกัน Resource Leaks

27. Testing Concurrent และ Systems Code

27.1 ลำดับชั้นของ Testing Strategy

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','background':'#282828','textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart TB
    subgraph Bottom["ระดับต่ำ — Fast & Narrow"]
        UT[Unit Tests
Alcotest]
    end
    subgraph Middle["ระดับกลาง — Property Coverage"]
        PBT[Property-Based
QCheck]
        FUZZ[Fuzzing
crowbar/afl]
    end
    subgraph High["ระดับสูง — Concurrency & Integration"]
        LIN[Linearizability
Lin/Ortac]
        CONC[Concurrency
Simulation]
        INT[Integration
real deps]
    end
    UT --> PBT
    UT --> FUZZ
    PBT --> LIN
    FUZZ --> LIN
    LIN --> CONC
    CONC --> INT
    style UT fill:#b8bb26,color:#282828
    style PBT fill:#fabd2f,color:#282828
    style FUZZ fill:#fabd2f,color:#282828
    style LIN fill:#fb4934,color:#282828
    style CONC fill:#fb4934,color:#282828
    style INT fill:#d3869b,color:#282828

27.2 Alcotest — Unit Testing พื้นฐาน

Alcotest เป็น lightweight test framework ที่ simple และ pretty output — เหมาะสำหรับงาน unit test

27.2.1 โครงสร้าง Project

my_project/
├── dune-project
├── lib/
│   ├── dune
│   └── my_lib.ml
└── test/
    ├── dune
    └── test_my_lib.ml

(* file: lib/my_lib.ml *)
(* โมดูลตัวอย่างที่จะทดสอบ *)

let add a b = a + b
let divide a b =
  if b = 0 then Error "division by zero"
  else Ok (a / b)

(* Stack แบบ mutable *)
type 'a stack = { mutable items : 'a list }
let make_stack () = { items = [] }
let push s x = s.items <- x :: s.items
let pop s =
  match s.items with
  | [] -> None
  | x :: rest -> s.items <- rest; Some x
let size s = List.length s.items

; file: lib/dune
(library
 (name my_lib))

(* file: test/test_my_lib.ml *)
(* Unit tests ด้วย Alcotest *)

open Alcotest

(* Test สำหรับ add *)
let test_add_positive () =
  check int "2+3" 5 (My_lib.add 2 3)

let test_add_zero () =
  check int "0+0" 0 (My_lib.add 0 0)

let test_add_negative () =
  check int "(-5) + 10" 5 (My_lib.add (-5) 10)

(* Test สำหรับ divide — ใช้ result testable *)
let result_int_string =
  result int string

let test_divide_ok () =
  check result_int_string "10/2" (Ok 5) (My_lib.divide 10 2)

let test_divide_by_zero () =
  check result_int_string "10/0"
    (Error "division by zero") (My_lib.divide 10 0)

(* Test สำหรับ stack — stateful *)
let test_stack_push_pop () =
  let s = My_lib.make_stack () in
  My_lib.push s 1;
  My_lib.push s 2;
  My_lib.push s 3;
  check int "size after 3 pushes" 3 (My_lib.size s);
  check (option int) "pop 3" (Some 3) (My_lib.pop s);
  check (option int) "pop 2" (Some 2) (My_lib.pop s);
  check (option int) "pop 1" (Some 1) (My_lib.pop s);
  check (option int) "pop empty" None (My_lib.pop s)

(* รวม tests เป็น suite *)
let () =
  run "My_lib" [
    "add", [
      test_case "positive"   `Quick test_add_positive;
      test_case "zero"       `Quick test_add_zero;
      test_case "negative"   `Quick test_add_negative;
    ];
    "divide", [
      test_case "ok"         `Quick test_divide_ok;
      test_case "by zero"    `Quick test_divide_by_zero;
    ];
    "stack", [
      test_case "push/pop"   `Quick test_stack_push_pop;
    ];
  ]

; file: test/dune
(test
 (name test_my_lib)
 (libraries my_lib alcotest))

การรัน:

$ dune runtest
Testing `My_lib'.
This run has ID `ABC123'.
  [OK]          add             0   positive.
  [OK]          add             1   zero.
  [OK]          add             2   negative.
  [OK]          divide          0   ok.
  [OK]          divide          1   by zero.
  [OK]          stack           0   push/pop.

Full test results in `.../_build/_tests/My_lib'.
Test Successful in 0.003s. 6 tests run.

27.3 Property-Based Testing ด้วย QCheck

Property-based testing คือการ generate input แบบ random จำนวนมาก (ปกติ 100–10000 cases) แล้วตรวจว่า property ยังเป็นจริง

27.3.1 QCheck Fundamentals

(* file: test/test_properties.ml *)
(* Property-based tests ด้วย QCheck *)

open QCheck2

(* Property 1: add เป็น commutative *)
let prop_add_commutative =
  Test.make
    ~name:"add is commutative"
    ~count:1000
    Gen.(pair int int)
    (fun (a, b) -> My_lib.add a b = My_lib.add b a)

(* Property 2: add เป็น associative *)
let prop_add_associative =
  Test.make
    ~name:"add is associative"
    ~count:1000
    Gen.(triple int int int)
    (fun (a, b, c) ->
      My_lib.add (My_lib.add a b) c
      = My_lib.add a (My_lib.add b c))

(* Property 3: push แล้ว pop ได้ค่าเดิม (stack invariant) *)
let prop_push_pop =
  Test.make
    ~name:"push then pop returns same value"
    ~count:500
    Gen.int
    (fun x ->
      let s = My_lib.make_stack () in
      My_lib.push s x;
      My_lib.pop s = Some x)

(* Property 4: reverse twice = identity *)
let prop_reverse_involutive =
  Test.make
    ~name:"reverse is involutive"
    ~count:500
    Gen.(list int)
    (fun xs -> List.rev (List.rev xs) = xs)

(* Property 5: sort แล้ว length เท่าเดิม *)
let prop_sort_preserves_length =
  Test.make
    ~name:"sort preserves length"
    ~count:500
    Gen.(list int)
    (fun xs -> List.length (List.sort compare xs) = List.length xs)

(* Property 6: sorted list เป็น non-decreasing *)
let is_sorted = function
  | [] | [_] -> true
  | xs ->
    let rec aux = function
      | a :: (b :: _ as rest) -> a <= b && aux rest
      | _ -> true
    in aux xs

let prop_sort_sorted =
  Test.make
    ~name:"sort produces sorted list"
    ~count:500
    Gen.(list small_int)
    (fun xs -> is_sorted (List.sort compare xs))

let () =
  let tests = [
    prop_add_commutative;
    prop_add_associative;
    prop_push_pop;
    prop_reverse_involutive;
    prop_sort_preserves_length;
    prop_sort_sorted;
  ] in
  let alcotests = List.map QCheck_alcotest.to_alcotest tests in
  Alcotest.run "properties" [
    "qcheck", alcotests
  ]

27.3.2 Shrinking — ค้นหา Minimal Counterexample

เมื่อ QCheck พบ counterexample มันจะพยายาม shrink ให้เล็กที่สุด:

(* file: test/test_shrinking.ml *)
(* ตัวอย่าง property ที่จะ fail เพื่อดู shrinking *)

open QCheck2

(* ฟังก์ชันที่ buggy: "sum จะไม่เกิน n*100 เมื่อ n <= list length" *)
let buggy_sum_bound =
  Test.make
    ~name:"sum bounded (buggy property)"
    ~count:100
    Gen.(list small_int)
    (fun xs ->
      let sum = List.fold_left (+) 0 xs in
      (* property นี้ผิดเมื่อ list มีค่าใหญ่ *)
      sum < List.length xs * 50)

(* รันเพื่อดูว่า QCheck จะ shrink อย่างไร *)
let () =
  QCheck_base_runner.run_tests_main [buggy_sum_bound]

(* QCheck จะรายงาน:
     test 'sum bounded (buggy property)' failed on input: [87; 99; 45]
     (shrank from longer list) *)

27.3.3 Custom Generators

(* file: test/test_custom_gen.ml *)
(* สร้าง generator เอง สำหรับ domain model *)

open QCheck2

(* Domain: user account *)
type user = {
  id : int;
  name : string;
  age : int;
  email : string;
}

let gen_email =
  let open Gen in
  let* local = string_size ~gen:(char_range 'a' 'z') (1 -- 10) in
  let* domain = oneofl ["example.com"; "test.org"; "mail.io"] in
  return (local ^ "@" ^ domain)

let gen_user =
  let open Gen in
  let* id = 1 -- 1_000_000 in
  let* name = string_size ~gen:(char_range 'A' 'Z') (3 -- 15) in
  let* age = 0 -- 120 in
  let* email = gen_email in
  return { id; name; age; email }

(* Property: user ที่ generate ทุกคนต้องมี email ที่ถูกต้อง *)
let prop_valid_email =
  Test.make
    ~name:"generated users have @ in email"
    ~count:200
    gen_user
    (fun u -> String.contains u.email '@')

let () =
  QCheck_base_runner.run_tests_main [prop_valid_email]

27.4 Concurrency Testing — Lin & Ortac

Linearizability Testing คือการตรวจสอบว่า concurrent data structure ทำงานเหมือน sequential version ราวกับ operation เกิดขึ้นทีละตัว (แม้จริง ๆ จะ interleave)

Lin คือ library ของ OCaml 5 (จาก Tarides) ที่ generate test interleaving จำนวนมาก แล้วตรวจว่าผลลัพธ์ linearizable

27.4.1 ตัวอย่าง — Testing Atomic Counter

(* file: test/test_counter_lin.ml *)
(* Linearizability test สำหรับ concurrent counter *)

(* Module ที่จะทดสอบ: atomic counter *)
module Counter = struct
  type t = int Atomic.t
  let make () = Atomic.make 0
  let incr t = Atomic.incr t
  let get t = Atomic.get t
  let reset t = Atomic.set t 0
end

(* Describe API ให้ Lin *)
module Spec = struct
  type t = Counter.t

  let init () = Counter.make ()
  let cleanup _ = ()

  open Lin
  let api = [
    val_ "Counter.incr"  Counter.incr  (t @-> returning unit);
    val_ "Counter.get"   Counter.get   (t @-> returning int);
    val_ "Counter.reset" Counter.reset (t @-> returning unit);
  ]
end

module Lin_test = Lin_domain.Make(Spec)

let () =
  QCheck_base_runner.run_tests_main [
    Lin_test.neg_lin_test ~count:1000 ~name:"Counter is linearizable"
  ]

(* Lin จะ:
   1. generate sequence ของ operations random
   2. รัน operations ใน 2+ domains พร้อมกัน
   3. พยายามหา linearization ที่ match กับผลลัพธ์จริง
   4. fail ถ้าไม่มี linearization ที่ valid *)

27.4.2 จับ Bug ใน Non-atomic Counter

(* file: test/test_buggy_counter.ml *)
(* Counter ที่ buggy — ไม่ใช้ Atomic *)

module Buggy_counter = struct
  type t = { mutable v : int }
  let make () = { v = 0 }
  let incr t = t.v <- t.v + 1   (* ❌ race condition! *)
  let get t = t.v
end

module Spec = struct
  type t = Buggy_counter.t
  let init () = Buggy_counter.make ()
  let cleanup _ = ()
  open Lin
  let api = [
    val_ "incr" Buggy_counter.incr (t @-> returning unit);
    val_ "get"  Buggy_counter.get  (t @-> returning int);
  ]
end

module Test = Lin_domain.Make(Spec)

let () =
  (* Lin จะพบว่าหลัง incr 100 ครั้งจาก 2 domains
     get อาจได้ค่าน้อยกว่า 200 → ไม่ linearizable *)
  QCheck_base_runner.run_tests_main [
    Test.neg_lin_test ~count:5000 ~name:"Buggy counter"
  ]

27.5 Fuzzing ด้วย Crowbar

Fuzzing = ป้อน input ที่ unexpected/malformed เข้า system เพื่อหา crash หรือ vulnerability Crowbar ใช้ afl-fuzz backend + QCheck-style property

(* file: test/fuzz_parser.ml *)
(* Fuzz test: JSON parser ไม่ควร crash ไม่ว่า input จะเป็นอะไร *)

open Crowbar

(* Generator ของ bytes แบบไม่จำกัด structure *)
let bytes_gen = bytes

(* Property: parse ต้องจบ (return Ok หรือ Error) ไม่ควร crash *)
let () =
  add_test ~name:"json parser never crashes" [bytes_gen]
    (fun input ->
      match Yojson.Safe.from_string input with
      | _ -> ()                          (* ok *)
      | exception Yojson.Json_error _ -> () (* ok — expected parse error *)
      | exception e ->
        (* ❌ unexpected exception — bug! *)
        failf "unexpected: %s" (Printexc.to_string e))

การรัน fuzzing:

# 1. build with AFL instrumentation
$ dune build --instrument-with afl

# 2. สร้าง corpus เริ่มต้น
$ mkdir -p corpus && echo '{"hello":"world"}' > corpus/seed1

# 3. รัน afl-fuzz
$ afl-fuzz -i corpus -o findings -- ./_build/default/test/fuzz_parser.exe @@

27.6 Testing Eio Code

การทดสอบ code ที่ใช้ Eio มี challenge เพราะต้องการ event loop — ใช้ Eio_mock สำหรับ time manipulation

(* file: test/test_eio_code.ml *)
(* ทดสอบ code ที่ใช้ Eio clock ด้วย mock clock *)

open Eio

(* โค้ดที่ต้องทดสอบ: timeout wrapper *)
let fetch_with_timeout ~clock ~timeout f =
  Time.with_timeout clock timeout f

(* Helper สำหรับ test: simulate ทำงาน n วินาที *)
let slow_task ~clock duration () =
  Time.sleep clock duration;
  Ok "done"

let test_within_timeout () =
  Eio_mock.Backend.run @@ fun () ->
  let clock = Eio_mock.Clock.make () in
  let result =
    Fiber.both
      (fun () ->
        (* task ใช้ 1 วินาที timeout 5 วินาที → ต้องสำเร็จ *)
        let r = fetch_with_timeout ~clock ~timeout:5.0
          (slow_task ~clock:(clock :> _ Time.clock_ty r) 1.0) in
        Alcotest.(check (result string string))
          "within timeout" (Ok "done") r)
      (fun () ->
        Eio_mock.Clock.advance clock)
  in
  result

let test_exceeds_timeout () =
  Eio_mock.Backend.run @@ fun () ->
  let clock = Eio_mock.Clock.make () in
  Fiber.both
    (fun () ->
      let r = fetch_with_timeout ~clock ~timeout:1.0
        (slow_task ~clock:(clock :> _ Time.clock_ty r) 5.0) in
      Alcotest.(check bool)
        "exceeds timeout"
        true
        (Result.is_error r))
    (fun () ->
      Eio_mock.Clock.advance clock)

let () =
  Alcotest.run "Eio" [
    "timeout", [
      Alcotest.test_case "within"  `Quick test_within_timeout;
      Alcotest.test_case "exceeds" `Quick test_exceeds_timeout;
    ]
  ]

27.7 Matrix สรุปการเลือก Testing Tool

28. Deployment และ Packaging

28.1 ภาพรวมการ Deploy OCaml Application

%%{init: {'theme':'base','themeVariables':{
  'primaryColor':'#3c3836','primaryTextColor':'#ebdbb2','primaryBorderColor':'#fabd2f',
  'lineColor':'#fabd2f','background':'#282828','textColor':'#ebdbb2','fontFamily':'monospace'
}}}%%
flowchart LR
    SRC[Source Code
ml/mli files] --> LOCK[opam.locked
reproducible deps]
    LOCK --> BUILD[dune build
--release]
    BUILD --> BIN[Native Binary
~5-50MB]
    BIN --> STATIC{Static
Link?}
    STATIC -->|Yes| MUSL[musl-libc
fully static]
    STATIC -->|No| DYN[glibc dynamic]
    MUSL --> DOCKER[Docker Image
FROM scratch
~10MB]
    DYN --> DOCKER_ALPINE[Docker Image
FROM alpine
~50MB]
    DOCKER --> K8S[Kubernetes /
systemd]
    DOCKER_ALPINE --> K8S
    style BIN fill:#fabd2f,color:#282828
    style MUSL fill:#b8bb26,color:#282828
    style DOCKER fill:#83a598,color:#282828

28.2 Static Linking ด้วย musl-libc

ทำไม static linking?

• ✅ Binary เดียว portable ข้าม distro
• ✅ ไม่ต้องกังวล glibc version mismatch
• ✅ Docker image ได้จาก scratch (เล็กมาก)
• ⚠️ Binary ใหญ่กว่าเล็กน้อย
• ⚠️ ไม่ได้ shared library updates อัตโนมัติ

28.2.1 ตั้งค่า musl Cross-Compile Switch

# 1. สร้าง opam switch สำหรับ musl static build
$ opam switch create 5.2.0+musl+static \
    --packages=ocaml-variants.5.2.0+options,ocaml-option-musl,ocaml-option-static

# 2. install deps
$ opam install . --deps-only --locked

# 3. build with static flag
$ dune build --release --profile=static

28.2.2 Dune Config สำหรับ Static Build

; file: dune-project
(lang dune 3.14)
(name myapp)

(generate_opam_files true)

(package
 (name myapp)
 (depends
  (ocaml (>= 5.2.0))
  (dune (>= 3.14))
  (eio_main (>= 1.0))
  (cmdliner (>= 1.2))
  (logs (>= 0.7))))

; file: bin/dune
(executable
 (name main)
 (public_name myapp)
 (libraries myapp_lib eio_main cmdliner logs logs.fmt)
 (flags (:standard))
 ; เพิ่ม link flags เมื่อ build ด้วย profile=static
 (ocamlopt_flags
  (:standard
   (when %{profile} = static
     (-cclib -static -cclib -no-pie)))))

(* file: bin/main.ml *)
(* Entrypoint สำหรับ production app *)

open Cmdliner

let setup_logs level =
  Logs.set_reporter (Logs_fmt.reporter ());
  Logs.set_level (Some level);
  ()

let run port verbose =
  let level = if verbose then Logs.Debug else Logs.Info in
  setup_logs level;
  Logs.info (fun m -> m "🚀 starting on port %d" port);
  Eio_main.run @@ fun env ->
  Myapp_lib.Server.run ~env ~port

let port =
  let doc = "Port to listen on" in
  Arg.(value & opt int 8080 & info ["p"; "port"] ~doc)

let verbose =
  let doc = "Enable debug logging" in
  Arg.(value & flag & info ["v"; "verbose"] ~doc)

let cmd =
  let doc = "Sample OCaml 5 production service" in
  let info = Cmd.info "myapp" ~version:"0.1.0" ~doc in
  Cmd.v info Term.(const run $ port $ verbose)

let () = exit (Cmd.eval cmd)

28.3 Docker Multi-Stage Build

Multi-stage build แยก stage build ออกจาก stage runtime ลดขนาด image อย่างมาก

28.3.1 Dockerfile สำหรับ OCaml 5 App

# file: Dockerfile
# ============================================
# Stage 1: Builder — มีเครื่องมือ build ครบ
# ============================================
FROM ocaml/opam:alpine-3.19-ocaml-5.2 AS builder

# ติดตั้ง dev deps ที่ opam packages ต้องการ
USER root
RUN apk add --no-cache \
      gmp-dev \
      libev-dev \
      openssl-dev \
      pkgconf \
      linux-headers \
      musl-dev \
      gcc \
      g++ \
      make
USER opam

WORKDIR /home/opam/app

# Copy opam files ก่อน → cache layer นี้จน deps เปลี่ยน
COPY --chown=opam:opam myapp.opam dune-project ./
COPY --chown=opam:opam myapp.opam.locked ./

# ติดตั้ง deps ตาม lockfile (reproducible)
RUN opam install . --deps-only --locked --yes

# Copy source แล้ว build release
COPY --chown=opam:opam . .
RUN eval $(opam env) && \
    dune build --release bin/main.exe && \
    cp _build/default/bin/main.exe /home/opam/myapp && \
    strip /home/opam/myapp

# ============================================
# Stage 2: Runtime — เล็กที่สุด
# ============================================
FROM alpine:3.19 AS runtime

RUN apk add --no-cache \
      gmp \
      libev \
      openssl \
      ca-certificates \
    && addgroup -S app \
    && adduser -S -G app -u 10001 app

COPY --from=builder /home/opam/myapp /usr/local/bin/myapp

USER app
EXPOSE 8080

# Health check ผ่าน endpoint /health
HEALTHCHECK --interval=30s --timeout=3s --start-period=5s \
  CMD wget -q -O /dev/null http://localhost:8080/health || exit 1

ENTRYPOINT ["/usr/local/bin/myapp"]
CMD ["--port", "8080"]

28.3.2 Fully-Static Variant (FROM scratch)

# file: Dockerfile.static
# Image สุดท้าย ~ 10-15 MB ไม่มี OS layer เลย

FROM ocaml/opam:alpine-3.19-ocaml-5.2 AS builder
USER root
RUN apk add --no-cache gmp-dev libev-dev openssl-dev pkgconf \
                      linux-headers musl-dev gcc g++ make

WORKDIR /app
COPY --chown=opam:opam . .
USER opam

# ใช้ musl+static switch
RUN opam switch create . 5.2.0+musl+static \
      --packages=ocaml-variants.5.2.0+options,ocaml-option-musl,ocaml-option-static \
      --yes && \
    opam install . --deps-only --locked --yes && \
    eval $(opam env) && \
    dune build --release --profile=static bin/main.exe && \
    strip _build/default/bin/main.exe

# -------- runtime from scratch --------
FROM scratch
COPY --from=builder /app/_build/default/bin/main.exe /myapp
COPY --from=builder /etc/ssl/certs /etc/ssl/certs
EXPOSE 8080
ENTRYPOINT ["/myapp"]

28.3.3 เปรียบเทียบขนาด Image

28.4 Cross-Compilation

การ cross-compile OCaml ทำได้หลายวิธี:

1. dockcross — ใช้ Docker images ที่ pre-configured cross-toolchains
2. opam-cross — opam repos สำหรับ cross-compile
3. esperanto (wip) — native OCaml cross-compile support

28.4.1 ตัวอย่างด้วย Docker (Linux → ARM64)

# build สำหรับ aarch64 บน x86_64 host ด้วย buildx
$ docker buildx create --use --name multi-arch
$ docker buildx build \
    --platform linux/amd64,linux/arm64 \
    --tag myrepo/myapp:0.1.0 \
    --push \
    .

# Makefile helper
# file: Makefile

IMAGE := myrepo/myapp
VERSION := $(shell cat VERSION)

.PHONY: build-multiarch
build-multiarch:
	docker buildx build \
		--platform linux/amd64,linux/arm64,linux/arm/v7 \
		--tag $(IMAGE):$(VERSION) \
		--tag $(IMAGE):latest \
		--push \
		.

.PHONY: build-local
build-local:
	docker build -t $(IMAGE):dev .

.PHONY: run
run: build-local
	docker run --rm -p 8080:8080 $(IMAGE):dev

28.5 opam Lock Files — Reproducible Builds

Lock file บันทึก version ที่ถูกทดสอบแล้วของ ทุก transitive dependency เพื่อให้ build ได้ผลเหมือนเดิมทุกครั้ง

28.5.1 การสร้างและใช้ Lock File

# สร้าง lockfile จาก current environment
$ opam lock .

# จะได้ไฟล์ myapp.opam.locked ที่ pin ทุก version:
#   opam-version: "2.0"
#   depends: [
#     "ocaml" {= "5.2.0"}
#     "dune" {= "3.14.0"}
#     "eio" {= "1.0"}
#     "eio_main" {= "1.0"}
#     ...
#   ]

# ติดตั้งจาก lockfile (reproducible)
$ opam install . --locked --deps-only

# update specific package แล้วสร้าง lock ใหม่
$ opam update
$ opam upgrade eio
$ opam lock .
$ git commit myapp.opam.locked -m "bump eio"

28.5.2 CI Pipeline Example (GitHub Actions)

# file: .github/workflows/ci.yml
name: CI

on:
  push:
    branches: [main]
  pull_request:

jobs:
  test:
    strategy:
      matrix:
        os: [ubuntu-latest, macos-latest]
        ocaml: ['5.2.x']
    runs-on: ${{ matrix.os }}

    steps:
      - uses: actions/checkout@v4

      - name: Setup OCaml ${{ matrix.ocaml }}
        uses: ocaml/setup-ocaml@v3
        with:
          ocaml-compiler: ${{ matrix.ocaml }}
          opam-pin: false

      - name: Install deps (locked)
        run: opam install . --deps-only --with-test --locked

      - name: Build
        run: opam exec -- dune build --release

      - name: Run tests
        run: opam exec -- dune runtest

      - name: Run property tests
        run: opam exec -- dune exec test/test_properties.exe

  docker:
    needs: test
    runs-on: ubuntu-latest
    if: github.ref == 'refs/heads/main'
    steps:
      - uses: actions/checkout@v4
      - uses: docker/setup-buildx-action@v3
      - uses: docker/login-action@v3
        with:
          username: ${{ secrets.DOCKER_USER }}
          password: ${{ secrets.DOCKER_TOKEN }}
      - uses: docker/build-push-action@v5
        with:
          platforms: linux/amd64,linux/arm64
          push: true
          tags: myrepo/myapp:${{ github.sha }},myrepo/myapp:latest

28.6 systemd Integration

สำหรับการ deploy แบบ bare metal หรือ VM systemd เป็น de-facto init system บน Linux

; file: /etc/systemd/system/myapp.service
[Unit]
Description=MyApp — OCaml 5 service
After=network-online.target
Wants=network-online.target
Documentation=https://github.com/myorg/myapp

[Service]
Type=exec
User=myapp
Group=myapp
ExecStart=/usr/local/bin/myapp --port 8080
Restart=on-failure
RestartSec=5s
TimeoutStopSec=30s

; ======= Hardening =======
; จำกัดสิทธิ์เพื่อความปลอดภัย
NoNewPrivileges=true
ProtectSystem=strict
ProtectHome=true
PrivateTmp=true
PrivateDevices=true
ProtectKernelTunables=true
ProtectKernelModules=true
ProtectControlGroups=true
RestrictAddressFamilies=AF_INET AF_INET6 AF_UNIX
RestrictNamespaces=true
LockPersonality=true
MemoryDenyWriteExecute=true
RestrictRealtime=true
SystemCallArchitectures=native

; Working directory ที่เขียนได้
StateDirectory=myapp
WorkingDirectory=/var/lib/myapp

; ======= Resource Limits =======
LimitNOFILE=65536
LimitNPROC=4096
MemoryMax=2G
CPUQuota=200%

; ======= Environment =======
Environment="OCAMLRUNPARAM=b,s=32M"
EnvironmentFile=-/etc/myapp/environment

[Install]
WantedBy=multi-user.target