giles
b67709dab5
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
43 lines
2.4 KiB
Plaintext
43 lines
2.4 KiB
Plaintext
;; lib/dream/websocket.sx — Dream-on-SX WebSockets.
|
|
;; dream-websocket wraps a (fn (ws) ...) handler into an ordinary handler that
|
|
;; returns a 101 upgrade response carrying the ws handler. The host detects the
|
|
;; upgrade, builds a ws backed by host IO, and runs the handler. The ws carries an
|
|
;; injectable io fn — a mock in-memory ws for tests, (perform op) in production.
|
|
;; Depends on types.sx.
|
|
|
|
;; ── upgrade response ───────────────────────────────────────────────
|
|
(define dream-websocket (fn (handler) (fn (req) {:websocket handler :body "" :headers {:connection "Upgrade" :upgrade "websocket"} :status 101})))
|
|
|
|
(define
|
|
dream-websocket?
|
|
(fn (resp) (and (dict? resp) (has-key? resp :websocket))))
|
|
(define dream-ws-handler (fn (resp) (get resp :websocket)))
|
|
|
|
;; ── ws operations (over an injectable io) ──────────────────────────
|
|
(define dream-send (fn (ws msg) ((get ws :io) {:op "ws/send" :msg msg})))
|
|
(define dream-receive (fn (ws) ((get ws :io) {:op "ws/receive"})))
|
|
(define dream-close (fn (ws) ((get ws :io) {:op "ws/close"})))
|
|
(define dream-ws-open? (fn (ws) ((get ws :io) {:op "ws/open?"})))
|
|
(define
|
|
dream-ws-broadcast
|
|
(fn (wss msg) (for-each (fn (ws) (dream-send ws msg)) wss)))
|
|
|
|
;; production io: every op suspends to the host
|
|
(define dream-ws-perform-io (fn (op) (perform op)))
|
|
(define dream-ws-from-io (fn (io) {:io io}))
|
|
|
|
;; ── in-memory mock ws (tests + demos) ──────────────────────────────
|
|
;; incoming is a list of messages dream-receive will yield in order.
|
|
(define
|
|
dream-mock-ws
|
|
(fn
|
|
(incoming)
|
|
(let ((inbox incoming) (outbox (list)) (closed false)) {:closed? (fn () closed) :outbox (fn () outbox) :io (fn (op) (cond ((= (get op :op) "ws/send") (begin (set! outbox (concat outbox (list (get op :msg)))) true)) ((= (get op :op) "ws/receive") (if (empty? inbox) nil (let ((m (first inbox))) (begin (set! inbox (rest inbox)) m)))) ((= (get op :op) "ws/close") (begin (set! closed true) true)) ((= (get op :op) "ws/open?") (not closed)) (else nil)))})))
|
|
|
|
;; test/demo introspection
|
|
(define dream-ws-sent (fn (ws) ((get ws :outbox))))
|
|
(define dream-ws-closed? (fn (ws) ((get ws :closed?))))
|
|
|
|
;; drive a ws handler (from an upgrade response) against a ws
|
|
(define dream-ws-run (fn (resp ws) ((dream-ws-handler resp) ws)))
|