(define-module (gemini-client)
  #:use-module (gnutls)
  #:use-module (ice-9 format)
  #:use-module (ice-9 rdelim)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-9)
  #:use-module (web uri)
  #:export (gemini-client
            gemini-client-host-name
            gemini-client-fetch-uri))

(define %gemini-port 1965)

;; Connection to a single Gemini server.
(define-record-type <gemini-client>
  (%gemini-client host-name session)
  gemini-client?
  (host-name gemini-client-host-name)
  (session   gemini-client-gnutls-session))

(define* (gemini-client host-name
                        #:optional (port %gemini-port))
  "Connect to a Gemini server located at HOST-NAME on PORT."
  (let* ((session (make-session connection-end/client))
         (ai (car (getaddrinfo host-name (number->string port) PF_UNSPEC)))
         (sock (socket (addrinfo:fam ai)
                       (addrinfo:socktype ai)
                       (addrinfo:protocol ai))))
    (connect sock (addrinfo:fam ai)
             (sockaddr:addr (addrinfo:addr ai))
             port)
    (set-session-default-priority! session)
    (set-session-credentials! session (make-certificate-credentials))
    (set-session-dh-prime-bits! session 1024)
    (set-session-transport-fd! session (fileno sock))
    (handshake session)
    (%gemini-client host-name session)))

(define (read-response mime port)
  "Read content according to MIME from PORT."
  (unless (eqv? mime 'text/gemini)
    (error "unsupported mime type" mime))
  (read-line port)
  (let loop ((response '()))
    (let ((line (read-line port)))
      (if (eof-object? line)
          (reverse! response)
          (loop (cons (string-trim-right line char-set:whitespace)
                      response))))))

(define (gemini-client-fetch-uri client uri)
  "Return a list of the form (mime-type content) where mime-type is a symbol
representing the content type, and content is the contents of the parsed
response. For 'text/gemini, this is a list of strings."
  (unless (eqv? (uri-scheme uri) 'gemini)
    (error "invalid uri scheme"))
  (let* ((session (gemini-client-gnutls-session client))
         (port (session-record-port session)))
    (format port "~a\r\n" (uri->string uri))
    (let ((initial-line (read-line port)))
      (match (string-split initial-line #\tab)
        ((status meta)
         (let ((meta (string->symbol
                      (string-trim-right meta char-set:whitespace))))
           (unless (> (string-length status) 0)
             (error "server error" status))
           (match (string-ref status 0)
             (#\1 (error "input requested, which library does not support"))
             (#\2 (list meta (read-response meta port)))
             (#\3 (gemini-client-fetch-uri client (string->uri meta)))
             (#\4 (error "temporary server failure" meta))
             (#\5 (error "permanent server failure" meta))
             (#\6 (error "client certificate required, which library does not support"))
             (_ (error "server error" status)))))
        (else (error "invalid response from server" initial-line))))))