diff --git a/frameworks/vif/Dockerfile b/frameworks/vif/Dockerfile new file mode 100644 index 00000000..79cff8e5 --- /dev/null +++ b/frameworks/vif/Dockerfile @@ -0,0 +1,39 @@ +# Build stage +FROM ocaml/opam:debian-12-ocaml-5.3 AS builder + +# Switch to root for system deps +USER root +RUN apt-get update && apt-get install -y --no-install-recommends \ + pkg-config libsqlite3-dev libgmp-dev libffi-dev && \ + rm -rf /var/lib/apt/lists/* + +# Switch back to opam user +USER opam +WORKDIR /home/opam/app + +# Install OCaml dependencies +RUN opam update && \ + opam install -y vif yojson sqlite3 + +# Copy source +COPY --chown=opam:opam dune-project ./ +COPY --chown=opam:opam src/ src/ + +# Build +RUN eval $(opam env) && dune build --release src/server.exe + +# Runtime stage +FROM debian:12-slim + +RUN apt-get update && apt-get install -y --no-install-recommends \ + libsqlite3-0 libgmp10 libffi8 ca-certificates && \ + rm -rf /var/lib/apt/lists/* + +WORKDIR /app +COPY --from=builder /home/opam/app/_build/default/src/server.exe /app/server +COPY run.sh /app/run.sh +RUN chmod +x /app/run.sh + +EXPOSE 8080 + +CMD ["/app/run.sh"] diff --git a/frameworks/vif/README.md b/frameworks/vif/README.md new file mode 100644 index 00000000..bd8667bf --- /dev/null +++ b/frameworks/vif/README.md @@ -0,0 +1,34 @@ +# Vif — OCaml 5 Web Framework + +[Vif](https://github.com/robur-coop/vif) is a simple web framework for OCaml 5 +built on [httpcats](https://github.com/robur-coop/httpcats) and the +[Miou](https://github.com/robur-coop/miou) cooperative/preemptive scheduler. + +## Key Features + +- **Multicore OCaml 5** — takes advantage of domains via Miou +- **httpcats engine** — high-performance HTTP/1.1 and H2 implementation +- **Typed routing** — routes are type-checked at compile time +- **Pure OCaml stack** — TLS, crypto, compression all implemented in OCaml + +## Architecture + +- Single binary, multicore via Miou domains +- httpcats handles HTTP parsing and connection management +- Gzip compression via decompress (pure OCaml zlib) +- JSON via Yojson, SQLite via sqlite3-ocaml + +## Build + +```bash +./build.sh +``` + +## Run + +```bash +docker run -p 8080:8080 \ + -v $(pwd)/../../data/dataset.json:/data/dataset.json:ro \ + -v $(pwd)/../../data/dataset-large.json:/data/dataset-large.json:ro \ + httparena-vif +``` diff --git a/frameworks/vif/build.sh b/frameworks/vif/build.sh new file mode 100755 index 00000000..c3cdeef4 --- /dev/null +++ b/frameworks/vif/build.sh @@ -0,0 +1,4 @@ +#!/bin/bash +set -euo pipefail +cd "$(dirname "$0")" +docker build --network host -t httparena-vif . diff --git a/frameworks/vif/dune-project b/frameworks/vif/dune-project new file mode 100644 index 00000000..37f995d6 --- /dev/null +++ b/frameworks/vif/dune-project @@ -0,0 +1 @@ +(lang dune 3.0) diff --git a/frameworks/vif/meta.json b/frameworks/vif/meta.json new file mode 100644 index 00000000..78025ce5 --- /dev/null +++ b/frameworks/vif/meta.json @@ -0,0 +1,19 @@ +{ + "display_name": "vif", + "language": "OCaml", + "type": "framework", + "engine": "httpcats/Miou", + "description": "Vif web framework for OCaml 5 with multicore support via Miou scheduler and httpcats HTTP engine.", + "repo": "https://github.com/robur-coop/vif", + "enabled": true, + "tests": [ + "baseline", + "pipelined", + "limited-conn", + "json", + "upload", + "compression", + "noisy", + "mixed" + ] +} diff --git a/frameworks/vif/run.sh b/frameworks/vif/run.sh new file mode 100755 index 00000000..c8dd0721 --- /dev/null +++ b/frameworks/vif/run.sh @@ -0,0 +1,2 @@ +#!/bin/sh +exec /app/server diff --git a/frameworks/vif/src/dune b/frameworks/vif/src/dune new file mode 100644 index 00000000..079d28e2 --- /dev/null +++ b/frameworks/vif/src/dune @@ -0,0 +1,3 @@ +(executable + (name server) + (libraries vif flux yojson sqlite3)) diff --git a/frameworks/vif/src/server.ml b/frameworks/vif/src/server.ml new file mode 100644 index 00000000..4291a26b --- /dev/null +++ b/frameworks/vif/src/server.ml @@ -0,0 +1,265 @@ +open Vif + +(* --------------------------------------------------------------------------- + Startup: load datasets once + --------------------------------------------------------------------------- *) + +let dataset_path = + try Sys.getenv "DATASET_PATH" with Not_found -> "/data/dataset.json" + +let large_dataset_path = "/data/dataset-large.json" +let db_path = "/data/benchmark.db" + +let read_file path = + if Sys.file_exists path then begin + let ic = open_in path in + let n = in_channel_length ic in + let s = Bytes.create n in + really_input ic s 0 n; + close_in ic; + Some (Bytes.unsafe_to_string s) + end else None + +(* Process items: add "total" = price * quantity rounded to 2 decimals *) +let process_items (items : Yojson.Basic.t list) : Yojson.Basic.t list = + List.map (fun item -> + match item with + | `Assoc fields -> + let price = match List.assoc_opt "price" fields with + | Some (`Float f) -> f + | Some (`Int n) -> Float.of_int n + | _ -> 0.0 in + let quantity = match List.assoc_opt "quantity" fields with + | Some (`Int n) -> n + | Some (`Float f) -> Float.to_int f + | _ -> 0 in + let total = Float.round (price *. Float.of_int quantity *. 100.0) /. 100.0 in + `Assoc (fields @ [("total", `Float total)]) + | other -> other + ) items + +(* Small dataset — raw JSON array *) +let dataset_raw : Yojson.Basic.t list option = + match read_file dataset_path with + | Some s -> + (match Yojson.Basic.from_string s with + | `List items -> Some items + | _ -> None + | exception _ -> None) + | None -> None + +(* Large dataset — pre-processed JSON string *) +let large_payload : string option = + match read_file large_dataset_path with + | Some s -> + (match Yojson.Basic.from_string s with + | `List items -> + let processed = process_items items in + let result = `Assoc [ + ("items", `List processed); + ("count", `Int (List.length processed)) + ] in + Some (Yojson.Basic.to_string result) + | _ -> None + | exception _ -> None) + | None -> None + +(* --------------------------------------------------------------------------- + Helpers + --------------------------------------------------------------------------- *) + +let server_header () = + Response.add ~field:"server" "vif" + +let sum_query_params req = + let params = Queries.all req in + List.fold_left (fun acc (_key, values) -> + List.fold_left (fun acc v -> + match int_of_string_opt v with + | Some n -> acc + n + | None -> acc + ) acc values + ) 0 params + +let read_body req = + let src = Request.source req in + let stream = Flux.Stream.from src in + Flux.Stream.into Flux.Sink.string stream + +let count_body_bytes req = + let src = Request.source req in + let stream = Flux.Stream.from src in + Flux.Stream.into (Flux.Sink.fold (fun acc chunk -> acc + String.length chunk) 0) stream + +(* --------------------------------------------------------------------------- + Routes + --------------------------------------------------------------------------- *) + +(* GET /pipeline — simple "ok" response *) +let pipeline req _server () = + let open Response.Syntax in + let* () = server_header () in + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req "ok" in + Response.respond `OK + +(* GET /baseline11 — sum query params *) +let baseline11_get req _server () = + let open Response.Syntax in + let* () = server_header () in + let total = sum_query_params req in + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req (string_of_int total) in + Response.respond `OK + +(* POST /baseline11 — sum query params + body *) +let baseline11_post req _server () = + let open Response.Syntax in + let* () = server_header () in + let total = sum_query_params req in + let body = String.trim (read_body req) in + let body_val = match int_of_string_opt body with + | Some n -> n + | None -> 0 in + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req (string_of_int (total + body_val)) in + Response.respond `OK + +(* GET /baseline2 — sum query params *) +let baseline2 req _server () = + let open Response.Syntax in + let* () = server_header () in + let total = sum_query_params req in + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req (string_of_int total) in + Response.respond `OK + +(* GET /json — process dataset and return JSON *) +let json_endpoint req _server () = + let open Response.Syntax in + let* () = server_header () in + match dataset_raw with + | Some items -> + let processed = process_items items in + let result = `Assoc [ + ("items", `List processed); + ("count", `Int (List.length processed)) + ] in + let s = Yojson.Basic.to_string result in + let* () = Response.add ~field:"content-type" "application/json" in + let* () = Response.with_string req s in + Response.respond `OK + | None -> + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req "No dataset" in + Response.respond `Internal_server_error + +(* GET /compression — gzip compressed large dataset *) +let compression req _server () = + let open Response.Syntax in + let* () = server_header () in + match large_payload with + | Some payload -> + let* () = Response.add ~field:"content-type" "application/json" in + let* () = Response.with_string ~compression:`Gzip req payload in + Response.respond `OK + | None -> + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req "No dataset" in + Response.respond `Internal_server_error + +(* POST /upload — count received bytes *) +let upload req _server () = + let open Response.Syntax in + let* () = server_header () in + let byte_count = count_body_bytes req in + let* () = Response.add ~field:"content-type" "text/plain" in + let* () = Response.with_string req (string_of_int byte_count) in + Response.respond `OK + +(* GET /db — SQLite query *) +let db_endpoint req _server () = + let open Response.Syntax in + let* () = server_header () in + if not (Sys.file_exists db_path) then begin + let* () = Response.add ~field:"content-type" "application/json" in + let* () = Response.with_string req {|{"items":[],"count":0}|} in + Response.respond `OK + end else begin + let min_val = match Queries.get req "min" with + | v :: _ -> (match float_of_string_opt v with Some f -> f | None -> 10.0) + | [] -> 10.0 in + let max_val = match Queries.get req "max" with + | v :: _ -> (match float_of_string_opt v with Some f -> f | None -> 50.0) + | [] -> 50.0 in + let db = Sqlite3.db_open ~mode:`READONLY db_path in + let sql = "SELECT id, name, category, price, quantity, active, tags, rating_score, rating_count FROM items WHERE price BETWEEN ? AND ? LIMIT 50" in + let stmt = Sqlite3.prepare db sql in + ignore (Sqlite3.bind stmt 1 (Sqlite3.Data.FLOAT min_val)); + ignore (Sqlite3.bind stmt 2 (Sqlite3.Data.FLOAT max_val)); + let items = ref [] in + while Sqlite3.step stmt = Sqlite3.Rc.ROW do + let id = match Sqlite3.column stmt 0 with + | Sqlite3.Data.INT i -> `Int (Int64.to_int i) | _ -> `Int 0 in + let name = match Sqlite3.column stmt 1 with + | Sqlite3.Data.TEXT s -> `String s | _ -> `String "" in + let category = match Sqlite3.column stmt 2 with + | Sqlite3.Data.TEXT s -> `String s | _ -> `String "" in + let price = match Sqlite3.column stmt 3 with + | Sqlite3.Data.FLOAT f -> `Float f | _ -> `Float 0.0 in + let quantity = match Sqlite3.column stmt 4 with + | Sqlite3.Data.INT i -> `Int (Int64.to_int i) | _ -> `Int 0 in + let active = match Sqlite3.column stmt 5 with + | Sqlite3.Data.INT i -> `Bool (i <> 0L) | _ -> `Bool false in + let tags = match Sqlite3.column stmt 6 with + | Sqlite3.Data.TEXT s -> + (try Yojson.Basic.from_string s with _ -> `List []) + | _ -> `List [] in + let rs = match Sqlite3.column stmt 7 with + | Sqlite3.Data.FLOAT f -> f | _ -> 0.0 in + let rc = match Sqlite3.column stmt 8 with + | Sqlite3.Data.INT i -> Int64.to_int i | _ -> 0 in + let item = `Assoc [ + ("id", id); ("name", name); ("category", category); + ("price", price); ("quantity", quantity); ("active", active); + ("tags", tags); + ("rating", `Assoc [("score", `Float rs); ("count", `Int rc)]) + ] in + items := item :: !items + done; + ignore (Sqlite3.finalize stmt); + ignore (Sqlite3.db_close db); + let items_list = List.rev !items in + let result = `Assoc [ + ("items", `List items_list); + ("count", `Int (List.length items_list)) + ] in + let s = Yojson.Basic.to_string result in + let* () = Response.add ~field:"content-type" "application/json" in + let* () = Response.with_string req s in + Response.respond `OK + end + +(* --------------------------------------------------------------------------- + Server config + --------------------------------------------------------------------------- *) + +let routes = + let open Uri in + let open Route in + let open Type in + [ get (rel / "pipeline" /?? any) --> pipeline + ; get (rel / "baseline11" /?? any) --> baseline11_get + ; post any (rel / "baseline11" /?? any) --> baseline11_post + ; get (rel / "baseline2" /?? any) --> baseline2 + ; get (rel / "json" /?? any) --> json_endpoint + ; get (rel / "compression" /?? any) --> compression + ; post any (rel / "upload" /?? any) --> upload + ; get (rel / "db" /?? any) --> db_endpoint + ] + +let () = + Miou_unix.run @@ fun () -> + let addr = Unix.ADDR_INET (Unix.inet_addr_any, 8080) in + let cfg = Vif.config ~level:(Some Logs.Error) addr in + Vif.run ~cfg routes ()