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!
andrecv!
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"))))
fchat/typed/json
as well? \$\endgroup\$fchat/typed/json
has actually been rolled into the main distribution astyped/json
. You can see it here. \$\endgroup\$