10
\$\begingroup\$

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"))))
\$\endgroup\$
2
  • \$\begingroup\$ Post fchat/typed/json as well? \$\endgroup\$
    – ferada
    Apr 22, 2015 at 20:46
  • \$\begingroup\$ @ferada Since posting this question, fchat/typed/json has actually been rolled into the main distribution as typed/json. You can see it here. \$\endgroup\$ Apr 22, 2015 at 20:48

1 Answer 1

2
\$\begingroup\$

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.

\$\endgroup\$
2
  • 1
    \$\begingroup\$ Thanks for the feedback! With regards to the last point, the official Racket style guide prefers define, but since I wrote this code I've drifted towards preferring let in most cases, so I'd tend to agree with you. \$\endgroup\$ Apr 22, 2015 at 22:49
  • \$\begingroup\$ I have to read more docs; thanks for the link. \$\endgroup\$
    – ferada
    Apr 22, 2015 at 23:10

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.