diff --git a/doc/reference/std/net/json-rpc.md b/doc/reference/std/net/json-rpc.md index 254816702..2708afde9 100644 --- a/doc/reference/std/net/json-rpc.md +++ b/doc/reference/std/net/json-rpc.md @@ -48,6 +48,13 @@ A variety of HTTP or JSON-RPC errors can be raised during the query that you may or may not want to report, log or inspect, but otherwise this is the only function you need to call as a JSON RPC client. +As for headers, you should follow the documentation and examples +for the services you're using, and lacking that may try some as follows: +``` +headers: '(("Content-Type" . "application/json-rpc") + ("Accept" . "application/json-rpc, application/json, application/jsonrequest")) +``` + ## json-rpc-handler ``` (json-rpc-handler processor log: (log #f)) diff --git a/src/std/net/json-rpc.ss b/src/std/net/json-rpc.ss index d70b50b93..f7c2b625f 100644 --- a/src/std/net/json-rpc.ss +++ b/src/std/net/json-rpc.ss @@ -155,14 +155,7 @@ message: (error-message e)))))) (http-post server-url auth: auth - headers: `(("Content-Type" . "application/json-rpc") - ;; The JSON RPC over HTTP standard says we MUST send - ;; some variant of the Accept header below, but actually - ;; no client bothers sending it, no server bothers checking it, - ;; and it can only make things slower and trigger unwanted - ;; edge cases, so we don't bother sending it either. - ;; ("Accept" . "application/json-rpc, application/json, application/jsonrequest") - ,@headers) + headers: headers ssl-context: ssl-context cookies: cookies data: data))) @@ -187,9 +180,7 @@ ("id" .,id)))) (http-get server-url auth: auth - headers: `(("Content-Type" . "application/json-rpc") - ;; NB: we don't bother with an Accept header here, either. - ,@headers) + headers: headers params: uri-params ssl-context: ssl-context cookies: cookies))) diff --git a/src/std/net/websocket/client.ss b/src/std/net/websocket/client.ss index 029687a93..61725dc68 100644 --- a/src/std/net/websocket/client.ss +++ b/src/std/net/websocket/client.ss @@ -69,7 +69,8 @@ "bad server response; no websocket upgrade" url Upgrade)) - (unless (and Sec-Websocket-Version (equal? (cdr Sec-Websocket-Version) +websocket-version+)) + ;; We only support a single version + (when Sec-Websocket-Version (raise-io-error websocket-connect "bad server response; unsupported websocket version" Sec-Websocket-Version)) diff --git a/src/std/net/websocket/server.ss b/src/std/net/websocket/server.ss index 67eb79abb..cb84a2d81 100644 --- a/src/std/net/websocket/server.ss +++ b/src/std/net/websocket/server.ss @@ -14,7 +14,7 @@ (def +websocket-version+ "13") (def +websocket-magic+ "258EAFA5-E914-47DA-95CA-C5AB0DC85B11") -;; creates an httpd handler that handles ws/wss requests +;; Creates an httpd handler that handles ws/wss requests ;; - continue is a procedure that receives a newly accepted websocket to handle ;; the request. When this process returns the handler closes the request. ;; - protocol is a procedure to select a protocol, if the client has specified @@ -30,44 +30,42 @@ (websocket-handle-request req res continue select-protocol max-frame-size)))) (def (websocket-handle-request req res continue select-protocol max-frame-size) - (let/cc exit - (def (bad-request! message) - (http-response-write res 400 [] message) - (exit 'bad-request)) + (def (bad-request! message) + (http-response-write res 400 [["Sec-Websocket-Version" . +websocket-version+]] message) + (raise 'bad-request)) - (let* ((request-headers (http-request-headers req)) - (_ (alet (version (aget "Sec-Websocket-Version" request-headers)) - (unless (equal? version +websocket-version+) - (bad-request! "unusupported websocket protocol version")))) - (proto - (alet (request-proto (aget "Sec-Websocket-Protocol" request-headers)) - (cond - ((select-protocol (string-split request-proto #\,))) - (else - (bad-request! "unsupported websocket protocol"))))) - (auth - (alet (nonce64 (aget "Sec-Websocket-Key" request-headers)) - (let* ((digest (make-digest digest::sha1)) - (_ (digest-update! digest (string->utf8 nonce64))) - (_ (digest-update! digest (string->utf8 +websocket-magic+))) - (auth (digest-final! digest))) - (base64-encode auth)))) - ;; TODO do we need any more headers? - (upgrade-headers - [["Upgrade" . "websocket"] - ["Sec-Websocket-Version" . +websocket-version+] - (if auth - [["Sec-Websocket-Accept" . auth]] - []) - ... - (if proto - [["Sec-Websocket-Protocol" . proto]] - []) - ...]) - ((values sock reader writer) - (http-response-upgrade! res upgrade-headers))) - (continue - (WebSocket (make-websocket sock reader writer - #t ; server socket - proto - max-frame-size)))))) + (let* ((request-headers (http-request-headers req)) + (_ (alet (version (aget "Sec-Websocket-Version" request-headers)) + (unless (equal? version +websocket-version+) + (bad-request! "unsupported websocket protocol version")))) + (proto + (alet (request-proto (aget "Sec-Websocket-Protocol" request-headers)) + (cond + ((select-protocol (string-split request-proto #\,))) + (else + (bad-request! "unsupported websocket protocol"))))) + (auth + (alet (nonce64 (aget "Sec-Websocket-Key" request-headers)) + (let* ((digest (make-digest digest::sha1)) + (_ (digest-update! digest (string->utf8 nonce64))) + (_ (digest-update! digest (string->utf8 +websocket-magic+))) + (auth (digest-final! digest))) + (base64-encode auth)))) + ;; TODO do we need any more headers? + (upgrade-headers + [["Upgrade" . "websocket"] + (if auth + [["Sec-Websocket-Accept" . auth]] + []) + ... + (if proto + [["Sec-Websocket-Protocol" . proto]] + []) + ...]) + ((values sock reader writer) + (http-response-upgrade! res upgrade-headers))) + (continue + (WebSocket (make-websocket sock reader writer + #t ; server socket + proto + max-frame-size)))))