(uiop:define-package ambrevar/gpg
  (:documentation "GPG utilities like writing .gpg files.")
  (:use #:common-lisp)
  (:use #:trivia)
  (:import-from #:log4cl)
  (:import-from #:serapeum #:export-always))
(in-package ambrevar/gpg)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (trivial-package-local-nicknames:add-package-local-nickname :alex :alexandria)
  (trivial-package-local-nicknames:add-package-local-nickname :sera :serapeum))

;; Borrowed from Nyxt.
;; TODO: Extract to public library?

(defvar *gpg-program* "gpg")

(export-always '*gpg-default-recipient*)
(defvar *gpg-default-recipient* "mail@ambrevar.xyz")

(defun gpg-recipient (file)             ; TODO: Find a proper way to do this.
  "Return the key of FILE's recipient if any, `*gpg-recipient*' otherwise.
As second value the email.
As third value the name."
  (if (uiop:file-exists-p file)
      (let* ((output (sera:lines (with-output-to-string (s)
                                   (uiop:run-program (list *gpg-program* "--decrypt" file)
                                                     :output nil :error-output s))))
             (first-line-tokens (str:split " " (first output)))
             (key (let ((key-string (second (member "ID" first-line-tokens :test #'string=))))
                    (if (str:ends-with? "," key-string)
                        (subseq key-string 0 (1- (length key-string)))
                        key-string)))
             (second-line (str:trim (second output)))
             (mail-start (position #\space second-line :from-end t))
             (mail (str:trim (reduce (lambda (target rep) (str:replace-all rep "" target))
                                     '(">" "<" "\"") :initial-value (subseq second-line mail-start))))
             (name (str:replace-all "\"" "" (subseq second-line 0 mail-start))))
        (values key mail name))
      *gpg-default-recipient*))

(defun gpg-write (stream gpg-file recipient)
  "Write STREAM to GPG-FILE using RECIPIENT key."
  (if recipient
      ;; TODO: Handle GPG errors.
      (uiop:run-program
       (list *gpg-program* "--output" gpg-file "--recipient" recipient
             "--batch" "--yes" "--encrypt")
       :input stream)
      (log:warn "Set `*gpg-default-recipient*' to save ~s." gpg-file)))

(export-always 'with-gpg-file)
(defmacro with-gpg-file ((stream gpg-file &rest options) &body body)
  "Like `with-open-file' but use
OPTIONS are as for `open''s `:direction'.
Other options are not supported.  File is overwritten if it exists, while
nothing is done if file is missing."
  ;; TODO: Support all of `open' options.
  (alex:with-gensyms (in clear-data result recipient)
    (if (member (getf options :direction) '(:io :input nil))
        `(when (uiop:file-exists-p ,gpg-file)
           (let ((,clear-data (with-output-to-string (out)
                                (uiop:run-program
                                 (list *gpg-program* "--decrypt" ,gpg-file)
                                 :output out))))
             (with-input-from-string (,stream ,clear-data)
               (prog1             ; TODO: Shouldn't we `unwind-protect' instead?
                   (progn
                     ,@body)
                 ,(when (eq (getf options :direction) :io)
                    ;; TODO: Need to handle error when gpg-file key is not available.
                    `(gpg-write ,stream ,gpg-file (gpg-recipient ,gpg-file)))))))
        `(let ((,result nil)
               (,recipient (gpg-recipient ,gpg-file)))
           (if ,recipient
               (with-input-from-string (,in (with-output-to-string (,stream)
                                              (setf ,result (progn ,@body))))
                 (gpg-write ,in ,gpg-file ,recipient))
               (error "No recipient."))
           ,result))))

(defun ensure-parent-exists (path)
  "Create parent directories of PATH if they don't exist and return PATH."
  (ensure-directories-exist (directory-namestring path))
  path)

(export-always 'with-maybe-gpg-file)
(defmacro with-maybe-gpg-file ((stream filespec &rest options) &body body)
  "Evaluate BODY with STREAM bound to DATA-PATH.
DATA-PATH can be a GPG-encrypted file if it ends with a .gpg extension.
If DATA-PATH expands to NIL or the empty string, do nothing.
OPTIONS are as for `open'.
Parent directories are created if necessary."
  `(if (str:ends-with? ".gpg" ,filespec :ignore-case t)
       (with-gpg-file (,stream ,filespec ,@options)
         ,@body)
       (progn
         ,(when (and (member (getf options :direction) '(:io :output))
                     (let ((l (nth-value 2 (get-properties options '(:if-does-not-exist)))))
                       (or (null l)
                           (eq (getf l :if-does-not-exist) :create))))
            `(ensure-parent-exists ,filespec))
         (with-open-file (,stream ,filespec ,@options)
           ,@body))))