From 8892b7849e75c83ab11f5dd5e713338f6afac07f Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Thu, 6 Aug 2026 08:09:05 +0200 Subject: [PATCH] fix(beam): read request headers from Cowboy instead of returning empty `HttpRequest.GetTypedHeaders()` returned an empty `RequestHeaders` and `HttpRequest.Headers` an empty `HeaderDictionary`, so on the BEAM target `mustAccept` and content negotiation could never resolve, and no handler could read a request header at all -- an endpoint gating on `Authorization` had to reach past Giraffe to `cowboy_req:header/3` itself. The binding was never missing: `Fable.Beam.Cowboy.CowboyReq.headers` has been there all along. Both accessors now read it through a shared `HeaderPairs`. Cowboy is already the normalising layer -- lowercase names, duplicates folded into one comma-joined value -- so this is a map read rather than a reimplementation of header semantics, and the two-element rows it yields match the shape the Python/ASGI backend builds from `scope["headers"]`, keeping `mustAccept` identical across targets. The BEAM `TestContext` was the other half of the gap, and the reason the suite could not have caught this: it accepted a `?headers` argument and silently dropped it, while the JS and Python factories both wired theirs in. It now seeds them into the fake Req map, lowercased on the way in to match what Cowboy hands a real handler. The three Accept-header cases are un-skipped on BEAM, and two tests cover reading an arbitrary header and case-insensitive lookup -- the case Accept-only coverage would not have pinned. BEAM 99 passed / 4 skipped (the remaining skips are the unrelated `routef` typed-capture divergences), JS 102/1, Python 103/0. Co-Authored-By: Claude Opus 5 (1M context) --- FOLLOWUPS.md | 12 +++++++--- src/beam/HttpContext.fs | 32 ++++++++++++++++++++++++--- test/beam/TestContext.fs | 32 +++++++++++++++++++-------- test/shared/HandlerTests.fs | 44 +++++++++++++++++++++++++++++++------ 4 files changed, 98 insertions(+), 22 deletions(-) diff --git a/FOLLOWUPS.md b/FOLLOWUPS.md index 5a48b9c..2c3b920 100644 --- a/FOLLOWUPS.md +++ b/FOLLOWUPS.md @@ -21,9 +21,15 @@ visible until fixed. - [ ] **`routef` typed captures on JS/BEAM** — `%O` (Guid), `%i`, `%u` diverge (`%s` works); the affected `routef` cases are skipped on JS and BEAM. Likely `FormatExpressions` parsing/conversion differences on those targets. `src/FormatExpressions.fs`. -- [ ] **BEAM `GetTypedHeaders()` is a stub** — returns empty (`RequestHeaders(ResizeArray())`), - so `mustAccept` / content negotiation can't resolve; the 3 Accept-header cases are - skipped on BEAM. Implement real Cowboy header reading. `src/beam/HttpContext.fs`. +- [x] **BEAM request headers were a stub** — FIXED. `GetTypedHeaders()` returned an empty + `RequestHeaders` and `Headers` an empty `HeaderDictionary`, so `mustAccept` / content + negotiation could not resolve and no handler could read a header at all — a `/mcp`-style + endpoint gating on `Authorization` had to reach past Giraffe to `cowboy_req:header/3`. + Both now read `cowboy_req:headers/1`, whose map is already lowercase-keyed with duplicates + folded, matching the Python/ASGI row shape. The 3 Accept cases are un-skipped and two + direct header-reading tests were added. `src/beam/HttpContext.fs`. + The BEAM `TestContext` was the other half: it accepted a `?headers` argument and silently + dropped it, so the suite could not have caught this. It now seeds them into the fake Req. ## BEAM DI / logging diff --git a/src/beam/HttpContext.fs b/src/beam/HttpContext.fs index c5ce7d1..1f3ef42 100644 --- a/src/beam/HttpContext.fs +++ b/src/beam/HttpContext.fs @@ -9,6 +9,7 @@ open Fable.Giraffe.Json open Fable.Beam.Cowboy.CowboyReq module CowboyReq = Fable.Beam.Cowboy.CowboyReq +module Maps = Fable.Beam.Maps /// A body pre-buffered into the request map under `giraffe_body`. The in-process test harness /// seeds it there because it has no live socket for `cowboy_req:read_body` to stream from; real @@ -29,9 +30,26 @@ type HttpRequest(req: Req) = member x.Protocol: string = CowboyReq.scheme req + /// The request headers as Cowboy parsed them: one entry per name, names already lowercase. + /// + /// Cowboy is the normalising layer here — a client's `Authorization` arrives as + /// `authorization`, and repeated headers are folded into a single comma-joined value — so + /// this is a plain map read rather than a reimplementation of header semantics. + member private x.HeaderPairs = Maps.maps.to_list (CowboyReq.headers req) + member x.GetTypedHeaders() : RequestHeaders = - // Convert Cowboy headers map to the expected format - RequestHeaders(ResizeArray()) + // RequestHeaders reads rows of [name; value; ...], the same shape the Python/ASGI + // backend produces from `scope["headers"]`. Cowboy's map holds one value per name, so + // every row here is exactly two elements — matching Python, where HeaderDictionary.Scoped + // likewise joins multiple values into one string before the row is built. + let rows = ResizeArray>() + + // An explicit loop, not Seq.map: on fable-beam, Seq.map over a ResizeArray passes a Ref + // where a list is expected (see HttpResponse below). + for (name, value) in x.HeaderPairs do + rows.Add(ResizeArray([ name; value ])) + + RequestHeaders(rows) member x.GetBodyAsync() = task { @@ -42,7 +60,15 @@ type HttpRequest(req: Req) = return body } - member x.Headers = HeaderDictionary() + /// invariant: keys are lowercase, because Cowboy lowercases them. HeaderDictionary's indexer + /// lowercases the lookup key too, so `headers["Content-Type"]` still resolves. + member x.Headers = + let dict = Dictionary() + + for (name, value) in x.HeaderPairs do + dict[name] <- value + + HeaderDictionary(dict) /// HTTP response that accumulates state before sending via cowboy_req:reply. /// Uses mutable F# list for headers — avoids fable-beam ResizeArray/Seq diff --git a/test/beam/TestContext.fs b/test/beam/TestContext.fs index bb927df..49ff544 100644 --- a/test/beam/TestContext.fs +++ b/test/beam/TestContext.fs @@ -1,20 +1,23 @@ namespace Fable.Giraffe.Tests open Fable.Core +open Fable.Beam.Maps open Fable.Beam.Cowboy.CowboyReq open Fable.Giraffe -// BEAM/Cowboy-target test-context factory. A fake Cowboy Req *map* with method/path/scheme -// satisfies the cowboy_req:method/path/scheme lookups without a live socket; the response is read -// straight off HttpResponse.Body. The request body is pre-buffered under `giraffe_body` (there is -// no socket for cowboy_req:read_body to stream from) — HttpRequest.GetBodyAsync reads it there. -// A factory (not a subclass) because Fable.Beam inheritance does not carry the base HttpContext's -// fields (e.g. field_response). +module Maps = Fable.Beam.Maps + +// BEAM/Cowboy-target test-context factory. A fake Cowboy Req *map* with method/path/scheme/headers +// satisfies the cowboy_req:method/path/scheme/headers lookups without a live socket; the response +// is read straight off HttpResponse.Body. The request body is pre-buffered under `giraffe_body` +// (there is no socket for cowboy_req:read_body to stream from) — HttpRequest.GetBodyAsync reads it +// there. A factory (not a subclass) because Fable.Beam inheritance does not carry the base +// HttpContext's fields (e.g. field_response). module private BeamFakes = - [ $0, path => $1, scheme => <<\"http\">>, giraffe_body => $2}")>] - let makeReq (method: string) (path: string) (body: string) : Req = nativeOnly + [ $0, path => $1, scheme => <<\"http\">>, headers => $3, giraffe_body => $2}")>] + let makeReq (method: string) (path: string) (body: string) (headers: BeamMap) : Req = nativeOnly type TestContext = @@ -25,6 +28,17 @@ type TestContext = let _method = defaultArg method "GET" let _path = defaultArg path "/" let _body = defaultArg body "" - let ctx = HttpContext(BeamFakes.makeReq _method _path _body) + + // Lowercased on the way in, because that is what Cowboy hands a real handler and what + // HttpRequest.Headers therefore keys on. + let mutable pairs: (string * string) list = [] + + match headers with + | Some hd -> + for pair in hd.Scoped do + pairs <- (pair[0].ToLower(), pair[1]) :: pairs + | None -> () + + let ctx = HttpContext(BeamFakes.makeReq _method _path _body (Maps.ofList pairs)) ctx.SetServices(defaultArg services (ServiceCollection())) ctx, (fun () -> ctx.Response.Body) diff --git a/test/shared/HandlerTests.fs b/test/shared/HandlerTests.fs index 9e35e45..8133ea0 100644 --- a/test/shared/HandlerTests.fs +++ b/test/shared/HandlerTests.fs @@ -147,9 +147,6 @@ let tests = testAsync ( "POST \"/text\" with supported Accept header returns \"text\"", - // BEAM's HttpRequest.GetTypedHeaders() is a stub returning empty, so - // mustAccept/Accept-negotiation cannot resolve (tracked: implement Cowboy headers). - skipIfBeam, fun _ -> toAsync ( task { @@ -191,8 +188,6 @@ let tests = testAsync ( "POST \"/json\" with supported Accept header returns \"json\"", - // BEAM: headers stub, see above. - skipIfBeam, fun _ -> toAsync ( task { @@ -234,8 +229,6 @@ let tests = testAsync ( "POST \"/either\" with supported Accept header returns \"either\"", - // BEAM: headers stub, see above. - skipIfBeam, fun _ -> toAsync ( task { @@ -454,5 +447,42 @@ let tests = assertThat (payload.Contains "age") isTrue } ) + ) + + testAsync ( + "HttpRequest.Headers reads an arbitrary request header", + // Not just Accept: a handler that gates on `Authorization` needs the raw + // dictionary, which BEAM used to answer as permanently empty. + fun _ -> + toAsync ( + task { + let headers = HeaderDictionary() + headers.Add("Authorization", StringValues("Bearer s3cret")) + headers.Add("X-Request-Id", StringValues("abc123")) + + let testCtx, _ = TestContext.create (path = "/", headers = headers) + + assertThat (testCtx.Request.Headers["Authorization"][0]) (isEqualTo "Bearer s3cret") + assertThat (testCtx.Request.Headers["X-Request-Id"][0]) (isEqualTo "abc123") + } + ) + ) + + testAsync ( + "HttpRequest.Headers lookup is case-insensitive", + // Names travel lowercase on the wire-facing backends (Cowboy and ASGI both + // normalise), so the indexer has to fold the *lookup* key to match. + fun _ -> + toAsync ( + task { + let headers = HeaderDictionary() + headers.Add("Authorization", StringValues("Bearer s3cret")) + + let testCtx, _ = TestContext.create (path = "/", headers = headers) + + assertThat (testCtx.Request.Headers["AUTHORIZATION"][0]) (isEqualTo "Bearer s3cret") + assertThat (testCtx.Request.Headers["authorization"][0]) (isEqualTo "Bearer s3cret") + } + ) ) ] )