(import http-curl
        intarweb
        uri-common
        (chicken base)
        (chicken condition)
        (chicken format)
        (chicken gc)
        (chicken io)
        (chicken process-context)
        (chicken string)
        srfi-13)

(define (env-number name default)
  (let ((value (get-environment-variable name)))
    (if value
        (or (string->number value)
            (error (sprintf "~A must be a number" name) value))
        default)))

(define (base-url path)
  (string-append (get-environment-variable "LEAK_BASE_URL") path))

(define iterations (env-number "LEAK_ITERATIONS" 200))
(define progress-every (env-number "LEAK_PROGRESS_EVERY" 25))

(define (read-all uri-or-request writer)
  (with-input-from-request uri-or-request writer read-string))

(define (expect-client-error thunk)
  (let ((raised? #f))
    (condition-case
     (thunk)
     ((http client-error) (set! raised? #t)))
    (unless raised?
      (error "expected (http client-error) condition"))))

(define (expect-server-error thunk)
  (let ((raised? #f))
    (condition-case
     (thunk)
     ((http server-error) (set! raised? #t)))
    (unless raised?
      (error "expected (http server-error) condition"))))

(define (exercise-success-paths i)
  (let ((get-body (read-all (base-url "/get") #f)))
    (unless (string-contains get-body "\"url\"")
      (error "GET response did not contain url field")))
  (let* ((uri (uri-reference (base-url "/post")))
         (h (headers '((content-type #(application/json ())))))
         (req (make-request uri: uri method: 'POST headers: h))
         (json-body (read-all req (sprintf "{\"iteration\":~A}" i))))
    (unless (string-contains json-body "iteration")
      (error "JSON POST response did not contain posted field")))
  (let ((form-body (read-all (base-url "/post")
                             `((iteration . ,(number->string i))
                               (kind . "form")))))
    (unless (string-contains form-body "form")
      (error "form POST response did not contain posted field")))
  (let ((redirect-body (read-all (base-url "/redirect/2") #f)))
    (unless (string-contains redirect-body "\"url\"")
      (error "redirect response did not contain url field"))))

(define (exercise-error-paths)
  (expect-client-error
   (lambda () (read-all (base-url "/status/404") #f)))
  (expect-server-error
   (lambda () (read-all (base-url "/status/500") #f))))

(define (exercise-early-exit)
  (call-with-input-request
   (base-url "/stream-bytes/65536")
   #f
   (lambda (port)
     (read-string 128 port))))

(define (run-iteration i)
  (exercise-success-paths i)
  (exercise-error-paths)
  (exercise-early-exit)
  (when (zero? (modulo i progress-every))
    (gc #t)
    (printf "completed ~A/~A iterations~%" i iterations)))

(unless (equal? "1" (get-environment-variable "TEST_NETWORK"))
  (printf "Set TEST_NETWORK=1 to run network leak checks.~%")
  (exit 0))

(unless (get-environment-variable "LEAK_BASE_URL")
  (set-environment-variable! "LEAK_BASE_URL" "https://httpbin.org"))

(printf "Running http-curl leak check: ~A iterations against ~A~%"
        iterations
        (get-environment-variable "LEAK_BASE_URL"))
(printf "For native leak reporting on macOS, run:~%")
(printf "  TEST_NETWORK=1 leaks --atExit -- csi -s tests/leak-check.scm~%~%")

(let loop ((i 1))
  (when (<= i iterations)
    (run-iteration i)
    (loop (add1 i))))

(gc #t)
(printf "Leak check completed successfully.~%")