;; The first three lines of this file were inserted by DrRacket. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname server) (read-case-sensitive #t) (teachpacks ()) (htdp-settings #(#t constructor repeating-decimal #f #t none #f () #f)))
(require 2htdp/universe)
(require racket/base)

;; Constants:
;; Rate limit on messages before being disconnected (ms)
(define DOS-TIME 250)

;; A Client is a (make-client iworld Number Color) 
(define-struct client (iw time color))
;; Where time is the time in milliseconds of the last message from the iworld
;; and color is one of:
;; - 'black (0)
;; - 'deeppink (1)
;; - 'darkorchid (2)
;; - 'dodgerblue (3)
;; - 'lawngreen (4)
;; - 'gold (5)
;; - 'darkorange (6)
;; - 'firebrick (7)
;; - 'chocolate (8)

;; A (chat) Server is (make-server [Listof Client])
(define-struct server (worlds))

;; a SimpleIncomingMessage is one of:
;;  - (list "MSG" <content>)
;;    meaning that the client who sent this message has sent the given message.
;;  - (list "COLOR" <content>)
;;    meaning that the client is setting the color of their nickname by <concent>

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

;; handle-new : Server iworld -> Bundle
;; Handles new connections
(define (handle-new s i)
  (cond [(string? (iworld-name i))
         (make-bundle (make-server (cons (make-client i (current-milliseconds) 'black)
                                         (server-worlds s)))
                      (map (lambda (w)
                             (make-mail (client-iw w)
                                        
                                        (list "MSG" "" (string-append (iworld-name i) " joined.") 'black)))
                           (server-worlds s))
                      (list))]
        [else (handle-disconnect s i)]))

;; handle-disconnect : Server iworld -> Bundle
;; Handles disconnections by clients
(define (handle-disconnect s i)
  (local [(define new-worlds (filter (λ (el) (not (iworld=? i (client-iw el))))
                                     (server-worlds s)))]
    (make-bundle (make-server new-worlds)
                 (map (lambda (w)
                        (make-mail (client-iw w)
                                   (list "MSG" "" (string-append (iworld-name i) " disconnected.") 'black)))
                      new-worlds)
                 (list i))))

;; message-content : SimpleIncomingMessage -> String 
(define (message-content x)
  (if (cons? (rest x))
      (second x)
      empty))

;; tagged-list? : Any String -> Boolean
;; Is x of the form (list tag String)?
(define (tagged-list? x tag)
  (and (cons? x)
       (string? (first x))
       (string=? (first x) tag)))

(check-expect (tagged-list? '("FOO" bar baz) "FOO") true)
(check-expect (tagged-list? '(fizz bar baz) "FOO") false)
(check-expect (tagged-list? '() "FOO") false)
(check-expect (tagged-list? 'crap "FOO") false)
(check-expect (tagged-list? "FOO" "FOO") false)

;; send-to-all : String Server -> [ListOf Mail]
(define (send-to-all content srv)
  (map (lambda (w)
         (make-mail (client-iw w) content))
       (server-worlds srv)))

;; get-client : Server iworld -> Client
;; Get the client from the Server based on the iworld
(define (get-client s i)
  (findf (λ (el) (iworld=? i (client-iw el))) (server-worlds s)))

;; handle-msg : Server iworld String -> Bundle
;; Handles messages coming from the clients, prepending the name of
;; the world to each before sending them out.
(define (handle-msg srv i msg)
  (local [(define client (get-client srv i))]
    (cond [(tagged-list? msg "MSG")
           (make-bundle (update-client-time srv client)
                        (send-to-all (list "MSG"
                                           (iworld-name i)
                                           (message-content msg)
                                           (client-color client))
                                     srv)
                        (list))]
          [(tagged-list? msg "COLOR")
           (make-bundle (update-client-color (update-client-time srv client)
                                             client
                                             (message-content msg))
                        (list)
                        (list))]
          [(and (cons? msg) (cons? (rest msg)))
           (make-bundle (update-client-time srv client)
                                    (send-to-all (list (first msg)
                                                       (iworld-name i)
                                                       (second msg)
                                                       (client-color client))
                                                 srv)
                                    (list))]
          [else (make-bundle (update-client-time srv client)
                                    (send-to-all msg
                                                 srv)
                                    (list))])))


;; update-client-time : Server Client -> Server
;; Update the Server with the time of last message for the given client
(define (update-client-time srv cl)
  (make-server
   (map (λ (el) (if (iworld=? (client-iw cl) (client-iw el))
                    (make-client (client-iw cl)
                                 (current-milliseconds)
                                 (client-color cl))
                    el))
        (server-worlds srv))))

;; update-client-color : Server Client Number -> Server
;; Update the Server with the new color for the client
(define (update-client-color srv cl n)
  (local [(define color
            (cond [(not (number? n)) n]
                  [(= n 1) 'deeppink]
                  [(= n 2) 'darkorchid]
                  [(= n 3) 'dodgerblue]
                  [(= n 4) 'lawngreen]
                  [(= n 5) 'gold]
                  [(= n 6) 'darkorange]
                  [(= n 7) 'firebrick]
                  [(= n 8) 'chocolate]
                  [(= n 0) 'black]
                  [else n ]))]
    (make-server (map (λ (el) (if (iworld=? (client-iw cl) (client-iw el))
                                  (make-client (client-iw cl)
                                               (client-time cl)
                                               color)
                                  el))
                      (server-worlds srv)))))

;; main : -> Server
(define (main)
  (universe (make-server empty)
            (on-msg handle-msg)
            (on-new handle-new)
            (on-disconnect handle-disconnect)))

(main)