07f4de3 · carlos/todomvc-bakeoff

diff --git a/apps/ocaml/.gitignore b/apps/ocaml/.gitignore

new file mode 100644

index 0000000..ef0307c

--- /dev/null

+++ b/apps/ocaml/.gitignore

@@ -0,0 +1,3 @@

+/_build/

+/static/base.css

+/static/index.css

diff --git a/apps/ocaml/AGENTS.md b/apps/ocaml/AGENTS.md

new file mode 100644

index 0000000..5060829

--- /dev/null

+++ b/apps/ocaml/AGENTS.md

@@ -0,0 +1,31 @@

+# 🤖 AGENTS.md: todo-ocaml

+

+The one rule: **the page works without JavaScript, and JavaScript only

+makes it nicer.** Every action is a plain form POST that answers 303. The

+script in `static/app.js` posts the same forms with `X-Fragment: todoapp`

+and swaps in the HTML the server renders; it never holds state of its own.

+

+## Tenancy

+

+- **One instance for the whole app** (`todo-ocaml.bfj.oncarlos.com`), one

+ SQLite file.

+- **Each visitor's list is kept separately by an anonymous cookie**

+ (`todomvc_list`, 128 random bits from `getrandom(2)`, `HttpOnly;

+ SameSite=Lax; Path=/`, plus `Secure` over https). An unknown or garbled

+ cookie gets a fresh, empty list. Every query that reads or writes a todo

+ is scoped by that list id; an id outside the caller's list is a 404.

+- **No sign-in.** Losing the cookie loses the list. That's accepted.

+- **Trust class C.** Todo titles are stored as plain text in SQLite, not

+ encrypted. That's a deliberate choice for a demo app holding nothing

+ sensitive.

+

+## Working here

+

+- Work only in `apps/ocaml/`. `BRIEF.md` and `CONTRACT.md` at the repo root

+ are binding.

+- Build with `make build` (x86, local) and `make build-arm64` (shipped,

+ inside the emulated arm64 root). Both use opam roots under `.cache/`.

+- `make test` runs the unit and handler tests. Run the shared suite with

+ `scripts/test-app.sh` before every deploy.

+- Migrations only add. Never drop or rewrite data.

+- Bind `127.0.0.1` only. Scratch goes in `mktemp -d -p "$TMPDIR"`.

diff --git a/apps/ocaml/Makefile b/apps/ocaml/Makefile

new file mode 100644

index 0000000..500a5a0

--- /dev/null

+++ b/apps/ocaml/Makefile

@@ -0,0 +1,42 @@

+# todo-ocaml: TodoMVC for the CARLOS bakeoff. See README.md.

+SHELL := /bin/bash

+VERSION ?= $(shell git rev-parse --short HEAD 2>/dev/null || echo dev)

+MESSAGE ?= Deploy todo-ocaml $(VERSION)

+CSS := static/base.css static/index.css

+DUNE := dune build --root . --profile release

+

+.PHONY: build build-arm64 test clean clean-deps bump unbump deploy

+

+# The shared TodoMVC styles are served byte for byte, compiled in.

+static/%.css: ../../shared/%.css

+ cp $< $@

+

+build: $(CSS)

+ APP_VERSION=$(VERSION) tools/x86.sh $(DUNE) --build-dir $(CURDIR)/_build/x86 ./bin/main.exe

+ mkdir -p dist && install -m 755 _build/x86/default/bin/main.exe dist/app

+

+build-arm64: $(CSS)

+ APP_VERSION=$(VERSION) LINK_FLAGS='-ccopt -static' \

+ tools/arm64.sh $(DUNE) --build-dir $(CURDIR)/_build/arm64 ./bin/main.exe

+ mkdir -p dist && install -m 755 _build/arm64/default/bin/main.exe dist/app-linux-arm64

+

+test: $(CSS)

+ tools/x86.sh dune test --root . --build-dir $(CURDIR)/_build/x86 --force

+

+clean:

+ rm -rf dist _build $(CSS)

+

+# Deletes both opam switches (every compiled library) but keeps the opam

+# repositories and the download cache, so the next build compiles every

+# library from its already-downloaded source.

+clean-deps: clean

+ rm -rf .cache/opam-arm64/default .cache/opam-x86/default

+

+bump:

+ sed -i 's/^let build_marker = "todomvc"$$/let build_marker = "todomvc-bumped"/' src/app.ml

+

+unbump:

+ sed -i 's/^let build_marker = "todomvc-bumped"$$/let build_marker = "todomvc"/' src/app.ml

+

+deploy:

+ carlos deploy --account bfj --app todo-ocaml --target linux-arm64 --message "$(MESSAGE)" dist/app-linux-arm64

diff --git a/apps/ocaml/bin/dune b/apps/ocaml/bin/dune

new file mode 100644

index 0000000..9cbd141

--- /dev/null

+++ b/apps/ocaml/bin/dune

@@ -0,0 +1,14 @@

+(executable

+ (name main)

+ (public_name todo-ocaml)

+ (package todo_ocaml)

+ (libraries todo eio eio_posix cohttp-eio http uri)

+ (link_flags (:standard (:include link_flags.sexp))))

+

+; LINK_FLAGS="-ccopt -static" links statically (the shipped arm64 build).

+(rule

+ (target link_flags.sexp)

+ (action

+ (with-stdout-to

+ %{target}

+ (echo "(%{env:LINK_FLAGS=})"))))

diff --git a/apps/ocaml/bin/main.ml b/apps/ocaml/bin/main.ml

new file mode 100644

index 0000000..3e1f655

--- /dev/null

+++ b/apps/ocaml/bin/main.ml

@@ -0,0 +1,90 @@

+(* todo-ocaml: <bin> --socket <path> --db <path>, or --listen 127.0.0.1:<port>

+ in place of --socket for local runs. *)

+

+let usage = "app (--socket <path> | --listen 127.0.0.1:<port>) --db <path>"

+

+(* Bodies are form posts; 1 MiB is far more than any title needs. *)

+let max_body = 1 lsl 20

+

+let fail fmt = Printf.ksprintf (fun s -> prerr_endline ("app: " ^ s); exit 2) fmt

+

+let parse_listen s =

+ match String.rindex_opt s ':' with

+ | None -> fail "--listen wants 127.0.0.1:<port>, got %S" s

