(use matchable)
 (use tweetnacl)
 (use socket)
 (use srfi-27)
 (use moa) ;; from srfi-27
 (use entropy-unix) ;; from srfi-27













 ;; FIXME: Accept a hostname for open-connection, and look it up

 ;; FIXME: Support sending creds over a unix-domain socket instead of a username.

 ;; FIXME: User data field in a connection

 (use matchable)
 (use tweetnacl)
 (use socket)
 (use srfi-27)
 (use moa) ;; from srfi-27
 (use entropy-unix) ;; from srfi-27

 ;; FIXME: Log handler exceptions - and call (get-call-chain) for details

 ;; FIXME: Try-again-later responses to requests, caused by a
 ;; configurable concurrent request limit or a special condition
 ;; type. CLient sleeps and retries (sleep time is listed in the
 ;; try-again-later response).

 ;; FIXME: TCP connection handshake to include option to redirect to
 ;; another server IP:port, controlled by the open handlers

 ;; open-connection gets all A records and tries until it gets in

 ;; FIXME: Accept a hostname for open-connection, and look it up

 ;; FIXME: Support sending creds over a unix-domain socket instead of a username.

 ;; FIXME: User data field in a connection

(use bokbok)

(use srfi-18)
(use test)

(define (make-test-client addr user key)
  (let ((callback-max 0)
        (close-count 0)
        (mutex (make-mutex)))
    (values
     ;; get counts closure
     (lambda ()
       (mutex-lock! mutex)
       (let ((cm callback-max)
             (cc close-count))
         (mutex-unlock! mutex)
         (values cm cc)))
     ;; connection object
     (open-connection addr user key
                      (lambda (con request)
                        (match request
                               (("count" numstr)
                                (let ((num (string->number numstr)))
                                  (mutex-lock! mutex)
                                  (when (> num callback-max)
                                        (set! callback-max num))
                                  (mutex-unlock! mutex)))))
                      (lambda (con)
                        (mutex-lock! mutex)
                        (set! close-count (+ close-count 1))
                        (mutex-unlock! mutex))))))

(define (make-test-server addr backlog user->key)
  (let ((total 0)
        (close-count 0)
        (mutex (make-mutex)))
    (values
     ;; get counts closure
     (lambda ()
       (mutex-lock! mutex)
       (let ((t total)
             (cc close-count))
         (mutex-unlock! mutex)
         (values t cc)))
     ;; connection object
     (start-server addr backlog user->key
                   (lambda (con)
                     (mutex-lock! mutex)
                     (let ((total-copy total))
                       (mutex-unlock! mutex)
                       (request! con (list "count"
                                           (number->string total-copy)))))
                   (lambda (con request)
                     (match request
                            (("add" numstr)
                             (let ((num (string->number numstr)))
                               (mutex-lock! mutex)
                               (set! total (+ total num))
                               (let ((total-copy total))
                                 (mutex-unlock! mutex)
                                 (request! con (list "count"
                                                     (number->string total-copy))))))))
                   (lambda (con)
                     (mutex-lock! mutex)
                     (set! close-count (+ close-count 1))
                     (mutex-unlock! mutex))))))

(define (run-test client-addr server-addr backlog encrypt?)
  (receive
   (get-server-counts server)
   (make-test-server server-addr backlog
                     (if encrypt? (lambda (username)
                                    (match username
                                           ("myuser" (passphrase->key "mypassphrase"))
                                           (else #f)))
                         #f))
   (receive
    (get-client-counts client)
    (make-test-client
     client-addr
     (if encrypt? "myuser" #f)
     (if encrypt? (passphrase->key "mypassphrase") #f))

    ;; Send test load: 10 threads sending 1..10 each
    (let ((threads
           (map
            (lambda (thread-number)
              (let ((thread
                     (make-thread
                      (lambda ()
                        (for-each
                         (lambda (idx)
                           (request! client
                                     (list "add" (number->string idx))))
                         (iota 10))))))
                (thread-start! thread)
                thread))
            (iota 10))))

    ;; Wait for them all to finish
      (for-each
       thread-join!
       threads))

    ;; Wait to make sure all callbacks have come back
    (thread-sleep! 1)

    ;; Close client
    (close-connection! client)

    ;; Close server
    (stop-server! server)
    (wait-until-server-stopped server)

    ;; Check everything is as expected
    ;; 450 = number of threads * sum of 1..number of iterations
    ;; = 10 * sum of 1..10
    ;; = 10 * 45
    ;; = 450
    (let-values (((client-total client-closes) (get-client-counts))
                 ((server-total server-closes) (get-server-counts)))
      (test "Client total" 450 client-total)
      (test "Client closes" 0 client-closes)
      (test "Server total" 450 server-total)
      (test "Server closes" 1 server-closes)))))


(run-test '(tcp "localhost" 9988) '(tcp #f 9988) 1 #f)