From 438d87675d9ef18695475685ff36ff75a5506466 Mon Sep 17 00:00:00 2001
From: Matthew Wolff <matthewjwolff@gmail.com>
Date: Wed, 8 May 2024 19:38:02 -0500
Subject: Distinguish close frames from timeouts.

---
 web/socket/client.scm | 36 +++++++++++++++++++++---------------
 web/socket/frame.scm  |  5 +++--
 web/socket/server.scm | 10 ++++++----
 3 files changed, 30 insertions(+), 21 deletions(-)

diff --git a/web/socket/client.scm b/web/socket/client.scm
index 4510493..966e3f7 100644
--- a/web/socket/client.scm
+++ b/web/socket/client.scm
@@ -211,18 +211,24 @@ connected to."
 
 (define* (websocket-receive ws #:key timeout)
   "Read data from the server that WS is connected to.  Returns a string
-if text data was received, a bytevector if binary data was received,
-or #f if the WebSocket connection was closed or TIMEOUT seconds
-elapsed without receiving a data frame."
-  (let* ((socket (websocket-socket ws))
-         (frame (read-data-frame socket #:timeout timeout)))
-    (cond ((not frame)
-           (when (port-closed? socket)
-             ;; EOF - clean up the websocket.
-             (close-port (websocket-entropy-port ws))
-             (set-websocket-state! ws 'closed))
-           #f)
-          ((binary-frame? frame)
-           (frame-data frame))
-          (else
-           (text-frame->string frame)))))
+if text data was received, a bytevector if binary data was received, a
+pair of (code . reason) if the WebSocket was closed, or #f if TIMEOUT
+seconds elapsed without receiving a data frame."
+  (let ((socket (websocket-socket ws)))
+    ;; For server initiated disconnects and timeouts.
+    (define (maybe-close)
+      (when (port-closed? socket)
+        ;; EOF - clean up the websocket.
+        (close-port (websocket-entropy-port ws))
+        (set-websocket-state! ws 'closed)))
+    (match (read-data-frame socket #:timeout timeout)
+      (#f ; timeout
+       (maybe-close)
+       #f)
+      ((? close-frame? frame)
+       (maybe-close)
+       (close-frame->status frame))
+      ((? binary-frame? frame)
+       (frame-data frame))
+      ((? text-frame? frame)
+       (text-frame->string frame)))))
diff --git a/web/socket/frame.scm b/web/socket/frame.scm
index 4c15a09..7f52e96 100644
--- a/web/socket/frame.scm
+++ b/web/socket/frame.scm
@@ -68,7 +68,8 @@
             read-frame
             read-data-frame
             read-close-frame
-            write-frame))
+            write-frame
+            close-frame->status))
 
 ;;;
 ;;; WebSocket frames
@@ -397,7 +398,7 @@ WebSocket connection."
           (false-if-exception
            (write-frame (make-close-frame (frame-data frame)) port)))
         (close-port port)
-        #f)
+        frame)
        ((ping-frame? frame)
         ;; Per section 5.5.3, a pong frame must include the exact
         ;; same data as the ping frame.
diff --git a/web/socket/server.scm b/web/socket/server.scm
index 3394d3b..353a2eb 100644
--- a/web/socket/server.scm
+++ b/web/socket/server.scm
@@ -95,10 +95,12 @@ called for each complete message that is received."
     (write-response response client-socket)
     (force-output client-socket)
     (let loop ()
-      (let ((frame (read-data-frame client-socket #:echo-close? #t)))
-        (when frame
-          (handle-data-frame (frame-type frame) (frame-data frame))
-          (loop))))))
+      (match (read-data-frame client-socket #:echo-close? #t)
+        ((or #f (? close-frame?))
+         (values))
+        (frame
+         (handle-data-frame (frame-type frame) (frame-data frame))
+         (loop))))))
 
 (define* (run-server handler #:optional (server-socket (make-server-socket)))
   "Run WebSocket server on SERVER-SOCKET.  HANDLER, a procedure that
-- 
cgit v1.2.3