+ | Some i -> (

+ let host = String.sub s 0 i and port = String.sub s (i + 1) (String.length s - i - 1) in

+ match (host, int_of_string_opt port) with

+ | "127.0.0.1", Some port when port > 0 && port < 65536 ->

+ (`Tcp (Eio.Net.Ipaddr.V4.loopback, port), "http://" ^ s)

+ | "127.0.0.1", _ -> fail "bad port in --listen %S" s

+ | _ -> fail "--listen only binds 127.0.0.1, got %S" host)

+

+let to_app_request req body =

+ let headers = Http.Request.headers req in

+ let uri = Uri.of_string (Http.Request.resource req) in

+ {

+ Todo.App.meth = Http.Method.to_string (Http.Request.meth req);

+ path = Uri.path uri;

+ query = List.map (fun (k, v) -> (k, String.concat "," v)) (Uri.query uri);

+ header = Http.Header.get headers;

+ body;

+ }

+

+let callback app _conn req body =

+ let read_body () =

+ match Http.Request.meth req with

+ | `POST -> Eio.Buf_read.(parse_exn take_all) ~max_size:max_body body

+ | _ -> ""

+ in

+ let (res : Todo.App.response) =

+ match read_body () with

+ | body -> Todo.App.handle app (to_app_request req body)

+ | exception Eio.Buf_read.Buffer_limit_exceeded -> Todo.App.text 413 "Too large\n"

+ in

+ let headers = Http.Header.of_list res.headers in

+ let status = Http.Status.of_int res.status in

+ match Http.Request.meth req with

+ | `HEAD ->

+ let headers = Http.Header.add headers "content-length" (string_of_int (String.length res.body)) in

+ Cohttp_eio.Server.respond ~headers ~status ~body:(Eio.Flow.string_source "") ()

+ | _ -> Cohttp_eio.Server.respond_string ~headers ~status ~body:res.body ()

+

+let () =

+ let socket = ref "" and listen = ref "" and db = ref "" in

+ Arg.parse

+ [ ("--socket", Arg.Set_string socket, "<path> unix socket to listen on");

+ ("--listen", Arg.Set_string listen, "<127.0.0.1:port> TCP address, for local runs");

+ ("--db", Arg.Set_string db, "<path> SQLite database file") ]

+ (fun a -> fail "unexpected argument %S" a)

+ usage;

+ if !db = "" || (!socket = "") = (!listen = "") then (prerr_endline ("usage: " ^ usage); exit 2);

+ let addr, origin =

+ if !listen <> "" then parse_listen !listen

+ else

+ ( `Unix !socket,

+ match Sys.getenv_opt "CARLOS_HOST" with

+ | Some h when h <> "" -> "https://" ^ h

+ | _ -> "http://localhost" )

+ in

+ let store = Todo.Store.open_ !db in

+ let app = Todo.App.create ~store ~origin ~version:Todo.Version.v in

+ (* SIGTERM and SIGINT stop the server; Condition.broadcast is signal-safe. *)

+ let stop = Eio.Condition.create () in

+ let on_signal _ = Eio.Condition.broadcast stop in

+ Sys.set_signal Sys.sigterm (Sys.Signal_handle on_signal);

+ Sys.set_signal Sys.sigint (Sys.Signal_handle on_signal);

+ Eio_posix.run (fun env ->

+ Eio.Switch.run (fun sw ->

+ (match addr with `Unix path when Sys.file_exists path -> Sys.remove path | _ -> ());

+ let sock = Eio.Net.listen ~sw ~backlog:128 ~reuse_addr:true (Eio.Stdenv.net env) addr in

+ Printf.eprintf "app: %s listening on %s\n%!" Todo.Version.v

+ (if !listen <> "" then !listen else !socket);

+ let server = Cohttp_eio.Server.make ~callback:(callback app) () in

+ Eio.Fiber.first

+ (fun () -> Eio.Condition.await_no_mutex stop)

+ (fun () ->

+ Cohttp_eio.Server.run sock server ~on_error:(fun e ->

+ Printf.eprintf "app: %s\n%!" (Printexc.to_string e)))));

+ (match addr with `Unix path -> (try Sys.remove path with Sys_error _ -> ()) | _ -> ());

+ Todo.Store.close store;

+ prerr_endline "app: stopped"

diff --git a/apps/ocaml/dune-project b/apps/ocaml/dune-project

new file mode 100644

index 0000000..eaf42de

--- /dev/null

+++ b/apps/ocaml/dune-project

@@ -0,0 +1,24 @@

+(lang dune 3.17)

+

+(name todo_ocaml)

+

+(generate_opam_files true)

+

+(maintainers "Paul Campbell <paul@keymail.dev>")

+

+(authors "Paul Campbell")

+

+(license MIT)

+

+(package

+ (name todo_ocaml)

+ (synopsis "TodoMVC for the CARLOS bakeoff, server-rendered in OCaml")

+ (depends

+ (ocaml (= 5.3.0))

+ (eio (>= 1.2))

+ (eio_posix (>= 1.2))

+ (cohttp-eio (>= 6.0))

+ (http (>= 6.0))

+ (uri (>= 4.4))

+ (sqlite3 (and (>= 5.3) (< 5.4)))

+ (alcotest :with-test)))

diff --git a/apps/ocaml/gen/dune b/apps/ocaml/gen/dune

new file mode 100644

index 0000000..bf8ec1f

--- /dev/null

+++ b/apps/ocaml/gen/dune

@@ -0,0 +1,2 @@

+(executable

+ (name embed))

diff --git a/apps/ocaml/gen/embed.ml b/apps/ocaml/gen/embed.ml

new file mode 100644

index 0000000..2e3a106

--- /dev/null

+++ b/apps/ocaml/gen/embed.ml

@@ -0,0 +1,14 @@

+(* Prints an OCaml module with one string per file: static/base.css

+ becomes [let base_css = "..."]. *)

+

+let ident path =

+ String.map (function 'a' .. 'z' | '0' .. '9' as c -> c | _ -> '_')

+ (String.lowercase_ascii (Filename.basename path))

+

+let () =

+ Array.iteri

+ (fun i path ->

+ if i > 0 then

+ Printf.printf "let %s = %S\n" (ident path)

+ (In_channel.with_open_bin path In_channel.input_all))

+ Sys.argv

diff --git a/apps/ocaml/src/app.ml b/apps/ocaml/src/app.ml

new file mode 100644

index 0000000..b8a238b

--- /dev/null

+++ b/apps/ocaml/src/app.ml

@@ -0,0 +1,167 @@

+(* Routes and actions, independent of the HTTP server: a request in, a

+ response out. bin/main.ml adapts this to cohttp-eio, and the tests call

+ it directly. *)

+

+type request = {

+ meth : string;

+ path : string;

+ query : (string * string) list;

+ header : string -> string option; (** by lower-case name *)

+ body : string;

+}

+

+type response = { status : int; headers : (string * string) list; body : string }

+

+type t = {

+ store : Store.t;

+ origin : string; (** this app's own origin, e.g. https://todo-ocaml.bfj.oncarlos.com *)

+ version : string;

+}

+

+(* `make bump` edits this constant so the next build must recompile this file. *)

+let build_marker = "todomvc"

+

+let create ~store ~origin ~version = { store; origin; version }

+

+let cookie_name = "todomvc_list"

+

+(* Kept for 400 days, the longest a browser will keep a cookie. *)

+let cookie_max_age = 400 * 24 * 60 * 60

+

+(* The inline script that marks the page as having JavaScript, and its hash

+ for the Content-Security-Policy. *)

+let csp =

+ "default-src 'self'; script-src 'self' 'sha256-qOhFsq0QMV2REqNwk5hGH5bZE9SkX6gt6yeyKdYPv+U='; \

+ img-src 'self' data:; frame-ancestors 'none'; base-uri 'none'; form-action 'self'"

+

+let respond ?(headers = []) status body = { status; headers; body }

+let text ?(headers = []) status body =

+ respond status body ~headers:(("content-type", "text/plain; charset=utf-8") :: headers)

+

+let html ?(headers = []) status body =

+ respond status body

+ ~headers:

+ ([ ("content-type", "text/html; charset=utf-8");

+ ("cache-control", "private, no-cache");

+ ("content-security-policy", csp);

+ ("x-content-type-options", "nosniff");

+ ("referrer-policy", "same-origin") ]

+ @ headers)

+

+let is_token s =

+ String.length s = 32 && String.for_all (function '0' .. '9' | 'a' .. 'f' -> true | _ -> false) s

+

+(* The caller's list id. An unknown or garbled cookie gets a fresh list,

+ and the response sets the cookie for it. *)

+let visitor t req =

+ let known =

+ Option.bind (req.header "cookie") (fun h -> Form.cookie h cookie_name)

+ |> Option.map String.trim

+ |> Option.to_list

+ |> List.find_opt (fun id -> is_token id && Store.list_exists t.store id)

+ in

+ match known with

+ | Some id -> (id, [])

+ | None ->

+ let id = Rand.token () in

+ Store.create_list t.store id;

+ let secure = String.starts_with ~prefix:"https:" t.origin in

+ ( id,

+ [ ( "set-cookie",

+ Printf.sprintf "%s=%s; Max-Age=%d; Path=/; HttpOnly; SameSite=Lax%s" cookie_name id

+ cookie_max_age (if secure then "; Secure" else "") ) ] )

+

+let static name =

+ let asset body ctype =

+ respond 200 body

+ ~headers:[ ("content-type", ctype); ("cache-control", "public, max-age=86400");

+ ("x-content-type-options", "nosniff") ]

+ in

+ match name with

+ | "base.css" -> Some (asset Assets.base_css "text/css; charset=utf-8")

+ | "index.css" -> Some (asset Assets.index_css "text/css; charset=utf-8")

+ | "app.css" -> Some (asset Assets.app_css "text/css; charset=utf-8")

+ | "app.js" -> Some (asset Assets.app_js "text/javascript; charset=utf-8")

+ | _ -> None

+

+(* GET /, /active and /completed. *)

+let page t req filter =

+ let list, cookie = visitor t req in

+ let editing = Option.bind (List.assoc_opt "edit" req.query) int_of_string_opt in

+ html 200 ~headers:cookie (View.page ~version:t.version ~filter ?editing (Store.todos t.store ~list))

+

+type action =

+ | Add

+ | Toggle_all

+ | Clear_completed

+ | Toggle of int

+ | Edit of int

+ | Destroy of int

+

+let action_of_path path =

+ let id s =

+ if s <> "" && String.for_all (function '0' .. '9' -> true | _ -> false) s then int_of_string_opt s

+ else None

+ in

+ match String.split_on_char '/' path with

+ | [ ""; "todos" ] -> Some Add

+ | [ ""; "todos"; "toggle-all" ] -> Some Toggle_all

+ | [ ""; "todos"; "clear-completed" ] -> Some Clear_completed

+ | [ ""; "todos"; n; verb ] -> (

+ match (id n, verb) with

+ | Some n, "toggle" -> Some (Toggle n)

+ | Some n, "edit" -> Some (Edit n)

+ | Some n, "destroy" -> Some (Destroy n)

+ | _ -> None)

+ | _ -> None

+

+let perform store ~list fields = function

+ | Add ->

+ let title = String.trim (Option.value ~default:"" (List.assoc_opt "title" fields)) in

+ if title <> "" then Store.add store ~list title;

+ true

+ | Toggle_all -> Store.toggle_all store ~list; true

+ | Clear_completed -> Store.clear_completed store ~list; true

+ | Toggle id -> Store.toggle store ~list id

+ | Destroy id -> Store.delete store ~list id

+ | Edit id -> (

+ match String.trim (Option.value ~default:"" (List.assoc_opt "title" fields)) with

+ | "" -> Store.delete store ~list id

+ | title -> Store.rename store ~list id title)

+

+(* Every action is a form POST answering 303 back to the filter. With

+ X-Fragment: todoapp (sent by app.js) it answers section.todoapp instead. *)

+let post t req action =

+ match req.header "origin" with

+ | Some o when o <> t.origin -> text 403 "Cross-origin request refused\n"

+ | _ when not (String.is_valid_utf_8 req.body) -> text 400 "Bad form body\n"

+ | _ ->

+ let fields = Form.parse req.body in

+ if not (List.for_all (fun (_, v) -> String.is_valid_utf_8 v) fields) then text 400 "Bad form body\n"

+ else

+ let list, cookie = visitor t req in

+ let filter = View.filter_of_string (Option.value ~default:"" (List.assoc_opt "filter" fields)) in

+ if not (perform t.store ~list fields action) then text 404 ~headers:cookie "No such todo\n"

+ else if req.header "x-fragment" = Some "todoapp" then

+ html 200 ~headers:cookie (View.fragment ~filter (Store.todos t.store ~list))

+ else respond 303 "" ~headers:(("location", View.filter_path filter) :: cookie)

+

+let handle t req =

+ let filter = function

+ | "/" -> Some View.All

+ | "/active" -> Some View.Active

+ | "/completed" -> Some View.Completed

+ | _ -> None

+ in

+ match (req.meth, req.path) with

+ | ("GET" | "HEAD"), "/healthz" -> text 200 "ok\n"

+ | ("GET" | "HEAD"), "/api/version" -> text 200 t.version

+ | ("GET" | "HEAD"), p when String.starts_with ~prefix:"/static/" p -> (

+ match static (String.sub p 8 (String.length p - 8)) with

+ | Some r -> r

+ | None -> text 404 "Not found\n")

+ | ("GET" | "HEAD"), p when filter p <> None -> page t req (Option.get (filter p))

+ | "POST", p when action_of_path p <> None -> post t req (Option.get (action_of_path p))

+ | _, p when filter p <> None || action_of_path p <> None ->

+ text 405 "Method not allowed\n" ~headers:[ ("allow", if filter p <> None then "GET, HEAD" else "POST") ]

+ | _ -> text 404 "Not found\n"

diff --git a/apps/ocaml/src/dune b/apps/ocaml/src/dune

new file mode 100644

index 0000000..1712e66

--- /dev/null

+++ b/apps/ocaml/src/dune

@@ -0,0 +1,28 @@

+(library

+ (name todo)

+ (libraries sqlite3 uri)

+ (foreign_stubs

+ (language c)

+ (names rand_stubs)))

+

+; The CSS and JS are compiled into the binary.

+(rule

+ (target assets.ml)

+ (deps

+ (:files

+ %{project_root}/static/base.css

+ %{project_root}/static/index.css

+ %{project_root}/static/app.css

+ %{project_root}/static/app.js))

+ (action

+ (with-stdout-to

+ %{target}

+ (run %{exe:../gen/embed.exe} %{files}))))

+

+; The build version, from APP_VERSION (the Makefile passes the git short SHA).

+(rule

+ (target version.ml)

+ (action

+ (with-stdout-to

+ %{target}

+ (echo "let v = \"%{env:APP_VERSION=dev}\"\n"))))

diff --git a/apps/ocaml/src/form.ml b/apps/ocaml/src/form.ml

new file mode 100644

index 0000000..701f247

--- /dev/null

+++ b/apps/ocaml/src/form.ml

@@ -0,0 +1,46 @@

+(* application/x-www-form-urlencoded bodies and Cookie headers. *)

+

+let hex c =

+ match c with

+ | '0' .. '9' -> Some (Char.code c - 48)

+ | 'a' .. 'f' -> Some (Char.code c - 87)

+ | 'A' .. 'F' -> Some (Char.code c - 55)

+ | _ -> None

+

+(* Decodes '+' as a space and %XX as a byte. A malformed escape is kept

+ as it is, the way browsers treat it. *)

+let decode s =

+ let n = String.length s in

+ let b = Buffer.create n in

+ let rec go i =

+ if i < n then

+ match s.[i] with

+ | '+' -> Buffer.add_char b ' '; go (i + 1)

+ | '%' when i + 2 < n -> (

+ match (hex s.[i + 1], hex s.[i + 2]) with

+ | Some h, Some l -> Buffer.add_char b (Char.chr ((h lsl 4) lor l)); go (i + 3)

+ | _ -> Buffer.add_char b '%'; go (i + 1))

+ | c -> Buffer.add_char b c; go (i + 1)

+ in

+ go 0;

+ Buffer.contents b

+

+let parse body =

+ String.split_on_char '&' body

+ |> List.filter_map (fun pair ->

+ if pair = "" then None

+ else

+ match String.index_opt pair '=' with

+ | Some i ->

+ Some (decode (String.sub pair 0 i),

+ decode (String.sub pair (i + 1) (String.length pair - i - 1)))

+ | None -> Some (decode pair, ""))

+

+(* The value of the first cookie called [name] in a Cookie header. *)

+let cookie header name =

+ String.split_on_char ';' header

+ |> List.find_map (fun part ->

+ match String.index_opt part '=' with

+ | Some i when String.trim (String.sub part 0 i) = name ->

+ Some (String.trim (String.sub part (i + 1) (String.length part - i - 1)))

+ | _ -> None)

diff --git a/apps/ocaml/src/rand.ml b/apps/ocaml/src/rand.ml

new file mode 100644

index 0000000..8c75d7a

--- /dev/null

+++ b/apps/ocaml/src/rand.ml

@@ -0,0 +1,6 @@

+external bytes : int -> string = "todo_getrandom"

+

+(* 128 random bits as 32 lowercase hex digits. *)

+let token () =

+ let b = bytes 16 in

+ String.concat "" (List.init 16 (fun i -> Printf.sprintf "%02x" (Char.code b.[i])))

diff --git a/apps/ocaml/src/rand_stubs.c b/apps/ocaml/src/rand_stubs.c

new file mode 100644

index 0000000..930f14f

--- /dev/null

+++ b/apps/ocaml/src/rand_stubs.c

@@ -0,0 +1,26 @@

+/* Random bytes straight from the kernel, so the app needs no /dev/urandom

+ inside its sandbox. */

+#include <errno.h>

+#include <string.h>

+#include <sys/random.h>

+#include <caml/alloc.h>

+#include <caml/fail.h>

+#include <caml/memory.h>

+#include <caml/mlvalues.h>

+

+CAMLprim value todo_getrandom(value len)

+{

+ CAMLparam1(len);

+ CAMLlocal1(buf);

+ size_t n = Long_val(len), got = 0;

+ buf = caml_alloc_string(n);

+ while (got < n) {

+ ssize_t r = getrandom((char *)Bytes_val(buf) + got, n - got, 0);

+ if (r < 0) {

+ if (errno == EINTR) continue;

+ caml_failwith(strerror(errno));

+ }

+ got += r;

+ }

+ CAMLreturn(buf);

+}

diff --git a/apps/ocaml/src/store.ml b/apps/ocaml/src/store.ml

new file mode 100644

index 0000000..4c6be07

--- /dev/null

+++ b/apps/ocaml/src/store.ml

@@ -0,0 +1,117 @@

+(* The SQLite store: one file, WAL mode, every todo scoped to a list. *)

+

+type todo = { id : int; title : string; completed : bool }

+type t = { db : Sqlite3.db; stmts : (string, Sqlite3.stmt) Hashtbl.t }

+

+(* Each entry runs once, in order, and is recorded in user_version.

+ Migrations only ever add: never edit or remove an entry. *)

+let migrations =

+ [

+ {|CREATE TABLE lists (

+ id TEXT PRIMARY KEY,

+ created_at INTEGER NOT NULL DEFAULT (unixepoch())

+ ) STRICT;

+ CREATE TABLE todos (

+ id INTEGER PRIMARY KEY AUTOINCREMENT,

+ list_id TEXT NOT NULL REFERENCES lists (id),

+ title TEXT NOT NULL,

+ completed INTEGER NOT NULL DEFAULT 0,

+ created_at INTEGER NOT NULL DEFAULT (unixepoch())

+ ) STRICT;

+ CREATE INDEX todos_by_list ON todos (list_id, id);|};

+ ]

+

+let exec db sql =

+ match Sqlite3.exec db sql with

+ | Sqlite3.Rc.OK -> ()

+ | rc -> failwith (Printf.sprintf "sqlite: %s: %s" (Sqlite3.Rc.to_string rc) (Sqlite3.errmsg db))

+

+let user_version db =

+ let v = ref 0 in

+ ignore (Sqlite3.exec_no_headers db "PRAGMA user_version" ~cb:(fun row ->

+ v := Option.fold ~none:0 ~some:int_of_string row.(0)));

+ !v

+

+let migrate db =

+ List.iteri

+ (fun i sql ->

+ if i >= user_version db then begin

+ exec db "BEGIN IMMEDIATE";

+ exec db sql;

+ exec db (Printf.sprintf "PRAGMA user_version = %d" (i + 1));

+ exec db "COMMIT"

+ end)

+ migrations

+

+let open_ path =

+ let db = Sqlite3.db_open path in

+ exec db "PRAGMA journal_mode = WAL";

+ exec db "PRAGMA synchronous = NORMAL";

+ exec db "PRAGMA busy_timeout = 5000";

+ exec db "PRAGMA foreign_keys = ON";

+ migrate db;

+ { db; stmts = Hashtbl.create 16 }

+

+let close t =

+ Hashtbl.iter (fun _ s -> ignore (Sqlite3.finalize s)) t.stmts;

+ Hashtbl.reset t.stmts;

+ ignore (Sqlite3.db_close t.db)

+

+(* Prepares [sql] once, binds [params], and calls [row] for each result. *)

+let query t sql params ~row =

+ let stmt =

+ match Hashtbl.find_opt t.stmts sql with

+ | Some s -> s

+ | None ->

+ let s = Sqlite3.prepare t.db sql in

+ Hashtbl.add t.stmts sql s;

+ s

+ in

+ Fun.protect ~finally:(fun () -> ignore (Sqlite3.reset stmt)) @@ fun () ->

+ Sqlite3.Rc.check (Sqlite3.bind_values stmt params);

+ let rec loop acc =

+ match Sqlite3.step stmt with

+ | Sqlite3.Rc.ROW -> loop (row stmt :: acc)

+ | Sqlite3.Rc.DONE -> List.rev acc

+ | rc -> failwith (Printf.sprintf "sqlite: %s: %s" (Sqlite3.Rc.to_string rc) (Sqlite3.errmsg t.db))

+ in

+ loop []

+

+(* Runs a statement and answers whether it changed any row. *)

+let change t sql params =

+ ignore (query t sql params ~row:ignore);

+ Sqlite3.changes t.db > 0

+

+let text s = Sqlite3.Data.TEXT s

+let int i = Sqlite3.Data.INT (Int64.of_int i)

+

+let list_exists t id = query t "SELECT 1 FROM lists WHERE id = ?" [ text id ] ~row:ignore <> []

+let create_list t id = ignore (change t "INSERT INTO lists (id) VALUES (?)" [ text id ])

+

+let todos t ~list =

+ query t "SELECT id, title, completed FROM todos WHERE list_id = ? ORDER BY id" [ text list ]

+ ~row:(fun s ->

+ { id = Sqlite3.column_int s 0; title = Sqlite3.column_text s 1; completed = Sqlite3.column_bool s 2 })

+

+let add t ~list title =

+ ignore (change t "INSERT INTO todos (list_id, title) VALUES (?, ?)" [ text list; text title ])

+

+let toggle t ~list id =

+ change t "UPDATE todos SET completed = NOT completed WHERE id = ? AND list_id = ?" [ int id; text list ]

+

+let rename t ~list id title =

+ change t "UPDATE todos SET title = ? WHERE id = ? AND list_id = ?" [ text title; int id; text list ]

+

+let delete t ~list id = change t "DELETE FROM todos WHERE id = ? AND list_id = ?" [ int id; text list ]

+

+(* Completes every item, or reopens them all if every one already was. *)

+let toggle_all t ~list =

+ ignore

+ (change t

+ {|UPDATE todos SET completed =

+ EXISTS (SELECT 1 FROM todos WHERE list_id = ?1 AND NOT completed)

+ WHERE list_id = ?1|}

+ [ text list ])

+

+let clear_completed t ~list =

+ ignore (change t "DELETE FROM todos WHERE list_id = ? AND completed" [ text list ])

diff --git a/apps/ocaml/src/view.ml b/apps/ocaml/src/view.ml

new file mode 100644

index 0000000..f500bf5

--- /dev/null

+++ b/apps/ocaml/src/view.ml

@@ -0,0 +1,123 @@

+(* The TodoMVC page, rendered from shared/reference.html. The no-JS controls

+ carry the class "nojs"; app.css hides them once app.js has loaded. *)

+

+type filter = All | Active | Completed

+

+let filter_of_string = function "active" -> Active | "completed" -> Completed | _ -> All

+let filter_name = function All -> "all" | Active -> "active" | Completed -> "completed"

+let filter_path = function All -> "/" | Active -> "/active" | Completed -> "/completed"

+

+let shows filter (t : Store.todo) =

+ match filter with All -> true | Active -> not t.completed | Completed -> t.completed

+

+let escape s =

+ let b = Buffer.create (String.length s + 16) in

+ String.iter

+ (function

+ | '&' -> Buffer.add_string b "&"

+ | '<' -> Buffer.add_string b "<"

+ | '>' -> Buffer.add_string b ">"

+ | '"' -> Buffer.add_string b """

+ | '\'' -> Buffer.add_string b "'"

+ | c -> Buffer.add_char b c)

+ s;

+ Buffer.contents b

+

+(* A hidden form that a control elsewhere submits with form="<id>". *)

+let action_form b ~id ~action filter =

+ Printf.bprintf b

+ {|<form id="%s" method="post" action="%s" hidden><input type="hidden" name="filter" value="%s"></form>|}

+ id action (filter_name filter)

+

+let item b filter ~editing (t : Store.todo) =

+ let title = escape t.title in

+ let classes = List.filter_map Fun.id

+ [ (if t.completed then Some "completed" else None); (if editing then Some "editing" else None) ] in

+ Printf.bprintf b {|<li data-id="%d"%s><div class="view">|} t.id

+ (if classes = [] then "" else Printf.sprintf {| class="%s"|} (String.concat " " classes));

+ Printf.bprintf b {|<input class="toggle" type="checkbox" form="toggle-%d"%s><label>%s</label>|}

+ t.id (if t.completed then " checked" else "") title;

+ Printf.bprintf b {|<button class="destroy" form="destroy-%d" aria-label="Delete"></button>|} t.id;

+ Printf.bprintf b

+ {|<button class="nojs toggle-button" data-action="toggle" form="toggle-%d">%s</button>|}

+ t.id (if t.completed then "Mark as active" else "Mark as completed");

+ Printf.bprintf b {|<a class="nojs edit-link" data-action="edit" href="%s?edit=%d">Edit</a></div>|}

+ (filter_path filter) t.id;

+ Printf.bprintf b

+ {|<form class="edit-form" method="post" action="/todos/%d/edit"><input type="hidden" name="filter" value="%s"><input class="edit" name="title" value="%s" autocomplete="off"%s></form>|}

+ t.id (filter_name filter) title (if editing then " autofocus" else "");

+ action_form b ~id:(Printf.sprintf "toggle-%d" t.id) ~action:(Printf.sprintf "/todos/%d/toggle" t.id) filter;

+ action_form b ~id:(Printf.sprintf "destroy-%d" t.id) ~action:(Printf.sprintf "/todos/%d/destroy" t.id) filter;

+ Buffer.add_string b "</li>"

+

+(* section.todoapp: the part app.js swaps after each action. *)

+let todoapp b ~filter ?editing (todos : Store.todo list) =

+ let left = List.length (List.filter (fun (t : Store.todo) -> not t.completed) todos) in

+ let done_ = List.length todos - left in

+ Printf.bprintf b

+ {|<section class="todoapp"><header class="header"><h1>todos</h1><form method="post" action="/todos"><input type="hidden" name="filter" value="%s"><input class="new-todo" name="title" placeholder="What needs to be done?" autocomplete="off"%s></form></header>|}

+ (filter_name filter) (if editing = None then " autofocus" else "");

+ if todos <> [] then begin

+ Buffer.add_string b {|<section class="main">|};

+ action_form b ~id:"toggle-all-form" ~action:"/todos/toggle-all" filter;

+ Printf.bprintf b

+ {|<input id="toggle-all" class="toggle-all" type="checkbox" form="toggle-all-form"%s><label for="toggle-all">Mark all as complete</label>|}

+ (if left = 0 then " checked" else "");

+ Buffer.add_string b

+ {|<button class="nojs toggle-all-button" data-action="toggle-all" form="toggle-all-form">Mark all as complete</button><ul class="todo-list">|};

+ List.iter

+ (fun (t : Store.todo) -> if shows filter t then item b filter ~editing:(editing = Some t.id) t)

+ todos;

+ Buffer.add_string b {|</ul></section><footer class="footer">|};

+ Printf.bprintf b {|<span class="todo-count"><strong>%d</strong> %s left</span><ul class="filters">|}

+ left (if left = 1 then "item" else "items");

+ List.iter

+ (fun (f, label) ->

+ Printf.bprintf b {|<li><a%s href="%s">%s</a></li>|}

+ (if f = filter then {| class="selected"|} else "") (filter_path f) label)

+ [ (All, "All"); (Active, "Active"); (Completed, "Completed") ];

+ Buffer.add_string b "</ul>";

+ if done_ > 0 then begin

+ action_form b ~id:"clear-completed-form" ~action:"/todos/clear-completed" filter;

+ Buffer.add_string b

+ {|<button class="clear-completed" form="clear-completed-form">Clear completed</button>|}

+ end;

+ Buffer.add_string b "</footer>"

+ end;

+ Buffer.add_string b "</section>"

+

+let fragment ~filter todos =

+ let b = Buffer.create 4096 in

+ todoapp b ~filter todos;

+ Buffer.contents b

+

+let page ~version ~filter ?editing todos =

+ let b = Buffer.create 8192 in

+ Printf.bprintf b

+ {|<!doctype html>

+<html lang="en">

+<head>

+<meta charset="utf-8">

+<meta name="viewport" content="width=device-width, initial-scale=1">

+<title>TodoMVC</title>

+<script>document.documentElement.classList.add("js")</script>

+<link rel="stylesheet" href="/static/base.css?v=%s">

+<link rel="stylesheet" href="/static/index.css?v=%s">

+<link rel="stylesheet" href="/static/app.css?v=%s">

+<script type="module" src="/static/app.js?v=%s"></script>

+</head>

+<body>

+|}

+ version version version version;

+ todoapp b ~filter ?editing todos;

+ Buffer.add_string b

+ {|

+<footer class="info">

+<p>Double-click to edit a todo</p>

+<p>Created by <a href="https://bakeoff.bfj.oncarlos.com">the CARLOS bakeoff</a> · OCaml</p>

+<p>Part of <a href="http://todomvc.com">TodoMVC</a></p>

+</footer>

+</body>

+</html>

+|};

+ Buffer.contents b

diff --git a/apps/ocaml/static/app.css b/apps/ocaml/static/app.css

new file mode 100644

index 0000000..4046ead

--- /dev/null

+++ b/apps/ocaml/static/app.css

@@ -0,0 +1,62 @@

+/* Controls for visitors without JavaScript. An inline script puts the

+ class "js" on <html> before the page paints, which hides them, so with

+ JavaScript on the page is TodoMVC's own. */

+.js .nojs {

+ display: none !important;

+}

+

+/* The toggle buttons lie, invisible, over the circle and the chevron they

+ stand for, so the page looks the same either way. */

+.todo-list li .toggle-button,

+.toggle-all-button {

+ position: absolute;

+ z-index: 1;

+ font-size: 0;

+ color: transparent;

+ cursor: pointer;

+}

+

+.todo-list li .toggle-button {

+ top: 0;

+ bottom: 0;

+ left: 0;

+ width: 50px;

+}

+

+.toggle-all-button {

+ top: -65px;

+ left: 0;

+ width: 45px;

+ height: 65px;

+}

+

+.todo-list li .toggle-button:focus-visible,

+.toggle-all-button:focus-visible {

+ outline: 2px solid #b83f45;

+ outline-offset: -6px;

+}

+

+/* Without double-click, each item gets an Edit link beside the delete

+ button. */

+html:not(.js) .todo-list li label {

+ padding-right: 100px;

+}

+

+.todo-list li .edit-link {

+ position: absolute;

+ top: 0;

+ bottom: 0;

+ right: 55px;

+ height: 20px;

+ margin: auto 0;

+ font-size: 14px;

+ line-height: 20px;

+ color: #949494;

+ text-decoration: none;

+}

+

+.todo-list li .edit-link:hover,

+.todo-list li .edit-link:focus {

+ color: #484848;

+ text-decoration: underline;

+}

diff --git a/apps/ocaml/static/app.js b/apps/ocaml/static/app.js

new file mode 100644

index 0000000..308dfd9

--- /dev/null

+++ b/apps/ocaml/static/app.js

@@ -0,0 +1,89 @@

+// With JavaScript on, the page behaves like TodoMVC's own apps. Every

+// change still goes through the same form POSTs as without JavaScript,

+// sent with X-Fragment: todoapp so the server answers with its rendering

+// of section.todoapp; the list and footer are swapped in from that. The

+// server is the only place the list lives.

+

+const app = document.querySelector('.todoapp');

+

+// Requests run one at a time, so responses can't land out of order.

+let queue = Promise.resolve();

+

+function post(form) {

+ const body = new URLSearchParams(new FormData(form));

+ queue = queue

+ .then(async () => {

+ const res = await fetch(form.action, {

+ method: 'POST',

+ body,

+ headers: { 'X-Fragment': 'todoapp' },

+ });

+ if (!res.ok) throw new Error(`${res.status} from ${form.action}`);

+ render(await res.text());

+ })

+ .catch((err) => {

+ console.error(err);

+ location.reload();

+ });

+}

+

+// Replaces section.main and footer.footer with the server's; either may be

+// absent when the list is empty. The header, and what's typed in it, stays.

+function render(html) {

+ const next = new DOMParser().parseFromString(html, 'text/html').querySelector('.todoapp');

+ for (const part of ['.main', '.footer']) app.querySelector(`:scope > ${part}`)?.remove();

+ for (const part of ['.main', '.footer']) {

+ const el = next.querySelector(`:scope > ${part}`);

+ if (el) app.append(el);

+ }

+}

+

+function startEditing(li) {

+ li.classList.add('editing');

+ const input = li.querySelector('.edit');

+ input.focus();

+ input.setSelectionRange(input.value.length, input.value.length);

+}

+

+function save(li) {

+ if (!li.classList.contains('editing')) return;

+ li.classList.remove('editing');

+ const input = li.querySelector('.edit');

+ li.querySelector('label').textContent = input.value.trim();

+ post(input.form);

+}

+

+function cancel(li) {

+ const input = li.querySelector('.edit');

+ input.value = input.defaultValue;

+ li.classList.remove('editing');

+}

+

+app.addEventListener('submit', (e) => {

+ e.preventDefault();

+ const form = e.target;

+ if (form.classList.contains('edit-form')) {

+ save(form.closest('li'));

+ } else {

+ post(form);

+ const input = form.querySelector('.new-todo');

+ if (input) input.value = '';

+ }

+});

+

+app.addEventListener('change', (e) => {

+ if (e.target.matches('.toggle, .toggle-all')) post(e.target.form);

+});

+

+app.addEventListener('dblclick', (e) => {

+ const label = e.target.closest('.todo-list label');

+ if (label) startEditing(label.closest('li'));

+});

+

+app.addEventListener('keydown', (e) => {

+ if (e.key === 'Escape' && e.target.matches('.edit')) cancel(e.target.closest('li'));

+});

+

+app.addEventListener('focusout', (e) => {

+ if (e.target.matches('.edit')) save(e.target.closest('li'));

+});

diff --git a/apps/ocaml/test/dune b/apps/ocaml/test/dune

new file mode 100644

index 0000000..50e30f5

--- /dev/null

+++ b/apps/ocaml/test/dune

@@ -0,0 +1,4 @@

+(test

+ (name test_todo)

+ (libraries todo alcotest)

+ (deps %{project_root}/static/base.css %{project_root}/static/index.css))

diff --git a/apps/ocaml/test/test_todo.ml b/apps/ocaml/test/test_todo.ml

new file mode 100644

index 0000000..c574b88

--- /dev/null

+++ b/apps/ocaml/test/test_todo.ml

@@ -0,0 +1,225 @@

+open Todo

+

+let contains s sub =

+ let n = String.length sub in

+ let rec go i = i + n <= String.length s && (String.sub s i n = sub || go (i + 1)) in

+ go 0

+

+let count s sub =

+ let n = String.length sub in

+ let rec go i acc =

+ if i + n > String.length s then acc

+ else if String.sub s i n = sub then go (i + n) (acc + 1)

+ else go (i + 1) acc

+ in

+ go 0 0

+

+(* --- Form ---------------------------------------------------------------- *)

+

+let form_decoding () =

+ Alcotest.(check (list (pair string string)))

+ "plus, escapes, utf-8, empty, bare key"

+ [ ("title", "buy milk & eggs"); ("filter", "active"); ("u", "naïve 🚀"); ("e", ""); ("k", "") ]

+ (Form.parse "title=buy+milk+%26+eggs&filter=active&u=na%C3%AFve%20%F0%9F%9A%80&e=&k");

+ Alcotest.(check string) "malformed escapes are kept" "100%" (Form.decode "100%");

+ Alcotest.(check string) "bad hex is kept" "%zz" (Form.decode "%zz")

+

+let cookies () =

+ Alcotest.(check (option string)) "finds by name" (Some "abc")

+ (Form.cookie "a=1; todomvc_list=abc; b=2" "todomvc_list");

+ Alcotest.(check (option string)) "missing" None (Form.cookie "a=1" "todomvc_list");

+ Alcotest.(check (option string)) "garbled" None (Form.cookie "%%%" "todomvc_list")

+

+let escaping () =

+ Alcotest.(check string) "html" "<img src=x> & "q" '"

+ (View.escape {|<img src=x> & "q" '|})

+

+(* --- App ----------------------------------------------------------------- *)

+

+let origin = "http://127.0.0.1:8080"

+

+let fresh () = App.create ~store:(Store.open_ ":memory:") ~origin ~version:"test-version"

+

+let request ?(meth = "GET") ?(headers = []) ?(body = "") ?cookie target =

+ let uri = Uri.of_string target in

+ let headers = match cookie with Some c -> ("cookie", "todomvc_list=" ^ c) :: headers | None -> headers in

+ { App.meth; path = Uri.path uri;

+ query = List.map (fun (k, v) -> (k, String.concat "," v)) (Uri.query uri);

+ header = (fun h -> List.assoc_opt h headers); body }

+

+let header (r : App.response) name = List.assoc_opt name r.headers

+

+let set_cookie (r : App.response) =

+ match header r "set-cookie" with

+ | Some c -> String.sub c (String.length "todomvc_list=") 32

+ | None -> Alcotest.fail "no set-cookie"

+

+(* A visitor: their cookie, from a first GET. *)

+let visit app = set_cookie (App.handle app (request "/"))

+

+let post app cookie ?headers target body =

+ App.handle app (request ~meth:"POST" ?headers ~cookie ~body target)

+

+let page app cookie target = (App.handle app (request ~cookie target)).body

+

+let first_cookie () =

+ let app = fresh () in

+ let r = App.handle app (request "/") in

+ Alcotest.(check int) "status" 200 r.status;

+ let c = Option.get (header r "set-cookie") in

+ Alcotest.(check bool) "attributes" true

+ (contains c "; Path=/" && contains c "; HttpOnly" && contains c "; SameSite=Lax"

+ && not (contains c "Secure"));

+ Alcotest.(check bool) "empty list hides main and footer" false

+ (contains r.body {|class="main"|} || contains r.body {|class="footer"|});

+ let again = App.handle app (request ~cookie:(set_cookie r) "/") in

+ Alcotest.(check (option string)) "known cookie kept" None (header again "set-cookie")

+

+let secure_cookie () =

+ let app = App.create ~store:(Store.open_ ":memory:") ~origin:"https://x.example" ~version:"v" in

+ let c = Option.get (header (App.handle app (request "/")) "set-cookie") in

+ Alcotest.(check bool) "Secure over https" true (contains c "; Secure")

+

+let garbled_cookie () =

+ let app = fresh () in

+ List.iter

+ (fun bad ->

+ let r = App.handle app (request ~cookie:bad "/") in

+ Alcotest.(check int) "status" 200 r.status;

+ Alcotest.(check bool) "fresh cookie" true (header r "set-cookie" <> None))

+ [ "%%%"; ""; String.make 32 'a'; "not-a-token" ]

+

+let add_and_redirect () =

+ let app = fresh () in

+ let c = visit app in

+ let r = post app c "/todos" "title=++buy+milk++&filter=active" in

+ Alcotest.(check int) "303" 303 r.status;

+ Alcotest.(check (option string)) "back to filter" (Some "/active") (header r "location");

+ let r = post app c "/todos" "title=x&filter=bogus" in

+ Alcotest.(check (option string)) "unknown filter" (Some "/") (header r "location");

+ let r = post app c "/todos" "title=y" in

+ Alcotest.(check (option string)) "missing filter" (Some "/") (header r "location");

+ ignore (post app c "/todos" "title=+++&filter=all");

+ let body = page app c "/" in

+ Alcotest.(check int) "three items, blank skipped" 3 (count body "<li data-id=");

+ Alcotest.(check bool) "trimmed" true (contains body "<label>buy milk</label>");

+ Alcotest.(check bool) "counter" true (contains body "<strong>3</strong> items left")

+

+let escapes_titles () =

+ let app = fresh () in

+ let c = visit app in

+ ignore (post app c "/todos" "title=%3Cimg+src%3Dx+onerror%3Dalert(1)%3E&filter=all");

+ let body = page app c "/" in

+ Alcotest.(check bool) "escaped" true (contains body "<img src=x onerror=alert(1)>");

+ Alcotest.(check bool) "no tag" false (contains body "<img")

+

+let toggle_and_filters () =

+ let app = fresh () in

+ let c = visit app in

+ ignore (post app c "/todos" "title=a");

+ ignore (post app c "/todos" "title=b");

+ ignore (post app c "/todos/1/toggle" "filter=all");

+ let all = page app c "/" in

+ Alcotest.(check bool) "completed class" true (contains all {|<li data-id="1" class="completed">|});

+ Alcotest.(check bool) "singular counter" true (contains all "<strong>1</strong> item left");

+ Alcotest.(check bool) "clear completed shown" true (contains all "clear-completed");

+ Alcotest.(check bool) "all selected" true (contains all {|<a class="selected" href="/">All</a>|});

+ let active = page app c "/active" in

+ Alcotest.(check bool) "active hides done" false (contains active {|data-id="1"|});

+ Alcotest.(check bool) "active selected" true (contains active {|<a class="selected" href="/active">|});

+ let completed = page app c "/completed" in

+ Alcotest.(check bool) "completed only" true

+ (contains completed {|data-id="1"|} && not (contains completed {|data-id="2"|}))

+

+let toggle_all_and_clear () =

+ let app = fresh () in

+ let c = visit app in

+ List.iter (fun t -> ignore (post app c "/todos" ("title=" ^ t))) [ "a"; "b"; "c" ];

+ ignore (post app c "/todos/2/toggle" "");

+ ignore (post app c "/todos/toggle-all" "filter=all");

+ let body = page app c "/" in

+ Alcotest.(check int) "all completed" 3 (count body {|class="completed"|});

+ Alcotest.(check bool) "toggle-all checked" true (contains body {|form="toggle-all-form" checked|});

+ ignore (post app c "/todos/toggle-all" "filter=all");

+ Alcotest.(check int) "all active again" 0 (count (page app c "/") {|class="completed"|});

+ ignore (post app c "/todos/1/toggle" "");

+ ignore (post app c "/todos/clear-completed" "filter=completed");

+ let body = page app c "/" in

+ Alcotest.(check int) "one cleared" 2 (count body "<li data-id=");

+ Alcotest.(check bool) "clear hidden" false (contains body "clear-completed")

+

+let edit_and_destroy () =

+ let app = fresh () in

+ let c = visit app in

+ ignore (post app c "/todos" "title=a");

+ ignore (post app c "/todos" "title=b");

+ let editing = page app c "/?edit=2" in

+ Alcotest.(check bool) "editing class" true (contains editing {|<li data-id="2" class="editing">|});

+ Alcotest.(check bool) "edit form" true (contains editing {|action="/todos/2/edit"|});

+ ignore (post app c "/todos/2/edit" "title=++renamed++&filter=all");

+ Alcotest.(check bool) "renamed" true (contains (page app c "/") "<label>renamed</label>");

+ ignore (post app c "/todos/2/edit" "title=+&filter=all");

+ Alcotest.(check int) "empty edit deletes" 1 (count (page app c "/") "<li data-id=");

+ ignore (post app c "/todos/1/destroy" "filter=all");

+ Alcotest.(check int) "destroyed" 0 (count (page app c "/") "<li data-id=")

+

+let isolation () =

+ let app = fresh () in

+ let mine = visit app and theirs = visit app in

+ ignore (post app mine "/todos" "title=mine");

+ Alcotest.(check int) "not in theirs" 0 (count (page app theirs "/") "<li data-id=");

+ List.iter

+ (fun target ->

+ Alcotest.(check int) target 404 (post app theirs target "title=x&filter=all").status)

+ [ "/todos/1/toggle"; "/todos/1/edit"; "/todos/1/destroy"; "/todos/99/toggle"; "/todos/x/toggle" ];

+ let body = page app mine "/" in

+ Alcotest.(check bool) "unchanged" true

+ (contains body "<label>mine</label>" && not (contains body {|class="completed"|}))

+

+let origins () =

+ let app = fresh () in

+ let c = visit app in

+ let r = post app c ~headers:[ ("origin", "https://evil.example") ] "/todos" "title=evil" in

+ Alcotest.(check int) "cross-site refused" 403 r.status;

+ let r = post app c ~headers:[ ("origin", origin) ] "/todos" "title=ok" in

+ Alcotest.(check int) "own origin" 303 r.status;

+ Alcotest.(check int) "one item" 1 (count (page app c "/") "<li data-id=")

+

+let fragments () =

+ let app = fresh () in

+ let c = visit app in

+ let r = post app c ~headers:[ ("x-fragment", "todoapp") ] "/todos" "title=a&filter=all" in

+ Alcotest.(check int) "200" 200 r.status;

+ Alcotest.(check bool) "section only" true

+ (String.starts_with ~prefix:{|<section class="todoapp">|} r.body && not (contains r.body "<html"))

+

+let platform_routes () =

+ let app = fresh () in

+ Alcotest.(check int) "healthz" 200 (App.handle app (request "/healthz")).status;

+ Alcotest.(check string) "version" "test-version" (App.handle app (request "/api/version")).body;

+ let read f = In_channel.with_open_bin f In_channel.input_all in

+ Alcotest.(check bool) "base.css byte for byte" true

+ ((App.handle app (request "/static/base.css")).body = read "../static/base.css");

+ Alcotest.(check bool) "index.css byte for byte" true

+ ((App.handle app (request "/static/index.css?v=1")).body = read "../static/index.css");

+ Alcotest.(check int) "unknown static" 404 (App.handle app (request "/static/nope")).status;

+ Alcotest.(check int) "unknown page" 404 (App.handle app (request "/nope")).status;

+ Alcotest.(check int) "GET on an action" 405 (App.handle app (request "/todos")).status

+

+let () =

+ Alcotest.run "todo"

+ [ ("form", [ Alcotest.test_case "decoding" `Quick form_decoding;

+ Alcotest.test_case "cookies" `Quick cookies;

+ Alcotest.test_case "escaping" `Quick escaping ]);

+ ("app", [ Alcotest.test_case "first cookie" `Quick first_cookie;

+ Alcotest.test_case "secure cookie" `Quick secure_cookie;

+ Alcotest.test_case "garbled cookie" `Quick garbled_cookie;

+ Alcotest.test_case "add and redirect" `Quick add_and_redirect;

+ Alcotest.test_case "escapes titles" `Quick escapes_titles;

+ Alcotest.test_case "toggle and filters" `Quick toggle_and_filters;

+ Alcotest.test_case "toggle all and clear" `Quick toggle_all_and_clear;

+ Alcotest.test_case "edit and destroy" `Quick edit_and_destroy;

+ Alcotest.test_case "isolation" `Quick isolation;

+ Alcotest.test_case "origins" `Quick origins;

+ Alcotest.test_case "fragments" `Quick fragments;

+ Alcotest.test_case "platform routes" `Quick platform_routes ]) ]

diff --git a/apps/ocaml/todo_ocaml.opam b/apps/ocaml/todo_ocaml.opam

new file mode 100644

index 0000000..3bef470

--- /dev/null

+++ b/apps/ocaml/todo_ocaml.opam

@@ -0,0 +1,32 @@

+# This file is generated by dune, edit dune-project instead

+opam-version: "2.0"

+synopsis: "TodoMVC for the CARLOS bakeoff, server-rendered in OCaml"

+maintainer: ["Paul Campbell <paul@keymail.dev>"]

+authors: ["Paul Campbell"]

+license: "MIT"

+depends: [

+ "dune" {>= "3.17"}

+ "ocaml" {= "5.3.0"}

+ "eio" {>= "1.2"}

+ "eio_posix" {>= "1.2"}

+ "cohttp-eio" {>= "6.0"}

+ "http" {>= "6.0"}

+ "uri" {>= "4.4"}

+ "sqlite3" {>= "5.3" & < "5.4"}

+ "alcotest" {with-test}

+ "odoc" {with-doc}

+]

+build: [

+ ["dune" "subst"] {dev}

+ [

+ "dune"

+ "build"

+ "-p"

+ name

+ "-j"

+ jobs

+ "@install"

+ "@runtest" {with-test}

+ "@doc" {with-doc}

+ ]

+]

diff --git a/apps/ocaml/todo_ocaml.opam.locked b/apps/ocaml/todo_ocaml.opam.locked

new file mode 100644

index 0000000..4d8ec27

--- /dev/null

+++ b/apps/ocaml/todo_ocaml.opam.locked

@@ -0,0 +1,80 @@

+opam-version: "2.0"

+name: "todo_ocaml"

+version: "dev"

+synopsis: "TodoMVC for the CARLOS bakeoff, server-rendered in OCaml"

+depends: [

+ "alcotest" {= "1.9.1" & with-test}

+ "angstrom" {= "0.16.1"}

+ "astring" {= "0.8.5" & with-test}

+ "base" {= "v0.17.3"}

+ "base-bigarray" {= "base"}

+ "base-domains" {= "base"}

+ "base-effects" {= "base"}

+ "base-nnp" {= "base"}

+ "base-threads" {= "base"}

+ "base-unix" {= "base"}

+ "base64" {= "3.5.2"}

+ "bigstringaf" {= "0.10.0"}

+ "cmdliner" {= "2.1.1"}

+ "cohttp" {= "6.3.0"}

+ "cohttp-eio" {= "6.3.0"}

+ "conf-pkg-config" {= "5"}

+ "conf-sqlite3" {= "1"}

+ "csexp" {= "1.5.2"}

+ "cstruct" {= "6.3.0"}

+ "domain-local-await" {= "1.0.1"}

+ "domain-name" {= "0.5.0"}

+ "dune" {= "3.24.2"}

+ "dune-configurator" {= "3.24.2"}

+ "eio" {= "1.6"}

+ "eio_posix" {= "1.6"}

+ "fmt" {= "0.11.0"}

+ "hmap" {= "0.8.1"}

+ "http" {= "6.3.0"}

+ "iomux" {= "0.4"}

+ "ipaddr" {= "5.6.2"}

+ "logs" {= "0.10.0"}

+ "lwt-dllist" {= "1.1.0"}

+ "macaddr" {= "5.6.2"}

+ "mtime" {= "2.2.0"}

+ "ocaml" {= "5.3.0"}

+ "ocaml-compiler-libs" {= "v0.17.0"}

+ "ocaml-config" {= "3"}

+ "ocaml-syntax-shims" {= "1.0.0"}

+ "ocaml-system" {= "5.3.0"}

+ "ocaml_intrinsics_kernel" {= "v0.17.2"}

+ "ocamlbuild" {= "0.16.1"}

+ "ocamlfind" {= "1.9.8"}

+ "optint" {= "0.3.0"}

+ "ppx_derivers" {= "1.2.1"}

+ "ppx_sexp_conv" {= "v0.17.1"}

+ "ppxlib" {= "0.39.0"}

+ "ppxlib_jane" {= "v0.17.4"}

+ "psq" {= "0.2.1"}

+ "ptime" {= "1.2.0"}

+ "re" {= "1.14.0"}

+ "seq" {= "base"}

+ "sexplib0" {= "v0.17.0"}

+ "sqlite3" {= "5.3.1"}

+ "stdlib-shims" {= "0.3.0" & with-test}

+ "stringext" {= "1.6.0"}

+ "thread-table" {= "1.0.0"}

+ "topkg" {= "1.1.1"}

+ "uri" {= "4.4.0"}

+ "uri-sexp" {= "4.4.0"}

+ "uutf" {= "1.0.4" & with-test}

+]

+build: [

+ ["dune" "subst"] {dev}

+ [

+ "dune"

+ "build"

+ "-p"

+ name

+ "-j"

+ jobs

+ "@install"

+ "@runtest" {with-test}

+ "@doc" {with-doc}

+ ]

+]

\ No newline at end of file

diff --git a/apps/ocaml/tools/arm64.sh b/apps/ocaml/tools/arm64.sh

new file mode 100755

index 0000000..6a110fb

--- /dev/null

+++ b/apps/ocaml/tools/arm64.sh

@@ -0,0 +1,25 @@

+#!/usr/bin/env bash

+# Runs a command in this app's arm64 opam switch (.cache/opam-arm64) inside

+# the emulated Debian arm64 root, creating the switch on first use. The

+# compiler is the root's Debian OCaml 5.3.0, used as ocaml-system; every

+# library is compiled from source into .cache, from the versions in

+# todo_ocaml.opam.locked.

+# tools/arm64.sh <command> [args...]

+set -euo pipefail

+app=$(cd "$(dirname "$0")/.." && pwd)

+if [ -z "${IN_ARM64_ROOT:-}" ]; then

+ exec "$app/../../scripts/arm64.sh" /usr/bin/env IN_ARM64_ROOT=1 \

+ APP_VERSION="${APP_VERSION:-dev}" LINK_FLAGS="${LINK_FLAGS:-}" "$app/tools/arm64.sh" "$@"

+fi

+# The root is shared: keep dune's cache off so nothing lands in its /root.

+export OPAMROOT=$app/.cache/opam-arm64 OPAMYES=1 OPAMCOLOR=never DUNE_CACHE=disabled

+if [ ! -d "$OPAMROOT/default" ]; then

+ [ -f "$OPAMROOT/config" ] || opam init -q --bare -n --disable-sandboxing default https://opam.ocaml.org

+ opam switch remove -q default >/dev/null 2>&1 || true # forget one make clean-deps deleted

+ opam switch create -q default ocaml-system.5.3.0

+fi

+if [ ! -f "$OPAMROOT/default/.deps-installed" ] || [ "$app/todo_ocaml.opam.locked" -nt "$OPAMROOT/default/.deps-installed" ]; then

+ (cd "$app" && opam install -q --switch default --deps-only --locked .)

+ touch "$OPAMROOT/default/.deps-installed"

+fi

+exec opam exec --switch default -- "$@"

diff --git a/apps/ocaml/tools/x86.sh b/apps/ocaml/tools/x86.sh

new file mode 100755

index 0000000..cdfe4e9

--- /dev/null

+++ b/apps/ocaml/tools/x86.sh

@@ -0,0 +1,44 @@

+#!/usr/bin/env bash

+# Runs a command in this app's x86 opam switch (.cache/opam-x86), creating

+# it on first use. The compiler is the bakeoff's OCaml 5.3.0, used as

+# ocaml-system; libraries are compiled into .cache. docs-t1 has no SQLite

+# headers or pkg-config, so their Debian packages are unpacked into

+# .cache/x86-sysroot (no root needed).

+# tools/x86.sh <command> [args...]

+set -euo pipefail

+app=$(cd "$(dirname "$0")/.." && pwd)

+cache=$app/.cache

+source "$app/../../scripts/env.sh"

+ocaml_bin=$(dirname "$(readlink -f "$(command -v ocamlopt)")")

+unset OPAMSWITCH OPAM_SWITCH_PREFIX OPAM_LAST_ENV CAML_LD_LIBRARY_PATH OCAML_TOPLEVEL_PATH OCAMLTOP_INCLUDE_PATH MANPATH

+export OPAMROOT=$cache/opam-x86 OPAMYES=1 OPAMCOLOR=never DUNE_CACHE=disabled

+

+# opam ignores compilers inside another opam root, so expose this one by symlink.

+bin=$cache/x86-bin

+if [ ! -x "$bin/pkg-config" ]; then

+ mkdir -p "$bin" "$cache/debs"

+ for f in "$ocaml_bin"/ocaml*; do ln -sf "$f" "$bin/"; done

+ (cd "$cache/debs" && apt-get download -q libsqlite3-dev pkgconf-bin libpkgconf3 >/dev/null)

+ for d in "$cache"/debs/*.deb; do dpkg-deb -x "$d" "$cache/x86-sysroot"; done

+ # The local build links the system libsqlite3.so.0 (the stubs need a shared one).

+ ln -sf /usr/lib/x86_64-linux-gnu/libsqlite3.so.0 "$cache/x86-sysroot/usr/lib/x86_64-linux-gnu/libsqlite3.so"

+ cat > "$bin/pkg-config" <<EOS

+#!/bin/sh

+root=$cache/x86-sysroot

+LD_LIBRARY_PATH=\$root/usr/lib/x86_64-linux-gnu PKG_CONFIG_LIBDIR=\$root/usr/lib/x86_64-linux-gnu/pkgconfig \\

+ PKG_CONFIG_SYSROOT_DIR=\$root exec \$root/usr/bin/pkgconf "\$@"

+EOS

+ chmod +x "$bin/pkg-config"

+fi

+export PATH=$bin:/usr/local/bin:/usr/bin:/bin:$HOME/.local/bin

+

+if [ ! -d "$OPAMROOT/default" ]; then

+ [ -f "$OPAMROOT/config" ] || opam init -q --bare -n --disable-sandboxing default https://opam.ocaml.org

+ opam switch remove -q default >/dev/null 2>&1 || true # forget one make clean-deps deleted

+ opam switch create -q default ocaml-system.5.3.0

+fi

+if [ ! -f "$OPAMROOT/default/.deps-installed" ] || [ "$app/todo_ocaml.opam.locked" -nt "$OPAMROOT/default/.deps-installed" ]; then

+ (cd "$app" && opam install -q --switch default --deps-only --with-test $([ -f todo_ocaml.opam.locked ] && echo --locked) --assume-depexts .)

+ touch "$OPAMROOT/default/.deps-installed"

+fi

+exec opam exec --switch default -- "$@"

carlos / todomvc-bakeoff Public

feat(ocaml): TodoMVC on Eio + cohttp-eio + SQLite, with tests