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

(define (bad-uri-condition? thunk)
  (let ((raised? #f))
    (condition-case
     (thunk)
     ((http bad-uri) (set! raised? #t)))
    raised?))

(define (with-environment-variable name value thunk)
  (let ((old-value (get-environment-variable name)))
    (dynamic-wind
      (lambda ()
        (if value
            (set-environment-variable! name value)
            (unset-environment-variable! name)))
      thunk
      (lambda ()
        (if old-value
            (set-environment-variable! name old-value)
            (unset-environment-variable! name))))))

(define (capture-body writer)
  (let ((out (open-output-string)))
    (writer out)
    (get-output-string out)))

(define network-tests? (equal? "1" (get-environment-variable "TEST_NETWORK")))

;; ==================== Tests ====================

(test-begin "http-curl")

(test-group "offline behavior"
  (test "max-retry-attempts default" 1 (max-retry-attempts))
  (test "max-redirect-depth default" 5 (max-redirect-depth))
  (test "max-idle-connections default" 32 (max-idle-connections))
  (test "client-software default" "http-curl/0.1" (client-software))
  (test-assert "retry-request? default accepts requests"
               ((retry-request?) (make-request uri: (uri-reference "https://example.com/"))))

  (call-with-values
    (lambda () ((determine-username/password) (uri-reference "https://example.com/") "realm"))
    (lambda (username password)
      (test "username default" #f username)
      (test "password default" #f password)))
  (call-with-values
    (lambda () ((determine-proxy-username/password) (uri-reference "https://example.com/") "realm"))
    (lambda (username password)
      (test "proxy username default" #f username)
      (test "proxy password default" #f password)))

  (let ((req (make-request uri: (uri-reference "https://example.com/") method: 'GET)))
    (test "default-prepare-request returns request" req (default-prepare-request req))
    (test "prepare-request default returns request" req ((prepare-request) req)))

  (call-with-values
    (lambda () (%prepare-input-request "https://example.com/path" #f #f))
    (lambda (req uri write-body)
      (test "request string without writer uses GET" 'GET (request-method req))
      (test "request string parses URI" "https://example.com/path" (uri->string uri))
      (test "missing writer produces empty body" "" (capture-body write-body))))

  (call-with-values
    (lambda () (%prepare-input-request "https://example.com/path" "hello" #f))
    (lambda (req uri write-body)
      (test "string writer uses POST" 'POST (request-method req))
      (test "string writer serializes body" "hello" (capture-body write-body))))

  (call-with-values
    (lambda () (%prepare-input-request "https://example.com/path" '((foo . "bar") (baz . "quux")) #f))
    (lambda (req uri write-body)
      (test "alist writer uses POST" 'POST (request-method req))
      (test "alist writer form-encodes body" "foo=bar&baz=quux" (capture-body write-body))
      (test-assert "alist writer adds content-type"
                   (header-value 'content-type (request-headers req)))))

  (call-with-values
    (lambda () (%prepare-input-request "https://example.com/path"
                                       (lambda (out) (display "generated" out))
                                       #f))
    (lambda (req uri write-body)
      (test "procedure writer uses POST" 'POST (request-method req))
      (test "procedure writer serializes body" "generated" (capture-body write-body))))

  (let ((req (make-request uri: (uri-reference "https://example.com/resource") method: 'PUT)))
    (call-with-values
      (lambda () (%prepare-input-request req "replacement" #f))
      (lambda (prepared-req uri write-body)
        (test "request object preserves method" 'PUT (request-method prepared-req))
        (test-assert "request object preserves URI" (equal? (request-uri req) uri))
        (test "request object still uses provided body" "replacement" (capture-body write-body)))))

  (with-environment-variable
   "http_proxy" "http://proxy.example:8080"
   (lambda ()
     (with-environment-variable
      "https_proxy" "http://secure-proxy.example:8443"
      (lambda ()
        (test "http proxy"
              "http://proxy.example:8080"
              (determine-proxy-from-environment (uri-reference "http://example.com/")))
        (test "https proxy"
              "http://secure-proxy.example:8443"
              (determine-proxy-from-environment (uri-reference "https://example.com/")))))))

  (test-assert "non-URI target raises bad-uri"
               (bad-uri-condition?
                (lambda () (%prepare-input-request 123 #f #f))))
  (test-assert "relative URI string raises bad-uri"
               (bad-uri-condition?
                (lambda () (%prepare-input-request "/relative" #f #f)))))

(if network-tests?
    (printf "~%Running network tests because TEST_NETWORK=1...~%~%")
    (printf "~%Skipping network tests; set TEST_NETWORK=1 to enable them.~%~%"))

(when network-tests?

;; Test 1: Simple HTTPS GET
(test-group "network behavior"
  (test-assert "HTTPS GET returns body"
    (let ((body (call-with-input-request "https://httpbin.org/get" #f
                   (lambda (p) (read-string #f p)))))
      (and (string? body)
           (> (string-length body) 0)
           (string-contains body "\"url\""))))

;; Test 2: with-input-from-request
  (test-assert "with-input-from-request works"
    (let ((body (with-input-from-request "https://httpbin.org/get" #f read-string)))
      (and (string? body)
           (string-contains body "\"url\""))))

;; Test 3: POST with JSON body and custom headers
  (test-assert "POST with JSON body and custom headers"
    (let* ((uri (uri-reference "https://httpbin.org/post"))
           (h (headers '((content-type #(application/json ())))))
           (req (make-request uri: uri method: 'POST headers: h))
           (body (with-input-from-request req "{\"test\":1}" read-string)))
      (and (string? body)
           (string-contains body "\"test\""))))

;; Test 4: call-with-input-request* gives port and response
  (test-assert "call-with-input-request* provides response"
    (call-with-input-request*
     "https://httpbin.org/get" #f
     (lambda (port response)
       (let ((body (read-string #f port)))
         (and (string? body)
              (response? response)
              (= 200 (response-code response)))))))

;; Test 5: 404 raises client-error condition
  (test-assert "404 raises (http client-error) condition"
    (let ((raised? #f))
      (condition-case
       (begin
         (with-input-from-request "https://httpbin.org/status/404" #f read-string)
         (error "should have raised an error"))
       ((http client-error) (set! raised? #t)))
      raised?))

;; Test 6: 500 raises server-error condition
  (test-assert "500 raises (http server-error) condition"
    (let ((raised? #f))
      (condition-case
       (begin
         (with-input-from-request "https://httpbin.org/status/500" #f read-string)
         (error "should have raised an error"))
       ((http server-error) (set! raised? #t)))
      raised?))

;; Test 7: Redirect following
  (test-assert "Follows redirects"
    (let ((body (with-input-from-request "https://httpbin.org/redirect/2" #f read-string)))
      (and (string? body)
           (string-contains body "\"url\""))))

;; Test 8: Form-encoded POST
  (test-assert "Form-encoded POST with alist writer"
    (let ((body (with-input-from-request
                 "https://httpbin.org/post"
                 '((foo . "bar") (baz . "quux"))
                 read-string)))
      (string-contains body "bar")))

;; Test 9: Repeated GET calls should remain stable
  (test-assert "Repeated GET requests do not crash"
    (let loop ((i 0))
      (or (= i 20)
          (let ((body (with-input-from-request "https://httpbin.org/get" #f read-string)))
            (and (string? body)
                 (string-contains body "\"url\"")
                 (loop (add1 i)))))))))

(test-end "http-curl")

(test-exit)