+15

.beads/issues.jsonl

reviewed

··· 1 1 {"id":"hcs-0ro","title":"Implement WebSocket frame types and parsing","description":"Implement WebSocket wire format in hcs-core/ws_frame.ml:\n\n```ocaml\ntype frame =\n | Text of string\n | Binary of Cstruct.t\n | Ping of Cstruct.t\n | Pong of Cstruct.t\n | Close of int option * string option\n\ntype parse_result =\n | Complete of frame * int (* frame and bytes consumed *)\n | Incomplete of int (* need more bytes *)\n | Error of string\n\nval parse_frame : Cstruct.t -\u003e parse_result\nval serialize_frame : ?mask:bool -\u003e frame -\u003e Cstruct.t\n\n(* Handshake *)\nval make_handshake_request : Uri.t -\u003e ?protocols:string list -\u003e Headers.t -\u003e request\nval validate_handshake_response : response -\u003e (string option, string) result (* selected protocol *)\nval make_handshake_response : request -\u003e ?protocol:string -\u003e (response, string) result\n```\n\nPure parsing/serialization.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:34:32.864373772+01:00","updated_at":"2025-12-29T16:00:43.877842667+01:00","closed_at":"2025-12-29T16:00:43.877842667+01:00","dependencies":[{"issue_id":"hcs-0ro","depends_on_id":"hcs-lhr","type":"parent-child","created_at":"2025-12-29T14:34:52.111489961+01:00","created_by":"gdiazlo"}]} 2 2 {"id":"hcs-0y4","title":"Implement compression middleware with gzip and zstd support","description":"","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-01T18:44:00.161388436+01:00","updated_at":"2026-01-01T18:53:17.947904901+01:00","closed_at":"2026-01-01T18:53:17.947904901+01:00"} 3 3 {"id":"hcs-0zq","title":"Testing Infrastructure and Compliance","description":"Set up testing infrastructure including unit tests, integration tests, and HTTP compliance test suites for both client and server implementations.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:35:43.905080385+01:00","updated_at":"2025-12-29T17:57:31.987947689+01:00","closed_at":"2025-12-29T17:57:31.987947689+01:00","dependencies":[{"issue_id":"hcs-0zq","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:35:55.080432801+01:00","created_by":"gdiazlo"}]} 4 4 + {"id":"hcs-15v","title":"Run tests and fix any issues","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T22:16:47.827724667+01:00","updated_at":"2026-01-01T22:22:18.249274206+01:00","closed_at":"2026-01-01T22:22:18.249274206+01:00","dependencies":[{"issue_id":"hcs-15v","depends_on_id":"hcs-g40","type":"blocks","created_at":"2026-01-01T22:17:06.229519632+01:00","created_by":"gdiazlo"}]} 4 5 {"id":"hcs-1h7","title":"Create Go WebSocket benchmark server","description":"Go server using gorilla/websocket or nhooyr.io/websocket. Same interface as HCS: accept connections, keep alive, report count.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T09:59:59.144195314+01:00","updated_at":"2025-12-30T10:08:50.856707182+01:00","closed_at":"2025-12-30T10:08:50.856707182+01:00","dependencies":[{"issue_id":"hcs-1h7","depends_on_id":"hcs-jk8","type":"parent-child","created_at":"2025-12-30T10:00:30.601603816+01:00","created_by":"gdiazlo"}]} 5 6 {"id":"hcs-1op","title":"Web framework building blocks","description":"Implement 5 core features to make HCS a minimal but complete web framework: Sessions, Tokens, Content Negotiation, Endpoint, and PubSub/Channels. Focus on minimal allocations, functional composition, and simplicity over feature parity with Phoenix.","status":"closed","priority":1,"issue_type":"epic","created_at":"2026-01-01T20:46:34.289608444+01:00","updated_at":"2026-01-01T21:36:15.141649231+01:00","closed_at":"2026-01-01T21:36:15.141649231+01:00"} 6 7 {"id":"hcs-1uy","title":"HTTP/2 Specific Features","description":"Implement H2 module with server push, stream priority, and HTTP/2 detection.","status":"closed","priority":3,"issue_type":"epic","created_at":"2025-12-29T14:25:37.55760677+01:00","updated_at":"2025-12-29T17:40:54.000014455+01:00","closed_at":"2025-12-29T17:40:54.000014455+01:00","dependencies":[{"issue_id":"hcs-1uy","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:20.914923161+01:00","created_by":"gdiazlo"}]} 7 8 {"id":"hcs-1vt","title":"Implement HTTP/2 server (Eio)","description":"Implement HTTP/2 server for Eio in hcs-eio/h2_server.ml:\n\n```ocaml\nval handle_connection :\n flow:Eio.Flow.two_way -\u003e\n clock:Eio.Time.clock -\u003e\n config:Server.config -\u003e\n handler:(request -\u003e (response, error) result) -\u003e\n unit\n```\n\nFeatures:\n- HPACK header compression\n- Stream multiplexing (concurrent requests)\n- Flow control\n- Server push support\n- GOAWAY for graceful shutdown\n- Priority handling\n\nDepends on hpack package.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:33:25.282940788+01:00","updated_at":"2025-12-29T16:00:42.340368477+01:00","closed_at":"2025-12-29T16:00:42.340368477+01:00","dependencies":[{"issue_id":"hcs-1vt","depends_on_id":"hcs-rw6","type":"parent-child","created_at":"2025-12-29T14:33:42.729783837+01:00","created_by":"gdiazlo"}]} 8 9 {"id":"hcs-23f","title":"Implement synchronous Stream module (core)","description":"Implement the synchronous Stream module in hcs-core/stream.ml:\n\nProducers:\n- empty, singleton, of_list, of_seq\n- unfold : ('s -\u003e ('a * 's) option) -\u003e 's -\u003e 'a t\n\nTransformers:\n- map, filter, filter_map\n- take, drop, chunks\n\nConsumers:\n- fold, iter, drain\n- to_string (for Cstruct.t streams)\n\nCombinators:\n- concat, zip\n\nThis is the pure, synchronous implementation. Runtime-specific async streams will wrap this.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:28:01.435958367+01:00","updated_at":"2025-12-29T14:51:05.189865738+01:00","closed_at":"2025-12-29T14:51:05.189865738+01:00","labels":["core"],"dependencies":[{"issue_id":"hcs-23f","depends_on_id":"hcs-czm","type":"parent-child","created_at":"2025-12-29T14:28:16.036236675+01:00","created_by":"gdiazlo"}]} 10 10 + {"id":"hcs-240","title":"LAS: Main entry point (las.ml)","description":"Endpoint with plug pipeline: Logger, Compress, Session, Csrf, Rate_limit. Start server with WebSocket support.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:42:02.46889176+01:00","updated_at":"2026-01-02T10:28:15.478431398+01:00","closed_at":"2026-01-02T10:28:15.478431398+01:00","dependencies":[{"issue_id":"hcs-240","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:58.522626786+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-240","depends_on_id":"hcs-nwb","type":"blocks","created_at":"2026-01-01T23:43:48.930728118+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-240","depends_on_id":"hcs-q4v","type":"blocks","created_at":"2026-01-01T23:43:53.974339722+01:00","created_by":"gdiazlo"}]} 9 11 {"id":"hcs-2ca","title":"Implement Eio TLS integration","description":"Implement TLS context creation for Eio runtime in hcs-eio/tls.ml:\n\n- Convert Tls_config.client to Tls.Config.client\n- Convert Tls_config.server to Tls.Config.server \n- Load system certificates using ca-certs\n- Handle ALPN negotiation for HTTP/2\n- Wrap Eio flows with TLS\n\nDepends on tls-eio, ca-certs, x509 packages.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:30:34.350512358+01:00","updated_at":"2025-12-29T15:24:43.224163622+01:00","closed_at":"2025-12-29T15:24:43.224163622+01:00","dependencies":[{"issue_id":"hcs-2ca","depends_on_id":"hcs-y9w","type":"parent-child","created_at":"2025-12-29T14:30:47.016262637+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-2ca","depends_on_id":"hcs-cyb","type":"blocks","created_at":"2025-12-29T14:30:47.870432453+01:00","created_by":"gdiazlo"}]} 10 12 {"id":"hcs-2ie","title":"Router Implementation","description":"Implement Path DSL for type-safe extraction and Router module with trie-based route lookup, scoping, and middleware support.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:30.896190732+01:00","updated_at":"2025-12-29T15:41:48.160193387+01:00","closed_at":"2025-12-29T15:41:48.160193387+01:00","dependencies":[{"issue_id":"hcs-2ie","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:15.462426699+01:00","created_by":"gdiazlo"}]} 11 13 {"id":"hcs-320","title":"Create benchmark client for load generation","description":"Create a benchmark client (bin/hcs_bench_client.ml) that generates load and measures performance:\n- Configurable concurrency (number of parallel connections)\n- Configurable duration or request count\n- Support for HTTP/1.1 and HTTP/2\n- Measures: requests/second, latency (min/max/avg/p50/p99), errors\n- Reports results in human-readable and JSON formats\n\nShould use Eio fibers for concurrent requests.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T18:03:53.28432088+01:00","updated_at":"2025-12-29T18:15:36.842283087+01:00","closed_at":"2025-12-29T18:15:36.842283087+01:00","dependencies":[{"issue_id":"hcs-320","depends_on_id":"hcs-jtz","type":"parent-child","created_at":"2025-12-29T18:04:20.175343889+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-320","depends_on_id":"hcs-40d","type":"blocks","created_at":"2025-12-29T18:04:35.617524274+01:00","created_by":"gdiazlo"}]} ··· 15 17 {"id":"hcs-42q","title":"Implement runtime-parameterized async Stream","description":"Design async stream interface that works with both Eio and Lwt:\n\n```ocaml\nmodule type ASYNC_STREAM = sig\n type 'a io\n type 'a t\n \n val from_flow : ... -\u003e Cstruct.t t\n val from_file : ... -\u003e Cstruct.t t\n val to_sink : ... -\u003e Cstruct.t t -\u003e unit io\nend\n\nmodule Make_stream (R : RUNTIME) : ASYNC_STREAM with type 'a io = 'a R.t\n```\n\nThe Eio implementation uses Eio.Flow, the future Lwt version will use Lwt_io.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:28:05.317935403+01:00","updated_at":"2025-12-29T17:08:13.483830721+01:00","closed_at":"2025-12-29T17:08:13.483830721+01:00","labels":["architecture","core"],"dependencies":[{"issue_id":"hcs-42q","depends_on_id":"hcs-czm","type":"parent-child","created_at":"2025-12-29T14:28:16.763534695+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-42q","depends_on_id":"hcs-23f","type":"blocks","created_at":"2025-12-29T14:28:17.658557754+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-42q","depends_on_id":"hcs-6bi","type":"blocks","created_at":"2025-12-29T14:28:18.52508237+01:00","created_by":"gdiazlo"}]} 16 18 {"id":"hcs-4w8","title":"Create benchmark server with configurable endpoints","description":"Create a dedicated benchmark server (bin/hcs_bench_server.ml) with endpoints optimized for benchmarking:\n- GET /ping - minimal response (measures raw throughput)\n- GET /bytes/:n - returns n bytes (measures payload handling)\n- POST /echo - echoes request body (measures request body parsing)\n- GET /delay/:ms - adds artificial delay (measures concurrency)\n- GET /headers/:n - returns n headers (measures header handling)\n\nServer should support both HTTP/1.1 and HTTP/2, with configurable port and worker count.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T18:03:49.541780606+01:00","updated_at":"2025-12-29T18:15:27.763639409+01:00","closed_at":"2025-12-29T18:15:27.763639409+01:00","dependencies":[{"issue_id":"hcs-4w8","depends_on_id":"hcs-jtz","type":"parent-child","created_at":"2025-12-29T18:04:17.563056726+01:00","created_by":"gdiazlo"}]} 17 19 {"id":"hcs-505","title":"Add HTTP/2 benchmark endpoints and comparison scripts","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-30T00:14:16.705365323+01:00","updated_at":"2025-12-30T00:28:18.304877441+01:00","closed_at":"2025-12-30T00:28:18.304877441+01:00"} 20 20 + {"id":"hcs-52s","title":"Remove mirage-crypto-rng-eio/unix from tests","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-02T00:23:50.329970611+01:00","updated_at":"2026-01-02T10:16:17.801891715+01:00","closed_at":"2026-01-02T10:16:17.801891715+01:00"} 18 21 {"id":"hcs-56z","title":"Implement HTTP/1.1 server parser/serializer","description":"Implement HTTP/1.1 server wire format in hcs-core/h1.ml (extend existing):\n\n```ocaml\n(* Request parsing *)\ntype request_parse_result =\n | Complete of request * int (* request and bytes consumed *)\n | Incomplete of int (* need more bytes *)\n | Error of string\n\nval parse_request_head : Cstruct.t -\u003e request_parse_result\n\n(* Response serialization *)\nval serialize_response : response -\u003e Cstruct.t\nval serialize_response_head : response -\u003e Cstruct.t\n```\n\nPure parsing, zero-copy with Cstruct views.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:33:19.050407222+01:00","updated_at":"2025-12-29T14:56:39.076056919+01:00","closed_at":"2025-12-29T14:56:39.076056919+01:00","dependencies":[{"issue_id":"hcs-56z","depends_on_id":"hcs-rw6","type":"parent-child","created_at":"2025-12-29T14:33:41.058840522+01:00","created_by":"gdiazlo"}]} 19 22 {"id":"hcs-5eu","title":"Implement Log module","description":"Implement logging in hcs-core/log.ml:\n\n```ocaml\ntype level = Debug | Info | Warn | Error\n\ntype event =\n | Request_start of { id: string; meth: method_; uri: Uri.t }\n | Request_end of { id: string; status: status; duration_ms: float }\n | Connection_open of { host: string; port: int }\n | Connection_close of { host: string; port: int; reason: string }\n | Connection_reuse of { host: string; port: int }\n | Tls_handshake of { host: string; protocol: string }\n | Retry of { id: string; attempt: int; reason: error }\n | Error of { id: string; error: error }\n\ntype logger = level -\u003e event -\u003e unit\n\n(* Built-in loggers *)\nval null : logger\nval stderr : ?min_level:level -\u003e unit -\u003e logger\nval custom : (level -\u003e string -\u003e unit) -\u003e logger\n\n(* Format event as string *)\nval event_to_string : event -\u003e string\nval level_to_string : level -\u003e string\n```\n\nPure OCaml, no runtime dependency.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:30:26.138649492+01:00","updated_at":"2025-12-29T17:06:37.134220488+01:00","closed_at":"2025-12-29T17:06:37.134220488+01:00","dependencies":[{"issue_id":"hcs-5eu","depends_on_id":"hcs-fgd","type":"parent-child","created_at":"2025-12-29T14:30:45.51204607+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-5eu","depends_on_id":"hcs-gmb","type":"blocks","created_at":"2025-12-29T14:30:48.61530863+01:00","created_by":"gdiazlo"}]} 20 23 {"id":"hcs-5wp","title":"Epic: Unified multi-protocol server + comprehensive benchmark suite","description":"Create unified servers (HCS, Hyper, Go) supporting HTTP/1.1, HTTP/2 h2c upgrade, and WebSocket. Build comprehensive benchmark client and automated benchmark runner.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-31T14:13:14.360303024+01:00","updated_at":"2025-12-31T14:47:54.828065477+01:00","closed_at":"2025-12-31T14:47:54.828065477+01:00"} 24 24 + {"id":"hcs-62k","title":"LAS: Link Aggregator Service Epic","description":"Tutorial application showcasing HCS features: content negotiation, sessions, CSRF, rate limiting, WebSocket pub/sub, compression. See bin/las/README.md for full tutorial.","status":"closed","priority":1,"issue_type":"epic","created_at":"2026-01-01T23:41:03.971590895+01:00","updated_at":"2026-01-02T00:15:18.204355616+01:00","closed_at":"2026-01-02T00:15:18.204355616+01:00"} 21 25 {"id":"hcs-6bi","title":"Design Runtime Abstraction Layer","description":"Design and implement a runtime abstraction layer that allows the library to work with both Eio and Lwt (future). This should include:\n\n1. Define a RUNTIME module signature abstracting:\n - Promise/fiber types ('a t)\n - Concurrency primitives (bind, return, map, both, all)\n - Cancellation tokens\n - Clock/time operations\n - Network operations (connect, listen, read, write)\n - Flow/stream abstractions\n\n2. Structure the library as:\n - `hcs-core`: Pure types, parsers, router trie, codec signatures (no IO)\n - `hcs-eio`: Eio runtime implementation\n - `hcs-lwt`: (future) Lwt runtime implementation\n\n3. Use functors where IO is needed:\n ```ocaml\n module type RUNTIME = sig\n type +'a t\n val return : 'a -\u003e 'a t\n val bind : 'a t -\u003e ('a -\u003e 'b t) -\u003e 'b t\n val both : 'a t -\u003e 'b t -\u003e ('a * 'b) t\n \n module Net : sig ... end\n module Time : sig ... end\n module Cancel : sig ... end\n end\n \n module Make_client (R : RUNTIME) : CLIENT with type 'a io = 'a R.t\n module Make_server (R : RUNTIME) : SERVER with type 'a io = 'a R.t\n ```\n\n4. Keep the core types (request, response, headers, body) runtime-agnostic where possible.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:26:44.115541536+01:00","updated_at":"2025-12-29T15:18:00.901135582+01:00","closed_at":"2025-12-29T15:18:00.901135582+01:00","labels":["architecture","design"],"dependencies":[{"issue_id":"hcs-6bi","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:55.24314139+01:00","created_by":"gdiazlo"}]} 22 26 {"id":"hcs-6hx","title":"Create WebSocket benchmark client","description":"Tool to open N concurrent WebSocket connections. Ramp up gradually, keep alive, report success/failure rates. Can target any server.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T10:00:01.720658703+01:00","updated_at":"2025-12-30T10:13:10.676804856+01:00","closed_at":"2025-12-30T10:13:10.676804856+01:00","dependencies":[{"issue_id":"hcs-6hx","depends_on_id":"hcs-jk8","type":"parent-child","created_at":"2025-12-30T10:00:40.686385073+01:00","created_by":"gdiazlo"}]} 23 27 {"id":"hcs-6ki","title":"Create Rust WebSocket benchmark server","description":"Rust server using tokio-tungstenite. Same interface as HCS: accept connections, keep alive, report count.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T09:59:59.970998267+01:00","updated_at":"2025-12-30T10:08:50.863660424+01:00","closed_at":"2025-12-30T10:08:50.863660424+01:00","dependencies":[{"issue_id":"hcs-6ki","depends_on_id":"hcs-jk8","type":"parent-child","created_at":"2025-12-30T10:00:35.642901603+01:00","created_by":"gdiazlo"}]} 28 28 + {"id":"hcs-6t7","title":"Create test_plug.ml test file","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T22:16:46.850226513+01:00","updated_at":"2026-01-01T22:19:33.378942728+01:00","closed_at":"2026-01-01T22:19:33.378942728+01:00"} 24 29 {"id":"hcs-6yl","title":"Implement method_ type and helpers","description":"Implement the HTTP method type in types.ml:\n- GET, POST, PUT, DELETE, PATCH, HEAD, OPTIONS, CONNECT, TRACE variants\n- to_string/of_string functions\n- Comparison and equality\n\nThis is pure OCaml with no runtime dependency.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:27:08.798345263+01:00","updated_at":"2025-12-29T14:50:42.057204391+01:00","closed_at":"2025-12-29T14:50:42.057204391+01:00","labels":["core"],"dependencies":[{"issue_id":"hcs-6yl","depends_on_id":"hcs-ugs","type":"parent-child","created_at":"2025-12-29T14:27:38.28650235+01:00","created_by":"gdiazlo"}]} 25 30 {"id":"hcs-763","title":"Create HTTP/1.1 server compliance tests","description":"Create comprehensive HTTP/1.1 server tests using curl and custom test client:\n\nTest categories (based on RFC 7230-7235):\n\n1. **Request parsing:**\n - Valid/invalid request lines\n - Header field parsing (folding, whitespace)\n - Host header requirement\n - Content-Length handling\n - Transfer-Encoding: chunked\n\n2. **Response generation:**\n - Status line format\n - Required headers (Date, Content-Length/Transfer-Encoding)\n - Connection: close/keep-alive\n\n3. **Methods:**\n - HEAD returns no body\n - OPTIONS with Allow header\n - TRACE (if supported)\n - Unknown methods\n\n4. **Connection management:**\n - Keep-alive (HTTP/1.1 default)\n - Pipelining support\n - Connection: close handling\n - Timeout behavior\n\n5. **Error handling:**\n - 400 Bad Request (malformed)\n - 405 Method Not Allowed\n - 411 Length Required\n - 413 Payload Too Large\n - 414 URI Too Long\n - 431 Request Header Fields Too Large\n - 501 Not Implemented\n\n6. **Edge cases:**\n - Empty body vs no body\n - Zero Content-Length\n - Multiple Content-Length headers (reject)\n - LF vs CRLF tolerance","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:36:24.121658164+01:00","updated_at":"2025-12-29T17:52:19.19217344+01:00","closed_at":"2025-12-29T17:52:19.19217344+01:00","dependencies":[{"issue_id":"hcs-763","depends_on_id":"hcs-0zq","type":"parent-child","created_at":"2025-12-29T14:36:50.138423904+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-763","depends_on_id":"hcs-cyk","type":"blocks","created_at":"2025-12-29T14:36:59.919859607+01:00","created_by":"gdiazlo"}]} 26 31 {"id":"hcs-7c6","title":"Add compression middleware tests","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T18:44:21.503420164+01:00","updated_at":"2026-01-01T20:27:15.06105377+01:00","closed_at":"2026-01-01T20:27:15.06105377+01:00","dependencies":[{"issue_id":"hcs-7c6","depends_on_id":"hcs-rvk","type":"blocks","created_at":"2026-01-01T18:44:51.69538876+01:00","created_by":"gdiazlo"}]} ··· 28 33 {"id":"hcs-7my","title":"Implement zero-copy optimizations in H2_server (Body_bigstring, Body_prebuilt)","description":"","status":"closed","priority":1,"issue_type":"feature","created_at":"2025-12-30T00:14:14.612100017+01:00","updated_at":"2025-12-30T00:19:21.483563727+01:00","closed_at":"2025-12-30T00:19:21.483563727+01:00"} 29 34 {"id":"hcs-7n9","title":"Implement HTTP/1.1 client (Eio)","description":"Implement HTTP/1.1 client for Eio in hcs-eio/h1_client.ml:\n\n```ocaml\nval request :\n flow:Eio.Flow.two_way -\u003e\n clock:Eio.Time.clock -\u003e\n config:Client.config -\u003e\n ?cancel:Cancel.t -\u003e\n request -\u003e\n (response, error) result\n```\n\nFeatures:\n- Send request, read response using h1 parser\n- Handle Content-Length and chunked bodies\n- Support streaming response body\n- Respect timeouts from config\n- Handle keep-alive\n- Integrate with logging","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:31:20.182355085+01:00","updated_at":"2025-12-29T15:03:26.826860172+01:00","closed_at":"2025-12-29T15:03:26.826860172+01:00","dependencies":[{"issue_id":"hcs-7n9","depends_on_id":"hcs-qnb","type":"parent-child","created_at":"2025-12-29T14:31:48.505518121+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-7n9","depends_on_id":"hcs-8zr","type":"blocks","created_at":"2025-12-29T14:31:52.981022505+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-7n9","depends_on_id":"hcs-kg1","type":"blocks","created_at":"2025-12-29T14:31:53.49623941+01:00","created_by":"gdiazlo"}]} 30 35 {"id":"hcs-82y","title":"HTTP/2 Performance Comparison: HCS vs Rust vs Go","description":"Compare HTTP/2 server performance across HCS (OCaml), Rust (hyper/axum), and Go (net/http). Focus on throughput, latency, and resource usage under various workloads.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-30T08:21:37.583365059+01:00","updated_at":"2025-12-30T08:49:54.887556286+01:00","closed_at":"2025-12-30T08:49:54.887556286+01:00"} 36 36 + {"id":"hcs-883","title":"Add tests for remaining plugs: Compress, Cors, Csrf, Basic_auth, Retry, Static","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T22:24:54.008491291+01:00","updated_at":"2026-01-01T22:35:25.772956789+01:00","closed_at":"2026-01-01T22:35:25.772956789+01:00"} 31 37 {"id":"hcs-8br","title":"Implement Cancel module","description":"Implement cooperative cancellation in hcs-core/cancel.ml:\n\n```ocaml\nmodule Cancel : sig\n type t\n \n val create : unit -\u003e t\n val cancel : t -\u003e unit\n val is_cancelled : t -\u003e bool\n val check : t -\u003e (unit, error) result (* Returns Error Cancelled if cancelled *)\n \n (* Combine multiple tokens - cancelled if any is cancelled *)\n val any : t list -\u003e t\nend\n```\n\nImplementation: Use an Atomic.t bool internally for thread-safety. The `any` combinator creates a new token that polls children.\n\nThis is the core, runtime-agnostic cancellation. Runtime-specific implementations (Eio.Cancel, Lwt.cancel) will wrap this or provide their own.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:29:20.005246967+01:00","updated_at":"2025-12-29T14:56:31.063102088+01:00","closed_at":"2025-12-29T14:56:31.063102088+01:00","labels":["core"],"dependencies":[{"issue_id":"hcs-8br","depends_on_id":"hcs-pnc","type":"parent-child","created_at":"2025-12-29T14:30:09.074639524+01:00","created_by":"gdiazlo"}]} 32 38 {"id":"hcs-8zr","title":"Implement HTTP/1.1 client parser/serializer","description":"Implement HTTP/1.1 wire format in hcs-core/h1.ml:\n\n```ocaml\n(* Request serialization *)\nval serialize_request : request -\u003e Cstruct.t\nval serialize_request_head : request -\u003e Cstruct.t (* without body *)\n\n(* Response parsing *)\ntype parse_result = \n | Complete of response * int (* response and bytes consumed *)\n | Incomplete of int (* need more bytes, minimum *)\n | Error of string\n\nval parse_response_head : Cstruct.t -\u003e parse_result\n\n(* Chunked transfer encoding *)\nval parse_chunk_header : Cstruct.t -\u003e (int * int, string) result (* size, header_len *)\nval serialize_chunk : Cstruct.t -\u003e Cstruct.t\nval serialize_last_chunk : Cstruct.t\n```\n\nPure parsing/serialization, no IO. Use zero-copy where possible with Cstruct views.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:31:17.431899471+01:00","updated_at":"2025-12-29T14:56:37.246977449+01:00","closed_at":"2025-12-29T14:56:37.246977449+01:00","dependencies":[{"issue_id":"hcs-8zr","depends_on_id":"hcs-qnb","type":"parent-child","created_at":"2025-12-29T14:31:46.61571522+01:00","created_by":"gdiazlo"}]} 33 39 {"id":"hcs-9dz","title":"Clean up duplicate implementations: remove non-optimized functions and rename optimized ones","description":"","status":"closed","priority":1,"issue_type":"chore","created_at":"2025-12-30T21:00:09.361966265+01:00","updated_at":"2025-12-30T21:08:48.343581414+01:00","closed_at":"2025-12-30T21:08:48.343581414+01:00"} ··· 54 60 {"id":"hcs-dd4","title":"Set up h2spec for HTTP/2 compliance testing","description":"Integrate h2spec for HTTP/2 server compliance:\n\n1. Add h2spec to CI (available as binary or Docker)\n2. Create test harness that:\n - Starts hcs HTTP/2 server on test port\n - Runs h2spec against it\n - Parses results\n\nh2spec tests:\n- HPACK header compression\n- Stream states and transitions\n- Flow control (window updates)\n- Error handling (RST_STREAM, GOAWAY)\n- SETTINGS frames\n- PRIORITY frames\n- CONTINUATION frames\n- Frame size limits\n- Connection preface\n\nTarget: Pass all h2spec generic tests\n\nCommand: `h2spec -h localhost -p 8080 --strict`","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:36:13.071332042+01:00","updated_at":"2025-12-29T17:57:10.493059681+01:00","closed_at":"2025-12-29T17:57:10.493059681+01:00","dependencies":[{"issue_id":"hcs-dd4","depends_on_id":"hcs-0zq","type":"parent-child","created_at":"2025-12-29T14:36:46.491278695+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-dd4","depends_on_id":"hcs-cyk","type":"blocks","created_at":"2025-12-29T14:36:57.517342388+01:00","created_by":"gdiazlo"}]} 55 61 {"id":"hcs-ddd","title":"Create HTTP/2 cross-language benchmark script","description":"Create run_h2_comparison.sh that starts all three servers (HCS, Rust, Go) and runs h2load benchmarks against each. Test /ping, /bytes/1024, /bytes/10240 endpoints. Output structured results for comparison.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T08:21:57.169092148+01:00","updated_at":"2025-12-30T08:48:51.028339202+01:00","closed_at":"2025-12-30T08:48:51.028339202+01:00","dependencies":[{"issue_id":"hcs-ddd","depends_on_id":"hcs-osg","type":"blocks","created_at":"2025-12-30T08:22:14.06532517+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-ddd","depends_on_id":"hcs-l9p","type":"blocks","created_at":"2025-12-30T08:22:16.71293984+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-ddd","depends_on_id":"hcs-82y","type":"parent-child","created_at":"2025-12-30T08:22:25.823611037+01:00","created_by":"gdiazlo"}]} 56 62 {"id":"hcs-dle","title":"Request/Response Helpers","description":"Implement Request and Response helper modules with body handling, status shortcuts, and codec integration.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:33.481216228+01:00","updated_at":"2025-12-29T15:40:53.163093449+01:00","closed_at":"2025-12-29T15:40:53.163093449+01:00","dependencies":[{"issue_id":"hcs-dle","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:17.959259297+01:00","created_by":"gdiazlo"}]} 63 63 + {"id":"hcs-dpu","title":"LAS: Project setup (dune, dependencies)","description":"Create bin/las/dune with libraries: hcs, caqti, caqti-driver-sqlite3, caqti-eio, yojson. Set up executable definition.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:22.138827845+01:00","updated_at":"2026-01-01T23:49:20.337195774+01:00","closed_at":"2026-01-01T23:49:20.337195774+01:00","dependencies":[{"issue_id":"hcs-dpu","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:18.213570142+01:00","created_by":"gdiazlo"}]} 57 64 {"id":"hcs-dsf","title":"Set up project structure and dune build","description":"Set up the OCaml project structure with dune:\n\n```\nhcs/\n├── dune-project\n├── hcs-core/ # Pure, runtime-agnostic\n│ ├── dune\n│ ├── types.ml\n│ ├── error.ml\n│ ├── headers.ml\n│ ├── stream.ml # Synchronous stream operations\n│ ├── codec.ml\n│ └── hcs_core.ml # Public API re-exports\n├── hcs-eio/ # Eio runtime\n│ ├── dune\n│ ├── runtime.ml # RUNTIME implementation for Eio\n│ ├── client.ml\n│ ├── server.ml\n│ └── hcs_eio.ml\n└── hcs/ # Convenience package (re-exports hcs-eio)\n ├── dune\n └── hcs.ml\n```\n\nConfigure opam dependencies.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:27:26.717322855+01:00","updated_at":"2025-12-29T14:50:39.789609025+01:00","closed_at":"2025-12-29T14:50:39.789609025+01:00","labels":["infrastructure"],"dependencies":[{"issue_id":"hcs-dsf","depends_on_id":"hcs-ugs","type":"parent-child","created_at":"2025-12-29T14:27:43.02614445+01:00","created_by":"gdiazlo"}]} 58 65 {"id":"hcs-dzr","title":"Create TechEmpower-style benchmark suite with hyper, fasthttp, and HCS servers","description":"","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-30T22:21:05.455078159+01:00","updated_at":"2025-12-30T22:33:15.399922114+01:00","closed_at":"2025-12-30T22:33:15.399922114+01:00"} 59 66 {"id":"hcs-ez2","title":"Implement Content Negotiation","description":"Parse Accept headers and select response format.\n\n## Design\n\n### Core Types\n```ocaml\ntype media_type = {\n type_: string; (* e.g., \"application\" *)\n subtype: string; (* e.g., \"json\" *)\n quality: float; (* 0.0 - 1.0 *)\n params: (string * string) list;\n}\n\ntype format = Json | Html | Text | Xml | Custom of string\n```\n\n### Parser\n```ocaml\nval parse_accept : string -\u003e media_type list\n(* Returns sorted by quality, highest first *)\n```\n\n### Negotiation\n```ocaml\nval negotiate : accept:string -\u003e available:format list -\u003e format option\n(* Returns best match or None *)\n\nval negotiate_exn : accept:string -\u003e available:format list -\u003e format\n(* Returns best match or raises Not_acceptable *)\n```\n\n### Plug Integration\n```ocaml\nmodule Plug.Negotiate : sig\n val create : formats:format list -\u003e Plug.t\n (* Sets negotiated format in request, returns 406 if no match *)\nend\n\nval get_format : request -\u003e format option\n```\n\n### Response Helpers\n```ocaml\nval respond_format : format -\u003e body:string -\u003e response\n(* Sets correct Content-Type *)\n\nval respond_negotiate : request -\u003e \n json:(unit -\u003e string) -\u003e \n html:(unit -\u003e string) -\u003e \n response\n(* Lazy evaluation - only runs the selected format *)\n```\n\n### Performance\n- Single-pass parser, no regex\n- Pre-sorted available formats by preference\n- Lazy body generation (no allocation until format selected)","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-01T20:47:14.119965918+01:00","updated_at":"2026-01-01T21:01:33.869936139+01:00","closed_at":"2026-01-01T21:01:33.869936139+01:00","dependencies":[{"issue_id":"hcs-ez2","depends_on_id":"hcs-1op","type":"parent-child","created_at":"2026-01-01T20:48:01.682801946+01:00","created_by":"gdiazlo"}]} ··· 61 68 {"id":"hcs-fgd","title":"Logging System","description":"Implement Log module with level, event types, built-in loggers (null, stderr, custom), and event formatting.","status":"closed","priority":2,"issue_type":"epic","created_at":"2025-12-29T14:25:26.517303879+01:00","updated_at":"2025-12-29T17:40:48.765669075+01:00","closed_at":"2025-12-29T17:40:48.765669075+01:00","dependencies":[{"issue_id":"hcs-fgd","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:08.827592455+01:00","created_by":"gdiazlo"}]} 62 69 {"id":"hcs-fsc","title":"Implement Request helper module","description":"Implement request helpers in hcs-core/request.ml:\n\n```ocaml\nval path : request -\u003e string\nval query : string -\u003e request -\u003e string option\nval query_all : string -\u003e request -\u003e string list\nval header : string -\u003e request -\u003e string option\nval header_all : string -\u003e request -\u003e string list\nval content_type : request -\u003e string option\nval content_length : request -\u003e int64 option\nval is_keep_alive : request -\u003e bool\n\n(* Body consumption - sync versions *)\nval body_string : request -\u003e (string, error) result\nval body_to_cstruct : request -\u003e (Cstruct.t, error) result\n\n(* Form data parsing *)\nval form : request -\u003e ((string * string) list, error) result\n```\n\nPure OCaml + uri package.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:34:09.842512086+01:00","updated_at":"2025-12-29T15:40:29.136273489+01:00","closed_at":"2025-12-29T15:40:29.136273489+01:00","dependencies":[{"issue_id":"hcs-fsc","depends_on_id":"hcs-dle","type":"parent-child","created_at":"2025-12-29T14:34:47.838799048+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-fsc","depends_on_id":"hcs-lpr","type":"blocks","created_at":"2025-12-29T14:34:54.851316989+01:00","created_by":"gdiazlo"}]} 63 70 {"id":"hcs-g2y","title":"Research HTTP compliance test suites","description":"Research and document available HTTP compliance testing tools and servers:\n\n**For Client Testing (test servers):**\n\n1. **httpbin** (https://httpbin.org / kennethreitz/httpbin)\n - Returns request info as JSON\n - Tests: methods, headers, redirects, auth, cookies, response codes\n - Can run locally via Docker\n\n2. **go-httpbin** (mccutchen/go-httpbin)\n - Go reimplementation, faster and more features\n - Better for local testing\n\n3. **h2spec** (summerwind/h2spec)\n - HTTP/2 conformance testing tool\n - Tests HPACK, streams, flow control, error handling\n - Essential for HTTP/2 compliance\n\n4. **curl test suite**\n - curl's own test servers have extensive edge cases\n\n**For Server Testing (test clients):**\n\n1. **h2load** (nghttp2)\n - HTTP/2 benchmarking and testing\n - Tests multiplexing, flow control\n\n2. **curl** with verbose options\n - Good for basic HTTP/1.1 compliance\n\n3. **nghttp** (nghttp2)\n - HTTP/2 client for testing server responses\n\n4. **Autobahn|Testsuite** (for WebSocket)\n - Comprehensive WebSocket protocol compliance\n - https://github.com/crossbario/autobahn-testsuite\n\n**RFC Compliance:**\n- RFC 7230-7235 (HTTP/1.1)\n- RFC 7540 (HTTP/2)\n- RFC 6455 (WebSocket)\n- RFC 7541 (HPACK)\n\nEvaluate which tools to integrate into CI.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:36:03.601972706+01:00","updated_at":"2025-12-29T17:31:46.947022974+01:00","closed_at":"2025-12-29T17:31:46.947022974+01:00","dependencies":[{"issue_id":"hcs-g2y","depends_on_id":"hcs-0zq","type":"parent-child","created_at":"2025-12-29T14:36:42.697870585+01:00","created_by":"gdiazlo"}]} 71 71 + {"id":"hcs-g40","title":"Update test/dune with mirage-crypto-rng dependency","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T22:16:47.415817521+01:00","updated_at":"2026-01-01T22:20:00.598342536+01:00","closed_at":"2026-01-01T22:20:00.598342536+01:00","dependencies":[{"issue_id":"hcs-g40","depends_on_id":"hcs-6t7","type":"blocks","created_at":"2026-01-01T22:17:01.18997103+01:00","created_by":"gdiazlo"}]} 72 72 + {"id":"hcs-gii","title":"LAS: Database layer (db.ml)","description":"Caqti connection pool, schema initialization, queries for links/users/votes/comments. Use SQLite.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:32.219826186+01:00","updated_at":"2026-01-01T23:55:18.482315084+01:00","closed_at":"2026-01-01T23:55:18.482315084+01:00","dependencies":[{"issue_id":"hcs-gii","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:28.299766704+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-gii","depends_on_id":"hcs-y5a","type":"blocks","created_at":"2026-01-01T23:43:08.598843871+01:00","created_by":"gdiazlo"}]} 64 73 {"id":"hcs-gmb","title":"Implement error type","description":"Implement comprehensive error type in error.ml:\n- Connection_failed, Connection_closed\n- Timeout variants (Connect, Read, Write, Total)\n- Cancelled\n- Invalid_url, Invalid_response\n- Too_many_redirects\n- Protocol_error, Tls_error, Codec_error\n- Body_too_large, IO_error\n\nInclude to_string for debugging. Pure OCaml.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:27:22.136715155+01:00","updated_at":"2025-12-29T14:50:40.75088559+01:00","closed_at":"2025-12-29T14:50:40.75088559+01:00","labels":["core"],"dependencies":[{"issue_id":"hcs-gmb","depends_on_id":"hcs-ugs","type":"parent-child","created_at":"2025-12-29T14:27:42.239579889+01:00","created_by":"gdiazlo"}]} 65 74 {"id":"hcs-gr3","title":"Implement gzip and zstd compression/decompression functions","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T18:44:16.145810916+01:00","updated_at":"2026-01-01T18:47:23.516801771+01:00","closed_at":"2026-01-01T18:47:23.516801771+01:00","dependencies":[{"issue_id":"hcs-gr3","depends_on_id":"hcs-ro3","type":"blocks","created_at":"2026-01-01T18:44:41.614944047+01:00","created_by":"gdiazlo"}]} 66 75 {"id":"hcs-h2a","title":"Benchmark runner script with memory profiling","description":"Create benchmark runner that tests all servers across all protocols, measures req/s, msg/s, memory/connection, and produces summary report.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-31T14:13:51.31059033+01:00","updated_at":"2025-12-31T14:47:32.444742919+01:00","closed_at":"2025-12-31T14:47:32.444742919+01:00","dependencies":[{"issue_id":"hcs-h2a","depends_on_id":"hcs-rzc","type":"blocks","created_at":"2025-12-31T14:14:05.717334469+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-h2a","depends_on_id":"hcs-9yc","type":"blocks","created_at":"2025-12-31T14:14:10.761462149+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-h2a","depends_on_id":"hcs-s94","type":"blocks","created_at":"2025-12-31T14:14:15.805316293+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-h2a","depends_on_id":"hcs-peu","type":"blocks","created_at":"2025-12-31T14:14:20.849391195+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-h2a","depends_on_id":"hcs-5wp","type":"parent-child","created_at":"2025-12-31T14:14:46.066127034+01:00","created_by":"gdiazlo"}]} ··· 91 100 {"id":"hcs-mli","title":"Run multi-CPU benchmarks (4, 8, 16 CPUs)","description":"Run benchmarks with 4, 8, and 16 domains for HCS, compare with Rust and Go multi-threaded.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-30T09:05:59.450548339+01:00","updated_at":"2025-12-30T09:16:49.37792589+01:00","closed_at":"2025-12-30T09:16:49.37792589+01:00","dependencies":[{"issue_id":"hcs-mli","depends_on_id":"hcs-zq3","type":"parent-child","created_at":"2025-12-30T09:06:29.226366436+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-mli","depends_on_id":"hcs-zln","type":"blocks","created_at":"2025-12-30T09:06:44.348550935+01:00","created_by":"gdiazlo"}]} 92 101 {"id":"hcs-nad","title":"Implement WebSocket connection (Eio)","description":"Implement WebSocket for Eio in hcs-eio/websocket.ml:\n\n```ocaml\ntype conn\n\nval is_open : conn -\u003e bool\n\n(* Receive *)\nval recv : conn -\u003e (frame option, error) result\nval recv_timeout : Eio.Time.clock -\u003e float -\u003e conn -\u003e (frame option, error) result\n\n(* Send *)\nval send : conn -\u003e frame -\u003e (unit, error) result\nval close : ?code:int -\u003e ?reason:string -\u003e conn -\u003e (unit, error) result\n\n(* Stream interface *)\nval recv_stream : conn -\u003e frame Stream.t\nval send_stream : conn -\u003e frame Stream.t -\u003e (unit, error) result\n\n(* Server: upgrade handler *)\nval upgrade :\n ?protocols:string list -\u003e\n ?on_close:(int option -\u003e string option -\u003e unit) -\u003e\n (conn -\u003e (unit, error) result) -\u003e\n unit handler\n\n(* Client: connect *)\nval connect :\n sw:Eio.Switch.t -\u003e\n net:Eio.Net.t -\u003e\n clock:Eio.Time.clock -\u003e\n ?tls:Tls_config.client -\u003e\n ?headers:Headers.t -\u003e\n ?protocols:string list -\u003e\n string -\u003e\n (conn, error) result\n```","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:34:33.686889707+01:00","updated_at":"2025-12-29T16:00:45.086724651+01:00","closed_at":"2025-12-29T16:00:45.086724651+01:00","dependencies":[{"issue_id":"hcs-nad","depends_on_id":"hcs-lhr","type":"parent-child","created_at":"2025-12-29T14:34:52.929848888+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-nad","depends_on_id":"hcs-0ro","type":"blocks","created_at":"2025-12-29T14:34:58.053806421+01:00","created_by":"gdiazlo"}]} 93 102 {"id":"hcs-njk","title":"Run HTTP/2 comparison benchmarks and analyze results","description":"Execute the HTTP/2 benchmarks across all three implementations. Collect req/s, latency (p50/p99), memory usage. Document results in BENCHMARKS.md with analysis of performance characteristics.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T08:21:59.417171367+01:00","updated_at":"2025-12-30T08:48:51.035410704+01:00","closed_at":"2025-12-30T08:48:51.035410704+01:00","dependencies":[{"issue_id":"hcs-njk","depends_on_id":"hcs-ddd","type":"blocks","created_at":"2025-12-30T08:22:17.716250574+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-njk","depends_on_id":"hcs-82y","type":"parent-child","created_at":"2025-12-30T08:22:28.307104582+01:00","created_by":"gdiazlo"}]} 103 103 + {"id":"hcs-nwb","title":"LAS: Route definitions (routes.ml)","description":"Router.compile with all routes. Apply content negotiation to appropriate endpoints. Rate limit submissions.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:47.344395357+01:00","updated_at":"2026-01-02T10:27:11.186653396+01:00","closed_at":"2026-01-02T10:27:11.186653396+01:00","dependencies":[{"issue_id":"hcs-nwb","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:43.416555822+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-nwb","depends_on_id":"hcs-yg6","type":"blocks","created_at":"2026-01-01T23:43:43.888397319+01:00","created_by":"gdiazlo"}]} 94 104 {"id":"hcs-oo5","title":"Benchmark suite: single-CPU comparison of HCS, hyper, fasthttp","description":"","notes":"## Benchmark Results (Dec 31, 2025)\n\n### HCS vs Eio Native (c=1000, 100k requests)\n\n| Domains | HCS run_parallel | Eio run_server | Winner |\n|---------|------------------|----------------|--------|\n| 1 | 142k | 136k | HCS +4% |\n| 2 | 196k | 200k | Eio +2% |\n| 4 | 264k | 259k | HCS +2% |\n| 8 | 259k | 267k | Eio +3% |\n\n**Key Finding**: Both approaches perform similarly. The 2-domain regression previously observed was a measurement artifact.\n\n### HCS vs Fasthttp (c=1000, 100k requests)\n\n| Domains | HCS | Fasthttp | Winner |\n|---------|-----|----------|--------|\n| 1 | 137k | 181k | Fasthttp +32% |\n| 4 | 242k | 186k | **HCS +30%** |\n| 8 | 228k | 204k | **HCS +12%** |\n\n**Key Finding**: HCS scales BETTER than Fasthttp and beats it at 4+ domains!\n\n### Conclusions\n\n1. The nested `Eio_main.run` is NOT a problem - Eio's Domain_manager.run does the same thing internally\n2. SO_REUSEPORT (HCS) vs shared socket (Eio native) perform similarly - no clear winner\n3. HCS multi-core scaling is actually quite good - beats Fasthttp at higher core counts\n4. Earlier \"2-domain regression\" was likely a measurement artifact (port reuse, warmup, etc.)\n\n### Remaining Optimization Opportunities\n\n1. Single-core performance still lags Fasthttp by ~32% - room for improvement in request parsing/response writing\n2. 8-domain shows slight regression from 4-domain for HCS - could investigate GC tuning\n3. Hyper benchmark failed to run - need to fix for comparison","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-30T22:41:13.187711389+01:00","updated_at":"2025-12-31T09:33:51.051037492+01:00","closed_at":"2025-12-31T09:33:51.051037492+01:00"} 95 105 {"id":"hcs-oqc","title":"Implement signed/encrypted Tokens","description":"Signed and encrypted tokens for auth, password reset, email verification.\n\n## Design\n\n### Core API\n```ocaml\nmodule Token : sig\n type t\n \n val sign : secret:string -\u003e data:string -\u003e max_age:float -\u003e string\n val verify : secret:string -\u003e token:string -\u003e (string, error) result\n \n val encrypt : secret:string -\u003e data:string -\u003e max_age:float -\u003e string \n val decrypt : secret:string -\u003e token:string -\u003e (string, error) result\nend\n```\n\n### Token Format\n```\nsigned: base64(data) . timestamp . base64(hmac)\nencrypted: base64(nonce + ciphertext + tag) . timestamp . base64(hmac)\n```\n\n### Implementation\n- Use existing `digestif` for HMAC-SHA256\n- Use existing `mirage-crypto` for AES-GCM encryption\n- Timestamp encoded as varint for compactness\n- Single allocation for final token string\n\n### Use Cases\n```ocaml\n(* Auth token *)\nlet token = Token.sign ~secret ~data:user_id ~max_age:86400.0\n\n(* Password reset - encrypted so user can't see payload *)\nlet token = Token.encrypt ~secret ~data:user_id ~max_age:3600.0\n\n(* Verify *)\nmatch Token.verify ~secret token with\n| Ok user_id -\u003e ...\n| Error Token.Expired -\u003e ...\n| Error Token.Invalid -\u003e ...\n```\n\n### Performance\n- No JSON parsing, raw bytes\n- Constant-time comparison for signatures\n- Reuse crypto contexts where possible","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-01T20:47:03.67375632+01:00","updated_at":"2026-01-01T21:07:48.604332258+01:00","closed_at":"2026-01-01T21:07:48.604332258+01:00","dependencies":[{"issue_id":"hcs-oqc","depends_on_id":"hcs-1op","type":"parent-child","created_at":"2026-01-01T20:47:56.644986614+01:00","created_by":"gdiazlo"}]} 96 106 {"id":"hcs-osg","title":"Create Rust HTTP/2 benchmark server (hyper)","description":"Implement a Rust HTTP/2 server using hyper with h2c (cleartext HTTP/2) support. Match endpoints: /ping, /bytes/:n, /json. Use tokio runtime, pre-allocate response buffers for zero-copy.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-30T08:21:52.194368992+01:00","updated_at":"2025-12-30T08:48:32.166538953+01:00","closed_at":"2025-12-30T08:48:32.166538953+01:00","dependencies":[{"issue_id":"hcs-osg","depends_on_id":"hcs-82y","type":"parent-child","created_at":"2025-12-30T08:22:20.416305094+01:00","created_by":"gdiazlo"}]} 97 107 {"id":"hcs-peu","title":"HCS benchmark client: HTTP/1.1 + HTTP/2 + WebSocket support","description":"Create comprehensive benchmark client supporting all protocols with connection reuse, multiplexing, and WebSocket message throughput.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-31T14:13:46.273123556+01:00","updated_at":"2025-12-31T14:37:50.862757453+01:00","closed_at":"2025-12-31T14:37:50.862757453+01:00","dependencies":[{"issue_id":"hcs-peu","depends_on_id":"hcs-5wp","type":"parent-child","created_at":"2025-12-31T14:14:41.0222415+01:00","created_by":"gdiazlo"}]} 98 108 {"id":"hcs-pnc","title":"Control Flow and Cancellation","description":"Implement Cancel module for cooperative cancellation and Control module for timeout, retry, deadline, and circuit breaker patterns.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:23.840150584+01:00","updated_at":"2025-12-29T15:41:49.225247023+01:00","closed_at":"2025-12-29T15:41:49.225247023+01:00","dependencies":[{"issue_id":"hcs-pnc","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:03.266144948+01:00","created_by":"gdiazlo"}]} 109 109 + {"id":"hcs-pod","title":"LAS: HTML views (views.ml)","description":"Layout template, link list, link detail, login/register forms, submit form. Include CSRF tokens in forms.","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-01T23:41:42.302380219+01:00","updated_at":"2026-01-01T23:55:18.489268725+01:00","closed_at":"2026-01-01T23:55:18.489268725+01:00","dependencies":[{"issue_id":"hcs-pod","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:38.379707386+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-pod","depends_on_id":"hcs-y5a","type":"blocks","created_at":"2026-01-01T23:43:18.676898601+01:00","created_by":"gdiazlo"}]} 99 110 {"id":"hcs-pwc","title":"Implement CODEC module signature","description":"Implement the CODEC module signature in hcs-core/codec.ml using buffers:\n\n```ocaml\nmodule type CODEC = sig\n type 'a encoder\n type 'a decoder\n\n val content_type : string (* e.g., \"application/json\", \"application/msgpack\" *)\n\n (* Use Cstruct.t for buffer-based encoding/decoding *)\n val encode : 'a encoder -\u003e 'a -\u003e (Cstruct.t, string) result\n val decode : 'a decoder -\u003e Cstruct.t -\u003e ('a, string) result\n \n (* Optional: streaming encode/decode for large payloads *)\n val encode_stream : 'a encoder -\u003e 'a -\u003e Cstruct.t Stream.t option\n val decode_stream : 'a decoder -\u003e Cstruct.t Stream.t -\u003e ('a, string) result option\nend\n```\n\nBenefits of buffer-based approach:\n- Zero-copy for binary formats (msgpack, protobuf, cbor)\n- Efficient for large payloads\n- Can still handle text formats (JSON) by converting at boundaries\n- Consistent with body type which uses Cstruct.t for streaming\n\nPure OCaml + cstruct, no runtime dependency.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-29T14:28:42.177976816+01:00","updated_at":"2025-12-29T17:04:22.669690697+01:00","closed_at":"2025-12-29T17:04:22.669690697+01:00","labels":["core"],"dependencies":[{"issue_id":"hcs-pwc","depends_on_id":"hcs-m4r","type":"parent-child","created_at":"2025-12-29T14:28:59.747767828+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-pwc","depends_on_id":"hcs-23f","type":"blocks","created_at":"2025-12-29T14:29:04.083986956+01:00","created_by":"gdiazlo"}]} 111 111 + {"id":"hcs-q4v","title":"LAS: Real-time updates (realtime.ml)","description":"Pubsub instance, broadcast_vote function, ws_handler for WebSocket subscriptions.","status":"closed","priority":2,"issue_type":"task","created_at":"2026-01-01T23:41:57.42802297+01:00","updated_at":"2026-01-02T00:15:18.203793023+01:00","closed_at":"2026-01-02T00:15:18.203793023+01:00","dependencies":[{"issue_id":"hcs-q4v","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:53.486720346+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-q4v","depends_on_id":"hcs-gii","type":"blocks","created_at":"2026-01-01T23:43:38.846098179+01:00","created_by":"gdiazlo"}]} 100 112 {"id":"hcs-qf7","title":"Implement radix trie for routing","description":"Implement radix trie in hcs-core/trie.ml:\n\n```ocaml\ntype 'a t\n\nval empty : 'a t\nval insert : Path.segment list -\u003e method_ -\u003e 'a -\u003e 'a t -\u003e 'a t\nval lookup : string list -\u003e method_ -\u003e 'a t -\u003e ('a * string list, string) result\n (* Returns handler and captured params *)\n\nval compile : 'a t -\u003e 'a t (* Optimize: compress edges, sort by priority *)\n```\n\nImplementation notes:\n- Radix trie with compressed edges for static segments\n- Parameter nodes stored separately for O(1) lookup\n- Method dispatch at leaf nodes (small array)\n- Priority: static \u003e typed param \u003e string param \u003e wildcard\n- Pre-compile regex for uuid validation\n\nPure OCaml, O(path_length) lookup.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:32:37.659665672+01:00","updated_at":"2025-12-29T15:18:02.267050922+01:00","closed_at":"2025-12-29T15:18:02.267050922+01:00","dependencies":[{"issue_id":"hcs-qf7","depends_on_id":"hcs-2ie","type":"parent-child","created_at":"2025-12-29T14:32:56.840281975+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-qf7","depends_on_id":"hcs-jsl","type":"blocks","created_at":"2025-12-29T14:32:57.708007508+01:00","created_by":"gdiazlo"}]} 101 113 {"id":"hcs-qnb","title":"HTTP Client Implementation","description":"Implement the Client module with connection pooling, HTTP/1.1 and HTTP/2 support, request/fetch/stream methods, and configuration.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:28.006219271+01:00","updated_at":"2025-12-29T17:41:34.620441464+01:00","closed_at":"2025-12-29T17:41:34.620441464+01:00","dependencies":[{"issue_id":"hcs-qnb","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:11.475056322+01:00","created_by":"gdiazlo"}]} 102 114 {"id":"hcs-ro3","title":"Add zlib and zstd to library dependencies","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T18:44:13.541332828+01:00","updated_at":"2026-01-01T18:47:23.510028123+01:00","closed_at":"2026-01-01T18:47:23.510028123+01:00"} ··· 112 124 {"id":"hcs-ucw","title":"Implement Response helper module","description":"Implement response helpers in hcs-core/response.ml:\n\n```ocaml\nval make : ?version:version -\u003e ?headers:Headers.t -\u003e ?body:body -\u003e status -\u003e response\n\n(* Status shortcuts *)\nval ok : ?headers:Headers.t -\u003e body -\u003e response\nval created : ?headers:Headers.t -\u003e ?location:string -\u003e body -\u003e response\nval no_content : unit -\u003e response\nval bad_request : ?body:body -\u003e unit -\u003e response\nval unauthorized : ?www_authenticate:string -\u003e unit -\u003e response\nval forbidden : ?body:body -\u003e unit -\u003e response\nval not_found : ?body:body -\u003e unit -\u003e response\nval method_not_allowed : allowed:method_ list -\u003e unit -\u003e response\nval internal_error : ?body:body -\u003e unit -\u003e response\n(* ... all status helpers from spec ... *)\n\n(* Body helpers *)\nval text : string -\u003e response\nval html : string -\u003e response\nval redirect : ?permanent:bool -\u003e string -\u003e response\n\n(* Modify response *)\nval with_header : string -\u003e string -\u003e response -\u003e response\nval with_headers : (string * string) list -\u003e response -\u003e response\nval with_body : body -\u003e response -\u003e response\n```\n\nPure OCaml.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-29T14:34:17.870074295+01:00","updated_at":"2025-12-29T15:40:30.579234447+01:00","closed_at":"2025-12-29T15:40:30.579234447+01:00","dependencies":[{"issue_id":"hcs-ucw","depends_on_id":"hcs-dle","type":"parent-child","created_at":"2025-12-29T14:34:48.628725792+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-ucw","depends_on_id":"hcs-lpr","type":"blocks","created_at":"2025-12-29T14:34:55.629240942+01:00","created_by":"gdiazlo"}]} 113 125 {"id":"hcs-ugs","title":"Core Types and Foundations","description":"Implement core type foundations: method_, version, status, Headers module, body type, request/response records, and error types.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:19.301411166+01:00","updated_at":"2025-12-29T15:42:11.485073934+01:00","closed_at":"2025-12-29T15:42:11.485073934+01:00","dependencies":[{"issue_id":"hcs-ugs","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:25:54.989012647+01:00","created_by":"gdiazlo"}]} 114 126 {"id":"hcs-uzm","title":"Middleware redesign: add circuit breaker and retry middlewares","description":"Expose Control.ml patterns (circuit breaker, retry) as proper Eio middlewares in middleware_eio.ml. Keep both rate limiters as they serve different purposes (token bucket for clients, sliding window for servers).","status":"closed","priority":1,"issue_type":"feature","created_at":"2026-01-01T18:14:50.873049196+01:00","updated_at":"2026-01-01T18:17:42.278585485+01:00","closed_at":"2026-01-01T18:17:42.278585485+01:00"} 127 127 + {"id":"hcs-w0w","title":"LAS: Authentication module (auth.ml)","description":"Password hashing, current_user helper using Session, require_auth middleware, login/logout functions.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:37.261591945+01:00","updated_at":"2026-01-02T00:15:18.196756733+01:00","closed_at":"2026-01-02T00:15:18.196756733+01:00","dependencies":[{"issue_id":"hcs-w0w","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:33.336368591+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-w0w","depends_on_id":"hcs-gii","type":"blocks","created_at":"2026-01-01T23:43:13.641056385+01:00","created_by":"gdiazlo"}]} 115 128 {"id":"hcs-w1c","title":"Create HCS WebSocket benchmark server","description":"OCaml server using lib/websocket.ml. Accept connections, keep alive with ping/pong, report connection count. Port configurable via CLI.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T09:59:57.95619465+01:00","updated_at":"2025-12-30T10:03:58.03114584+01:00","closed_at":"2025-12-30T10:03:58.03114584+01:00","dependencies":[{"issue_id":"hcs-w1c","depends_on_id":"hcs-jk8","type":"parent-child","created_at":"2025-12-30T10:00:25.560665813+01:00","created_by":"gdiazlo"}]} 116 129 {"id":"hcs-wdm","title":"Verify tests pass after middleware changes","description":"","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T18:15:17.049685065+01:00","updated_at":"2026-01-01T18:17:42.271637225+01:00","closed_at":"2026-01-01T18:17:42.271637225+01:00","dependencies":[{"issue_id":"hcs-wdm","depends_on_id":"hcs-h2u","type":"blocks","created_at":"2026-01-01T18:15:31.619079845+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wdm","depends_on_id":"hcs-d9v","type":"blocks","created_at":"2026-01-01T18:15:36.663284028+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wdm","depends_on_id":"hcs-sby","type":"blocks","created_at":"2026-01-01T18:15:41.701006323+01:00","created_by":"gdiazlo"}]} 117 130 {"id":"hcs-wkv","title":"Create WebSocket benchmark runner script","description":"Script like run_h2_comparison.sh. Start servers, run tests at 1k/10k/50k/100k connections, measure memory via /proc/[pid]/status VmRSS, report results.","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T10:00:03.612055281+01:00","updated_at":"2025-12-30T10:14:42.952379356+01:00","closed_at":"2025-12-30T10:14:42.952379356+01:00","dependencies":[{"issue_id":"hcs-wkv","depends_on_id":"hcs-jk8","type":"parent-child","created_at":"2025-12-30T10:00:45.722495633+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wkv","depends_on_id":"hcs-w1c","type":"blocks","created_at":"2025-12-30T10:00:55.80122372+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wkv","depends_on_id":"hcs-1h7","type":"blocks","created_at":"2025-12-30T10:01:00.843226486+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wkv","depends_on_id":"hcs-6ki","type":"blocks","created_at":"2025-12-30T10:01:05.885715216+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-wkv","depends_on_id":"hcs-6hx","type":"blocks","created_at":"2025-12-30T10:01:10.922318474+01:00","created_by":"gdiazlo"}]} 118 131 {"id":"hcs-x1l","title":"Create benchmark runner script for standardized testing","description":"","status":"closed","priority":2,"issue_type":"task","created_at":"2025-12-30T22:21:46.718118939+01:00","updated_at":"2025-12-30T22:33:10.362379965+01:00","closed_at":"2025-12-30T22:33:10.362379965+01:00"} 132 132 + {"id":"hcs-y5a","title":"LAS: Data models (models.ml)","description":"Define types for user, link, vote, comment. Include JSON serialization helpers.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:27.179866273+01:00","updated_at":"2026-01-01T23:50:41.86681997+01:00","closed_at":"2026-01-01T23:50:41.86681997+01:00","dependencies":[{"issue_id":"hcs-y5a","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:23.256823169+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-y5a","depends_on_id":"hcs-dpu","type":"blocks","created_at":"2026-01-01T23:43:03.557959162+01:00","created_by":"gdiazlo"}]} 119 133 {"id":"hcs-y9w","title":"TLS Configuration","description":"Implement Tls_config module for client and server TLS configuration with verification modes and system certificate loading.","status":"closed","priority":2,"issue_type":"epic","created_at":"2025-12-29T14:25:24.911800471+01:00","updated_at":"2025-12-29T15:25:06.384359847+01:00","closed_at":"2025-12-29T15:25:06.384359847+01:00","dependencies":[{"issue_id":"hcs-y9w","depends_on_id":"hcs-zba","type":"parent-child","created_at":"2025-12-29T14:26:05.906211432+01:00","created_by":"gdiazlo"}]} 134 134 + {"id":"hcs-yg6","title":"LAS: Request handlers (handlers.ml)","description":"Handlers for index, show_link, create_link, vote, login, logout, register. Use Plug.Negotiate.respond for dual JSON/HTML.","status":"closed","priority":1,"issue_type":"task","created_at":"2026-01-01T23:41:52.385545141+01:00","updated_at":"2026-01-02T10:23:27.072133297+01:00","closed_at":"2026-01-02T10:23:27.072133297+01:00","dependencies":[{"issue_id":"hcs-yg6","depends_on_id":"hcs-62k","type":"parent-child","created_at":"2026-01-01T23:42:48.451290008+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-yg6","depends_on_id":"hcs-gii","type":"blocks","created_at":"2026-01-01T23:43:23.721075403+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-yg6","depends_on_id":"hcs-w0w","type":"blocks","created_at":"2026-01-01T23:43:28.763639466+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-yg6","depends_on_id":"hcs-pod","type":"blocks","created_at":"2026-01-01T23:43:33.804311531+01:00","created_by":"gdiazlo"}]} 120 135 {"id":"hcs-zba","title":"HCS HTTP Library Implementation","description":"Implement the hcs HTTP library for OCaml 5+ supporting HTTP/1.1, HTTP/2, and WebSockets. Built with a runtime-agnostic core to support Eio initially with Lwt support planned for the future. Features zero-copy streaming and minimal allocations.\n\nDesign Principle: The library should have a pure functional core with IO effects abstracted behind a runtime interface, allowing future Lwt integration without major rewrites.","status":"closed","priority":1,"issue_type":"epic","created_at":"2025-12-29T14:25:07.01892354+01:00","updated_at":"2025-12-29T17:57:35.070502613+01:00","closed_at":"2025-12-29T17:57:35.070502613+01:00"} 121 136 {"id":"hcs-zft","title":"Document CODEC implementation examples","description":"Document how users can implement their own CODEC for various formats. Include examples in documentation/comments showing the pattern:\n\n```ocaml\n(* Example: User implements JSON codec with their preferred library *)\nmodule My_json_codec : Hcs.CODEC = struct\n type 'a encoder = 'a -\u003e Yojson.Safe.t (* or Jsonm, Jsoo, etc. *)\n type 'a decoder = Yojson.Safe.t -\u003e ('a, string) result\n \n let content_type = \"application/json\"\n \n let encode enc value =\n try Ok (Cstruct.of_string (Yojson.Safe.to_string (enc value)))\n with exn -\u003e Error (Printexc.to_string exn)\n \n let decode dec buf =\n try \n let json = Yojson.Safe.from_string (Cstruct.to_string buf) in\n dec json\n with exn -\u003e Error (Printexc.to_string exn)\n \n let encode_stream _ _ = None (* Optional streaming *)\n let decode_stream _ _ = None\nend\n\n(* Example: MessagePack codec *)\nmodule My_msgpack_codec : Hcs.CODEC = struct\n (* Similar pattern with msgpck library *)\nend\n```\n\nThis is documentation only - no actual JSON library dependency in hcs. Users choose their own serialization libraries.","status":"closed","priority":3,"issue_type":"task","created_at":"2025-12-29T14:28:49.108715641+01:00","updated_at":"2025-12-29T17:32:45.942298931+01:00","closed_at":"2025-12-29T17:32:45.942298931+01:00","labels":["codec","optional"],"dependencies":[{"issue_id":"hcs-zft","depends_on_id":"hcs-m4r","type":"parent-child","created_at":"2025-12-29T14:29:01.540146453+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-zft","depends_on_id":"hcs-pwc","type":"blocks","created_at":"2025-12-29T14:29:03.003001157+01:00","created_by":"gdiazlo"}]} 122 137 {"id":"hcs-zln","title":"Update benchmark server with --domains flag","description":"Add --domains N flag to bench_server_h2.exe to test with configurable domain count.","status":"closed","priority":1,"issue_type":"task","created_at":"2025-12-30T09:05:56.907974106+01:00","updated_at":"2025-12-30T09:16:33.434469675+01:00","closed_at":"2025-12-30T09:16:33.434469675+01:00","dependencies":[{"issue_id":"hcs-zln","depends_on_id":"hcs-zq3","type":"parent-child","created_at":"2025-12-30T09:06:24.184829345+01:00","created_by":"gdiazlo"},{"issue_id":"hcs-zln","depends_on_id":"hcs-k8f","type":"blocks","created_at":"2025-12-30T09:06:39.306344162+01:00","created_by":"gdiazlo"}]}

