;; -*- lexical-binding: t -*-

(require 'ert)
(require 'gnutls)

(defun t--read (proc nchars)
  "Read at least NCHARS characters from process PROC.
Return 'ok on success; otherwise return 'not-live."
  (let* ((buf (process-buffer proc))
	 (size (+ (buffer-size buf) nchars))
	 (result nil))
    (t--accept-process-output proc 0)
    (while (eq result nil)
      (cond ((>= (buffer-size buf) size)
	     (setq result 'ok))
	    ((not (process-live-p proc))
	     (setq result 'not-live))
	    (t
	     (t--accept-process-output proc nil))))
    result))

;; a wrapper around accept-process-output for debugging
(defun t--accept-process-output (proc timeout)
  (let ((buf (process-buffer proc)))
    (message "%s accept-process-output %S %s %s …"
	     (current-thread) proc (process-status proc) timeout)
    (let ((val (accept-process-output proc timeout)))
      (message "%s accept-process-output %S %s %s => %S %d"
	       (current-thread) proc (process-status proc) timeout
	       val (buffer-size buf))
      val)))

(defun t--read-all (proc)
  (while (pcase-exhaustive (t--read proc 1)
	   ('ok t)
	   ('not-live nil)))
  (with-current-buffer (process-buffer proc)
    (buffer-string)))

(defun t--make-buffer (name)
  (with-current-buffer (generate-new-buffer name t)
    (buffer-disable-undo)
    (set-buffer-multibyte nil)
    (current-buffer)))

(ert-deftest t-tls ()
  (thread-join
   (make-thread
    (lambda ()
      (let* ((proc (make-process
		    :name "cat"
		    :command (list "cat")
		    :sentinel (lambda (_ _))
		    :buffer (t--make-buffer "cat"))))
	(process-send-eof proc)
	(should (equal (t--read-all proc) ""))))))
  (let* ((host "www.example.net")
	 (proc (make-network-process
		:name "tls"
		:host host
		:service 443
		:tls-parameters (cons 'gnutls-x509pki
				      (gnutls-boot-parameters
				       :hostname host))
		:buffer (t--make-buffer "tls")
		:sentinel (lambda (_ _))))
	 (request (format "GET / HTTP/1.1\r\nHost: %s\r\n\r\n" host)))
    (process-send-string proc request)
    (process-send-eof proc)
    (let* ((response (t--read-all proc)))
      (should (string-match "^HTTP/1.1 200 OK" response)))))

;; Local Variables:
;; read-symbol-shorthands: (("t-" . "apo-tests-"))
;; End: