WebSocket-based API library in Racket

Question

I've developed a library in (typed) Racket that wraps a WebSocket-based API. The API itself is very simple—it operates via a series of three-letter commands optionally followed by a JSON-encoded payload.

The simple library itself provides a series of small abstractions over interfacing with the raw WebSocket data:

• The connection/handshaking sequence is handled automatically by the library itself. It notifies the client when the handshaking is complete via a synchronizeable event in the form of a semaphore.
• It also automatically responds to ping commands to prevent the connection from timing out.
• The send! and recv! functions automatically wrap/unwrap commands and JSON payloads so that parsing doesn't need to be done manually.
• The received commands are queued by the library until read so that they can be handled on-demand.

I think the implementation is fairly solid, but I'd like to know if anything could be improved. Anything from simple readability adjustments to proposed structural changes would be appreciated.

#lang typed/racket/base

(provide
 (prefix-out fchat- (combine-out request-ticket!
                                 connect
                                 send!
                                 recv!
                                 close!
                                 conn-character))
 FChatConn
 fchat-conn?)

;; ---------------------------------------------------------------------------------------------------

(require racket/match
         racket/list
         typed/racket/async-channel
         typed/net/http-client
         typed/net/uri-codec
         fchat/typed/json)

(require/typed net/url-structs
               [#:struct path/param ([path : (U String 'up 'same)]
                                     [param : (Listof String)])
                         #:extra-constructor-name make-path/param]
               [#:struct url ([scheme : (Option String)]
                              [user : (Option String)]
                              [host : (Option String)]
                              [port : (Option Nonnegative-Integer)]
                              [path-absolute? : Boolean]
                              [path : (Listof path/param)]
                              [query : (Listof (Pair Symbol (Option String)))]
                              [fragment : (Option String)])
                         #:extra-constructor-name make-url])

(require/typed net/url
               [string->url (String -> url)])

(require/typed web-server/http
               [#:struct header ([field : Bytes] [value : Bytes])
                         #:extra-constructor-name make-header])

(require/typed net/rfc6455
               [#:opaque WSConn ws-conn?]
               [ws-connect (->* (url)
                                (#:headers (Listof header) #:protocol (U 'rfc6455 'hybi00))
                                WSConn)]
               [ws-send! (->* (WSConn (U String Bytes Input-Port))
                              (#:final-fragment? Boolean
                                                 #:payload-type (U 'continuation 'text 'binary)
                                                 #:flush? Boolean)
                              Void)]
               [ws-recv (->* (WSConn)
                             (#:stream? Boolean #:payload-type (U 'auto 'text 'binary))
                             (U EOF String Bytes Input-Port))]
               [ws-close! (->* (WSConn)
                               (#:status Integer #:reason String)
                               Void)])

(require/typed srfi/13
               [string-index (->* (String (U Char (Char -> Boolean)))
                                  (Integer Integer)
                                  (Option Integer))])

;; ---------------------------------------------------------------------------------------------------

;; Represents a single connection to the F-chat servers.
(struct fchat-conn ([socket : (Boxof (Option WSConn))]
                    [message-channel : (Async-Channelof (List String (Option JSExpr)))]
                    [character : String]))
(define-type FChatConn fchat-conn)

;; Requests a new API ticket from the server, invalidating all previous tickets for the account.
;; The data is returned as a JSExpr containing the ticket and other server-provided data.
(: request-ticket! (String String -> JSExpr))
(define (request-ticket! username password)
  (define-values (response headers data)
    (http-sendrecv "www.f-list.net"
                   "/json/getApiTicket.php"
                   #:method "POST"
                   #:data (alist->form-urlencoded
                           (list (cons 'account username)
                                 (cons 'password password)))
                   #:headers (list "Content-type: application/x-www-form-urlencoded")))
  (define json-data (read-json data))
  (cond
    [(eof-object? json-data) (error "failed to retrieve F-list API ticket")]
    [else json-data]))

;; Connects to the F-chat server with username and password, and logs in as character.
;; If debug is #t, connects to the debug server instead.
;; Returns two values, a connection handler and a synchronizable event that becomes ready
;; when the connection becomes usable.
(: connect (->*
            (#:ticket String #:username String #:character String
                      #:client-name String #:client-version String)
            (#:debug Boolean)
            (values fchat-conn Semaphore)))
(define (connect
         #:ticket ticket
         #:username username
         #:character character
         #:client-name client-name
         #:client-version client-version
         #:debug [debug #f])
  ; Perform connection asynchronously
  (define ready-sem (make-semaphore))
  (define fcc (fchat-conn (box #f) (make-async-channel) character))
  (thread
   (λ ()
     ; Connect to chat server
     (define ws (ws-connect (string->url (format "ws://chat.f-list.net:~a/"
                                                 (if debug "8722" "9722")))))
     (set-box! (fchat-conn-socket fcc) ws)
     ; Authorize with chat server
     (send! fcc "IDN" (make-hasheq `((method . "ticket")
                                     (account . ,username)
                                     (ticket . ,ticket)
                                     (character . ,character)
                                     (cname . ,client-name)
                                     (cversion . ,client-version))))
     ; Start worker thread
     (thread
      (λ ()
        (with-handlers ([exn:fail? void])
          (let loop ()
            (define-values (command payload) (recv-raw! fcc))
            (match command
              ["PIN"
               (send! fcc "PIN")]
              ["IDN"
               (semaphore-post ready-sem)]
              [_
               (async-channel-put (fchat-conn-message-channel fcc) (list command payload))])
            (loop)))))))
  (values fcc ready-sem))

;; Sends a command to the F-chat server. If a payload is specified,
;; its JSON-encoded value is sent with the command.
(: send! (->* (fchat-conn String) ((Option JSExpr)) Void))
(define (send! fcc command [payload #f])
  (ws-send! (cast (unbox (fchat-conn-socket fcc)) WSConn)
            (encode-message command payload)))

;; Encodes a command + json payload into a single string to be
;; sent to the F-chat servers.
(: encode-message (String (Option JSExpr) -> String))
(define (encode-message command payload)
  (if payload
      (format "~a ~a" command (jsexpr->string payload))
      command))

;; Internal command to actually recieve and parse data from the F-chat servers.
(: recv-raw! (fchat-conn -> (values String (Option JSExpr))))
(define (recv-raw! fcc)
  (define data (ws-recv (cast (unbox (fchat-conn-socket fcc)) WSConn)))
  (if (string? data)
      (decode-message data)
      (error "error recieving F-chat data")))

;; Decodes a message from the F-chat server into a command + json payload.
(: decode-message (String -> (values String (Option JSExpr))))
(define (decode-message message)
  (define space-index (string-index message #\space))
  (cond
    [space-index
     (define command (substring message 0 space-index))
     (define payload (string->jsexpr (substring message (add1 space-index))))
     (values command payload)]
    [else
     (values message #f)]))

;; Recieves a single command from the server. The commands are internally queued,
;; so this will return immediately if a command is on the queue, otherwise it will
;; block until a command arrives.
;; Returns the command and its accompanying payload, if it exists, otherwise #f.
(: recv! (fchat-conn -> (values String (Option JSExpr))))
(define (recv! fcc)
  (define data : (List String (Option JSExpr)) (async-channel-get (fchat-conn-message-channel fcc)))
  (values (first data) (second data)))

;; Closes the connection. Once the connection has been closed,
;; it cannot be reopened or otherwise reused.
(: close! (fchat-conn -> Void))
(define (close! fcc)
  (ws-close! (cast (unbox (fchat-conn-socket fcc)) WSConn)))

;; Gets the name of the character being used with the given connection.
(: conn-character (fchat-conn -> String))
(define (conn-character fcc)
  (fchat-conn-character fcc))

(module+ test
  (require typed/rackunit)

  (test-case
   "Encode a join channel message with a payload"
   (let ([command "JCH"]
         [payload : JSExpr (make-hasheq '((channel . "Frontpage")))]
         [result "JCH {\"channel\":\"Frontpage\"}"])
     (check-equal? (encode-message command payload) result
                   "encoded JCH message not equal?")))

  (test-case
   "Encode a ping message without a payload"
   (let ([command "PIN"]
         [result "PIN"])
     (check-equal? (encode-message command #f) result
                   "encoded PIN message not equal?")))

  (test-case
   "Decode an identification message with a payload"
   (let ([message "IDN {\"character\":\"Racket\"}"]
         [command "IDN"]
         [payload : JSExpr (make-immutable-hasheq '((character . "Racket")))])
     (define-values (c p) (decode-message message))
     (check-equal? c command "decoded IDN command not equal?")
     (check-equal? p payload "decoded IDN payload not equal?")))

  (test-case
   "Decode a ping message without a payload"
   (let ([message "PIN"]
         [command "PIN"])
     (define-values (c p) (decode-message message))
     (check-equal? c command "decoded PIN command not equal?")
     (check-false p "decoded PIN payload not #f"))))

Answer 1

Well, take this with a grain of salt, as I have a lot less knowledge of (typed) Racket; that said it's very readable, the comments are nice and you have a few test, looks good I think.

I'd suggest a few really minor things:

• Consistency: At some points you use (list (cons ..., at others the backquote syntax; I'd probably use only one of them.

• Configurability: The URLs and paths are hardcoded at the moment; moving them out into their own definitions would make it a bit nicer, same for the ports. If the only difference for debug is the port, I'd say use a port parameter with default value instead (more reusable).

• Style: This SO answer captures this quite well, basically that let is a bit more portable across Lisps and also captures the actual lexical nesting quite well. See comments.