+3

.gitignore

reviewed

··· 47 47 setup.data 48 48 setup.log 49 49 *.sh 50 50 + 51 51 + # LAS tutorial local DB 52 52 + las.db

+1

README.md

reviewed

··· 18 18 | [Log](lib/log.ml) | Structured logging | 19 19 | [Request](lib/request.ml) | Request helpers | 20 20 | [Response](lib/response.ml) | Response helpers | 21 21 + | [Multipart](lib/multipart.ml) | Multipart form data parsing | 21 22 | [Http](lib/http.ml) | Request builder DSL | 22 23 | [H1_client](lib/h1_client.ml) | HTTP/1.1 client | 23 24 | [H2_client](lib/h2_client.ml) | HTTP/2 client |

+1

bin/las/dune

reviewed

··· 6 6 sqlite3 7 7 pure-html 8 8 digestif 9 9 + climate 9 10 eio_main))

+22 -42

bin/las/handlers.ml

reviewed

··· 1 1 open Hcs 2 2 3 3 - let accepts_json (req : Server.request) = 4 4 - match 5 5 - List.find_opt 6 6 - (fun (n, _) -> String.lowercase_ascii n = "accept") 7 7 - req.headers 8 8 - with 9 9 - | None -> false 10 10 - | Some (_, v) -> String.contains v 'j' && String.contains v 's' 11 11 - 12 3 let parse_form_urlencoded (body : string) : (string * string) list = 13 4 let decode_plus s = String.map (fun c -> if c = '+' then ' ' else c) s in 14 5 let uri_decode s = ··· 48 39 match Db.list_links ~sort:Db.Score () with 49 40 | Error e -> Server.respond ~status:`Internal_server_error e 50 41 | Ok links -> 51 51 - if accepts_json req then 52 52 - Server.respond 53 53 - ~headers:[ ("Content-Type", "application/json") ] 54 54 - (Models.links_to_json links) 55 55 - else 56 56 - Server.respond 57 57 - ~headers:[ ("Content-Type", "text/html") ] 58 58 - (Views.index_page links) 42 42 + Plug.Negotiate.respond req 43 43 + ~json:(fun () -> Models.links_to_json links) 44 44 + ~html:(fun () -> Views.index_page links) 45 45 + () 59 46 60 47 let index_new _params (req : Server.request) : Server.response = 61 48 match Db.list_links ~sort:Db.New () with 62 49 | Error e -> Server.respond ~status:`Internal_server_error e 63 50 | Ok links -> 64 64 - if accepts_json req then 65 65 - Server.respond 66 66 - ~headers:[ ("Content-Type", "application/json") ] 67 67 - (Models.links_to_json links) 68 68 - else 69 69 - Server.respond 70 70 - ~headers:[ ("Content-Type", "text/html") ] 71 71 - (Views.index_page links) 51 51 + Plug.Negotiate.respond req 52 52 + ~json:(fun () -> Models.links_to_json links) 53 53 + ~html:(fun () -> Views.index_page links) 54 54 + () 72 55 73 56 let show_link params (req : Server.request) : Server.response = 74 57 let link_id = Router.param_int_or "id" ~default:0 params in ··· 79 62 match Db.list_comments link_id with 80 63 | Error e -> Server.respond ~status:`Internal_server_error e 81 64 | Ok comments -> 82 82 - if accepts_json req then 83 83 - Server.respond 84 84 - ~headers:[ ("Content-Type", "application/json") ] 85 85 - (Models.link_to_json link) 86 86 - else 87 87 - Server.respond 88 88 - ~headers:[ ("Content-Type", "text/html") ] 89 89 - (Views.link_page link comments)) 65 65 + Plug.Negotiate.respond req 66 66 + ~json:(fun () -> Models.link_to_json link) 67 67 + ~html:(fun () -> Views.link_page link comments) 68 68 + ()) 90 69 91 70 let login_form _params (_req : Server.request) : Server.response = 92 71 Server.respond ··· 142 121 (Views.submit_page ~error:"URL and title are required" ()) 143 122 else 144 123 match Db.submit_link ~url ~title ~user_id with 145 145 - | Ok link_id -> 146 146 - if accepts_json req then 147 147 - Server.respond 148 148 - ~headers:[ ("Content-Type", "application/json") ] 149 149 - (Printf.sprintf {|{"id":%d}|} link_id) 150 150 - else 151 151 - Server.respond ~status:`Found 152 152 - ~headers:[ ("Location", Printf.sprintf "/links/%d" link_id) ] 153 153 - "" 124 124 + | Ok link_id -> ( 125 125 + match Plug.Negotiate.get_format req with 126 126 + | Some Json -> 127 127 + Server.respond 128 128 + ~headers:[ ("Content-Type", "application/json") ] 129 129 + (Printf.sprintf {|{"id":%d}|} link_id) 130 130 + | _ -> 131 131 + Server.respond ~status:`Found 132 132 + ~headers:[ ("Location", Printf.sprintf "/links/%d" link_id) ] 133 133 + "") 154 134 | Error e -> Server.respond ~status:`Internal_server_error e) 155 135 156 136 let vote params (req : Server.request) : Server.response =

