;; 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 code related to the repository format and indices.

(in-package :ybackup)

(defclass base-file ()
  ((permissions :initarg :permissions :type (unsigned-byte 16))
   (name :initarg :name :type string)))

(defclass file (base-file)
  ((read-capability :initarg :read-capability :type (simple-array (unsigned-byte 8) (66)))
   (date :initarg :date :type (unsigned-byte 64)
         :documentation "Modification time of the file.")))

(defclass dir (base-file)
  ((files :initarg :files :type hash-table)))

(defclass symlink (base-file)
  ((link :initarg :link :type string)))

(defclass previous-repository ()
  ((date :initarg :date :type (unsigned-byte 64))
   (read-capability :initarg :read-capability :type (octet-vector 66))
   (name :initarg :name :type string)))

(defclass repository ()
  ((files :initarg :files :type dir)
   (date :initarg :date :type (unsigned-byte 64))
   (name :initarg :name :type string)
   (previous-repository :initarg :previous-repository :type (or null (octet-vector 66)))))

(conspack:defencoding file
  permissions name read-capability date)

(conspack:defencoding dir
  permissions name files)

(conspack:defencoding symlink
 permissions name link)

(conspack:defencoding previous-repository
  date read-capability name)

(conspack:defencoding repository
  files date name previous-repository)

(conspack:define-index backup-index
  name permissions read-capability date files link file dir symlink repository previous-repository)

(alexandria:define-constant permission-flags
    '((:user-read 1)
      (:user-write 2)
      (:user-exec 3)
      (:group-read 4)
      (:group-write 5)
      (:group-exec 6)
      (:other-read 7)
      (:other-write 8)
      (:other-exec 9)
      (:set-user-id 10)
      (:set-group-id 11)
      (:sticky 12)
      (t 13))
  :test #'equalp)


(-> osicat-file-permissions-to-integer (list) (values (unsigned-byte 16) &optional))
(-> integer-to-file-permissions ((unsigned-byte 16)) (values list &optional))

(defun osicat-file-permissions-to-integer (permissions)
  "Convert a list of file permissions as returned by osicat:file-permissions to a
16-bit integer, represented as a set of bit flags."
  (let ((flags (make-array 16 :element-type 'bit :initial-element 0)))
    (declare (type (simple-bit-vector 16) flags)
             (dynamic-extent flags))
    (map nil (lambda (perm)
               #.`(ecase perm
                    ,@(map 'list (lambda (pair) `(,(first pair) (setf (sbit flags ,(second pair)) 1)))
                       permission-flags)))
         permissions)
    ;; always set the MSB and LSB so that the integer is always 16-bit
    (setf (sbit flags 15) 1
          (sbit flags 0) 1) 
    (bit-smasher:bits->int flags)))

(defun integer-to-file-permissions (integer)
  (let ((flags (bit-smasher:int->bits integer)))
    (declare (type bit-vector flags)
             (dynamic-extent flags))
    (declare (type (simple-bit-vector 16) flags))
    (loop for i from 1 to 14
          if (eq 1 (sbit flags i))
            collecting (cdr
                        (assoc i '#.(loop for (x y) in permission-flags
                                          collecting (cons y x)))))))

(defgeneric print-file (file)
  (:documentation "Return the file object as a S-expression."))

(defmethod print-file ((file file))
  (with-slots (permissions name read-capability date) file
    (list :file name
          (eris:read-capability-to-urn (eris:octets-to-read-capability read-capability))
          (local-time:format-timestring nil (local-time:universal-to-timestamp date))
          permissions)))

(defmethod print-file ((file symlink))
  (with-slots (permissions name link) file
    (list :symlink name :to link)))

(defmethod print-file ((file dir))
  (with-slots (permissions name files) file
    (list :directory name :files (loop for key being the hash-key using (hash-value file) of files
                                     collect (print-file file)))))

(defun print-repository (repo)
  (with-slots (files date name previous-repository) repo
    (list :name name :date (local-time:format-timestring nil (local-time:universal-to-timestamp date))
          :files files
          :previous-repository (if previous-repository
                                   (eris:read-capability-to-urn
                                    (eris:octets-to-read-capability previous-repository))
                                   nil))))