(module dispatch-server-unit mzscheme
  (require (lib "tcp-sig.ss" "net")
           (lib "unitsig.ss")
           (lib "thread.ss")
           (lib "contract.ss")
           (lib "kw.ss"))
  (require "web-server-structs.ss"
           "connection-manager.ss"
           "dispatch-server-sig.ss")
  
  (provide/contract
   ; XXX contract
   [dispatch-server@ unit/sig?]) 
  
  ;; ****************************************  
  (define dispatch-server@
    (unit/sig dispatch-server^
      (import net:tcp^ (config : dispatch-server-config^))
      
      ;; serve: -> -> void
      ;; start the server and return a thunk to shut it down
      (define (serve)
        (define the-server-custodian (make-custodian))
        (start-connection-manager the-server-custodian)
        (parameterize ([current-custodian the-server-custodian]
                       [current-server-custodian the-server-custodian]
                       [current-thread-initial-stack-size 3])
          (thread
           (lambda ()
             (run-server config:port 
                         handle-connection
                         #f
                         (lambda (exn)
                           #f)
                         (lambda (p mw re)
                           (tcp-listen p config:max-waiting #t config:listen-ip))
                         tcp-close
                         tcp-accept
                         tcp-accept/enable-break))))
        (lambda ()
          (custodian-shutdown-all the-server-custodian)))
      
      ;; serve-ports : input-port output-port -> void
      ;; returns immediately, spawning a thread to handle
      ;; the connection
      ;; NOTE: (GregP) should allow the user to pass in a connection-custodian
      (define (serve-ports ip op)
        (define server-cust (make-custodian))
        (start-connection-manager server-cust)
        (parameterize ([current-custodian server-cust]
                       [current-server-custodian server-cust])
          (define connection-cust (make-custodian))
          (parameterize ([current-custodian connection-cust])
            (thread
             (lambda ()
               (handle-connection ip op
                                  (lambda (ip)
                                    (values "127.0.0.1"
                                            "127.0.0.1"))))))))
      
      ;; handle-connection : input-port output-port (input-port -> string string) -> void
      ;; returns immediately, spawning a thread to handle
      (define/kw (handle-connection ip op
                                    #:optional
                                    [port-addresses tcp-addresses])
        (define conn
          (new-connection config:initial-connection-timeout
                          ip op (current-custodian) #f))
        (with-handlers ([exn:fail:network?
                         (lambda (e)
                           (kill-connection! conn)
                           (raise e))])
          (let connection-loop ()
            (define-values (req close?) (config:read-request conn config:port port-addresses))
            (adjust-connection-timeout! conn config:initial-connection-timeout)
            (config:dispatch conn req)
            (unless (connection-close? conn)
              (set-connection-close?! conn close?))
            (cond
              [(connection-close? conn) (kill-connection! conn)]
              [else (connection-loop)])))))))