+63 -16

bin/las/las.ml

reviewed

··· 1 1 - let () = 2 2 - Eio_main.run @@ fun env -> 3 3 - let clock = Eio.Stdenv.clock env in 1 1 + let command = 2 2 + Climate.Command.singleton 3 3 + ~doc:"Link Aggregator Service - A demo application for HCS" 4 4 + @@ 5 5 + let open Climate.Arg_parser in 6 6 + let+ port = 7 7 + named_opt [ "p"; "port" ] int ~value_name:"PORT" 8 8 + ~doc:"Port to listen on (default: 8080, or PORT env var)" 9 9 + and+ db_path = 10 10 + named_opt [ "d"; "database" ] string ~value_name:"PATH" 11 11 + ~doc:"Database path (default: las.db, or DATABASE_PATH env var)" 12 12 + and+ verbose = flag [ "v"; "verbose" ] ~doc:"Enable request logging" in 13 13 + 14 14 + let port = 15 15 + match port with 16 16 + | Some p -> p 17 17 + | None -> 18 18 + Sys.getenv_opt "PORT" 19 19 + |> Option.map int_of_string_opt 20 20 + |> Option.join |> Option.value ~default:8080 21 21 + in 4 22 let db_path = 5 5 - Sys.getenv_opt "DATABASE_PATH" |> Option.value ~default:"las.db" 23 23 + match db_path with 24 24 + | Some p -> p 25 25 + | None -> Sys.getenv_opt "DATABASE_PATH" |> Option.value ~default:"las.db" 6 26 in 27 27 + 28 28 + Eio_main.run @@ fun env -> 29 29 + let clock = Eio.Stdenv.clock env in 7 30 (match Db.init db_path with 8 31 | Ok () -> () 9 32 | Error e -> failwith ("Database init failed: " ^ e)); 10 33 let store = Hcs.Plug.Session.Memory_store.create () in 11 11 - let logger _level _event = () in 34 34 + let logger = if verbose then Hcs.Log.stderr () else Hcs.Log.null in 12 35 let rate_key (req : Hcs.Server.request) = 13 13 - match 14 14 - List.find_opt 15 15 - (fun (n, _) -> String.lowercase_ascii n = "x-forwarded-for") 16 16 - req.Hcs.Server.headers 17 17 - with 18 18 - | Some (_, ip) -> "ip:" ^ ip 19 19 - | None -> "anon" 36 36 + match Hcs.Plug.Session.get "user_id" with 37 37 + | Some uid -> "user:" ^ uid 38 38 + | None -> ( 39 39 + match 40 40 + List.find_opt 41 41 + (fun (n, _) -> String.lowercase_ascii n = "x-forwarded-for") 42 42 + req.Hcs.Server.headers 43 43 + with 44 44 + | Some (_, ip) -> "ip:" ^ ip 45 45 + | None -> "anon") 20 46 in 47 47 + 48 48 + Printf.printf "Starting LAS on http://0.0.0.0:%d\n%!" port; 49 49 + Printf.printf "Database: %s\n%!" db_path; 50 50 + if verbose then Printf.printf "Verbose logging: enabled\n%!"; 51 51 + 21 52 let endpoint = 22 53 let e = 23 54 Hcs.Endpoint.create 24 55 { 25 56 Hcs.Endpoint.default_config with 26 26 - port = 8080; 57 57 + port; 27 58 secret_key_base = 28 59 Sys.getenv_opt "SECRET_KEY" 29 60 |> Option.value ~default:"dev-secret-32-chars-minimum!!!"; ··· 31 62 in 32 63 let e = Hcs.Endpoint.plug e (Hcs.Plug.Logger.create ~clock logger) in 33 64 let e = Hcs.Endpoint.plug e (Hcs.Plug.Compress.create ()) in 34 34 - let e = Hcs.Endpoint.plug e (Hcs.Plug.Session.create ~store ()) in 35 35 - let e = Hcs.Endpoint.plug e (Hcs.Plug.Csrf.create ()) in 65 65 + let e = 66 66 + Hcs.Endpoint.plug e (Hcs.Plug.Session.create ~store ~secure:false ()) 67 67 + in 68 68 + let e = 69 69 + Hcs.Endpoint.plug e 70 70 + (Hcs.Plug.Csrf.create 71 71 + ~config: 72 72 + { 73 73 + Hcs.Plug.Csrf.cookie_name = "_csrf"; 74 74 + header_name = "X-CSRF-Token"; 75 75 + field_name = "_csrf"; 76 76 + secure = false; 77 77 + same_site = `Strict; 78 78 + } 79 79 + ()) 80 80 + in 36 81 let e = 37 82 Hcs.Endpoint.plug e 38 83 (Hcs.Plug.Rate_limit.create ~clock ~key:rate_key ~requests:100 ~per:60.0) 39 84 in 40 40 - let e = Hcs.Endpoint.router e Routes.router in 85 85 + let e = Hcs.Endpoint.router e (Routes.router clock) in 41 86 let e = Hcs.Endpoint.websocket e Realtime.ws_handler in 42 87 e 43 88 in 44 89 Hcs.Endpoint.start endpoint ~env 90 90 + 91 91 + let () = Climate.Command.run command

+19 -5

bin/las/routes.ml

reviewed

··· 1 1 open Hcs 2 2 3 3 - let router = 3 3 + let negotiate = Plug.Negotiate.create ~formats:[ Json; Html ] () 4 4 + 5 5 + let with_negotiate handler params req = 6 6 + Plug.apply negotiate (handler params) req 7 7 + 8 8 + let router clock = 9 9 + let submit_rate_limit = 10 10 + Plug.Rate_limit.create ~clock 11 11 + ~key:(fun _ -> 12 12 + match Plug.Session.get "user_id" with Some uid -> uid | None -> "anon") 13 13 + ~requests:10 ~per:3600.0 14 14 + in 4 15 Router.compile 5 16 [ 6 6 - Router.Route.get "/" Handlers.index; 7 7 - Router.Route.get "/new" Handlers.index_new; 8 8 - Router.Route.get "/links/:id" Handlers.show_link; 17 17 + Router.Route.get "/" (with_negotiate Handlers.index); 18 18 + Router.Route.get "/new" (with_negotiate Handlers.index_new); 19 19 + Router.Route.get "/links/:id" (with_negotiate Handlers.show_link); 9 20 Router.Route.get "/login" Handlers.login_form; 10 21 Router.Route.post "/login" Handlers.login_submit; 11 22 Router.Route.get "/register" Handlers.register_form; ··· 14 25 Router.Route.get "/submit" (fun params req -> 15 26 Auth.require_auth (Handlers.submit_form params) req); 16 27 Router.Route.post "/links" (fun params req -> 17 17 - Auth.require_auth (Handlers.create_link params) req); 28 28 + Plug.apply submit_rate_limit 29 29 + (Auth.require_auth (fun r -> 30 30 + Plug.apply negotiate (Handlers.create_link params) r)) 31 31 + req); 18 32 Router.Route.post "/links/:id/vote" Handlers.vote; 19 33 Router.Route.post "/links/:id/comments" (fun params req -> 20 34 Auth.require_auth (Handlers.create_comment params) req);

+1

dune-project

reviewed

··· 45 45 (climate (>= 0.9)) 46 46 (zlib (>= 0.8)) 47 47 (zstd (>= 0.4)) 48 48 + (http-multipart-formdata (>= 3.0)) 48 49 (alcotest (and (>= 1.9) :with-test)) 49 50 (qcheck (and (>= 0.21) :with-test)) 50 51 (qcheck-alcotest (and (>= 0.21) :with-test))

+1

hcs.opam

reviewed

··· 32 32 "climate" {>= "0.9"} 33 33 "zlib" {>= "0.8"} 34 34 "zstd" {>= "0.4"} 35 35 + "http-multipart-formdata" {>= "3.0"} 35 36 "alcotest" {>= "1.9" & with-test} 36 37 "qcheck" {>= "0.21" & with-test} 37 38 "qcheck-alcotest" {>= "0.21" & with-test}

+1 -1

lib/dune

reviewed

··· 3 3 (library 4 4 (name hcs) 5 5 (public_name hcs) 6 6 - (libraries eio eio.unix h1 h2 tls-eio tls ca-certs x509 ptime ptime.clock.os cstruct uri digestif base64 bigstringaf faraday bytesrw bytesrw.zlib bytesrw.zstd mirage-crypto mirage-crypto-rng kcas kcas_data unix)) 6 6 + (libraries eio eio.unix h1 h2 tls-eio tls ca-certs x509 ptime ptime.clock.os cstruct uri digestif base64 bigstringaf faraday bytesrw bytesrw.zlib bytesrw.zstd mirage-crypto mirage-crypto-rng kcas kcas_data unix http-multipart-formdata))

+3 -6

lib/hcs.ml

reviewed

··· 21 21 module Endpoint = Endpoint 22 22 (** Application bootstrap tying router, plugs, and server *) 23 23 24 24 - module Middleware = Middleware 25 25 - (** Generic middleware composition (for non-HTTP use cases) *) 26 26 - 27 27 - module Middleware_eio = Middleware_eio 28 28 - (** Eio-based middleware (deprecated, use Plug instead) *) 29 29 - 30 24 module Pool = Pool 31 25 (** Connection pool *) 32 26 ··· 68 62 69 63 module Stream = Stream 70 64 (** Streaming abstractions *) 65 65 + 66 66 + module Multipart = Multipart 67 67 + (** Multipart form data parsing *) 71 68 72 69 module Http = Http 73 70 (** HTTP Request builder DSL *)

-10

lib/middleware.ml

reviewed

··· 1 1 - type ('req, 'resp) t = ('req -> 'resp) -> 'req -> 'resp 2 2 - 3 3 - let identity : ('req, 'resp) t = fun handler req -> handler req 4 4 - 5 5 - let compose (m1 : ('req, 'resp) t) (m2 : ('req, 'resp) t) : ('req, 'resp) t = 6 6 - fun handler -> m1 (m2 handler) 7 7 - 8 8 - let compose_all middlewares = List.fold_right compose middlewares identity 9 9 - let ( @> ) = compose 10 10 - let apply middleware handler = middleware handler

-851

lib/middleware_eio.ml

reviewed

··· 1 1 - (** Eio-specific middleware implementations. 2 2 - 3 3 - These middleware require Eio runtime features like clocks, filesystem 4 4 - access, and structured concurrency. 5 5 - 6 6 - {1 Usage} 7 7 - 8 8 - {[ 9 9 - open Hcs.Middleware_eio 10 10 - 11 11 - (* Add logging with timing *) 12 12 - let handler = 13 13 - handler 14 14 - |> Middleware.apply (logging ~clock (Log.stderr ())) 15 15 - |> Middleware.apply (timeout ~clock 30.0) 16 16 - ]} *) 17 17 - 18 18 - (** {1 String Helpers} *) 19 19 - 20 20 - (** Check if string starts with prefix *) 21 21 - let string_starts_with ~prefix s = 22 22 - let plen = String.length prefix in 23 23 - let slen = String.length s in 24 24 - plen <= slen && String.sub s 0 plen = prefix 25 25 - 26 26 - (** Check if substring exists in string *) 27 27 - let string_contains_substring ~substring s = 28 28 - let rec check i = 29 29 - if i + String.length substring > String.length s then false 30 30 - else if String.sub s i (String.length substring) = substring then true 31 31 - else check (i + 1) 32 32 - in 33 33 - check 0 34 34 - 35 35 - (** {1 Types} *) 36 36 - 37 37 - type request = Server.request 38 38 - type response = Server.response 39 39 - 40 40 - type middleware = (request -> response) -> request -> response 41 41 - (** Equivalent to [(Server.request, Server.response) Middleware.t]. Specialized 42 42 - for HTTP server handlers. *) 43 43 - 44 44 - (** {1 Response Helpers} *) 45 45 - 46 46 - (** Get the body size from a response, if known *) 47 47 - let response_body_size (resp : response) : int option = 48 48 - match resp.Server.body with 49 49 - | Server.Body_empty -> Some 0 50 50 - | Server.Body_string s -> Some (String.length s) 51 51 - | Server.Body_bigstring b -> Some (Bigstringaf.length b) 52 52 - | Server.Body_prebuilt p -> Some (Bigstringaf.length p.Server.Prebuilt.body) 53 53 - | Server.Body_stream _ -> None 54 54 - 55 55 - let response_body_string (resp : response) : string = 56 56 - match resp.Server.body with 57 57 - | Server.Body_empty -> "" 58 58 - | Server.Body_string s -> s 59 59 - | Server.Body_bigstring b -> Bigstringaf.to_string b 60 60 - | Server.Body_prebuilt p -> Bigstringaf.to_string p.Server.Prebuilt.body 61 61 - | Server.Body_stream _ -> "" 62 62 - 63 63 - (** {1 Logging Middleware} *) 64 64 - 65 65 - (** Logging middleware that records request timing and details. 66 66 - 67 67 - Uses the Log module for structured event logging. *) 68 68 - let logging ~(clock : _ Eio.Time.clock) (logger : Log.logger) : middleware = 69 69 - fun handler req -> 70 70 - let id = Log.generate_request_id () in 71 71 - let start = Eio.Time.now clock in 72 72 - let meth = Log.method_of_h1 req.Server.meth in 73 73 - logger Log.Info 74 74 - (Log.Request_start { id; meth; uri = req.target; headers = req.headers }); 75 75 - let resp = handler req in 76 76 - let duration_ms = (Eio.Time.now clock -. start) *. 1000.0 in 77 77 - let status = H1.Status.to_code resp.Server.status in 78 78 - let body_size = response_body_size resp in 79 79 - logger Log.Info (Log.Request_end { id; status; duration_ms; body_size }); 80 80 - resp 81 81 - 82 82 - (** {1 Timeout Middleware} *) 83 83 - 84 84 - (** Timeout middleware that cancels requests exceeding the time limit. 85 85 - 86 86 - Returns a 504 Gateway Timeout response if the handler takes too long. *) 87 87 - let timeout ~(clock : _ Eio.Time.clock) (seconds : float) : middleware = 88 88 - fun handler req -> 89 89 - let timeout_response () = 90 90 - Eio.Time.sleep clock seconds; 91 91 - Server.respond ~status:`Gateway_timeout "Request timed out" 92 92 - in 93 93 - Eio.Fiber.first (fun () -> handler req) timeout_response 94 94 - 95 95 - (** {1 Rate Limiting} *) 96 96 - 97 97 - (** Simple in-memory rate limiter state *) 98 98 - module Rate_limit_state = struct 99 99 - type t = { 100 100 - mutable requests : int; 101 101 - mutable window_start : float; 102 102 - window_seconds : float; 103 103 - max_requests : int; 104 104 - } 105 105 - 106 106 - let create ~max_requests ~window_seconds = 107 107 - { requests = 0; window_start = 0.0; window_seconds; max_requests } 108 108 - 109 109 - let check_and_increment t now = 110 110 - if now -. t.window_start >= t.window_seconds then begin 111 111 - t.window_start <- now; 112 112 - t.requests <- 1; 113 113 - true 114 114 - end 115 115 - else if t.requests < t.max_requests then begin 116 116 - t.requests <- t.requests + 1; 117 117 - true 118 118 - end 119 119 - else false 120 120 - 121 121 - let remaining t = max 0 (t.max_requests - t.requests) 122 122 - let reset_at t = t.window_start +. t.window_seconds 123 123 - end 124 124 - 125 125 - (** Rate limiting middleware. 126 126 - 127 127 - Limits requests per time window, keyed by a function (e.g., by IP, by user). 128 128 - Returns 429 Too Many Requests when the limit is exceeded. *) 129 129 - let rate_limit ~(clock : _ Eio.Time.clock) ~(key : request -> string) 130 130 - ~(requests : int) ~(per : float) : middleware = 131 131 - let states : (string, Rate_limit_state.t) Hashtbl.t = Hashtbl.create 256 in 132 132 - let mutex = Eio.Mutex.create () in 133 133 - fun handler req -> 134 134 - let k = key req in 135 135 - let now = Eio.Time.now clock in 136 136 - let allowed, remaining, reset_at = 137 137 - Eio.Mutex.use_rw ~protect:true mutex (fun () -> 138 138 - let state = 139 139 - match Hashtbl.find_opt states k with 140 140 - | Some s -> s 141 141 - | None -> 142 142 - let s = 143 143 - Rate_limit_state.create ~max_requests:requests 144 144 - ~window_seconds:per 145 145 - in 146 146 - Hashtbl.add states k s; 147 147 - s 148 148 - in 149 149 - let allowed = Rate_limit_state.check_and_increment state now in 150 150 - ( allowed, 151 151 - Rate_limit_state.remaining state, 152 152 - Rate_limit_state.reset_at state )) 153 153 - in 154 154 - if allowed then handler req 155 155 - else 156 156 - let headers = 157 157 - [ 158 158 - ("X-RateLimit-Limit", string_of_int requests); 159 159 - ("X-RateLimit-Remaining", string_of_int remaining); 160 160 - ("X-RateLimit-Reset", string_of_int (int_of_float reset_at)); 161 161 - ("Retry-After", string_of_int (int_of_float (reset_at -. now))); 162 162 - ] 163 163 - in 164 164 - { 165 165 - Server.status = `Code 429; 166 166 - headers; 167 167 - body = Server.Body_string "Too Many Requests"; 168 168 - } 169 169 - 170 170 - (** {1 ETag and Caching} *) 171 171 - 172 172 - (** Generate ETag from response body using MD5 hash *) 173 173 - let generate_etag body = 174 174 - let hash = Digestif.MD5.digest_string body in 175 175 - "\"" ^ Digestif.MD5.to_hex hash ^ "\"" 176 176 - 177 177 - let etag : middleware = 178 178 - fun handler req -> 179 179 - let resp = handler req in 180 180 - let body_str = response_body_string resp in 181 181 - let etag_value = generate_etag body_str in 182 182 - let if_none_match = 183 183 - List.find_opt 184 184 - (fun (n, _) -> String.lowercase_ascii n = "if-none-match") 185 185 - req.headers 186 186 - |> Option.map snd 187 187 - in 188 188 - match if_none_match with 189 189 - | Some client_etag when String.equal client_etag etag_value -> 190 190 - { 191 191 - status = `Code 304; 192 192 - headers = [ ("ETag", etag_value) ]; 193 193 - body = Server.Body_empty; 194 194 - } 195 195 - | _ -> { resp with headers = ("ETag", etag_value) :: resp.headers } 196 196 - 197 197 - (** Cache-Control middleware - adds Cache-Control header *) 198 198 - let cache_control (directive : string) : middleware = 199 199 - fun handler req -> 200 200 - let resp = handler req in 201 201 - { resp with headers = ("Cache-Control", directive) :: resp.headers } 202 202 - 203 203 - (** {1 CORS} *) 204 204 - 205 205 - type cors_config = { 206 206 - origins : string list; 207 207 - methods : string list; 208 208 - headers : string list; 209 209 - max_age : int option; 210 210 - credentials : bool; 211 211 - } 212 212 - 213 213 - let default_cors_config = 214 214 - { 215 215 - origins = [ "*" ]; 216 216 - methods = [ "GET"; "HEAD"; "POST"; "PUT"; "DELETE"; "OPTIONS" ]; 217 217 - headers = [ "*" ]; 218 218 - max_age = Some 86400; 219 219 - credentials = false; 220 220 - } 221 221 - 222 222 - let cors ?(config = default_cors_config) () : middleware = 223 223 - fun handler req -> 224 224 - let origin = 225 225 - List.find_opt 226 226 - (fun (n, _) -> String.lowercase_ascii n = "origin") 227 227 - req.headers 228 228 - |> Option.map snd 229 229 - in 230 230 - let allowed_origin = 231 231 - match (origin, config.origins) with 232 232 - | _, [ "*" ] -> Some "*" 233 233 - | Some o, origins when List.mem o origins -> Some o 234 234 - | _ -> None 235 235 - in 236 236 - let cors_headers = 237 237 - match allowed_origin with 238 238 - | None -> [] 239 239 - | Some ao -> 240 240 - let h = [ ("Access-Control-Allow-Origin", ao) ] in 241 241 - let h = 242 242 - if config.credentials then 243 243 - ("Access-Control-Allow-Credentials", "true") :: h 244 244 - else h 245 245 - in 246 246 - h 247 247 - in 248 248 - match req.meth with 249 249 - | `OPTIONS -> 250 250 - let preflight_headers = 251 251 - ("Access-Control-Allow-Methods", String.concat ", " config.methods) 252 252 - :: ("Access-Control-Allow-Headers", String.concat ", " config.headers) 253 253 - :: cors_headers 254 254 - in 255 255 - let preflight_headers = 256 256 - match config.max_age with 257 257 - | Some age -> 258 258 - ("Access-Control-Max-Age", string_of_int age) :: preflight_headers 259 259 - | None -> preflight_headers 260 260 - in 261 261 - { status = `No_content; headers = preflight_headers; body = Body_empty } 262 262 - | _ -> 263 263 - let resp = handler req in 264 264 - { resp with headers = cors_headers @ resp.headers } 265 265 - 266 266 - (** {1 Static Files} *) 267 267 - 268 268 - let mime_type_of_extension ext = 269 269 - match String.lowercase_ascii ext with 270 270 - | ".html" | ".htm" -> "text/html; charset=utf-8" 271 271 - | ".css" -> "text/css; charset=utf-8" 272 272 - | ".js" | ".mjs" -> "application/javascript; charset=utf-8" 273 273 - | ".json" | ".map" -> "application/json" 274 274 - | ".xml" -> "application/xml" 275 275 - | ".txt" -> "text/plain; charset=utf-8" 276 276 - | ".md" -> "text/markdown; charset=utf-8" 277 277 - | ".png" -> "image/png" 278 278 - | ".jpg" | ".jpeg" -> "image/jpeg" 279 279 - | ".gif" -> "image/gif" 280 280 - | ".svg" -> "image/svg+xml" 281 281 - | ".ico" -> "image/x-icon" 282 282 - | ".webp" -> "image/webp" 283 283 - | ".avif" -> "image/avif" 284 284 - | ".woff" -> "font/woff" 285 285 - | ".woff2" -> "font/woff2" 286 286 - | ".ttf" -> "font/ttf" 287 287 - | ".otf" -> "font/otf" 288 288 - | ".eot" -> "application/vnd.ms-fontobject" 289 289 - | ".pdf" -> "application/pdf" 290 290 - | ".zip" -> "application/zip" 291 291 - | ".gz" -> "application/gzip" 292 292 - | ".tar" -> "application/x-tar" 293 293 - | ".mp3" -> "audio/mpeg" 294 294 - | ".ogg" -> "audio/ogg" 295 295 - | ".wav" -> "audio/wav" 296 296 - | ".mp4" -> "video/mp4" 297 297 - | ".webm" -> "video/webm" 298 298 - | ".avi" -> "video/x-msvideo" 299 299 - | ".wasm" -> "application/wasm" 300 300 - | _ -> "application/octet-stream" 301 301 - 302 302 - let extension path = 303 303 - match String.rindex_opt path '.' with 304 304 - | Some i -> String.sub path i (String.length path - i) 305 305 - | None -> "" 306 306 - 307 307 - let html_escape s = 308 308 - let buf = Buffer.create (String.length s) in 309 309 - String.iter 310 310 - (function 311 311 - | '<' -> Buffer.add_string buf "&lt;" 312 312 - | '>' -> Buffer.add_string buf "&gt;" 313 313 - | '&' -> Buffer.add_string buf "&amp;" 314 314 - | '"' -> Buffer.add_string buf "&quot;" 315 315 - | c -> Buffer.add_char buf c) 316 316 - s; 317 317 - Buffer.contents buf 318 318 - 319 319 - let directory_listing ~path entries = 320 320 - let buf = Buffer.create 4096 in 321 321 - Buffer.add_string buf "<!DOCTYPE html>\n<html>\n<head>\n"; 322 322 - Buffer.add_string buf "<meta charset=\"utf-8\">\n"; 323 323 - Buffer.add_string buf 324 324 - "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n"; 325 325 - Printf.bprintf buf "<title>Index of /%s</title>\n" (html_escape path); 326 326 - Buffer.add_string buf 327 327 - "<style>body{font-family:system-ui,sans-serif;margin:2em}"; 328 328 - Buffer.add_string buf 329 329 - "table{border-collapse:collapse;width:100%;max-width:800px}"; 330 330 - Buffer.add_string buf "th,td{text-align:left;padding:.5em 1em}"; 331 331 - Buffer.add_string buf "th{border-bottom:2px solid #333}"; 332 332 - Buffer.add_string buf "tr:hover{background:#f5f5f5}"; 333 333 - Buffer.add_string buf "a{color:#0066cc;text-decoration:none}"; 334 334 - Buffer.add_string buf "a:hover{text-decoration:underline}"; 335 335 - Buffer.add_string buf ".size{color:#666}</style>\n</head>\n<body>\n"; 336 336 - Printf.bprintf buf "<h1>Index of /%s</h1>\n" (html_escape path); 337 337 - Buffer.add_string buf 338 338 - "<table>\n<thead><tr><th>Name</th><th>Size</th></tr></thead>\n<tbody>\n"; 339 339 - if path <> "" then 340 340 - Buffer.add_string buf "<tr><td><a href=\"../\">..</a></td><td>-</td></tr>\n"; 341 341 - let sorted = 342 342 - List.sort 343 343 - (fun (a, a_is_dir, _) (b, b_is_dir, _) -> 344 344 - match (a_is_dir, b_is_dir) with 345 345 - | true, false -> -1 346 346 - | false, true -> 1 347 347 - | _ -> String.compare a b) 348 348 - entries 349 349 - in 350 350 - List.iter 351 351 - (fun (name, is_dir, size) -> 352 352 - let display = if is_dir then name ^ "/" else name in 353 353 - let href = if is_dir then name ^ "/" else name in 354 354 - let size_str = 355 355 - if is_dir then "-" 356 356 - else if size < 1024 then Printf.sprintf "%dB" size 357 357 - else if size < 1024 * 1024 then 358 358 - Printf.sprintf "%.1fK" (float size /. 1024.) 359 359 - else Printf.sprintf "%.1fM" (float size /. 1024. /. 1024.) 360 360 - in 361 361 - Printf.bprintf buf 362 362 - "<tr><td><a href=\"%s\">%s</a></td><td class=\"size\">%s</td></tr>\n" 363 363 - (html_escape href) (html_escape display) size_str) 364 364 - sorted; 365 365 - Buffer.add_string buf 366 366 - "</tbody></table>\n<hr><p><em>hs (HCS)</em></p>\n</body></html>\n"; 367 367 - Buffer.contents buf 368 368 - 369 369 - let normalize_path path = 370 370 - let path = 371 371 - if String.length path > 0 && path.[0] = '/' then 372 372 - String.sub path 1 (String.length path - 1) 373 373 - else path 374 374 - in 375 375 - let path = 376 376 - match String.index_opt path '?' with 377 377 - | Some i -> String.sub path 0 i 378 378 - | None -> path 379 379 - in 380 380 - let path = 381 381 - match String.index_opt path '#' with 382 382 - | Some i -> String.sub path 0 i 383 383 - | None -> path 384 384 - in 385 385 - let segments = String.split_on_char '/' path in 386 386 - let rec check acc = function 387 387 - | [] -> Some (String.concat "/" (List.rev acc)) 388 388 - | ".." :: _ -> None 389 389 - | "." :: rest -> check acc rest 390 390 - | "" :: rest -> check acc rest 391 391 - | seg :: rest -> 392 392 - if String.contains seg '\x00' then None else check (seg :: acc) rest 393 393 - in 394 394 - check [] segments 395 395 - 396 396 - type static_config = { index : string list; listing : bool; dotfiles : bool } 397 397 - 398 398 - let default_static_config = 399 399 - { index = [ "index.html" ]; listing = false; dotfiles = false } 400 400 - 401 401 - let static_server ~(fs : _ Eio.Path.t) ?(config = default_static_config) 402 402 - (root : string) : request -> response = 403 403 - fun req -> 404 404 - match req.meth with 405 405 - | `GET | `HEAD -> ( 406 406 - match normalize_path req.target with 407 407 - | None -> Server.respond ~status:`Forbidden "Forbidden" 408 408 - | Some path -> ( 409 409 - if (not config.dotfiles) && string_starts_with ~prefix:"." path then 410 410 - Server.respond ~status:`Forbidden "Forbidden" 411 411 - else 412 412 - let full_path = Eio.Path.(fs / root / path) in 413 413 - try 414 414 - let stat = Eio.Path.stat ~follow:true full_path in 415 415 - match stat.kind with 416 416 - | `Directory -> ( 417 417 - let try_index () = 418 418 - List.find_map 419 419 - (fun idx -> 420 420 - try 421 421 - let idx_path = Eio.Path.(full_path / idx) in 422 422 - Some (Eio.Path.load idx_path, idx) 423 423 - with _ -> None) 424 424 - config.index 425 425 - in 426 426 - match try_index () with 427 427 - | Some (content, idx) -> 428 428 - let content_type = 429 429 - mime_type_of_extension (extension idx) 430 430 - in 431 431 - let body = 432 432 - if req.meth = `HEAD then Server.Body_empty 433 433 - else Server.Body_string content 434 434 - in 435 435 - { 436 436 - status = `OK; 437 437 - headers = 438 438 - [ 439 439 - ("Content-Type", content_type); 440 440 - ( "Content-Length", 441 441 - string_of_int (String.length content) ); 442 442 - ]; 443 443 - body; 444 444 - } 445 445 - | None -> 446 446 - if config.listing then begin 447 447 - let entries = 448 448 - Eio.Path.read_dir full_path 449 449 - |> List.filter_map (fun name -> 450 450 - if 451 451 - (not config.dotfiles) 452 452 - && String.length name > 0 453 453 - && name.[0] = '.' 454 454 - then None 455 455 - else 456 456 - try 457 457 - let child = Eio.Path.(full_path / name) in 458 458 - let st = Eio.Path.stat ~follow:true child in 459 459 - let is_dir = st.kind = `Directory in 460 460 - let size = Optint.Int63.to_int st.size in 461 461 - Some (name, is_dir, size) 462 462 - with _ -> None) 463 463 - in 464 464 - let html = directory_listing ~path entries in 465 465 - { 466 466 - status = `OK; 467 467 - headers = 468 468 - [ 469 469 - ("Content-Type", "text/html; charset=utf-8"); 470 470 - ( "Content-Length", 471 471 - string_of_int (String.length html) ); 472 472 - ]; 473 473 - body = Server.Body_string html; 474 474 - } 475 475 - end 476 476 - else 477 477 - Server.respond ~status:`Forbidden 478 478 - "Directory listing disabled") 479 479 - | `Regular_file -> 480 480 - let content = Eio.Path.load full_path in 481 481 - let content_type = mime_type_of_extension (extension path) in 482 482 - let body = 483 483 - if req.meth = `HEAD then Server.Body_empty 484 484 - else Server.Body_string content 485 485 - in 486 486 - { 487 487 - status = `OK; 488 488 - headers = 489 489 - [ 490 490 - ("Content-Type", content_type); 491 491 - ("Content-Length", string_of_int (String.length content)); 492 492 - ]; 493 493 - body; 494 494 - } 495 495 - | _ -> Server.respond ~status:`Forbidden "Not a file" 496 496 - with 497 497 - | Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> 498 498 - Server.respond ~status:`Not_found "Not Found" 499 499 - | Eio.Io (Eio.Fs.E (Eio.Fs.Permission_denied _), _) -> 500 500 - Server.respond ~status:`Forbidden "Permission Denied" 501 501 - | _ -> 502 502 - Server.respond ~status:`Internal_server_error 503 503 - "Internal Server Error")) 504 504 - | _ -> Server.respond ~status:`Method_not_allowed "Method Not Allowed" 505 505 - 506 506 - (** Static file middleware - serves files from a directory, falls back to next 507 507 - handler. 508 508 - 509 509 - @param fs The Eio filesystem to use 510 510 - @param root The root directory path for static files 511 511 - @param index 512 512 - Index files to try for directory requests (default: ["index.html"]) 513 513 - @param with_etag Whether to add ETag headers (default: true) *) 514 514 - let static ~(fs : _ Eio.Path.t) ?(index = [ "index.html" ]) ?(with_etag = true) 515 515 - (root : string) : middleware = 516 516 - fun handler req -> 517 517 - (* Only handle GET and HEAD *) 518 518 - match req.meth with 519 519 - | `GET | `HEAD -> ( 520 520 - (* Normalize and validate path to prevent directory traversal *) 521 521 - let path = req.target in 522 522 - let path = 523 523 - if String.length path > 0 && path.[0] = '/' then 524 524 - String.sub path 1 (String.length path - 1) 525 525 - else path 526 526 - in 527 527 - (* Remove query string *) 528 528 - let path = 529 529 - match String.index_opt path '?' with 530 530 - | Some i -> String.sub path 0 i 531 531 - | None -> path 532 532 - in 533 533 - (* Check for directory traversal *) 534 534 - if String.contains path '\x00' || string_starts_with ~prefix:".." path 535 535 - then handler req (* Pass to next handler *) 536 536 - else 537 537 - let full_path = Eio.Path.(fs / root / path) in 538 538 - try 539 539 - (* Try to read the file *) 540 540 - let content = Eio.Path.load full_path in 541 541 - let content_type = mime_type_of_extension (extension path) in 542 542 - let headers = 543 543 - [ 544 544 - ("Content-Type", content_type); 545 545 - ("Content-Length", string_of_int (String.length content)); 546 546 - ] 547 547 - in 548 548 - let headers = 549 549 - if with_etag then ("ETag", generate_etag content) :: headers 550 550 - else headers 551 551 - in 552 552 - (* Handle If-None-Match *) 553 553 - let if_none_match = 554 554 - List.find_opt 555 555 - (fun (n, _) -> String.lowercase_ascii n = "if-none-match") 556 556 - req.headers 557 557 - |> Option.map snd 558 558 - in 559 559 - let etag_value = generate_etag content in 560 560 - match if_none_match with 561 561 - | Some client_etag when String.equal client_etag etag_value -> 562 562 - { 563 563 - status = `Code 304; 564 564 - headers = [ ("ETag", etag_value) ]; 565 565 - body = Server.Body_empty; 566 566 - } 567 567 - | _ -> 568 568 - let body = 569 569 - if req.meth = `HEAD then Server.Body_empty 570 570 - else Server.Body_string content 571 571 - in 572 572 - { status = `OK; headers; body } 573 573 - with 574 574 - | Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) -> ( 575 575 - (* Try index files if path looks like a directory *) 576 576 - let try_index () = 577 577 - List.find_map 578 578 - (fun idx -> 579 579 - try 580 580 - let idx_path = Eio.Path.(fs / root / path / idx) in 581 581 - let content = Eio.Path.load idx_path in 582 582 - Some (idx, content) 583 583 - with _ -> None) 584 584 - index 585 585 - in 586 586 - match try_index () with 587 587 - | Some (idx, content) -> 588 588 - let content_type = mime_type_of_extension (extension idx) in 589 589 - let headers = 590 590 - [ 591 591 - ("Content-Type", content_type); 592 592 - ("Content-Length", string_of_int (String.length content)); 593 593 - ] 594 594 - in 595 595 - let body = 596 596 - if req.meth = `HEAD then Server.Body_empty 597 597 - else Server.Body_string content 598 598 - in 599 599 - { status = `OK; headers; body } 600 600 - | None -> handler req) 601 601 - | _ -> handler req) 602 602 - | _ -> handler req 603 603 - 604 604 - (** {1 Compression} *) 605 605 - 606 606 - type compression = Gzip | Zstd | Identity 607 607 - 608 608 - let parse_accept_encoding (req : request) : compression list = 609 609 - let header = 610 610 - List.find_opt 611 611 - (fun (n, _) -> String.lowercase_ascii n = "accept-encoding") 612 612 - req.headers 613 613 - |> Option.map snd |> Option.value ~default:"" 614 614 - in 615 615 - let encodings = String.split_on_char ',' header in 616 616 - List.filter_map 617 617 - (fun s -> 618 618 - let s = String.trim (String.lowercase_ascii s) in 619 619 - let encoding = 620 620 - match String.index_opt s ';' with 621 621 - | Some i -> String.sub s 0 i |> String.trim 622 622 - | None -> s 623 623 - in 624 624 - match encoding with 625 625 - | "zstd" -> Some Zstd 626 626 - | "gzip" -> Some Gzip 627 627 - | "identity" | "*" -> Some Identity 628 628 - | _ -> None) 629 629 - encodings 630 630 - 631 631 - open Bytesrw 632 632 - 633 633 - let reader_of_body_stream (next : unit -> Cstruct.t option) : Bytes.Reader.t = 634 634 - let read () = 635 635 - match next () with 636 636 - | None -> Bytes.Slice.eod 637 637 - | Some cs -> 638 638 - if Cstruct.length cs = 0 then Bytes.Slice.eod 639 639 - else 640 640 - let b = Stdlib.Bytes.create (Cstruct.length cs) in 641 641 - Cstruct.blit_to_bytes cs 0 b 0 (Cstruct.length cs); 642 642 - Bytes.Slice.of_bytes b 643 643 - in 644 644 - Bytes.Reader.make read 645 645 - 646 646 - let body_stream_of_reader (reader : Bytes.Reader.t) : unit -> Cstruct.t option = 647 647 - fun () -> 648 648 - let slice = Bytes.Reader.read reader in 649 649 - if Bytes.Slice.is_eod slice then None 650 650 - else 651 651 - let len = Bytes.Slice.length slice in 652 652 - let b = Bytes.Slice.bytes slice in 653 653 - let first = Bytes.Slice.first slice in 654 654 - let cs = Cstruct.create len in 655 655 - Cstruct.blit_from_bytes b first cs 0 len; 656 656 - Some cs 657 657 - 658 658 - let gzip_compress ?(level = 6) (data : string) : string = 659 659 - let reader = Bytes.Reader.of_string data in 660 660 - let compressed = Bytesrw_zlib.Gzip.compress_reads ~level () reader in 661 661 - Bytes.Reader.to_string compressed 662 662 - 663 663 - let gzip_decompress (data : string) : string = 664 664 - let reader = Bytes.Reader.of_string data in 665 665 - let decompressed = Bytesrw_zlib.Gzip.decompress_reads () reader in 666 666 - Bytes.Reader.to_string decompressed 667 667 - 668 668 - let zstd_compress ?(level = 3) (data : string) : string = 669 669 - let reader = Bytes.Reader.of_string data in 670 670 - let params = Bytesrw_zstd.Cctx_params.make ~clevel:level () in 671 671 - let compressed = Bytesrw_zstd.compress_reads ~params () reader in 672 672 - Bytes.Reader.to_string compressed 673 673 - 674 674 - let zstd_decompress (data : string) : string = 675 675 - let reader = Bytes.Reader.of_string data in 676 676 - let decompressed = Bytesrw_zstd.decompress_reads () reader in 677 677 - Bytes.Reader.to_string decompressed 678 678 - 679 679 - let gzip_compress_stream ?(level = 6) (next : unit -> Cstruct.t option) : 680 680 - unit -> Cstruct.t option = 681 681 - let reader = reader_of_body_stream next in 682 682 - let compressed = Bytesrw_zlib.Gzip.compress_reads ~level () reader in 683 683 - body_stream_of_reader compressed 684 684 - 685 685 - let gzip_decompress_stream (next : unit -> Cstruct.t option) : 686 686 - unit -> Cstruct.t option = 687 687 - let reader = reader_of_body_stream next in 688 688 - let decompressed = Bytesrw_zlib.Gzip.decompress_reads () reader in 689 689 - body_stream_of_reader decompressed 690 690 - 691 691 - let zstd_compress_stream ?(level = 3) (next : unit -> Cstruct.t option) : 692 692 - unit -> Cstruct.t option = 693 693 - let reader = reader_of_body_stream next in 694 694 - let params = Bytesrw_zstd.Cctx_params.make ~clevel:level () in 695 695 - let compressed = Bytesrw_zstd.compress_reads ~params () reader in 696 696 - body_stream_of_reader compressed 697 697 - 698 698 - let zstd_decompress_stream (next : unit -> Cstruct.t option) : 699 699 - unit -> Cstruct.t option = 700 700 - let reader = reader_of_body_stream next in 701 701 - let decompressed = Bytesrw_zstd.decompress_reads () reader in 702 702 - body_stream_of_reader decompressed 703 703 - 704 704 - let compress_body (encoding : compression) (body : string) : string * string = 705 705 - match encoding with 706 706 - | Gzip -> (gzip_compress body, "gzip") 707 707 - | Zstd -> (zstd_compress body, "zstd") 708 708 - | Identity -> (body, "identity") 709 709 - 710 710 - let select_encoding encodings = 711 711 - let dominated = ref false in 712 712 - List.find_opt 713 713 - (fun enc -> 714 714 - if !dominated then false 715 715 - else 716 716 - match enc with 717 717 - | Zstd -> true 718 718 - | Gzip -> true 719 719 - | Identity -> 720 720 - dominated := true; 721 721 - false) 722 722 - encodings 723 723 - 724 724 - let compress_stream_headers ~encoding_name headers = 725 725 - ("Content-Encoding", encoding_name) 726 726 - :: ("Vary", "Accept-Encoding") 727 727 - :: List.filter 728 728 - (fun (n, _) -> 729 729 - let n = String.lowercase_ascii n in 730 730 - n <> "content-length" && n <> "content-encoding") 731 731 - headers 732 732 - 733 733 - let compress ?(min_size = 256) ?(level = 6) : middleware = 734 734 - fun handler req -> 735 735 - let encodings = parse_accept_encoding req in 736 736 - let resp = handler req in 737 737 - match resp.body with 738 738 - | Server.Body_stream { content_length = _; next } -> 739 739 - if List.is_empty encodings then resp 740 740 - else begin 741 741 - match select_encoding encodings with 742 742 - | Some Gzip -> 743 743 - let compressed_next = gzip_compress_stream ~level next in 744 744 - let headers = 745 745 - compress_stream_headers ~encoding_name:"gzip" resp.headers 746 746 - in 747 747 - { 748 748 - resp with 749 749 - headers; 750 750 - body = 751 751 - Server.Body_stream 752 752 - { content_length = None; next = compressed_next }; 753 753 - } 754 754 - | Some Zstd -> 755 755 - let compressed_next = zstd_compress_stream ~level next in 756 756 - let headers = 757 757 - compress_stream_headers ~encoding_name:"zstd" resp.headers 758 758 - in 759 759 - { 760 760 - resp with 761 761 - headers; 762 762 - body = 763 763 - Server.Body_stream 764 764 - { content_length = None; next = compressed_next }; 765 765 - } 766 766 - | Some Identity | None -> resp 767 767 - end 768 768 - | _ -> 769 769 - let body_str = response_body_string resp in 770 770 - let body_size = String.length body_str in 771 771 - if body_size < min_size || List.is_empty encodings then resp 772 772 - else begin 773 773 - match select_encoding encodings with 774 774 - | None -> resp 775 775 - | Some encoding -> 776 776 - let compressed, encoding_name = 777 777 - match encoding with 778 778 - | Gzip -> (gzip_compress ~level body_str, "gzip") 779 779 - | Zstd -> (zstd_compress ~level body_str, "zstd") 780 780 - | Identity -> (body_str, "identity") 781 781 - in 782 782 - if String.length compressed >= body_size then resp 783 783 - else 784 784 - let headers = 785 785 - ("Content-Encoding", encoding_name) 786 786 - :: ("Vary", "Accept-Encoding") 787 787 - :: List.filter 788 788 - (fun (n, _) -> 789 789 - let n = String.lowercase_ascii n in 790 790 - n <> "content-length" && n <> "content-encoding") 791 791 - resp.headers 792 792 - in 793 793 - let headers = 794 794 - ("Content-Length", string_of_int (String.length compressed)) 795 795 - :: headers 796 796 - in 797 797 - { resp with headers; body = Server.Body_string compressed } 798 798 - end 799 799 - 800 800 - let accepts_gzip (req : request) = 801 801 - List.exists (fun enc -> enc = Gzip) (parse_accept_encoding req) 802 802 - 803 803 - let accepts_zstd (req : request) = 804 804 - List.exists (fun enc -> enc = Zstd) (parse_accept_encoding req) 805 805 - 806 806 - let get_content_encoding (req : request) : compression option = 807 807 - match 808 808 - List.find_opt 809 809 - (fun (n, _) -> String.lowercase_ascii n = "content-encoding") 810 810 - req.headers 811 811 - with 812 812 - | None -> None 813 813 - | Some (_, v) -> ( 814 814 - match String.lowercase_ascii (String.trim v) with 815 815 - | "gzip" -> Some Gzip 816 816 - | "zstd" -> Some Zstd 817 817 - | "identity" -> Some Identity 818 818 - | _ -> None) 819 819 - 820 820 - let decompress_request : middleware = 821 821 - fun handler req -> 822 822 - match get_content_encoding req with 823 823 - | None | Some Identity -> handler req 824 824 - | Some Gzip -> 825 825 - let decompressed = gzip_decompress req.body in 826 826 - let headers = 827 827 - List.filter 828 828 - (fun (n, _) -> 829 829 - let n = String.lowercase_ascii n in 830 830 - n <> "content-encoding" && n <> "content-length") 831 831 - req.headers 832 832 - in 833 833 - let headers = 834 834 - ("Content-Length", string_of_int (String.length decompressed)) 835 835 - :: headers 836 836 - in 837 837 - handler { req with body = decompressed; headers } 838 838 - | Some Zstd -> 839 839 - let decompressed = zstd_decompress req.body in 840 840 - let headers = 841 841 - List.filter 842 842 - (fun (n, _) -> 843 843 - let n = String.lowercase_ascii n in 844 844 - n <> "content-encoding" && n <> "content-length") 845 845 - req.headers 846 846 - in 847 847 - let headers = 848 848 - ("Content-Length", string_of_int (String.length decompressed)) 849 849 - :: headers 850 850 - in 851 851 - handler { req with body = decompressed; headers }

+212

lib/multipart.ml

reviewed

··· 1 1 + (** Multipart form data parsing. 2 2 + 3 3 + {[ 4 4 + (* Non-streaming *) 5 5 + match Multipart.parse req with 6 6 + | Ok parts -> Multipart.find_part "name" parts 7 7 + | Error e -> Response.bad_request (Multipart.error_to_string e) 8 8 + 9 9 + (* Streaming large files *) 10 10 + match Multipart.create_parser req with 11 11 + | Ok parser -> 12 12 + Multipart.iter_parts (fun part -> 13 13 + Stream.Async.iter write_chunk part.body 14 14 + ) parser 15 15 + | Error e -> ... 16 16 + ]} *) 17 17 + 18 18 + module Hmf = Http_multipart_formdata 19 19 + 20 20 + type part = { 21 21 + name : string; 22 22 + filename : string option; 23 23 + content_type : string; 24 24 + data : string; 25 25 + } 26 26 + 27 27 + type error = 28 28 + | Missing_content_type 29 29 + | Not_multipart 30 30 + | Missing_boundary 31 31 + | Invalid_boundary of string 32 32 + | Parse_error of string 33 33 + 34 34 + let error_to_string = function 35 35 + | Missing_content_type -> "Missing Content-Type header" 36 36 + | Not_multipart -> "Content-Type is not multipart/form-data" 37 37 + | Missing_boundary -> "Missing boundary parameter in Content-Type" 38 38 + | Invalid_boundary msg -> "Invalid boundary: " ^ msg 39 39 + | Parse_error msg -> "Parse error: " ^ msg 40 40 + 41 41 + let is_multipart (req : Request.t) = 42 42 + match Request.content_type req with 43 43 + | None -> false 44 44 + | Some ct -> 45 45 + let ct_lower = String.lowercase_ascii ct in 46 46 + let prefix = "multipart/form-data" in 47 47 + String.length ct_lower >= String.length prefix 48 48 + && String.sub ct_lower 0 (String.length prefix) = prefix 49 49 + 50 50 + let boundary (req : Request.t) : (Hmf.boundary, error) result = 51 51 + match Request.content_type req with 52 52 + | None -> Error Missing_content_type 53 53 + | Some ct -> ( 54 54 + if not (is_multipart req) then Error Not_multipart 55 55 + else 56 56 + match Hmf.boundary ct with 57 57 + | Ok b -> Ok b 58 58 + | Error msg -> 59 59 + if String.length msg > 0 && msg.[0] = '\'' then 60 60 + Error Missing_boundary 61 61 + else Error (Invalid_boundary msg)) 62 62 + 63 63 + let parse (req : Request.t) : (part list, error) result = 64 64 + match boundary req with 65 65 + | Error e -> Error e 66 66 + | Ok b -> ( 67 67 + let body = Request.body req in 68 68 + match Hmf.parts b body with 69 69 + | Error msg -> Error (Parse_error msg) 70 70 + | Ok parts -> 71 71 + Ok 72 72 + (List.map 73 73 + (fun (_name, (header, body)) -> 74 74 + { 75 75 + name = Hmf.name header; 76 76 + filename = Hmf.filename header; 77 77 + content_type = Hmf.content_type header; 78 78 + data = body; 79 79 + }) 80 80 + parts)) 81 81 + 82 82 + let find_part name parts = List.find_opt (fun p -> p.name = name) parts 83 83 + 84 84 + let find_file name parts = 85 85 + List.find_opt (fun p -> p.name = name && Option.is_some p.filename) parts 86 86 + 87 87 + let to_assoc parts : (string * part) list = 88 88 + List.map (fun p -> (p.name, p)) parts 89 89 + 90 90 + type stream_part = { 91 91 + name : string; 92 92 + filename : string option; 93 93 + content_type : string; 94 94 + body : Cstruct.t Stream.Async.t; 95 95 + } 96 96 + 97 97 + type parser = { 98 98 + reader : Hmf.reader; 99 99 + body_stream : unit -> Cstruct.t option; 100 100 + mutable current_state : Hmf.read; 101 101 + mutable finished : bool; 102 102 + } 103 103 + 104 104 + let create_parser (req : Request.t) : (parser, error) result = 105 105 + match boundary req with 106 106 + | Error e -> Error e 107 107 + | Ok b -> 108 108 + let body_stream = 109 109 + Request.body_reader req |> fun r -> r.H1_server.read_stream 110 110 + in 111 111 + let reader = Hmf.reader b `Incremental in 112 112 + let current_state = Hmf.read reader in 113 113 + Ok { reader; body_stream; current_state; finished = false } 114 114 + 115 115 + let rec advance_state parser = 116 116 + match parser.current_state with 117 117 + | `Awaiting_input continue -> ( 118 118 + match parser.body_stream () with 119 119 + | None -> 120 120 + parser.current_state <- continue `Eof; 121 121 + advance_state parser 122 122 + | Some chunk -> 123 123 + parser.current_state <- continue (`Cstruct chunk); 124 124 + advance_state parser) 125 125 + | other -> other 126 126 + 127 127 + let make_body_stream parser : Cstruct.t Stream.Async.t = 128 128 + let finished = ref false in 129 129 + fun () -> 130 130 + if !finished then None 131 131 + else 132 132 + let rec read_body () = 133 133 + match advance_state parser with 134 134 + | `Body chunk -> 135 135 + parser.current_state <- Hmf.read parser.reader; 136 136 + Some chunk 137 137 + | `Body_end -> 138 138 + finished := true; 139 139 + parser.current_state <- Hmf.read parser.reader; 140 140 + None 141 141 + | `End -> 142 142 + finished := true; 143 143 + parser.finished <- true; 144 144 + None 145 145 + | `Error _ -> 146 146 + finished := true; 147 147 + parser.finished <- true; 148 148 + None 149 149 + | `Header _ -> 150 150 + finished := true; 151 151 + None 152 152 + | `Awaiting_input _ -> read_body () 153 153 + in 154 154 + read_body () 155 155 + 156 156 + let next_part parser : stream_part option = 157 157 + if parser.finished then None 158 158 + else 159 159 + let rec find_header () = 160 160 + match advance_state parser with 161 161 + | `Header header -> 162 162 + parser.current_state <- Hmf.read parser.reader; 163 163 + let body = make_body_stream parser in 164 164 + Some 165 165 + { 166 166 + name = Hmf.name header; 167 167 + filename = Hmf.filename header; 168 168 + content_type = Hmf.content_type header; 169 169 + body; 170 170 + } 171 171 + | `End -> 172 172 + parser.finished <- true; 173 173 + None 174 174 + | `Error _ -> 175 175 + parser.finished <- true; 176 176 + None 177 177 + | `Body _ | `Body_end -> 178 178 + parser.current_state <- Hmf.read parser.reader; 179 179 + find_header () 180 180 + | `Awaiting_input _ -> find_header () 181 181 + in 182 182 + find_header () 183 183 + 184 184 + let iter_parts f parser : (unit, error) result = 185 185 + let rec loop () = 186 186 + match next_part parser with 187 187 + | None -> 188 188 + if parser.finished then Ok () else Error (Parse_error "Unexpected end") 189 189 + | Some part -> 190 190 + f part; 191 191 + Stream.Async.drain part.body; 192 192 + loop () 193 193 + in 194 194 + loop () 195 195 + 196 196 + let fold_parts f init parser = 197 197 + let rec loop acc = 198 198 + match next_part parser with 199 199 + | None -> 200 200 + if parser.finished then Ok acc else Error (Parse_error "Unexpected end") 201 201 + | Some part -> 202 202 + let acc' = f part acc in 203 203 + Stream.Async.drain part.body; 204 204 + loop acc' 205 205 + in 206 206 + loop init 207 207 + 208 208 + let collect_body (part : stream_part) : string = 209 209 + Stream.Async.cstructs_to_string part.body 210 210 + 211 211 + let parse_assoc req = 212 212 + match parse req with Error e -> Error e | Ok parts -> Ok (to_assoc parts)

+13 -5

lib/plug/csrf.ml

reviewed

··· 61 61 match String.index_opt pair '=' with 62 62 | None -> None 63 63 | Some i -> 64 64 - let name = String.sub pair 0 i in 64 64 + let name = Uri.pct_decode (String.sub pair 0 i) in 65 65 if name = field_name then 66 66 - Some (String.sub pair (i + 1) (String.length pair - i - 1)) 66 66 + Some 67 67 + (Uri.pct_decode 68 68 + (String.sub pair (i + 1) (String.length pair - i - 1))) 67 69 else None) 68 70 pairs 69 71 else None ··· 111 113 let create ?(config = default_config) () : Core.t = 112 114 fun handler req -> 113 115 if is_safe_method req.meth then begin 114 114 - (* Safe method - ensure cookie is set *) 116 116 + (* Safe method - ensure cookie is set and token is in session *) 117 117 + let existing_cookie = 118 118 + get_cookie_token ~cookie_name:config.cookie_name req 119 119 + in 120 120 + let token = 121 121 + match existing_cookie with Some t -> t | None -> generate_token () 122 122 + in 123 123 + (try Session.put config.field_name token with Failure _ -> ()); 115 124 let resp = handler req in 116 116 - match get_cookie_token ~cookie_name:config.cookie_name req with 125 125 + match existing_cookie with 117 126 | Some _ -> resp 118 127 | None -> 119 119 - let token = generate_token () in 120 128 let cookie = make_cookie ~config token in 121 129 { resp with headers = ("Set-Cookie", cookie) :: resp.headers } 122 130 end

+6 -1

lib/plug/session.ml

reviewed

··· 151 151 (if config.http_only then "; HttpOnly" else "") 152 152 same_site 153 153 154 154 - let generate_id () = Token.b64_encode (Mirage_crypto_rng.generate 16) 154 154 + let generate_id () = 155 155 + let b = Bytes.create 16 in 156 156 + for i = 0 to 15 do 157 157 + Bytes.set b i (Char.chr (Random.int 256)) 158 158 + done; 159 159 + Token.b64_encode (Bytes.unsafe_to_string b) 155 160 156 161 (** Create session plug with configurable storage and cookie options. *) 157 162 let create ~store ?(cookie_name = "_session") ?(secure = true)

+7 -1

lib/plug/token.ml

reviewed

··· 146 146 if String.length secret >= 32 then String.sub secret 0 32 147 147 else Digestif.SHA256.(digest_string secret |> to_raw_string) 148 148 in 149 149 - let nonce = Mirage_crypto_rng.generate 12 in 149 149 + let nonce = 150 150 + let b = Bytes.create 12 in 151 151 + for i = 0 to 11 do 152 152 + Bytes.set b i (Char.chr (Random.int 256)) 153 153 + done; 154 154 + Bytes.unsafe_to_string b 155 155 + in 150 156 let key = Mirage_crypto.AES.GCM.of_secret aes_key in 151 157 let ciphertext = 152 158 Mirage_crypto.AES.GCM.authenticate_encrypt ~key ~nonce data

+4 -4

test/dune

reviewed

··· 6 6 (test 7 7 (name test_plug) 8 8 (package hcs) 9 9 - (libraries hcs alcotest eio_main mirage-crypto-rng.unix)) 9 9 + (libraries hcs alcotest eio_main)) 10 10 11 11 (executable 12 12 (name test_client_integration) 13 13 - (libraries hcs eio_main mirage-crypto-rng-eio) 13 13 + (libraries hcs eio_main) 14 14 (modules test_client_integration)) 15 15 16 16 (executable 17 17 (name test_alpn_server) 18 18 - (libraries hcs eio_main mirage-crypto-rng-eio mirage-crypto-rng.unix) 18 18 + (libraries hcs eio_main) 19 19 (modules test_alpn_server)) 20 20 21 21 (executable 22 22 (name test_alpn_client) 23 23 - (libraries hcs eio_main mirage-crypto-rng-eio mirage-crypto-rng.unix) 23 23 + (libraries hcs eio_main) 24 24 (modules test_alpn_client))

+1 -3

test/test_alpn_client.ml

reviewed

··· 62 62 Eio.traceln "Error: %s" msg) 63 63 urls 64 64 65 65 - let () = 66 66 - Mirage_crypto_rng_unix.use_default (); 67 67 - test_external_servers () 65 65 + let () = test_external_servers ()

-1

test/test_alpn_server.ml

reviewed

··· 1 1 let () = 2 2 - Mirage_crypto_rng_unix.use_default (); 3 2 Eio_main.run @@ fun env -> 4 3 let net = Eio.Stdenv.net env in 5 4 Eio.Switch.run @@ fun sw ->

+1 -5

test/test_client_integration.ml

reviewed

··· 179 179 Printf.printf "HCS HTTP Client Integration Tests\n"; 180 180 Printf.printf "Using httpbin at: %s\n\n" httpbin_url; 181 181 182 182 - Eio_main.run @@ fun env -> 183 183 - (Mirage_crypto_rng_eio.run [@alert "-deprecated"]) 184 184 - (module Mirage_crypto_rng.Fortuna) 185 185 - env 186 186 - @@ run_tests env 182 182 + Eio_main.run @@ fun env -> run_tests env ()

-291

test/test_hcs.ml

reviewed

··· 5 5 - Stream module (sync and async streams) 6 6 - Http module (request builder DSL) 7 7 - Router module (path parsing, route matching) 8 8 - - Middleware module (composition, conditional) 9 8 - Property-based tests using QCheck *) 10 9 11 10 open Alcotest ··· 602 601 end 603 602 604 603 (* ================================================================== *) 605 605 - (* Middleware Tests *) 606 606 - (* ================================================================== *) 607 607 - 608 608 - module Test_middleware = struct 609 609 - open Hcs.Middleware 610 610 - 611 611 - let test_identity () = 612 612 - let handler x = x + 1 in 613 613 - let wrapped = apply identity handler in 614 614 - check int "identity" 2 (wrapped 1) 615 615 - 616 616 - let test_compose () = 617 617 - let m1 : (int, int) t = fun next x -> next (x * 2) in 618 618 - let m2 : (int, int) t = fun next x -> next (x + 1) in 619 619 - let composed = compose m1 m2 in 620 620 - let handler x = x in 621 621 - let result = apply composed handler 5 in 622 622 - (* m1 runs first: 5 * 2 = 10, then m2: 10 + 1 = 11 *) 623 623 - check int "compose" 11 result 624 624 - 625 625 - let test_compose_all () = 626 626 - let m1 : (int, int) t = fun next x -> next (x * 2) in 627 627 - let m2 : (int, int) t = fun next x -> next (x + 1) in 628 628 - let m3 : (int, int) t = fun next x -> next (x - 3) in 629 629 - let composed = compose_all [ m1; m2; m3 ] in 630 630 - let handler x = x in 631 631 - let result = apply composed handler 5 in 632 632 - (* m1: 5 * 2 = 10, m2: 10 + 1 = 11, m3: 11 - 3 = 8 *) 633 633 - check int "compose_all" 8 result 634 634 - 635 635 - let test_infix_compose () = 636 636 - let m1 : (int, int) t = fun next x -> next (x * 2) in 637 637 - let m2 : (int, int) t = fun next x -> next (x + 1) in 638 638 - let composed = m1 @> m2 in 639 639 - let handler x = x in 640 640 - check int "infix" 11 (apply composed handler 5) 641 641 - 642 642 - let tests = 643 643 - [ 644 644 - test_case "identity" `Quick test_identity; 645 645 - test_case "compose" `Quick test_compose; 646 646 - test_case "compose_all" `Quick test_compose_all; 647 647 - test_case "infix compose" `Quick test_infix_compose; 648 648 - ] 649 649 - end 650 650 - 651 651 - (* ================================================================== *) 652 604 (* Log Tests *) 653 605 (* ================================================================== *) 654 606 ··· 930 882 let open Hcs.Http in 931 883 meth_to_string (meth_of_string m) = m) 932 884 933 933 - (* Middleware properties *) 934 934 - let prop_middleware_identity = 935 935 - QCheck.Test.make ~name:"middleware identity is neutral" ~count:100 936 936 - QCheck.int (fun x -> 937 937 - let open Hcs.Middleware in 938 938 - let handler n = n + 1 in 939 939 - apply identity handler x = handler x) 940 940 - 941 941 - let prop_middleware_compose_associative = 942 942 - QCheck.Test.make ~name:"middleware compose is associative" ~count:100 943 943 - QCheck.nat_small (fun x -> 944 944 - let open Hcs.Middleware in 945 945 - let m1 : (int, int) t = fun next n -> next (n + 1) in 946 946 - let m2 : (int, int) t = fun next n -> next (n * 2) in 947 947 - let m3 : (int, int) t = fun next n -> next (n - 3) in 948 948 - let handler n = n in 949 949 - let left = apply (compose (compose m1 m2) m3) handler x in 950 950 - let right = apply (compose m1 (compose m2 m3)) handler x in 951 951 - left = right) 952 952 - 953 885 let tests = 954 886 List.map QCheck_alcotest.to_alcotest 955 887 [ ··· 961 893 prop_sync_fold_sum; 962 894 prop_router_param_extraction; 963 895 prop_http_method_roundtrip; 964 964 - prop_middleware_identity; 965 965 - prop_middleware_compose_associative; 966 896 ] 967 897 end 968 898 969 899 (* ================================================================== *) 970 970 - (* Compression Tests *) 971 971 - (* ================================================================== *) 972 972 - 973 973 - module Test_compression = struct 974 974 - open Hcs.Middleware_eio 975 975 - 976 976 - let test_gzip_roundtrip () = 977 977 - let original = "Hello, World! This is a test string for compression." in 978 978 - let compressed = gzip_compress original in 979 979 - let decompressed = gzip_decompress compressed in 980 980 - check string "roundtrip" original decompressed 981 981 - 982 982 - let test_gzip_reduces_size () = 983 983 - let original = String.make 1000 'a' in 984 984 - let compressed = gzip_compress original in 985 985 - check bool "compressed smaller" true 986 986 - (String.length compressed < String.length original) 987 987 - 988 988 - let test_zstd_roundtrip () = 989 989 - let original = "Hello, World! This is a test string for compression." in 990 990 - let compressed = zstd_compress original in 991 991 - let decompressed = zstd_decompress compressed in 992 992 - check string "roundtrip" original decompressed 993 993 - 994 994 - let test_zstd_reduces_size () = 995 995 - let original = String.make 1000 'a' in 996 996 - let compressed = zstd_compress original in 997 997 - check bool "compressed smaller" true 998 998 - (String.length compressed < String.length original) 999 999 - 1000 1000 - let test_parse_accept_encoding_gzip () = 1001 1001 - let req : Hcs.Server.request = 1002 1002 - { 1003 1003 - meth = `GET; 1004 1004 - target = "/"; 1005 1005 - version = Hcs.Server.HTTP_1_1; 1006 1006 - headers = [ ("Accept-Encoding", "gzip, deflate") ]; 1007 1007 - body = ""; 1008 1008 - } 1009 1009 - in 1010 1010 - let encodings = parse_accept_encoding req in 1011 1011 - check bool "has gzip" true (List.exists (fun e -> e = Gzip) encodings) 1012 1012 - 1013 1013 - let test_parse_accept_encoding_zstd () = 1014 1014 - let req : Hcs.Server.request = 1015 1015 - { 1016 1016 - meth = `GET; 1017 1017 - target = "/"; 1018 1018 - version = Hcs.Server.HTTP_1_1; 1019 1019 - headers = [ ("Accept-Encoding", "zstd, gzip") ]; 1020 1020 - body = ""; 1021 1021 - } 1022 1022 - in 1023 1023 - let encodings = parse_accept_encoding req in 1024 1024 - check bool "has zstd" true (List.exists (fun e -> e = Zstd) encodings); 1025 1025 - check bool "zstd is first" true (List.hd encodings = Zstd) 1026 1026 - 1027 1027 - let test_accepts_gzip () = 1028 1028 - let req : Hcs.Server.request = 1029 1029 - { 1030 1030 - meth = `GET; 1031 1031 - target = "/"; 1032 1032 - version = Hcs.Server.HTTP_1_1; 1033 1033 - headers = [ ("Accept-Encoding", "gzip") ]; 1034 1034 - body = ""; 1035 1035 - } 1036 1036 - in 1037 1037 - check bool "accepts gzip" true (accepts_gzip req) 1038 1038 - 1039 1039 - let test_accepts_zstd () = 1040 1040 - let req : Hcs.Server.request = 1041 1041 - { 1042 1042 - meth = `GET; 1043 1043 - target = "/"; 1044 1044 - version = Hcs.Server.HTTP_1_1; 1045 1045 - headers = [ ("Accept-Encoding", "zstd") ]; 1046 1046 - body = ""; 1047 1047 - } 1048 1048 - in 1049 1049 - check bool "accepts zstd" true (accepts_zstd req) 1050 1050 - 1051 1051 - let test_no_accept_encoding () = 1052 1052 - let req : Hcs.Server.request = 1053 1053 - { 1054 1054 - meth = `GET; 1055 1055 - target = "/"; 1056 1056 - version = Hcs.Server.HTTP_1_1; 1057 1057 - headers = []; 1058 1058 - body = ""; 1059 1059 - } 1060 1060 - in 1061 1061 - check bool "no gzip" false (accepts_gzip req); 1062 1062 - check bool "no zstd" false (accepts_zstd req) 1063 1063 - 1064 1064 - let test_gzip_stream_roundtrip () = 1065 1065 - let original = "Hello, World! This is a test for streaming compression." in 1066 1066 - let chunks = 1067 1067 - [ 1068 1068 - Cstruct.of_string "Hello, "; 1069 1069 - Cstruct.of_string "World! "; 1070 1070 - Cstruct.of_string "This is a test "; 1071 1071 - Cstruct.of_string "for streaming compression."; 1072 1072 - ] 1073 1073 - in 1074 1074 - let chunk_list = ref chunks in 1075 1075 - let next () = 1076 1076 - match !chunk_list with 1077 1077 - | [] -> None 1078 1078 - | h :: t -> 1079 1079 - chunk_list := t; 1080 1080 - Some h 1081 1081 - in 1082 1082 - let compressed_next = gzip_compress_stream next in 1083 1083 - let compressed_chunks = ref [] in 1084 1084 - let rec collect () = 1085 1085 - match compressed_next () with 1086 1086 - | None -> () 1087 1087 - | Some chunk -> 1088 1088 - compressed_chunks := chunk :: !compressed_chunks; 1089 1089 - collect () 1090 1090 - in 1091 1091 - collect (); 1092 1092 - let compressed = 1093 1093 - !compressed_chunks |> List.rev |> List.map Cstruct.to_string 1094 1094 - |> String.concat "" 1095 1095 - in 1096 1096 - let decompressed = gzip_decompress compressed in 1097 1097 - check string "stream roundtrip" original decompressed 1098 1098 - 1099 1099 - let test_gzip_decompress_stream () = 1100 1100 - let original = "Streaming decompression test data" in 1101 1101 - let compressed = gzip_compress original in 1102 1102 - let compressed_cstruct = Cstruct.of_string compressed in 1103 1103 - let returned = ref false in 1104 1104 - let next () = 1105 1105 - if !returned then None 1106 1106 - else begin 1107 1107 - returned := true; 1108 1108 - Some compressed_cstruct 1109 1109 - end 1110 1110 - in 1111 1111 - let decompress_next = gzip_decompress_stream next in 1112 1112 - let decompressed_chunks = ref [] in 1113 1113 - let rec collect () = 1114 1114 - match decompress_next () with 1115 1115 - | None -> () 1116 1116 - | Some chunk -> 1117 1117 - if Cstruct.length chunk > 0 then 1118 1118 - decompressed_chunks := chunk :: !decompressed_chunks; 1119 1119 - collect () 1120 1120 - in 1121 1121 - collect (); 1122 1122 - let decompressed = 1123 1123 - !decompressed_chunks |> List.rev |> List.map Cstruct.to_string 1124 1124 - |> String.concat "" 1125 1125 - in 1126 1126 - check string "decompress stream" original decompressed 1127 1127 - 1128 1128 - let test_decompress_request_gzip () = 1129 1129 - let original_body = "Request body to be decompressed" in 1130 1130 - let compressed_body = gzip_compress original_body in 1131 1131 - let req : Hcs.Server.request = 1132 1132 - { 1133 1133 - meth = `POST; 1134 1134 - target = "/"; 1135 1135 - version = Hcs.Server.HTTP_1_1; 1136 1136 - headers = [ ("Content-Encoding", "gzip") ]; 1137 1137 - body = compressed_body; 1138 1138 - } 1139 1139 - in 1140 1140 - let captured_body = ref "" in 1141 1141 - let handler (r : Hcs.Server.request) = 1142 1142 - captured_body := r.Hcs.Server.body; 1143 1143 - Hcs.Server.respond "ok" 1144 1144 - in 1145 1145 - let _ = decompress_request handler req in 1146 1146 - check string "decompressed body" original_body !captured_body 1147 1147 - 1148 1148 - let test_decompress_request_zstd () = 1149 1149 - let original_body = "Request body compressed with zstd" in 1150 1150 - let compressed_body = zstd_compress original_body in 1151 1151 - let req : Hcs.Server.request = 1152 1152 - { 1153 1153 - meth = `POST; 1154 1154 - target = "/"; 1155 1155 - version = Hcs.Server.HTTP_1_1; 1156 1156 - headers = [ ("Content-Encoding", "zstd") ]; 1157 1157 - body = compressed_body; 1158 1158 - } 1159 1159 - in 1160 1160 - let captured_body = ref "" in 1161 1161 - let handler (r : Hcs.Server.request) = 1162 1162 - captured_body := r.Hcs.Server.body; 1163 1163 - Hcs.Server.respond "ok" 1164 1164 - in 1165 1165 - let _ = decompress_request handler req in 1166 1166 - check string "decompressed body" original_body !captured_body 1167 1167 - 1168 1168 - let tests = 1169 1169 - [ 1170 1170 - test_case "gzip roundtrip" `Quick test_gzip_roundtrip; 1171 1171 - test_case "gzip reduces size" `Quick test_gzip_reduces_size; 1172 1172 - test_case "zstd roundtrip" `Quick test_zstd_roundtrip; 1173 1173 - test_case "zstd reduces size" `Quick test_zstd_reduces_size; 1174 1174 - test_case "parse accept-encoding gzip" `Quick 1175 1175 - test_parse_accept_encoding_gzip; 1176 1176 - test_case "parse accept-encoding zstd" `Quick 1177 1177 - test_parse_accept_encoding_zstd; 1178 1178 - test_case "accepts_gzip" `Quick test_accepts_gzip; 1179 1179 - test_case "accepts_zstd" `Quick test_accepts_zstd; 1180 1180 - test_case "no accept-encoding" `Quick test_no_accept_encoding; 1181 1181 - test_case "gzip stream roundtrip" `Quick test_gzip_stream_roundtrip; 1182 1182 - test_case "gzip decompress stream" `Quick test_gzip_decompress_stream; 1183 1183 - test_case "decompress request gzip" `Quick test_decompress_request_gzip; 1184 1184 - test_case "decompress request zstd" `Quick test_decompress_request_zstd; 1185 1185 - ] 1186 1186 - end 1187 1187 - 1188 1188 - (* ================================================================== *) 1189 900 (* Main *) 1190 901 (* ================================================================== *) 1191 902 ··· 1196 907 ("Stream", Test_stream.tests); 1197 908 ("Http", Test_http.tests); 1198 909 ("Router", Test_router.tests); 1199 1199 - ("Middleware", Test_middleware.tests); 1200 910 ("Log", Test_log.tests); 1201 911 ("Tls_config", Test_tls_config.tests); 1202 912 ("Properties", Test_properties.tests); 1203 1203 - ("Compression", Test_compression.tests); 1204 913 ]

+1 -1

test/test_plug.ml

reviewed

··· 1535 1535 end 1536 1536 1537 1537 let () = 1538 1538 - Mirage_crypto_rng_unix.use_default (); 1538 1538 + Random.self_init (); 1539 1539 Eio_main.run @@ fun env -> 1540 1540 run "HCS Plug" 1541 1541 [