- ,(wrap-apply websocket-client-loop)))
- #:allocation #:each-subclass
- #:accessor .upgrade-paths)
-
- (gen-client-id #:init-thunk make-simple-counter)
-
- ;; active websocket connections
- (ws-clients #:init-thunk make-hash-table
- #:accessor .ws-clients)
-
- (on-ws-message #:init-keyword #:on-ws-message
- #:getter .on-ws-message)
- (on-ws-client-connect #:init-keyword #:on-ws-client-connect
- #:init-value no-op
- #:getter .on-ws-client-connect)
- (on-ws-client-disconnect #:init-keyword #:on-ws-client-disconnect
- #:init-value no-op
- #:getter .on-ws-client-disconnect))
-
-(define (web-server-gen-client-id websocket-server)
- ((slot-ref websocket-server 'gen-client-id)))
-
-(define (websocket-client-loop websocket-server client request body)
- "Serve client connected via CLIENT by performing the HTTP
-handshake and listening for control and data frames. HANDLER is
-called for each complete message that is received."
- ;; TODO: We'll also want to handle stuff like the sub-protocol.
- (define (handle-data-frame type data)
- ((.on-ws-message websocket-server)
- websocket-server client-id
- (match type
- ('text (utf8->string data))
- ('binary data))))
-
- (define (read-frame-maybe)
- (and (not (eof-object? (lookahead-u8 client)))
- (read-frame client)))
-
- ;; Allows other actors to send things to this specific client
- ;; @@: We probably could just increment a counter...
- (define client-id (web-server-gen-client-id websocket-server))
-
- (define (close-down)
- (close-port client)
- (hash-remove! (.ws-clients websocket-server) client-id)
- ((.on-ws-client-disconnect websocket-server)
- websocket-server client-id))
-
- (hash-set! (.ws-clients websocket-server) client-id client)
+ ,(wrap-apply make-websocket-actor)))
+ #:allocation #:each-subclass)
+
+ (on-ws-connection #:init-keyword #:on-ws-connection
+ #:init-value no-op
+ #:getter .on-ws-connection)
+
+ (on-ws-close #:init-keyword #:on-ws-close
+ #:init-value no-op
+ #:getter .on-ws-close)
+ (on-ws-error #:init-keyword #:on-ws-error
+ #:init-value no-op
+ #:getter .on-ws-error)
+ (on-ws-message #:init-keyword #:on-ws-message
+ #:init-value no-op
+ #:getter .on-ws-message)
+ (on-ws-open #:init-keyword #:on-ws-open
+ #:init-value no-op
+ #:getter .on-ws-open))
+
+(define (make-websocket-actor websocket-server client request body)
+ "Setup websocket actor connected via CLIENT by performing the HTTP
+handshake."