movie-night-chat/chat.rkt

#lang racket
(provide (all-defined-out))
(require net/url
         net/rfc6455 ;; web sockets
         json
         "api.rkt")

(ws-idle-timeout +inf.0)

;; Creates a new connection and spaws threads for handling incoming events
;; and for sending pings.
;; Returns an object that can be used with e.g. send-message
(define (make-connection server-addr user-name
                         #:on-chat on-chat         ;;;  called with (on-chat from message)
                         #:on-response on-response ;;;  called with (on-response message)
                         #:on-users on-users       ;;;  called with (on-users users)
                         #:on-notify on-notify     ;;;  called with (on-notify msg)
                         #:on-join on-join         ;;;  called with (on-join user)
                         #:on-leave on-leave       ;;;  called with (on-leave user)
                         #:on-name-change on-name-change
                         ;;; called with (on-name-change old-name new-name)
                         )
  (define c (ws-connect (string->url server-addr)))
  (define user-color "#00FFAA")
  (define evt (ws-recv-evt c))
  (define (handle-evt)
    (let ([v (sync evt)])
      (cond
        [(eof-object? v)
         (printf "RIP socket\n")
         (ws-close! c)]
        [(string? v)
         (let ([js (string->jsexpr v)])
           (cond
             [(is-chat-message? js)
              (define msg (get-chat-message js))
              (match msg
                [(chat-message message from color type)
                 (match type
                   ['chat (on-chat from message)]
                   ['response (on-response message)]
                   [_
                    (log-warning
                     (format "chat.rkt/handl-evt: cannot handle message type in ~s" msg))])])]
             [(is-users-reply? js)
              (on-users (get-users-reply js))]
             [(is-notify? js)
              (log-info (format "MovieNight notification: ~a" js))
              (on-notify (get-notify js))]
             [(is-event? js)
              (log-info (format "got ~a" js))
              (define ed (get-event-data js))
              (match ed
                [(event-data type data)
                 (match type
                   ['join (on-join data)]
                   ['leave (on-leave data)]
                   [(or 'name-changed
                        'name-change-forced)
                    (match (string-split data ":")
                      [(list old-nick new-nick)
                       (on-name-change old-nick new-nick)]
                      [_ #f])]
                   [_
                    (log-warning
                     (format "chat.rkt/handl-evt: cannot handle event type in ~s" ed))])])]
             [else
              (log-warning
               (format "chat.rkt/handle-evt: don't know how to handle ~a" (jsexpr->string js)))]))
         (handle-evt)]
        [else
         (printf "Unknown msg: ~a" v)
         (handle-evt)])))
  (define (do-ping)
    (sleep 10)
    (send-ping c)
    (do-ping))
  (void (thread handle-evt))
  (void (thread do-ping))
  (send-join c user-name user-color)
  (sleep 2)
  (send-users c)
  c)


(define (nickname-check nick)
  (and (>= (string-length nick) 3)
       (<= (string-length nick) 10)
       ;; TODO other checks
       ))