giles
d917a5f92f
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
lib/host/server.sx adapts the native http-listen contract (string-keyed
{method,path,query,headers,body} -> {:status :headers :body}) to the Dream
host app: native->dream reassembles path+query into a target dream-request
parses; dream->native is near-identity (dream-response is already
{:body :headers :status}). host/serve = http-listen over host/native-handler
. host/make-app. lib/host/serve.sh boots the full module set and serves in the
foreground (container-entry shaped). Verified live on a host port: health/feed/
feed?actor=/relations reads serve real JSON, unknown->404. server suite (13)
covers the bridge as pure functions.
Co-Authored-By: Claude Opus 4.8 <noreply@anthropic.com>
89 lines
3.4 KiB
Plaintext
89 lines
3.4 KiB
Plaintext
;; lib/host/tests/server.sx — the native<->dream bridge. Pure-function coverage of
|
|
;; host/-native->dream, host/-dream->native, and the host/native-handler adapter
|
|
;; over a real host app (no socket — the http-listen call itself is exercised live
|
|
;; via lib/host/serve.sx, not here).
|
|
|
|
(define host-sv-pass 0)
|
|
(define host-sv-fail 0)
|
|
(define host-sv-fails (list))
|
|
|
|
(define
|
|
host-sv-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! host-sv-pass (+ host-sv-pass 1))
|
|
(begin
|
|
(set! host-sv-fail (+ host-sv-fail 1))
|
|
(append! host-sv-fails {:name name :actual actual :expected expected})))))
|
|
|
|
(define host-sv-native
|
|
(fn (method path query body)
|
|
{"method" method "path" path "query" query "body" body "headers" {}}))
|
|
|
|
;; ── native request -> dream request ─────────────────────────────────
|
|
(define host-sv-dreq (host/-native->dream (host-sv-native "post" "/feed" "actor=alice" "hi")))
|
|
(host-sv-test "n->d method upcased" (get host-sv-dreq :method) "POST")
|
|
(host-sv-test "n->d path" (get host-sv-dreq :path) "/feed")
|
|
(host-sv-test "n->d query param" (dream-query-param host-sv-dreq "actor") "alice")
|
|
(host-sv-test "n->d body" (get host-sv-dreq :body) "hi")
|
|
;; empty query -> bare path, no trailing "?"
|
|
(host-sv-test
|
|
"n->d empty query -> bare path"
|
|
(get (host/-native->dream (host-sv-native "GET" "/health" "" "")) :path)
|
|
"/health")
|
|
|
|
;; ── dream response -> native response ───────────────────────────────
|
|
(define host-sv-nresp
|
|
(host/-dream->native (dream-response 201 {:content-type "application/json"} "{}")))
|
|
(host-sv-test "d->n status" (get host-sv-nresp :status) 201)
|
|
(host-sv-test "d->n body" (get host-sv-nresp :body) "{}")
|
|
(host-sv-test "d->n headers is dict" (= (type-of (get host-sv-nresp :headers)) "dict") true)
|
|
|
|
;; ── adapter over a real host app ────────────────────────────────────
|
|
(feed/reset!)
|
|
(define host-sv-app (host/native-handler (host/make-app (list host/feed-routes))))
|
|
(host-sv-test
|
|
"health -> 200"
|
|
(get (host-sv-app (host-sv-native "GET" "/health" "" "")) :status)
|
|
200)
|
|
(host-sv-test
|
|
"health body healthy"
|
|
(contains? (get (host-sv-app (host-sv-native "GET" "/health" "" "")) :body) "healthy")
|
|
true)
|
|
(host-sv-test
|
|
"feed read -> 200"
|
|
(get (host-sv-app (host-sv-native "GET" "/feed" "" "")) :status)
|
|
200)
|
|
;; native response shape is exactly {:status :headers :body}
|
|
(host-sv-test
|
|
"native resp keys"
|
|
(let ((r (host-sv-app (host-sv-native "GET" "/health" "" ""))))
|
|
(and (has-key? r :status) (has-key? r :headers) (has-key? r :body)))
|
|
true)
|
|
|
|
;; ── relations read through the bridge (end-to-end shape) ────────────
|
|
(relations/load! (list))
|
|
(relations/relate (string->symbol "org:1") (string->symbol "list:7") (string->symbol "member"))
|
|
(define host-sv-rapp (host/native-handler (host/make-app (list host/relations-routes))))
|
|
(host-sv-test
|
|
"relations read via bridge"
|
|
(contains?
|
|
(get
|
|
(host-sv-rapp
|
|
(host-sv-native "GET" "/internal/data/get-children"
|
|
"parent-type=org&parent-id=1&relation-type=member" ""))
|
|
:body)
|
|
"list:7")
|
|
true)
|
|
|
|
(define
|
|
host-sv-tests-run!
|
|
(fn
|
|
()
|
|
{:total (+ host-sv-pass host-sv-fail)
|
|
:passed host-sv-pass
|
|
:failed host-sv-fail
|
|
:fails host-sv-fails}))
|