host: Phase 2 complete — SXTP wire format + Dream bridge, 82/82

lib/host/sxtp.sx implements the host<->subsystem wire format per
applications/sxtp/spec.sx:

- message algebra (request/response/condition/event + status helpers
  ok/created/not-found/forbidden/invalid/fail) as string-keyed dicts;
  verb/status/type stored as symbols (ride the wire bare)
- codec: sxtp/serialize (dict -> text/sx list form, deterministic top-level
  field order, nested messages emitted in their own list form, no :msg leak)
  and sxtp/parse (text/sx -> dict via a deep keyword-token->string normaliser)
- Dream bridge: sxtp/from-dream (HTTP req -> SXTP req, method->verb,
  query->params) and sxtp/to-dream (SXTP resp -> HTTP resp, status->code,
  body serialised to text/sx)
- 39-test suite covering algebra, serialise/parse round-trip, mappings, bridge

Runtime notes: serialize renders string-keyed dicts as {:k v} and symbols
bare; parsed keyword tokens are a distinct type (not = to string literals) so
parse normalises; unquote-splicing is unreliable so the emitter is str-based.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>

lib/host/conformance.sh

@@ -56,6 +56,7 @@ MODULES=(
   "lib/dream/router.sx"
   "lib/host/handler.sx"
   "lib/host/middleware.sx"
+  "lib/host/sxtp.sx"
   "lib/host/router.sx"
   "lib/host/feed.sx"
 )
@@ -64,6 +65,7 @@ MODULES=(
 SUITES=(
   "handler     host-hd-tests-run!  lib/host/tests/handler.sx"
   "middleware  host-mw-tests-run!  lib/host/tests/middleware.sx"
+  "sxtp        host-sx-tests-run!  lib/host/tests/sxtp.sx"
   "router      host-rt-tests-run!  lib/host/tests/router.sx"
   "feed        host-fd-tests-run!  lib/host/tests/feed.sx"
 )

lib/host/sxtp.sx

@@ -0,0 +1,173 @@
+;; lib/host/sxtp.sx — SXTP, the host<->subsystem wire format. SXTP messages are
+;; SX s-expressions (content-type text/sx): a request/response/condition/event is
+;; a tagged list `(request :verb navigate :path "/x" ...)`. See the protocol spec
+;; at applications/sxtp/spec.sx.
+;;
+;; Representation: internally a message is a plain dict tagged by :msg ("request"
+;; /"response"/"condition"/"event"), with string keys so the keyword==string rule
+;; makes construction and access trivial. verb/status/type are stored as SYMBOLS
+;; (they ride the wire bare, not quoted). The wire LIST form is produced/consumed
+;; only at the serialise/parse boundary:
+;;   sxtp/serialize : msg-dict -> text/sx string
+;;   sxtp/parse     : text/sx string -> msg-dict
+;; A Dream HTTP request/response bridges to/from SXTP via sxtp/from-dream and
+;; sxtp/to-dream, so the host can speak SXTP to subsystems while serving HTTP.
+;; Depends on lib/dream/types.sx (dream-response + request/response accessors).
+
+;; ── helpers ────────────────────────────────────────────────────────
+(define sxtp/-sym
+  (fn (x) (if (= (type-of x) "symbol") x (string->symbol x))))
+(define sxtp/-name
+  (fn (x) (if (= (type-of x) "symbol") (symbol->string x) x)))
+
+;; ── constructors ───────────────────────────────────────────────────
+;; opts is a dict of optional fields (e.g. {:headers .. :params .. :body ..}).
+(define sxtp/request
+  (fn (verb path opts)
+    (merge {:msg "request" :verb (sxtp/-sym verb) :path path} opts)))
+(define sxtp/response
+  (fn (status opts)
+    (merge {:msg "response" :status (sxtp/-sym status)} opts)))
+(define sxtp/condition
+  (fn (ctype opts)
+    (merge {:msg "condition" :type (sxtp/-sym ctype)} opts)))
+(define sxtp/event
+  (fn (etype opts)
+    (merge {:msg "event" :type (sxtp/-sym etype)} opts)))
+
+;; ── predicates ─────────────────────────────────────────────────────
+(define sxtp/-is?
+  (fn (m tag) (and (= (type-of m) "dict") (= (get m :msg) tag))))
+(define sxtp/request? (fn (m) (sxtp/-is? m "request")))
+(define sxtp/response? (fn (m) (sxtp/-is? m "response")))
+(define sxtp/condition? (fn (m) (sxtp/-is? m "condition")))
+(define sxtp/event? (fn (m) (sxtp/-is? m "event")))
+
+;; ── accessors ──────────────────────────────────────────────────────
+(define sxtp/verb (fn (m) (get m :verb)))
+(define sxtp/path (fn (m) (get m :path)))
+(define sxtp/req-headers (fn (m) (get m :headers)))
+(define sxtp/params (fn (m) (get m :params)))
+(define sxtp/param (fn (m name) (get (get m :params) name)))
+(define sxtp/body (fn (m) (get m :body)))
+(define sxtp/capabilities (fn (m) (get m :capabilities)))
+(define sxtp/status (fn (m) (get m :status)))
+(define sxtp/resp-headers (fn (m) (get m :headers)))
+(define sxtp/stream? (fn (m) (= (get m :stream) true)))
+(define sxtp/cond-type (fn (m) (get m :type)))
+(define sxtp/cond-message (fn (m) (get m :message)))
+
+;; ── status helpers (build responses) ───────────────────────────────
+(define sxtp/ok (fn (body) (sxtp/response "ok" {:body body})))
+(define sxtp/created (fn (body) (sxtp/response "created" {:body body})))
+(define sxtp/no-content (fn () (sxtp/response "no-content" {})))
+(define sxtp/not-found
+  (fn (path message)
+    (sxtp/response "not-found"
+      {:body (sxtp/condition "resource-not-found"
+               {:path path :message message :retry false})})))
+(define sxtp/forbidden
+  (fn (message)
+    (sxtp/response "forbidden"
+      {:body (sxtp/condition "forbidden" {:message message})})))
+(define sxtp/invalid
+  (fn (message)
+    (sxtp/response "invalid"
+      {:body (sxtp/condition "invalid" {:message message})})))
+(define sxtp/fail
+  (fn (message)
+    (sxtp/response "error"
+      {:body (sxtp/condition "error" {:message message})})))
+
+;; ── HTTP <-> SXTP mappings ─────────────────────────────────────────
+(define sxtp/-method-verbs
+  {:GET "fetch" :HEAD "fetch" :POST "create"
+   :PUT "mutate" :PATCH "mutate" :DELETE "delete" :OPTIONS "inspect"})
+(define sxtp/verb-for-method
+  (fn (method) (sxtp/-sym (get sxtp/-method-verbs (upper method) "fetch"))))
+
+(define sxtp/-status-http
+  {:ok 200 :created 201 :accepted 202 :no-content 204 :redirect 302
+   :not-modified 304 :error 500 :not-found 404 :forbidden 403
+   :invalid 400 :conflict 409 :unavailable 503})
+(define sxtp/http-status
+  (fn (status) (get sxtp/-status-http (sxtp/-name status) 200)))
+
+;; ── Dream bridge ───────────────────────────────────────────────────
+;; HTTP request -> SXTP request: method->verb, query->params, headers/body carry.
+(define sxtp/from-dream
+  (fn (req)
+    (sxtp/request
+      (sxtp/verb-for-method (get req :method))
+      (get req :path)
+      {:headers (get req :headers)
+       :params (get req :query)
+       :body (get req :body)})))
+
+;; SXTP response -> HTTP response: status->code, body serialised to text/sx.
+(define sxtp/-body-text
+  (fn (b) (if (nil? b) "" (serialize b))))
+(define sxtp/to-dream
+  (fn (resp)
+    (dream-response
+      (sxtp/http-status (sxtp/status resp))
+      (merge {:content-type "text/sx"} (or (sxtp/resp-headers resp) {}))
+      (sxtp/-body-text (sxtp/body resp)))))
+
+;; ── wire serialise (msg-dict -> text/sx) ───────────────────────────
+;; Top-level field order is fixed per message type so output is deterministic;
+;; nested dict/value order follows the serialize primitive.
+(define sxtp/-field-order
+  {:request (list :verb :path :headers :cookies :params :capabilities :body)
+   :response (list :status :headers :set-cookie :body :stream)
+   :condition (list :type :message :path :retry :detail)
+   :event (list :type :id :body :time)})
+;; A nested SXTP message (a condition/event in a :body) serialises in its own
+;; list form; plain data values go through the serialize primitive.
+(define sxtp/-emit-value
+  (fn (v)
+    (if (and (= (type-of v) "dict") (has-key? v :msg))
+      (sxtp/serialize v)
+      (serialize v))))
+(define sxtp/serialize
+  (fn (msg)
+    (let ((head (get msg :msg)))
+      (let ((order (get sxtp/-field-order head)))
+        (str "("
+          head
+          (reduce
+            (fn (acc k)
+              (if (has-key? msg k)
+                (str acc " :" k " " (sxtp/-emit-value (get msg k)))
+                acc))
+            ""
+            order)
+          ")")))))
+
+;; ── wire parse (text/sx -> msg-dict) ───────────────────────────────
+;; parse yields a list with keyword-token keys and possibly keyword-token dict
+;; keys; sxtp/-normalize deep-converts those tokens to strings so the result is
+;; the same string-keyed shape the constructors produce.
+(define sxtp/-normalize
+  (fn (v)
+    (let ((t (type-of v)))
+      (cond
+        ((= t "keyword") (str v))
+        ((= t "dict")
+          (reduce
+            (fn (acc k) (assoc acc (str k) (sxtp/-normalize (get v k))))
+            {}
+            (keys v)))
+        ((= t "list") (map sxtp/-normalize v))
+        (true v)))))
+(define sxtp/-pairs->dict
+  (fn (kvs acc)
+    (if (< (len kvs) 2)
+      acc
+      (sxtp/-pairs->dict
+        (rest (rest kvs))
+        (assoc acc (str (first kvs)) (sxtp/-normalize (first (rest kvs))))))))
+(define sxtp/parse
+  (fn (text)
+    (let ((lst (parse text)))
+      (sxtp/-pairs->dict (rest lst) {:msg (symbol->string (first lst))}))))

lib/host/tests/sxtp.sx

@@ -0,0 +1,129 @@
+;; lib/host/tests/sxtp.sx — SXTP message algebra, wire serialise/parse round-trip,
+;; and the Dream HTTP <-> SXTP bridge.
+
+(define host-sx-pass 0)
+(define host-sx-fail 0)
+(define host-sx-fails (list))
+
+(define
+  host-sx-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! host-sx-pass (+ host-sx-pass 1))
+      (begin
+        (set! host-sx-fail (+ host-sx-fail 1))
+        (append! host-sx-fails {:name name :actual actual :expected expected})))))
+
+;; ── constructors + predicates ──────────────────────────────────────
+(define host-sx-req (sxtp/request "navigate" "/x" {:headers {:host "h"}}))
+(define host-sx-resp (sxtp/ok {:id "e1"}))
+
+(host-sx-test "request?" (sxtp/request? host-sx-req) true)
+(host-sx-test "request not response" (sxtp/response? host-sx-req) false)
+(host-sx-test "response?" (sxtp/response? host-sx-resp) true)
+(host-sx-test "condition?" (sxtp/condition? (sxtp/condition "x" {})) true)
+
+;; ── accessors (verb/status are symbols) ────────────────────────────
+(host-sx-test "verb" (symbol->string (sxtp/verb host-sx-req)) "navigate")
+(host-sx-test "path" (sxtp/path host-sx-req) "/x")
+(host-sx-test "req header" (get (sxtp/req-headers host-sx-req) :host) "h")
+(host-sx-test "status" (symbol->string (sxtp/status host-sx-resp)) "ok")
+(host-sx-test "body" (get (sxtp/body host-sx-resp) :id) "e1")
+
+;; ── status helpers ─────────────────────────────────────────────────
+(host-sx-test "created status" (symbol->string (sxtp/status (sxtp/created {}))) "created")
+(host-sx-test
+  "not-found status"
+  (symbol->string (sxtp/status (sxtp/not-found "/p" "gone")))
+  "not-found")
+(host-sx-test
+  "not-found body is condition"
+  (sxtp/condition? (sxtp/body (sxtp/not-found "/p" "gone")))
+  true)
+(host-sx-test
+  "forbidden message"
+  (sxtp/cond-message (sxtp/body (sxtp/forbidden "no")))
+  "no")
+
+;; ── serialise (deterministic top-level field order) ────────────────
+(host-sx-test
+  "serialize request"
+  (sxtp/serialize host-sx-req)
+  "(request :verb navigate :path \"/x\" :headers {:host \"h\"})")
+(host-sx-test
+  "serialize ok"
+  (sxtp/serialize (sxtp/ok {:id "e1"}))
+  "(response :status ok :body {:id \"e1\"})")
+;; nested condition rides the wire in its (condition ...) list form, no :msg leak.
+(host-sx-test
+  "serialize nested condition as list"
+  (contains?
+    (sxtp/serialize (sxtp/not-found "/p" "gone"))
+    "(condition :type resource-not-found")
+  true)
+(host-sx-test
+  "serialize no :msg leak"
+  (contains? (sxtp/serialize host-sx-resp) ":msg")
+  false)
+
+;; ── parse + round-trip ─────────────────────────────────────────────
+(define host-sx-parsed
+  (sxtp/parse "(request :verb query :path \"/events\" :headers {:host \"h\"})"))
+(host-sx-test "parse msg type" (sxtp/request? host-sx-parsed) true)
+(host-sx-test "parse verb" (symbol->string (sxtp/verb host-sx-parsed)) "query")
+(host-sx-test "parse path" (sxtp/path host-sx-parsed) "/events")
+(host-sx-test
+  "parse nested header normalised"
+  (get (sxtp/req-headers host-sx-parsed) :host)
+  "h")
+
+(define host-sx-rt (sxtp/parse (sxtp/serialize (sxtp/ok {:id "e1" :n 3}))))
+(host-sx-test "round-trip status" (symbol->string (sxtp/status host-sx-rt)) "ok")
+(host-sx-test "round-trip body id" (get (sxtp/body host-sx-rt) :id) "e1")
+(host-sx-test "round-trip body n" (get (sxtp/body host-sx-rt) :n) 3)
+
+;; ── HTTP <-> SXTP mappings ─────────────────────────────────────────
+(host-sx-test "verb GET->fetch" (symbol->string (sxtp/verb-for-method "GET")) "fetch")
+(host-sx-test "verb POST->create" (symbol->string (sxtp/verb-for-method "POST")) "create")
+(host-sx-test "verb DELETE->delete" (symbol->string (sxtp/verb-for-method "DELETE")) "delete")
+(host-sx-test "verb unknown->fetch" (symbol->string (sxtp/verb-for-method "WIBBLE")) "fetch")
+(host-sx-test "http ok->200" (sxtp/http-status (string->symbol "ok")) 200)
+(host-sx-test "http not-found->404" (sxtp/http-status (string->symbol "not-found")) 404)
+
+;; ── Dream bridge ───────────────────────────────────────────────────
+(define host-sx-from
+  (sxtp/from-dream (dream-request "POST" "/feed?a=1" {} "hi")))
+(host-sx-test "from-dream verb" (symbol->string (sxtp/verb host-sx-from)) "create")
+(host-sx-test "from-dream path" (sxtp/path host-sx-from) "/feed")
+(host-sx-test "from-dream param" (sxtp/param host-sx-from "a") "1")
+(host-sx-test "from-dream body" (sxtp/body host-sx-from) "hi")
+
+(define host-sx-tod (sxtp/to-dream (sxtp/ok {:id "e1"})))
+(host-sx-test "to-dream status" (dream-status host-sx-tod) 200)
+(host-sx-test
+  "to-dream content-type text/sx"
+  (dream-resp-header host-sx-tod "content-type")
+  "text/sx")
+(host-sx-test
+  "to-dream body is sx text"
+  (dream-resp-body host-sx-tod)
+  "{:id \"e1\"}")
+(host-sx-test
+  "to-dream not-found->404"
+  (dream-status (sxtp/to-dream (sxtp/not-found "/p" "gone")))
+  404)
+(host-sx-test
+  "to-dream forbidden->403"
+  (dream-status (sxtp/to-dream (sxtp/forbidden "no")))
+  403)
+
+(define
+  host-sx-tests-run!
+  (fn
+    ()
+    {:total (+ host-sx-pass host-sx-fail)
+     :passed host-sx-pass
+     :failed host-sx-fail
+     :fails host-sx-fails}))