- (write-response response client)
- (let loop ((fragments '())
- (type #f))
- (let ((frame (read-frame-maybe)))
- (cond
- ;; EOF - port is closed.
- ;; @@: Sometimes the eof object appears here as opposed to
- ;; at lookahead, but I'm not sure why
- ((or (not frame) (eof-object? frame))
- (close-down))
- ;; Per section 5.4, control frames may appear interspersed
- ;; along with a fragmented message.
- ((close-frame? frame)
- ;; Per section 5.5.1, echo the close frame back to the
- ;; client before closing the socket. The client may no
- ;; longer be listening.
- (false-if-exception
- (write-frame (make-close-frame (frame-data frame)) client))
- (close-down))
- ((ping-frame? frame)
- ;; Per section 5.5.3, a pong frame must include the exact
- ;; same data as the ping frame.
- (write-frame (make-pong-frame (frame-data frame)) client)
- (loop fragments type))
- ((pong-frame? frame) ; silently ignore pongs
- (loop fragments type))
- ((first-fragment-frame? frame) ; begin accumulating fragments
- (loop (list frame) (frame-type frame)))
- ((final-fragment-frame? frame) ; concatenate all fragments
- (handle-data-frame type (frame-concatenate
- (reverse (cons frame fragments))))
- (loop '() #f))
- ((fragment-frame? frame) ; add a fragment
- (loop (cons frame fragments) type))
- ((data-frame? frame) ; unfragmented data frame
- (handle-data-frame (frame-type frame) (frame-data frame))
- (loop '() #f)))))))
-
-(define (websocket-server-send websocket-server message client-id data)
- (cond ((hash-ref (.ws-clients websocket-server) client-id) =>
- (lambda (client)
- (write-frame
- (cond ((string? data)
- (make-text-frame data))
- ((bytevector? data)
- (make-binary-frame data)))
- client)
- ;; ok is like success, amirite
- (<-reply message 'ok)))
- (else
- ;; No such client with that id.
- ;; Either it closed, or it was never there.
- (<-reply message 'client-gone))))
+ (write-response response client))
+
+ (let* ((websocket-id (create-actor websocket-server <websocket>
+ #:socket client
+ #:state 'open
+ #:on-close (.on-ws-close websocket-server)
+ #:on-error (.on-ws-error websocket-server)
+ #:on-message (.on-ws-message websocket-server)
+ #:on-open (.on-ws-open websocket-server)))
+ (hive ((@@ (8sync actors) actor-hive) websocket-server))
+ (websocket ((@@ (8sync actors) hive-resolve-local-actor) hive websocket-id)))
+ ((.on-ws-connection websocket-server) websocket-id)
+ (websocket-loop websocket 'message)))