movie-night-chat/api.rkt

#lang racket
(provide send-ping send-message send-join send-users
         (struct-out chat-message)
         is-chat-message? get-chat-message
         is-notify? get-notify
         (struct-out event-data)
         is-event? get-event-data
         is-users-reply? get-users-reply)

(require net/rfc6455 ;; web sockets
         json
         "macros.rkt"
         )

(define (send-jsexpr c js)
  (when (ws-conn-closed? c)
    (error "trying to send-jsexpr to a closed connection"
           (ws-conn-close-status c)
           (ws-conn-close-reason c)))
  (ws-send! c (jsexpr->string js)))

(define/contract (send-ping conn)
  (-> ws-conn? void?)
  (send-jsexpr conn (hasheq 'Type CdPing 'Message "")))

(define/contract (send-message conn msg)
  (-> ws-conn? string? void?)
  (send-jsexpr conn (hasheq 'Type CdMessage 'Message msg)))

(define/contract (send-join conn name color)
  (-> ws-conn? string? string? void?)
  (define jd
    (jsexpr->string (hasheq 'Name name 'Color color)))
  (send-jsexpr conn (hasheq 'Type CdJoin 'Message jd)))

(define/contract (send-users conn)
  (-> ws-conn? any)
  (send-jsexpr conn (hasheq 'Type CdUsers 'Message "")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; is it a reply to the /users command?
(define/contract (is-users-reply? js)
  (-> jsexpr? boolean?)
  (and (= DTHidden (hash-ref js 'Type -1))
       (= CdUsers (hash-ref (hash-ref js 'Data) 'Type -1))))

(define/contract (get-users-reply js)
  (-> is-users-reply? (listof string?))
  (hash-ref (hash-ref js 'Data) 'Data))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(struct event-data (type payload) #:transparent)

(define/contract (is-event? js)
  (-> jsexpr? boolean?)
  (= DTEvent (hash-ref js 'Type -1)))


;; bad code
(define (convert-event-data-type t)
  (cond
    [(= t EvJoin) 'join]
    [(= t EvLeave) 'leave]
    [(= t EvKick) 'kick]
    [(= t EvBan) 'ban]
    [(= t EvServerMessage) 'server-message]
    [(= t EvNameChange) 'name-changed]
    [(= t EvNameChangeForced) 'name-change-forced]
    [else 'unknown]))

(define/contract (get-event-data js)
  (-> is-event? event-data?)
  (define data (hash-ref js 'Data))
  (event-data (convert-event-data-type (hash-ref data 'Event))
              (hash-ref data 'User "")))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define/contract (is-notify? js)
  (-> jsexpr? boolean?)
  (and (= DTHidden (hash-ref js 'Type -1))
       (= CdNotify (hash-ref (hash-ref js 'Data) 'Type -1))))

(define/contract (get-notify js)
  (-> is-notify? string?)
  (hash-ref (hash-ref js 'Data) 'Data))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(struct chat-message
  (message from color type)
  #:transparent)

(define/contract (is-chat-message? js)
  (-> jsexpr? boolean?)
  (= DTChat (hash-ref js 'Type 0)))

;; XXX: this code is bad
(define (convert-type t)
  (cond
    [(= t MsgChat) 'chat]
    [(= t MsgAction) 'action]
    [(= t MsgServer) 'server]
    [(= t MsgError) 'error]
    [(= t MsgNotice) 'notice]
    [(= t MsgCommandResponse) 'response]
    [(= t MsgCommandError) 'command-error]
    [else 'unknown]))

(define/contract (get-chat-message js)
  (-> jsexpr? chat-message?)
  (define data (hash-ref js 'Data))
  (chat-message (hash-ref data 'Message)
                (hash-ref data 'From)
                (hash-ref data 'Color)
                (convert-type (hash-ref data 'Type))))