;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.number-toss)

;;;;;;
;;; Constant

(def constant +default-database-name+ "hu.dwim.number-toss")

(def constant +default-database-user-name+ "hu.dwim.number-toss")

(def constant +default-database-password+ "engedjbe")

(def constant +recalculation-frequency+ +seconds-per-minute+)

;;;;;;
;;; Application

(def class* number-toss-application (application-with-home-package application-with-perec-support)
  ())

(def special-variable *number-toss-application* (make-instance 'number-toss-application))

;;;;;;
;;; Entry point

(def entry-point (*number-toss-application* :path "status")
  (disallow-response-caching
    (make-byte-vector-response ((+header/content-type+ +utf-8-plain-text-content-type+))
      (with-database (hu.dwim.web-server::database-of *number-toss-application*)
        (with-new-compiled-query-cache
          (with-transaction
            (write-server-status t)
            (format t "~%")
            (format t "Number of registered players:               ~A~%" (count-instances 'player))
            (format t "Number of submitted games:                  ~A~%" (count-instances 'game))
            (format t "Number of submitted challenges:             ~A~%" (count-instances 'challenge))
            (iter (for size :from 5 :to 9)
                  (for overall-scoreboard = (overall-scoreboard/ensure size ""))
                  (when overall-scoreboard
                    (format t "Scoreboard (~Ax~A) last refreshed:            ~A~%" size size (created-at-of overall-scoreboard))))))))))

(def class* request-builder (hu.dwim.util.flexml:builder)
  ())

(def method sax:end-element ((builder request-builder) namespace-uri local-name qname)
  (bind ((node (call-next-method)))
    (if (eq node (root-of builder))
        (throw 'end-document node)
        node)))

;; TODO: prevent denial of service attacks
(def entry-point (*number-toss-application* :path "service")
  (make-buffered-functional-html-response ((+header/status+ +http-ok+ +header/content-type+ +xml-mime-type+))
    (bind ((request (catch 'end-document
                      ;; NOTE: the concatenated stream prevents cxml closing the network stream too early
                      ;; NOTE: the buffer size 1 prevents blocking on not enough input
                      (cxml::parse-xstream (cxml:make-xstream (make-concatenated-stream (client-stream-of *request*)) :speed 1)
                                           (make-instance 'request-builder
                                                          :default-package (find-package :hu.dwim.number-toss)
                                                          :default-node-class 'node
                                                          :drop-whitespace #t))))
           (service-function-name (string+ "SERVICE/PROCESS-" (string-upcase (local-name-of request))))
           (function (find-symbol service-function-name (find-package :hu.dwim.number-toss))))
      (with-error-log-decorator (make-error-log-decorator
                                  (format t "~%request: ~A" request))
        (when function
          (with-database (hu.dwim.web-server::database-of *number-toss-application*)
            (with-new-compiled-query-cache
              (with-transaction
                (funcall function request)))))))))

;;;;;;
;;; Server

(def (class* e) number-toss-server (broker-based-server)
  ())

(def special-variable *number-toss-server* (make-instance 'number-toss-server
                                                          :host +any-host+
                                                          :port +default-http-server-port+
                                                          :brokers (list *number-toss-application*)))

;;;;;;
;;; Production

(def function executable-toplevel ()
  "The toplevel function that is called when the dwim Server is started from the command line. For development use (asdf:develop-system :hu.dwim.number-toss) instead."
  (with-standard-toplevel-restarts
    (bind ((options (append (list +help-command-line-option+)
                            (list +quiet-command-line-option+)
                            (copy-command-line-options +database-command-line-options+
                                                       :database-port +default-postgresql-database-server-port+
                                                       :database-name +default-database-name+
                                                       :database-user-name +default-database-user-name+
                                                       :database-password +default-database-password+)
                            +generic-command-line-options+))
           (arguments (process-command-line-options options (get-command-line-arguments))))
      (process-help-command-line-argument options arguments)
      (process-quiet-command-line-argument arguments)
      (run-production-server arguments :hu.dwim.number-toss *number-toss-server* *number-toss-application*))
    +process-return-code/no-error+))