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

;; ybackup is free software: you can redistribute it and/or modify it under the
;; terms of the GNU Lesser 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 (uiop:directory*
                            (make-pathname :directory (namestring target-file)
                                           :name :wild :type :wild :version :wild)))
                    (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 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 (when incremental (fetch-index incremental))))
     (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
                         (eris:read-capability-to-octets (eris:urn-to-read-capability incremental)))))
       *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))
    (print-file (slot-value (fetch-index urn) 'files))))

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