;;;; client-info.lisp

(in-package #:quicklisp-client)

(defparameter *client-base-url* "http://beta.quicklisp.org/")

(defgeneric info-equal (info1 info2)
  (:documentation "Return TRUE if INFO1 and INFO2 are 'equal' in some
  important sense."))

;;; Information for checking the validity of files fetched for
;;; installing/updating the client code.

(defclass client-file-info ()
  ((plist-key
    :initarg :plist-key
    :reader plist-key)
   (file-url
    :initarg :url
    :reader file-url)
   (name
    :reader name
    :initarg :name)
   (size
    :initarg :size
    :reader size)
   (md5
    :reader md5
    :initarg :md5)
   (sha256
    :reader sha256
    :initarg :sha256)
   (plist
    :reader plist
    :initarg :plist)))

(defmethod print-object ((info client-file-info) stream)
  (print-unreadable-object (info stream :type t)
    (format stream "~S ~D ~S"
            (name info)
            (size info)
            (md5 info))))

(defmethod info-equal ((info1 client-file-info) (info2 client-file-info))
  (and (eql (size info1) (size info2))
       (equal (name info1) (name info2))
       (equal (md5 info1) (md5 info2))))

(defclass asdf-file-info (client-file-info)
  ()
  (:default-initargs
   :plist-key :asdf
   :name "asdf.lisp"))

(defclass setup-file-info (client-file-info)
  ()
  (:default-initargs
   :plist-key :setup
   :name "setup.lisp"))

(defclass client-tar-file-info (client-file-info)
  ()
  (:default-initargs
   :plist-key :client-tar
   :name "quicklisp.tar"))

(define-condition invalid-client-file (error)
  ((file
    :initarg :file
    :reader invalid-client-file-file)))

(define-condition badly-sized-client-file (invalid-client-file)
  ((expected-size
    :initarg :expected-size
    :reader badly-sized-client-file-expected-size)
   (actual-size
    :initarg :actual-size
    :reader badly-sized-client-file-actual-size))
  (:report (lambda (condition stream)
             (format stream "Unexpected file size for ~A ~
                             - expected ~A but got ~A"
                     (invalid-client-file-file condition)
                     (badly-sized-client-file-expected-size condition)
                     (badly-sized-client-file-actual-size condition)))))

(defun check-client-file-size (file expected-size)
  (let ((actual-size (file-size file)))
    (unless (eql expected-size actual-size)
      (error 'badly-sized-client-file
             :file file
             :expected-size expected-size
             :actual-size actual-size))))

;;; TODO: check cryptographic digests too.

(defgeneric check-client-file (file client-file-info)
  (:documentation
   "Signal an INVALID-CLIENT-FILE error if FILE does not match the
   metadata in CLIENT-FILE-INFO.")
  (:method (file client-file-info)
    (check-client-file-size file (size client-file-info))
    client-file-info))

;;; Structuring and loading information about the Quicklisp client
;;; code

(defclass client-info ()
  ((setup-info
    :reader setup-info
    :initarg :setup-info)
   (asdf-info
    :reader asdf-info
    :initarg :asdf-info)
   (client-tar-info
    :reader client-tar-info
    :initarg :client-tar-info)
   (canonical-client-info-url
    :reader canonical-client-info-url
    :initarg :canonical-client-info-url)
   (version
    :reader version
    :initarg :version)
   (subscription-url
    :reader subscription-url
    :initarg :subscription-url)
   (plist
    :reader plist
    :initarg :plist)
   (source-file
    :reader source-file
    :initarg :source-file)))

(defmethod print-object ((client-info client-info) stream)
  (print-unreadable-object (client-info stream :type t)
    (prin1 (version client-info) stream)))

(defmethod available-versions-url ((info client-info))
  (make-versions-url (subscription-url info)))

(defgeneric extract-client-file-info (file-info-class plist)
  (:method (file-info-class plist)
    (let* ((instance (make-instance file-info-class))
           (key (plist-key instance))
           (file-info-plist (getf plist key)))
      (unless file-info-plist
        (error "Missing client-info data for ~S" key))
      (destructuring-bind (&key url size md5 sha256 &allow-other-keys)
          file-info-plist
        (unless (and url size md5 sha256)
          (error "Missing client-info data for ~S" key))
        (reinitialize-instance instance
                               :plist file-info-plist
                               :url url
                               :size size
                               :md5 md5
                               :sha256 sha256)))))

(defun format-client-url (path &rest format-arguments)
  (if format-arguments
      (format nil "~A~{~}" *client-base-url* path format-arguments)
      (format nil "~A~A" *client-base-url* path)))

(defun client-info-url-from-version (version)
  (format-client-url "client/~A/client-info.sexp" version))

(define-condition invalid-client-info (error)
  ((plist
    :initarg plist
    :reader invalid-client-info-plist)))

(defun load-client-info (file)
  (let ((plist (safely-read-file file)))
    (destructuring-bind (&key subscription-url
                              version
                              canonical-client-info-url
                              &allow-other-keys)
        plist
      (make-instance 'client-info
                     :setup-info (extract-client-file-info 'setup-file-info
                                                           plist)
                     :asdf-info (extract-client-file-info 'asdf-file-info
                                                          plist)
                     :client-tar-info
                     (extract-client-file-info 'client-tar-file-info
                                               plist)
                     :canonical-client-info-url canonical-client-info-url
                     :version version
                     :subscription-url subscription-url
                     :plist plist
                     :source-file (probe-file file)))))

(defun mock-client-info ()
  (flet ((mock-client-file-info (class)
           (make-instance class
                          :size 0
                          :url ""
                          :md5 ""
                          :sha256 ""
                          :plist nil)))
    (make-instance 'client-info
                   :version ql-info:*version*
                   :subscription-url
                   (format-client-url "client/quicklisp.sexp")
                   :setup-info (mock-client-file-info 'setup-file-info)
                   :asdf-info (mock-client-file-info 'asdf-file-info)
                   :client-tar-info (mock-client-file-info
                                     'client-tar-file-info))))

(defun fetch-client-info (url)
  (let ((info-file (qmerge "tmp/client-info.sexp")))
    (delete-file-if-exists info-file)
    (fetch url info-file :quietly t)
    (handler-case
        (load-client-info info-file)
      ;; FIXME: So many other things could go wrong here; I think it
      ;; would be nice to catch and report them clearly as bogus URLs
      (invalid-client-info ()
        (error "Invalid client info URL -- ~A" url)))))

(defun local-client-info ()
  (let ((info-file (qmerge "client-info.sexp")))
    (if (probe-file info-file)
        (load-client-info info-file)
        (progn
          (warn "Missing client-info.sexp, using mock info")
          (mock-client-info)))))

(defun newest-client-info (&optional (info (local-client-info)))
  (let ((latest (subscription-url info)))
    (when latest
      (fetch-client-info latest))))

(defun client-version-lessp (client-info-1 client-info-2)
  (string-lessp (version client-info-1)
                (version client-info-2)))

(defun client-version ()
  "Return the version for the current local client installation. May
or may not be suitable for passing as the :VERSION argument to
INSTALL-CLIENT, depending on if it's a standard Quicklisp-provided
client."
  (version (local-client-info)))

(defun client-url ()
  "Return an URL suitable for passing as the :URL argument to
INSTALL-CLIENT for the current local client installation."
  (canonical-client-info-url (local-client-info)))

(defun available-client-versions ()
  (let ((url (available-versions-url (local-client-info)))
        (temp-file (qmerge "tmp/client-versions.sexp")))
    (when url
      (handler-case
          (progn
            (maybe-fetch-gzipped url temp-file)
            (prog1
                (with-open-file (stream temp-file)
                  (safely-read stream))
              (delete-file-if-exists temp-file)))
        (unexpected-http-status (condition)
          (unless (url-not-suitable-error-p condition)
            (error condition)))))))