;; This file is part of ybackup.
;; Copyright (C) 2023 Piotr Szarmański

;; ybackup is free software: you can redistribute it and/or modify it under the
;; terms of the GNU General Public License as published by the Free
;; Software Foundation, either version 3 of the License, or (at your option) any
;; later version.

;; ybackup is distributed in the hope that it will be useful, but WITHOUT ANY
;; WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
;; A PARTICULAR PURPOSE. See the GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License along with
;; ybackup. If not, see <https://www.gnu.org/licenses/>.

;; This file contains the code related to uploading and reading backups. The
;; make-backup, read-backup and list-files functions are the most important.

(in-package :ybackup)

(defun filename-last-part (filename)
  (let* ((name (namestring filename))
         (end (1- (length name))))
    (loop while (eql #\/ (aref name end))
          do (decf end))
    (subseq name
            (or (loop for i from end downto 0
                   when (eql #\/ (aref name i))
                     return (1+ i))
                0)
            (1+ end))))

(defvar *eris-secret* eris:null-secret)
(defvar *eris-backend* nil)

(defun package-file (target-file &key incremental-record file-predicate)
  (declare (ignore file-predicate))
  (ecase (osicat:file-kind target-file :follow-symlinks nil)
    (:regular-file
     ;; if incremental-record is set and the mtime matches, then ignore it
     (if (and incremental-record
              (eql (file-write-date target-file) (slot-value incremental-record 'date)))
         incremental-record
         (let ((read-capability
                 (eris:read-capability-to-octets
                  (with-open-file (file target-file :direction :input :element-type 'octet)
                    (eris:store-data file *eris-backend* :secret *eris-secret*)))))
           (declare (type (octet-vector 66) read-capability))
           (make-instance 'file
                          :date (file-write-date target-file)
                          :name (filename-last-part target-file)
                          :permissions (osicat-file-permissions-to-integer (osicat:file-permissions target-file))
                          :read-capability read-capability))))
    (:symbolic-link
     (if (and incremental-record (eql (file-write-date target-file) (slot-value incremental-record 'date)))
         incremental-record
         (make-instance
          'symlink
          :link (namestring (osicat:read-link target-file))
          :name (filename-last-part target-file)
          ;; osicat:file-permissions cannot be used here because it resolves symlinks. Set it to 0 instead.
          :permissions 0)))
    (:directory
     ;; Do not check incremental records here.
     (make-instance
      'dir
      :permissions (osicat-file-permissions-to-integer (osicat:file-permissions target-file))
      :name (filename-last-part target-file)
      :files (let* ((files (append (uiop:directory-files (namestring target-file))
                                   (uiop:subdirectories (namestring target-file))))
                    (table (make-hash-table :size (+ 7 (length files)) :test #'equal)))
               (map nil #'(lambda (file)
                            ;; Handle files that aren't in the ecase
                            (handler-case
                                (setf (serapeum:href table (filename-last-part file))
                                      (package-file
                                       file
                                       :incremental-record
                                       (if incremental-record
                                           (serapeum:href (slot-value incremental-record 'files)
                                                          (filename-last-part file))
                                           nil)))
                              (type-error () (format t "Warning: file ~a of type ~a ignored." file (osicat:file-kind file :follow-symlinks nil)))))
                    files)
               table)))))

(defun make-backup (directory backend
                    &key incremental
                      (secret eris:null-secret)
                      (name (local-time:format-rfc3339-timestring nil (local-time:now))))
  "Make a backup of DIRECTORY into BACKEND. 

If INCREMENTAL is a URN, then incrementally backup using that repository.
Otherwise, create a new repository.

SECRET can be specified in order to use a specific secret for ERIS encryption.
This secret is only necessary when writing. If an incremental backup is done,
the secret used is always the same as in the original repository."

  (declare (type (or null string) incremental name)
           (type octet-vector secret)
           (type (or pathname string) directory))
  ;; check for existance of directory
  ;; TODO: actual condition
  (unless (uiop:directory-exists-p directory) 
    (error 'error))
  (let ((*eris-backend* backend)
        (*eris-secret* secret))

    ;; fetch incremental index
    (let ((incremental-index (if incremental (fetch-index incremental) nil)))
      (eris:read-capability-to-urn
       (eris:store-data
        (cpk:with-named-index 'backup-index
          (cpk:encode
           (make-instance 'repository
                          :files (package-file directory
                                               :incremental-record
                                               (if incremental
                                                   (slot-value incremental-index 'files)
                                                   nil))
                          :date (get-universal-time)
                          :name name
                          :previous-repository
                          (if incremental
                              (eris:read-capability-to-octets (eris:urn-to-read-capability incremental))
                              nil))))
        *eris-backend*
        :secret *eris-secret*)))))


;;; BACKUP READING

(defun fetch-index (urn)
  (cpk:with-named-index 'backup-index
    (cpk:decode
     (alexandria:read-stream-content-into-byte-vector
      (eris:fetch-data (eris:urn-to-read-capability urn) *eris-backend*)))))

(defgeneric unpack-file (file directory &key overwrite))

(defmethod unpack-file ((file file) directory &key overwrite)
  (with-slots (read-capability name permissions) file
    (let ((filename (merge-pathnames directory name)))
      (with-open-file (stream filename
                       :direction :output
                       :if-does-not-exist :create
                       :if-exists (if overwrite :supersede :error)
                       :element-type 'octet)
        (alexandria:copy-stream
         (eris:fetch-data (eris:octets-to-read-capability read-capability) *eris-backend*)
         stream))
      (setf (osicat:file-permissions filename)
            (integer-to-file-permissions permissions)))))

(defmethod unpack-file ((symlink symlink) directory &key overwrite)
  (with-slots (name link) symlink
    (when (and (osicat:file-exists-p (merge-pathnames directory name)) (not overwrite)
             ;; TODO: actual error
             (error 'error)))
    (osicat:make-link (merge-pathnames directory name)
                      :target link)))

(defmethod unpack-file ((dir dir) directory &key overwrite)
  (with-slots (name permissions files) dir
    (let ((next-dir (make-pathname :directory (append1 (pathname-directory directory) name)
                                   :defaults directory)))
      (ensure-directories-exist next-dir)
      (setf (osicat:file-permissions next-dir) (integer-to-file-permissions permissions))
      (maphash #'(lambda (key value)
                   (declare (ignore key))
                   (unpack-file value next-dir :overwrite overwrite))
               files))))

(defun read-backup (urn backend target-directory &key (overwrite nil))
  "Read/unpack the backup into TARGET-DIRECTORY.

OVERWRITE keyword decides whether to overwrite files. By default, it errors on
encountering existing files. Set to T to overwrite existing files.

TODO: Add an option to make it just ignore existing files."
  (let ((*eris-backend* backend))
    (when (null (pathname-directory target-directory))
      (error 'error))
    (unpack-file (slot-value (fetch-index urn) 'files) target-directory :overwrite overwrite)))

(defun read-specific-file (urn backend target-directory specific-file)
  "Read a specific file from a backend. The file is given as a list containing the
successive directories and the file-name at the end, such as `(\"home\" \"user\"
\"images\" \"dog.png\")'. This does not respect symlinks whatsoever."
  (let* ((*eris-backend* backend)
        (index-files (slot-value (fetch-index urn) 'files)))
    (unless (equal (first specific-file) (slot-value index-files 'name))
      (error 'cl:file-error :pathname specific-file))
    (unpack-file
     (loop for i from 0 to (length specific-file)
           for file = index-files
             then (gethash (nth i specific-file) (slot-value file 'files))
           when (null file)
             do (error 'cl:file-error :pathname specific-file)
           if (null (nth (1+ i) specific-file))
             return file)
     target-directory)))

(defun list-files (urn backend)
  (let ((*eris-backend* backend))
    (let ((index (fetch-index urn)))
      (print-file (slot-value index 'files)))))

(defun metadata (urn backend)
  (let ((*eris-backend* backend))
    (print-repository (fetch-index urn))))

(defun search-predicate (predicate urn backend)
  "Return a list of files that return non-nil when applied to PREDICATE"
  (let ((*eris-backend* backend))
    (let ((index (fetch-index urn)))
      (fmap-over-dir
       (lambda (f) (if (funcall predicate f) f nil))
       (slot-value index 'files)))))

(defun search-regexp (regexp urn backend)
  "Return a list of files whose names match REGEXP."
  (let ((scanner (ppcre:create-scanner regexp)))
    (search-predicate (lambda (file) (ppcre:scan scanner (slot-value file 'name)))
                      urn backend)))


(defmacro collect-if (expr collector)
  (alexandria:with-gensyms (v)
    `(let ((,v ,expr))
       (if ,v (,collector ,v)))))

(defun fmap-over-dir (fn dir)
  "Apply FN to each file under DIR, excluding directories. A list of non-nil
return values of FN is returned.."
  (mvlet ((lfiles ldirs
                  (with-collectors (cfiles cdirs)
                    (loop for i being the hash-value of (slot-value dir 'files)
                          do (typecase i
                               (dir (collect-if (fmap-over-dir fn i) cdirs)) ;; makes a list of lists
                               (t (collect-if (funcall fn i) cfiles)))))))
    (apply #'concatenate 'list lfiles ldirs)))