#lang racket

(provide (contract-out
          [request (-> url? (values integer? string? input-port?))])
         (struct-out exn:fail:response))

(require openssl)
(require net/url-string)

;; ssl-connect may raise (by way of tcp-connect) exn:fail:network
;; read-response may raise exn:fail:network:gemini
(define (request url)
  (define-values (c-in c-out)
    (ssl-connect (url-host url)
                 (or (url-port url) 1965)))

  (write-string (url->string url) c-out)
  (write-string "\r\n" c-out)

  (define-values (status header)
    (read-response c-in))

  (values status header c-in))

(struct exn:fail:response exn:fail ()
  #:extra-constructor-name make-exn:fail:response
  #:transparent)

(define (raise-response-error name message response)
  (raise (make-exn:fail:response
          (format (string-append "~a: ~a~n"
                                 "  response: ~a")
                  (symbol->string name)
                  message
                  (if (> (string-length response) 20)
                      (format "~a... (truncated)" (substring response 0 20))
                      response))
          (current-continuation-marks))))

(define (read-response (c-in (current-input-port)))
  (define maxlen 1027)

  (let ([header (peek-string maxlen 0 c-in)])

    (if (not (string-contains? header "\r\n"))
        (raise-response-error 'read-response
                              "header exceeds maximum length"
                              header)

        (let ([header (read-line c-in 'return-linefeed)])
          (define-values (status meta)
            (let ([status-meta (string-split header " ")])
              (values (car status-meta)
                      (string-join (cdr status-meta)))))

          (cond
            [(> (string-length status) 2)
             (raise-response-error 'read-response
                                   "status code exceeds maximum length"
                                   header)]


            [(andmap (compose not char-numeric?) (string->list status))
             (raise-response-error 'read-response
                                   "status code not numeric"
                                   header)]

            [else
             (values (string->number status) meta)])))))