path: root/lisp/zfs.el

;;; zfs.el --- ZFS management UI -*- lexical-binding: t; -*-

(require 'vui)
(require 'vui-components)
(require 'async)
(require 'zfs-cli)

(defcustom zfs-buffer-name "*zfs*"
  "Name of the ZFS management buffer."
  :type 'string
  :group 'zfs)

(defcustom zfs-targets-file (locate-user-emacs-file "zfs-targets.eld")
  "File where backup targets are stored as a plain elisp list."
  :type 'file
  :group 'zfs)

(defcustom zfs-backup-targets nil
  "Seed backup targets, used when `zfs-targets-file' does not exist yet.
Same plist shape as documented there."
  :type '(repeat sexp)
  :group 'zfs)

(defvar-local zfs-ui--row-actions nil)
(defvar-local zfs-ui--refresh-fn nil)

(defun zfs-ui--targets-load ()
  (if (file-exists-p zfs-targets-file)
      (with-temp-buffer
        (insert-file-contents zfs-targets-file)
        (goto-char (point-min))
        (read (current-buffer)))
    zfs-backup-targets))

(defun zfs-ui--targets-save (targets)
  (with-temp-file zfs-targets-file
    (pp targets (current-buffer))))

(defun zfs--format-bytes (bytes)
  (cond
   ((null bytes) "-")
   ((not (numberp bytes)) (format "%s" bytes))
   (t (let ((units '((1099511627776 . "T") (1073741824 . "G") (1048576 . "M") (1024 . "K")))
            (result nil))
        (dolist (unit units)
          (when (and (not result) (>= bytes (car unit)))
            (let ((value (/ bytes (float (car unit)))))
              (setq result (if (< value 10) (format "%.1f%s" value (cdr unit))
                             (format "%.0f%s" value (cdr unit)))))))
        (or result (format "%dB" bytes))))))

(defun zfs--format-ago (epoch)
  (if (not (numberp epoch))
      "-"
    (let ((delta (- (float-time) epoch)))
      (cond
       ((< delta 90) "just now")
       ((< delta 3600) (format "%dm ago" (truncate (/ delta 60))))
       ((< delta 86400) (format "%dh ago" (truncate (/ delta 3600))))
       ((< delta (* 30 86400)) (format "%dd ago" (truncate (/ delta 86400))))
       ((< delta (* 365 86400)) (format "%dmo ago" (truncate (/ delta (* 30 86400)))))
       (t (format "%dy ago" (truncate (/ delta (* 365 86400)))))))))

(defun zfs--gauge (percent &optional width)
  (let* ((width (or width 20))
         (done (max 0 (min width (round (* width (/ (or percent 0) 100.0)))))))
    (concat (make-string done ?█) (make-string (- width done) ?░))))

(defun zfs--health-face (health)
  (pcase health
    ("ONLINE" 'success)
    ("DEGRADED" 'warning)
    (_ 'error)))

(defun zfs--capacity-face (percent)
  (cond
   ((>= (or percent 0) 90) 'error)
   ((>= (or percent 0) 75) 'warning)
   (t 'success)))

(defun zfs--direct-children (datasets parent)
  (let ((prefix (concat parent "/")))
    (seq-filter (lambda (entry)
                  (and (string-prefix-p prefix (car entry))
                       (not (string-match-p "/" (substring (car entry) (length prefix))))))
                datasets)))

(defun zfs--snapshots-of (snaps dataset)
  (seq-filter (lambda (entry)
                (string-prefix-p (concat dataset "@") (car entry)))
              snaps))

(defun zfs--snapshot-leaf (full-name)
  (car (last (split-string full-name "@" t))))

(defun zfs-ui--fetch (host include-disks callback)
  (let ((cli-dir (file-name-directory (locate-library "zfs-cli.el"))))
    (async-start
     `(lambda ()
        (add-to-list 'load-path ,cli-dir)
        (require 'zfs-cli)
        (list :pools (condition-case err (zfs-cli-pools ',host)
                       (error (cons :error (error-message-string err))))
              :datasets (condition-case err (zfs-cli-datasets ',host)
                          (error (cons :error (error-message-string err))))
              :snaps (condition-case err (zfs-cli-snapshots ',host)
                       (error (cons :error (error-message-string err))))
              :locked ,(if include-disks
                           '(condition-case err
                                (mapcar (lambda (device)
                                          (append device
                                                  (list :pool (and (zfs-cli-disk-unlocked-p device)
                                                                   (zfs-cli-pool-on-device
                                                                    (concat "/dev/mapper/" (zfs-cli-disk-mapper device)))))))
                                        (zfs-cli-locked-disks))
                              (error (cons :error (error-message-string err))))
                         nil)))
     callback)))

(defun zfs-ui--fetch-done (result)
  (let ((pools (plist-get result :pools))
        (datasets (plist-get result :datasets))
        (snaps (plist-get result :snaps))
        (locked (plist-get result :locked)))
    (vui-batch
     (vui-set-state :loading nil)
     (vui-set-state :refreshed (format-time-string "%H:%M"))
     (if (and (eq (car-safe pools) :error) (eq (car-safe datasets) :error))
         (vui-set-state :message (cons (format "Could not reach host: %s" (cdr pools)) 'error))
       (vui-set-state :pools (and (not (eq (car-safe pools) :error)) pools))
       (vui-set-state :datasets (and (not (eq (car-safe datasets) :error)) datasets))
       (vui-set-state :snaps (and (not (eq (car-safe snaps) :error)) snaps))
       (vui-set-state :locked (and (listp locked) (not (eq (car-safe locked) :error)) locked))))))

(defun zfs-ui--refresh (host)
  (vui-set-state :loading t)
  (zfs-ui--fetch host (null host) (vui-async-callback (result) (zfs-ui--fetch-done result))))

(defun zfs-ui--go (page &optional arg)
  (vui-batch
   (vui-set-state :page page)
   (vui-set-state :page-arg arg)
   (vui-set-state :backup-target nil)
   (vui-set-state :backup-preview nil)
   (vui-set-state :backup-progress nil)
   (vui-set-state :backup-done nil)
   (vui-set-state :create-status nil)
   (vui-set-state :format-disk nil)
   (vui-set-state :format-status nil)))

(defun zfs-ui--fail (err)
  (vui-set-state :message (cons (format "Error: %s" (error-message-string err)) 'error)))

(defun zfs-ui--do-snapshot (host dataset)
  (let ((snap-name (read-string (format "Snapshot name for %s: " dataset)
                                (format-time-string "manual-%Y-%m-%d_%H-%M"))))
    (condition-case err
        (progn
          (zfs-cli-snapshot host dataset snap-name)
          (vui-set-state :message (cons (format "Snapshot %s@%s created" dataset snap-name) 'success))
          (zfs-ui--refresh host))
      (error (zfs-ui--fail err)))))

(defun zfs-ui--do-destroy (host target has-dependents)
  (when (yes-or-no-p (if has-dependents
                         (format "Destroy %s including its children and snapshots? " target)
                       (format "Destroy %s? " target)))
    (condition-case err
        (progn
          (zfs-cli-destroy host target has-dependents)
          (vui-set-state :message (cons (format "Destroyed %s" target) 'success))
          (zfs-ui--refresh host))
      (error (zfs-ui--fail err)))))

(defun zfs-ui--do-rollback (host snapshot)
  (when (yes-or-no-p (format "Roll back to %s? Snapshots taken after it are destroyed. " snapshot))
    (condition-case err
        (progn
          (zfs-cli-rollback host snapshot)
          (vui-set-state :message (cons (format "Rolled back to %s" snapshot) 'success))
          (zfs-ui--refresh host))
      (error (zfs-ui--fail err)))))

(defun zfs-ui--do-mount (host dataset)
  (condition-case err
      (progn
        (zfs-cli-mount host dataset)
        (vui-set-state :message (cons (format "Mounted %s" dataset) 'success))
        (zfs-ui--refresh host))
    (error (zfs-ui--fail err))))

(defun zfs-ui--do-diff (host snapshot)
  (let ((command (if host
                     (format "ssh -o BatchMode=yes %s %s"
                             (shell-quote-argument (plist-get host :ssh))
                             (shell-quote-argument (concat "doas -n zfs diff -H " snapshot)))
                   (format "doas -n zfs diff -H %s" snapshot))))
    (if (fboundp 'ghostel-compile)
        (ghostel-compile command)
      (compile command))))

(defun zfs-ui--do-scrub (host pool stop)
  (condition-case err
      (progn
        (zfs-cli-scrub host pool stop)
        (vui-set-state :message (cons (if stop "Scrub stopped" "Scrub started — reads all data, verifies checksums")
                                      'success))
        (zfs-ui--refresh host))
    (error (zfs-ui--fail err))))

(defun zfs-ui--do-export (host pool)
  (when (yes-or-no-p (format "Export %s? The pool goes offline until imported again. " pool))
    (condition-case err
        (progn
          (zfs-cli-export host pool)
          (vui-set-state :message (cons (format "Exported %s" pool) 'success))
          (zfs-ui--go 'overview)
          (zfs-ui--refresh host))
      (error (zfs-ui--fail err)))))

(defun zfs-ui--do-unlock (device)
  (let ((passphrase (read-passwd (format "LUKS passphrase for %s: " (plist-get device :name)))))
    (condition-case err
        (let ((mapper (concat "luks-" (plist-get device :name))))
          (zfs-cli-luks-open (plist-get device :path) mapper passphrase)
          (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" mapper))))
            (if pool
                (progn
                  (zfs-cli-import nil pool t)
                  (vui-set-state :message (cons (format "Unlocked — pool %s imported" pool) 'success)))
              (vui-set-state :message (cons "Unlocked, but no ZFS pool found on the device" 'warning))))
          (zfs-ui--refresh nil))
      (error (zfs-ui--fail err)))))

(defun zfs-ui--do-import (device)
  (condition-case err
      (let ((pool (zfs-cli-pool-on-device (concat "/dev/mapper/" (zfs-cli-disk-mapper device)))))
        (if pool
            (progn
              (zfs-cli-import nil pool t)
              (vui-set-state :message (cons (format "Imported %s" pool) 'success))
              (zfs-ui--refresh nil))
          (vui-set-state :message (cons "No ZFS pool found on the device" 'warning))))
    (error (zfs-ui--fail err))))

(defun zfs-ui--do-lock (device pools)
  (let* ((mapper (zfs-cli-disk-mapper device))
         (pool (zfs-cli-pool-on-device (concat "/dev/mapper/" mapper))))
    (when (yes-or-no-p (if (and pool (assoc pool pools))
                           (format "Export %s and lock %s? " pool (plist-get device :name))
                         (format "Lock %s? " (plist-get device :name))))
      (condition-case err
          (progn
            (when (and pool (assoc pool pools))
              (zfs-cli-export nil pool))
            (zfs-cli-luks-close mapper)
            (vui-set-state :message (cons (format "Locked %s" (plist-get device :name)) 'success))
            (zfs-ui--refresh nil))
        (error (zfs-ui--fail err))))))

(defun zfs-ui--common-base (snaps target-snap-names dataset)
  (let* ((own (zfs--snapshots-of snaps dataset))
         (common (seq-filter (lambda (entry)
                               (member (zfs--snapshot-leaf (car entry)) target-snap-names))
                             own))
         (sorted (sort (copy-sequence common)
                       (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0)
                                        (or (zfs-cli-prop b 'creation) 0))))))
    (when sorted
      (car (car (last sorted))))))

(defun zfs-ui--newest-snapshot (snaps dataset)
  (let ((sorted (sort (copy-sequence (zfs--snapshots-of snaps dataset))
                      (lambda (a b) (< (or (zfs-cli-prop a 'creation) 0)
                                       (or (zfs-cli-prop b 'creation) 0))))))
    (car (last sorted))))

(defun zfs-ui--backup-preview (host dataset snapshot snaps entry target)
  (let* ((leaf (file-name-nondirectory dataset))
         (target-dataset (concat (plist-get target :dataset) "/" leaf))
         (target-snap-names (condition-case nil
                                (mapcar (lambda (snap-entry) (zfs--snapshot-leaf (car snap-entry)))
                                        (zfs-cli-snapshots target target-dataset))
                              (error nil)))
         (base (zfs-ui--common-base snaps target-snap-names dataset))
         (raw (and entry (not (member (zfs-cli-prop entry 'encryption) '(nil "off")))))
         (preview (zfs-cli-send-preview host snapshot base)))
    (list :target-dataset target-dataset
          :base base
          :raw raw
          :kind (plist-get preview :kind)
          :bytes (plist-get preview :bytes))))

(defun zfs-ui--backup-event (event)
  (pcase (car event)
    (:progress
     (vui-set-state :backup-progress (nth 1 event)))
    (:done
     (if (zerop (nth 1 event))
         (vui-batch
          (vui-set-state :backup-done 'success)
          (vui-set-state :backup-progress nil))
       (vui-batch
        (vui-set-state :backup-done (format "%s" (nth 2 event)))
        (vui-set-state :backup-progress nil))))))

(defun zfs-ui--start-backup (host snapshot target preview)
  (vui-batch
   (vui-set-state :backup-progress "starting…")
   (vui-set-state :backup-done nil))
  (zfs-cli-send-async host snapshot target (plist-get preview :target-dataset)
                      (plist-get preview :base) (plist-get preview :raw)
                      (vui-async-callback (event)
                        (zfs-ui--backup-event event))))

(defun zfs-ui--field-string (key)
  (or (vui-field-value key) ""))

(defun zfs-ui--start-move (host dataset mountpoint move-dir)
  (vui-set-state :create-status (cons "Copying… 0%" 'shadow))
  (zfs-cli-rsync-async
   move-dir mountpoint
   (vui-async-callback (event)
     (pcase (car event)
       (:progress
        (when (string-match "\\([0-9]+%\\)" (nth 1 event))
          (vui-set-state :create-status
                         (cons (format "Copying… %s" (match-string 1 (nth 1 event))) 'shadow))))
       (:done
        (if (zerop (nth 1 event))
            (vui-set-state :message
                           (cons (format "%s created, data copied — original kept in %s" dataset move-dir)
                                 'success))
          (vui-set-state :message
                         (cons (format "%s created, but copying failed: %s" dataset (nth 2 event))
                               'error)))
        (zfs-ui--go 'dataset dataset)
        (zfs-ui--refresh host))))))

(defun zfs-ui--do-create-dataset (host parent)
  (let* ((leaf (zfs-ui--field-string "create-name"))
         (mountpoint (zfs-ui--field-string "create-mountpoint"))
         (quota (zfs-ui--field-string "create-quota"))
         (passphrase (zfs-ui--field-string "create-passphrase"))
         (encrypted (not (string-blank-p passphrase)))
         (compression (zfs-ui--field-string "create-compression"))
         (move-dir (zfs-ui--field-string "create-move"))
         (dataset (concat parent "/" leaf)))
    (cond
     ((string-blank-p leaf)
      (vui-set-state :create-status (cons "Name is empty" 'error)))
     ((string-match-p "/" leaf)
      (vui-set-state :create-status (cons "Name must be a single segment, no slashes" 'error)))
     ((and (not (string-blank-p move-dir)) (string-blank-p mountpoint))
      (vui-set-state :create-status (cons "Moving a folder in needs a mountpoint" 'error)))
     (t
      (let ((properties nil))
        (when (and compression (not (equal compression "inherit")))
          (push (cons "compression" compression) properties))
        (when (and mountpoint (not (string-blank-p mountpoint)) (not (equal mountpoint "none")))
          (push (cons "mountpoint" mountpoint) properties))
        (when (and quota (not (string-blank-p quota)))
          (push (cons "quota" quota) properties))
        (condition-case err
            (progn
              (if encrypted
                  (zfs-cli-create-encrypted host dataset passphrase properties)
                (zfs-cli-create host dataset properties))
              (when (and (not (string-blank-p mountpoint)) (not (equal mountpoint "none")))
                (ignore-errors (zfs-cli-mount host dataset)))
              (if (not (string-blank-p move-dir))
                  (zfs-ui--start-move host dataset mountpoint move-dir)
                (vui-set-state :message (cons (format "Created %s" dataset) 'success))
                (zfs-ui--go 'dataset dataset)
                (zfs-ui--refresh host)))
          (error (vui-set-state :create-status (cons (error-message-string err) 'error)))))))))

(defun zfs-ui--do-format (device pool-name encrypted passphrase)
  (let ((mapper (concat "luks-" (plist-get device :name))))
    (vui-set-state :format-status (cons "Formatting… this takes a moment" 'shadow))
    (zfs-cli-format-disk-async
     (plist-get device :path) pool-name mapper (and encrypted passphrase)
     (vui-async-callback (status err)
       (if (zerop status)
           (vui-batch
            (vui-set-state :format-status (cons (format "Pool %s created on %s" pool-name (plist-get device :name))
                                                'success))
            (vui-set-state :format-disk nil)
            (zfs-ui--refresh nil))
         (vui-set-state :format-status (cons (format "Format failed: %s" err) 'error)))))))

(defconst zfs-ui--property-glossary
  '(("used" . "live data + snapshots + children together")
    ("referenced" . "live data right now, snapshots excluded")
    ("usedbysnapshots" . "only reachable through snapshots; freed when you delete them")
    ("usedbychildren" . "used by datasets below this one")
    ("available" . "room this dataset can still grow into")
    ("compressratio" . "how much smaller data is stored; 1.31x ≈ 24% saved")
    ("encryption" . "dataset-level encryption, independent of disk LUKS")
    ("keystatus" . "available = key loaded, data readable")
    ("mountpoint" . "where it shows up; legacy = mounted by the system, not zfs")
    ("recordsize" . "max block size; matters for databases and VM images")
    ("quota" . "hard size limit, if set")
    ("reservation" . "space guaranteed to this dataset, if set")
    ("creation" . "when the dataset was created")
    ("mounted" . "whether it is currently mounted")))

(defun zfs-ui--dataset-row (entry depth snap-count)
  (let* ((name (car entry))
         (short (file-name-nondirectory name))
         (label (concat (make-string (* 2 depth) ?\s)
                        (if (> snap-count 0) "▸ " "  ")
                        short
                        (when (> snap-count 0) (format " (%d)" snap-count))))
         (encryption (zfs-cli-prop entry 'encryption))
         (keystatus (zfs-cli-prop entry 'keystatus)))
    (vui-hstack
     (vui-box (vui-button (truncate-string-to-width label 32) :no-decoration t
                          :key (concat "ds:" name)
                          :on-click (lambda () (zfs-ui--go 'dataset name)))
              :width 34)
     (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'used))) :width 9)
     (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop entry 'available)) :face 'shadow) :width 9)
     (vui-box (vui-text (format "%s" (or (zfs-cli-prop entry 'compressratio) "-")) :face 'shadow) :width 7)
     (vui-box (cond
               ((or (null encryption) (equal encryption "off")) (vui-text "·" :face 'shadow))
               ((equal keystatus "available") (vui-text "🔓" :face 'success))
               (t (vui-text "🔒" :face 'warning)))
              :width 4))))

(defun zfs-ui--dataset-rows (entry depth datasets snaps)
  (let* ((name (car entry))
         (children (zfs--direct-children datasets name))
         (own-snaps (zfs--snapshots-of snaps name)))
    (push (cons (concat "ds:" name)
                (list :open (vui-with-async-context (zfs-ui--go 'dataset name))
                      :backup (vui-with-async-context (zfs-ui--go 'backup name))
                      :create-child (vui-with-async-context (zfs-ui--go 'create name))))
          zfs-ui--row-actions)
    (cons (zfs-ui--dataset-row entry depth (length own-snaps))
          (mapcan (lambda (child) (zfs-ui--dataset-rows child (1+ depth) datasets snaps))
                  children))))

(defun zfs-ui--pool-row (pool)
  (let* ((name (car pool))
         (health (zfs-cli-prop pool 'health))
         (capacity (zfs-cli-prop pool 'capacity))
         (size (zfs-cli-prop pool 'size))
         (free (zfs-cli-prop pool 'free)))
    (push (cons (concat "pool:" name)
                (list :open (vui-with-async-context (zfs-ui--go 'pool name))
                      :create-child (vui-with-async-context (zfs-ui--go 'create name))))
          zfs-ui--row-actions)
    (vui-hstack
     :spacing 1
     (vui-box (vui-button name :no-decoration t
                          :key (concat "pool:" name)
                          :on-click (lambda () (zfs-ui--go 'pool name)))
              :width 10)
     (vui-box (vui-text (or health "?") :face (zfs--health-face health)) :width 9)
     (vui-box (vui-text (zfs--gauge capacity)
                        :face (zfs--capacity-face capacity))
              :width 22)
     (vui-text (format "%d%% · %s free of %s"
                       (or capacity 0)
                       (zfs--format-bytes free)
                       (zfs--format-bytes size))
               :face 'shadow))))

(defun zfs-ui--locked-disk-row (device pools)
  (let* ((name (plist-get device :name))
         (unlocked (zfs-cli-disk-unlocked-p device))
         (mapper (zfs-cli-disk-mapper device))
         (pool (plist-get device :pool))
         (imported (and pool (assoc pool pools))))
    (push (cons (concat "lock:" name)
                (if unlocked
                    (append (unless imported
                              (list :import (vui-with-async-context (zfs-ui--do-import device))))
                            (list :lock (vui-with-async-context (zfs-ui--do-lock device pools))))
                  (list :unlock (vui-with-async-context (zfs-ui--do-unlock device)))))
          zfs-ui--row-actions)
    (vui-hstack
     :spacing 1
     (vui-box (vui-text (if unlocked "🔓" "🔒") :face (if unlocked 'warning 'shadow)) :width 3)
     (vui-box (vui-button name :no-decoration t
                          :key (concat "lock:" name)
                          :on-click (lambda () nil))
              :width 10)
     (vui-box (vui-text (or (plist-get device :model) "?") :face 'shadow) :width 24)
     (vui-box (vui-text (zfs--format-bytes (plist-get device :size)) :face 'shadow) :width 8)
     (vui-text (cond
                (imported (format "pool %s imported · L ejects and locks" pool))
                (unlocked (format "unlocked as %s · i imports pool %s · L locks" mapper (or pool "?")))
                (t "locked · u unlock"))
               :face 'shadow))))

(defun zfs-ui--page-overview (pools datasets snaps locked)
  (push (cons 'page
              (list :format (vui-with-async-context (zfs-ui--go 'new-pool))
                    :targets (vui-with-async-context (zfs-ui--go 'targets))))
        zfs-ui--row-actions)
  (let ((roots (seq-filter (lambda (entry) (not (string-match-p "/" (car entry)))) datasets)))
    (apply
     #'vui-vstack
     :spacing 1
     (append
      (when locked
        (list (vui-vstack
               :spacing 0
               (vui-heading-3 "Disks")
               (vui-muted "LUKS disks ZFS can use once unlocked")
               (apply #'vui-vstack :spacing 0
                      (mapcar (lambda (device) (zfs-ui--locked-disk-row device pools)) locked)))))
      (list
       (vui-vstack
        :spacing 0
        (vui-heading-3 "Pools")
        (vui-muted "teams of disks; datasets live inside them · RET details · F format a disk")
        (apply #'vui-vstack :spacing 0 (mapcar #'zfs-ui--pool-row pools)))
       (vui-vstack
        :spacing 0
        (vui-heading-3 "Datasets")
        (vui-muted "named drawers · RET details · b backup · c new dataset inside")
        (vui-hstack
         (vui-box (vui-text "NAME" :face 'shadow) :width 34)
         (vui-box (vui-text "USED" :face 'shadow) :width 9)
         (vui-box (vui-text "AVAIL" :face 'shadow) :width 9)
         (vui-box (vui-text "RATIO" :face 'shadow) :width 7)
         (vui-box (vui-text "ENC" :face 'shadow) :width 4))
        (apply #'vui-vstack :spacing 0
               (mapcan (lambda (root) (zfs-ui--dataset-rows root 0 datasets snaps)) roots))))))))

(defun zfs-ui--property-row (entry property)
  (let* ((raw (zfs-cli-prop entry (intern property)))
         (value (cond
                 ((equal property "creation") (format "%s (%s)"
                                                     (format-time-string "%Y-%m-%d" raw)
                                                     (zfs--format-ago raw)))
                 ((and (member property '("quota" "reservation")) (or (null raw) (equal raw 0))) "none")
                 ((numberp raw) (zfs--format-bytes raw))
                 (t (format "%s" (or raw "-")))))
         (gloss (cdr (assoc property zfs-ui--property-glossary))))
    (vui-hstack
     (vui-box (vui-text property :face 'shadow) :width 18)
     (vui-box (vui-text value) :width 22)
     (vui-text (or gloss "") :face 'shadow))))

(defun zfs-ui--snapshot-row (snap dataset host)
  (let* ((full-name (car snap))
         (leaf (zfs--snapshot-leaf full-name)))
    (push (cons (concat "snap:" full-name)
                (list :diff (vui-with-async-context (zfs-ui--do-diff host full-name))
                      :rollback (vui-with-async-context (zfs-ui--do-rollback host full-name))
                      :backup (vui-with-async-context (zfs-ui--go 'backup (cons dataset full-name)))
                      :destroy (vui-with-async-context (zfs-ui--do-destroy host full-name nil))))
          zfs-ui--row-actions)
    (vui-hstack
     (vui-box (vui-button (concat "@" leaf) :no-decoration t :face 'shadow
                          :key (concat "snap:" full-name)
                          :on-click (lambda () nil))
              :width 38)
     (vui-box (vui-text (zfs--format-bytes (zfs-cli-prop snap 'used)) :face 'shadow) :width 9)
     (vui-text (zfs--format-ago (zfs-cli-prop snap 'creation)) :face 'shadow))))

(defun zfs-ui--page-dataset (name host datasets snaps)
  (let* ((entry (assoc name datasets))
         (own-snaps (zfs--snapshots-of snaps name)))
    (when entry
      (push (cons 'page
                  (list :snapshot (vui-with-async-context (zfs-ui--do-snapshot host name))
                        :backup (vui-with-async-context (zfs-ui--go 'backup name))
                        :create-child (vui-with-async-context (zfs-ui--go 'create name))
                        :destroy (vui-with-async-context (zfs-ui--do-destroy host name t))
                        :mount (vui-with-async-context (zfs-ui--do-mount host name))))
            zfs-ui--row-actions))
    (if (null entry)
        (vui-text (format "%s not found — g to refresh" name) :face 'error)
      (apply
       #'vui-vstack
       :spacing 1
       (append
        (list
         (vui-hstack :spacing 2
                     (vui-heading-3 name)
                     (vui-text (downcase (or (alist-get 'type (cdr entry)) "")) :face 'shadow))
         (vui-muted (format "Everything in this dataset and its snapshots uses %s."
                            (zfs--format-bytes (zfs-cli-prop entry 'used))))
         (vui-text "s snapshot · b backup · c new dataset inside · m mount · D destroy" :face 'shadow)
         (apply #'vui-vstack :spacing 0
                (mapcar (lambda (property) (zfs-ui--property-row entry property))
                        '("used" "referenced" "usedbysnapshots" "usedbychildren" "available"
                          "compressratio" "encryption" "keystatus" "mountpoint" "recordsize"
                          "quota" "creation" "mounted"))))
        (list
         (apply
          #'vui-vstack
          :spacing 0
          (append
           (list (vui-heading-3 (format "Snapshots (%d)" (length own-snaps)))
                 (vui-muted "frozen moments · d what changed since · r roll back to · D delete"))
           (if own-snaps
               (mapcar (lambda (snap) (zfs-ui--snapshot-row snap name host)) own-snaps)
             (list (vui-muted "none yet — press s to freeze this moment")))))))))))

(defun zfs-ui--vdev-row (vdev depth)
  (vui-hstack
   (vui-box (vui-text (concat (make-string (* 2 depth) ?\s) (plist-get vdev :name))) :width 40)
   (vui-box (vui-text (or (plist-get vdev :state) "?")
                      :face (zfs--health-face (plist-get vdev :state)))
            :width 9)
   (vui-text (format "%s/%s/%s errors"
                     (or (plist-get vdev :read-errors) 0)
                     (or (plist-get vdev :write-errors) 0)
                     (or (plist-get vdev :checksum-errors) 0))
             :face 'shadow)))

(defun zfs-ui--page-pool (name host)
  (let ((status (ignore-errors (zfs-cli-pool-status host name))))
    (when status
      (push (cons 'page
                  (list :scrub-start (vui-with-async-context (zfs-ui--do-scrub host name nil))
                        :scrub-stop (vui-with-async-context (zfs-ui--do-scrub host name t))
                        :export (vui-with-async-context (zfs-ui--do-export host name))))
            zfs-ui--row-actions))
    (if (null status)
        (vui-text (format "Could not read status of %s" name) :face 'error)
      (let ((state (alist-get 'state status))
            (error-count (alist-get 'error_count status))
            (scan (alist-get 'scan status))
            (vdevs (zfs-cli-pool-vdevs status)))
        (vui-vstack
         :spacing 1
         (vui-hstack :spacing 2
                     (vui-heading-3 name)
                     (vui-text state :face (zfs--health-face state)))
         (vui-muted (if (> (or error-count 0) 0)
                        (format "%d errors — check the devices below" error-count)
                      "No known data errors."))
         (vui-text (if scan
                       (format "Scan: %s" (or (alist-get 'state scan) "recorded"))
                     "Scrub: never run here — it reads everything and verifies checksums")
                   :face 'shadow)
         (vui-text "1 scrub start · 2 scrub stop · x export (take offline)" :face 'shadow)
         (vui-vstack
          :spacing 0
          (vui-heading-3 "Devices")
          (apply #'vui-vstack :spacing 0
                 (mapcar (lambda (vdev) (zfs-ui--vdev-row vdev 0)) vdevs))))))))

(defun zfs-ui--form-row (label content &optional gloss)
  (vui-hstack
   (vui-box (vui-text label :face 'shadow) :width 14 :align :right)
   content
   (when gloss (vui-hstack (vui-space 2) (vui-text gloss :face 'shadow)))))

(defun zfs-ui--page-create (parent host create-status)
  (push (cons 'page (list :submit (vui-with-async-context (zfs-ui--do-create-dataset host parent))))
        zfs-ui--row-actions)
  (vui-vstack
   :spacing 1
   (vui-heading-3 (format "New dataset inside %s" parent))
   (vui-muted "A dataset is a drawer: its own compression, quota and snapshots.")
   (zfs-ui--form-row "Name"
                     (vui-field :size 24 :key "create-name" :placeholder "music")
                     (format "→ %s/<name>" parent))
   (zfs-ui--form-row "Mountpoint"
                     (vui-field :size 24 :key "create-mountpoint"
                                :placeholder (expand-file-name "~/music"))
                     "where it appears; empty = not mounted")
   (zfs-ui--form-row "Compression"
                     (vui-field :size 24 :key "create-compression" :value "zstd"
                                :placeholder "zstd")
                     "zstd squeezes better, lz4 is faster, off disables")
   (zfs-ui--form-row "Passphrase"
                     (vui-field :size 24 :key "create-passphrase" :secret t
                                :placeholder "empty = not encrypted")
                     "dataset-level, on top of disk LUKS")
   (zfs-ui--form-row "Quota"
                     (vui-field :size 24 :key "create-quota" :placeholder "empty = no limit")
                     "e.g. 50G")
   (zfs-ui--form-row "Move folder in"
                     (vui-field :size 24 :key "create-move"
                                :placeholder "empty = start empty")
                     "rsync copy with progress; original is kept")
   (vui-hstack
    (vui-box (vui-text "") :width 14)
    (vui-button "Create dataset" :on-click (lambda () (zfs-ui--do-create-dataset host parent))))
   (when create-status
     (vui-text (car create-status) :face (cdr create-status)))))

(defun zfs-ui--page-backup (arg host datasets snaps targets backup-target backup-preview backup-progress backup-done)
  (let* ((dataset (if (consp arg) (car arg) arg))
         (snapshot (if (consp arg) (cdr arg)
                     (car (zfs-ui--newest-snapshot snaps dataset))))
         (entry (assoc dataset datasets)))
    (if (null snapshot)
        (vui-vstack
         :spacing 1
         (vui-heading-3 (format "Backup %s" dataset))
         (vui-text "No snapshots yet — a backup sends a snapshot." :face 'warning)
         (vui-button "Create one now"
                     :on-click (lambda () (zfs-ui--do-snapshot host dataset))))
      (vui-vstack
       :spacing 1
       (vui-heading-3 (format "Backup %s" dataset))
       (vui-muted "Sends a snapshot to another machine or pool. After the first full copy only the changes travel.")
       (vui-hstack
        (vui-box (vui-text "Snapshot" :face 'shadow) :width 14 :align :right)
        (vui-text (concat "@" (zfs--snapshot-leaf snapshot)))
        (vui-space 2)
        (vui-text (format "(%s)" (zfs--format-ago (zfs-cli-prop (assoc snapshot snaps) 'creation)))
                  :face 'shadow))
       (vui-vstack
        :spacing 0
        (vui-hstack (vui-box (vui-text "Target" :face 'shadow) :width 14 :align :right)
                    (vui-text ""))
        (apply
         #'vui-vstack
         :spacing 0
         (mapcar (lambda (target)
                   (vui-hstack
                    (vui-box (vui-text "") :width 14)
                    (vui-button (format "%s — %s %s"
                                        (plist-get target :name)
                                        (or (plist-get target :ssh) "this machine")
                                        (plist-get target :dataset))
                                :no-decoration (not (equal target backup-target))
                                :face (when (equal target backup-target) 'success)
                                :on-click
                                (lambda ()
                                  (vui-set-state :backup-target target)
                                  (condition-case err
                                      (vui-set-state :backup-preview
                                                     (zfs-ui--backup-preview host dataset snapshot snaps entry target))
                                    (error (vui-set-state :message
                                                          (cons (format "Preview failed: %s" (error-message-string err)) 'error))))))))
                 targets)))
       (vui-hstack
        (vui-box (vui-text "One-off" :face 'shadow) :width 14 :align :right)
        (vui-field :size 18 :key "oneoff-ssh" :placeholder "user@host — empty = local")
        (vui-space 1)
        (vui-field :size 18 :key "oneoff-prefix" :placeholder "pool/prefix")
        (vui-space 1)
        (vui-button "Use once"
                    :on-click
                    (lambda ()
                      (let ((prefix (zfs-ui--field-string "oneoff-prefix")))
                        (if (string-blank-p prefix)
                            (vui-set-state :message (cons "One-off target needs a dataset prefix" 'error))
                          (let ((target (list :name "one-off" :dataset prefix))
                                (ssh (zfs-ui--field-string "oneoff-ssh")))
                            (unless (string-blank-p ssh)
                              (setq target (append target (list :ssh ssh))))
                            (vui-set-state :backup-target target)
                            (condition-case err
                                (vui-set-state :backup-preview
                                               (zfs-ui--backup-preview host dataset snapshot snaps entry target))
                              (error (vui-set-state :message
                                                    (cons (format "Preview failed: %s" (error-message-string err)) 'error))))))))))
       (when backup-target
         (vui-hstack
          (vui-box (vui-text "Will send" :face 'shadow) :width 14 :align :right)
          (if backup-preview
              (vui-text (format "%s · %s%s"
                                (if (equal (plist-get backup-preview :kind) "incremental")
                                    (format "only changes since @%s" (zfs--snapshot-leaf (plist-get backup-preview :base)))
                                  "everything (first time)")
                                (zfs--format-bytes (plist-get backup-preview :bytes))
                                (if (plist-get backup-preview :raw) " · stays encrypted" "")))
            (vui-text "…" :face 'shadow))))
       (when (and backup-target backup-preview (not backup-progress) (not backup-done))
         (vui-hstack
          (vui-box (vui-text "") :width 14)
          (vui-button "Start backup"
                      :on-click (lambda () (zfs-ui--start-backup host snapshot backup-target backup-preview)))))
       (when backup-progress
         (vui-hstack
          (vui-box (vui-text "Sending" :face 'shadow) :width 14 :align :right)
          (vui-text backup-progress :face 'shadow)))
       (when backup-done
         (vui-hstack
          (vui-box (vui-text "") :width 14)
          (if (eq backup-done 'success)
              (vui-text "Backup complete." :face 'success)
            (vui-text (format "Backup failed: %s" backup-done) :face 'error))))))))

(defun zfs-ui--page-format (format-disk format-status)
  (if (null format-disk)
      (let ((candidates (zfs-cli-disk-candidates)))
        (vui-vstack
         :spacing 1
         (vui-heading-3 "Format a disk as ZFS")
         (vui-muted "Everything on the chosen disk is erased. Only unused disks are listed.")
         (if candidates
             (apply
              #'vui-vstack
              :spacing 0
              (mapcar (lambda (device)
                        (vui-button (format "%s — %s — %s"
                                            (plist-get device :name)
                                            (or (plist-get device :model) "?")
                                            (zfs--format-bytes (plist-get device :size)))
                                    :no-decoration t
                                    :on-click (lambda () (vui-set-state :format-disk device))))
                      candidates))
           (vui-muted "No unused disks found. Plug one in and press g."))))
    (vui-vstack
     :spacing 1
     (vui-heading-3 (format "Format %s" (plist-get format-disk :name)))
     (vui-text (format "%s · %s — all data on it is erased"
                       (or (plist-get format-disk :model) "?")
                       (zfs--format-bytes (plist-get format-disk :size)))
               :face 'warning)
     (zfs-ui--form-row "Pool name" (vui-field :size 24 :key "format-pool" :placeholder "tank"))
     (zfs-ui--form-row "Passphrase" (vui-field :size 24 :key "format-pass" :secret t
                                               :placeholder "empty = no encryption")
                       "LUKS passphrase; empty leaves the disk unencrypted")
     (zfs-ui--form-row "Type disk name" (vui-field :size 24 :key "format-confirm"
                                                   :placeholder (plist-get format-disk :name))
                       "confirms you picked the right disk")
     (vui-hstack
      (vui-box (vui-text "") :width 14)
      (vui-button "Format"
                  :face 'error
                  :on-click
                  (lambda ()
                    (let ((pool-name (zfs-ui--field-string "format-pool"))
                          (passphrase (zfs-ui--field-string "format-pass")))
                      (cond
                       ((string-blank-p pool-name)
                        (vui-set-state :format-status (cons "Pool name is empty" 'error)))
                       ((not (equal (zfs-ui--field-string "format-confirm") (plist-get format-disk :name)))
                        (vui-set-state :format-status (cons "Type the disk name to confirm" 'error)))
                       (t
                        (zfs-ui--do-format format-disk
                                           pool-name
                                           (not (string-blank-p passphrase))
                                           passphrase)))))))
     (when format-status
       (vui-text (car format-status) :face (cdr format-status))))))

(defun zfs-ui--page-targets (targets)
  (push (cons 'page
              (list :add (vui-with-async-context
                           (let ((name (zfs-ui--field-string "target-name"))
                                 (ssh (zfs-ui--field-string "target-ssh"))
                                 (prefix (zfs-ui--field-string "target-prefix")))
                             (if (or (string-blank-p name) (string-blank-p prefix))
                                 (vui-set-state :message (cons "Name and dataset prefix are required" 'error))
                               (let ((new (list :name name :dataset prefix)))
                                 (unless (string-blank-p ssh)
                                   (setq new (append new (list :ssh ssh))))
                                 (let ((updated (append targets (list new))))
                                   (zfs-ui--targets-save updated)
                                   (vui-set-state :targets updated)
                                   (vui-set-state :message (cons (format "Target %s saved to %s" name zfs-targets-file)
                                                                 'success)))))))))
        zfs-ui--row-actions)
  (apply
   #'vui-vstack
   :spacing 1
   (append
    (list
     (vui-heading-3 "Backup targets")
     (vui-muted (format "Stored as plain elisp data in %s — edit by hand or here." zfs-targets-file)))
    (if targets
        (list (apply
               #'vui-vstack
               :spacing 0
               (mapcar (lambda (target)
                         (vui-hstack
                          :spacing 2
                          (vui-box (vui-text (plist-get target :name)) :width 16)
                          (vui-box (vui-text (or (plist-get target :ssh) "this machine") :face 'shadow) :width 24)
                          (vui-box (vui-text (plist-get target :dataset) :face 'shadow) :width 28)
                          (vui-button "Delete" :face 'error
                                      :on-click
                                      (lambda ()
                                        (when (yes-or-no-p (format "Delete target %s? " (plist-get target :name)))
                                          (let ((updated (seq-remove (lambda (other) (equal other target)) targets)))
                                            (zfs-ui--targets-save updated)
                                            (vui-set-state :targets updated)
                                            (vui-set-state :message (cons "Target deleted" 'success))))))))
                       targets)))
      (list (vui-muted "No targets yet — add one below.")))
    (list
     (vui-vstack
      :spacing 1
      (vui-heading-3 "Add target")
      (zfs-ui--form-row "Name" (vui-field :size 24 :key "target-name" :placeholder "interserver"))
      (zfs-ui--form-row "SSH" (vui-field :size 24 :key "target-ssh" :placeholder "user@host — empty = this machine"))
      (zfs-ui--form-row "Dataset prefix" (vui-field :size 24 :key "target-prefix" :placeholder "backuppool/mainframe")
                        "must exist on the target; the dataset's leaf name is appended")
      (vui-hstack
       (vui-box (vui-text "") :width 14)
       (vui-button "Save target"
                   :on-click (lambda ()
                               (when-let* ((actions (cdr (assoc 'page zfs-ui--row-actions)))
                                           (fn (plist-get actions :add)))
                                 (funcall fn))))))))))

(vui-defcomponent zfs-app ()
  :state ((page 'overview)
          (page-arg nil)
          (host nil)
          (pools nil)
          (datasets nil)
          (snaps nil)
          (locked nil)
          (targets (zfs-ui--targets-load))
          (loading t)
          (message nil)
          (refreshed nil)
          (backup-target nil)
          (backup-preview nil)
          (backup-progress nil)
          (backup-done nil)
          (create-status nil)
          (format-disk nil)
          (format-status nil))
  :render
  (progn
    (vui-use-effect ()
      (zfs-ui--refresh host)
      nil)
    (setq zfs-ui--row-actions nil)
    (setq zfs-ui--refresh-fn (vui-with-async-context (zfs-ui--refresh host)))
    (push (cons 'nav
                (list :back (vui-with-async-context
                              (if (eq page 'overview)
                                  (bury-buffer)
                                (zfs-ui--go 'overview)))))
          zfs-ui--row-actions)
    (let ((content
           (cond
            (loading (vui-text "Loading…" :face 'shadow))
            ((eq page 'overview)
             (if pools
                 (zfs-ui--page-overview pools datasets snaps locked)
               (vui-vstack :spacing 1
                           (vui-heading-3 "No pools found")
                           (vui-muted "ZFS returned no pools. Kernel module loaded, pools imported?"))))
            ((eq page 'dataset) (zfs-ui--page-dataset page-arg host datasets snaps))
            ((eq page 'pool) (zfs-ui--page-pool page-arg host))
            ((eq page 'create) (zfs-ui--page-create page-arg host create-status))
            ((eq page 'backup) (zfs-ui--page-backup page-arg host datasets snaps targets
                                                    backup-target backup-preview
                                                    backup-progress backup-done))
            ((eq page 'new-pool) (zfs-ui--page-format format-disk format-status))
            ((eq page 'targets) (zfs-ui--page-targets targets))
            (t (vui-text "unknown page" :face 'error)))))
      (vui-vstack
       :spacing 1
       (vui-flex :width 'window :justify :space-between
                 (vui-hstack :spacing 2
                             (vui-heading-2 "ZFS")
                             (vui-text (cond
                                        ((eq page 'overview) (if host (format "on %s" (plist-get host :name)) "on this machine"))
                                        (t (format "› %s" (if (symbolp page) (symbol-name page) page))))
                                       :face 'shadow))
                 (vui-text (format "%s pools · refreshed %s" (length pools) (or refreshed "—")) :face 'shadow))
       (if message
           (vui-text (car message) :face (cdr message))
         (vui-text " "))
       content
       (vui-text (pcase page
                   ('overview "RET open · u unlock · F format disk · T targets · g refresh · q quit")
                   ('dataset "q back · s snapshot · b backup · c new dataset · d diff · r rollback · D destroy · g refresh")
                   ('pool "q back · 1 scrub start · 2 scrub stop · x export · g refresh")
                   ('backup "q back · click a target · g refresh")
                   (_ "q back · g refresh"))
                 :face 'shadow)))))

(defun zfs-ui--key-on-line ()
  (save-excursion
    (beginning-of-line)
    (let ((end (line-end-position))
          (found nil))
      (while (and (<= (point) end) (not found))
        (setq found (vui-key-at))
        (forward-char 1))
      found)))

(defun zfs-ui--invoke (action)
  (let* ((key (zfs-ui--key-on-line))
         (row (and key (cdr (assoc key zfs-ui--row-actions))))
         (page (cdr (assoc 'page zfs-ui--row-actions))))
    (cond
     ((plist-get row action) (funcall (plist-get row action)))
     ((and (eq action :open) (plist-get row :open)) (funcall (plist-get row :open)))
     ((plist-get page action) (funcall (plist-get page action)))
     (t (message "Nothing here for that key")))))

(define-derived-mode zfs-mode vui-mode "ZFS"
  (hl-line-mode 1))

(define-key zfs-mode-map (kbd "q") (lambda () (interactive) (zfs-ui--invoke :back)))
(define-key zfs-mode-map (kbd "g") (lambda () (interactive) (when zfs-ui--refresh-fn (funcall zfs-ui--refresh-fn))))
(define-key zfs-mode-map (kbd "s") (lambda () (interactive) (zfs-ui--invoke :snapshot)))
(define-key zfs-mode-map (kbd "b") (lambda () (interactive) (zfs-ui--invoke :backup)))
(define-key zfs-mode-map (kbd "c") (lambda () (interactive) (zfs-ui--invoke :create-child)))
(define-key zfs-mode-map (kbd "d") (lambda () (interactive) (zfs-ui--invoke :diff)))
(define-key zfs-mode-map (kbd "r") (lambda () (interactive) (zfs-ui--invoke :rollback)))
(define-key zfs-mode-map (kbd "D") (lambda () (interactive) (zfs-ui--invoke :destroy)))
(define-key zfs-mode-map (kbd "m") (lambda () (interactive) (zfs-ui--invoke :mount)))
(define-key zfs-mode-map (kbd "u") (lambda () (interactive) (zfs-ui--invoke :unlock)))
(define-key zfs-mode-map (kbd "i") (lambda () (interactive) (zfs-ui--invoke :import)))
(define-key zfs-mode-map (kbd "L") (lambda () (interactive) (zfs-ui--invoke :lock)))
(define-key zfs-mode-map (kbd "F") (lambda () (interactive) (zfs-ui--invoke :format)))
(define-key zfs-mode-map (kbd "T") (lambda () (interactive) (zfs-ui--invoke :targets)))
(define-key zfs-mode-map (kbd "1") (lambda () (interactive) (zfs-ui--invoke :scrub-start)))
(define-key zfs-mode-map (kbd "2") (lambda () (interactive) (zfs-ui--invoke :scrub-stop)))
(define-key zfs-mode-map (kbd "x") (lambda () (interactive) (zfs-ui--invoke :export)))

;;;###autoload
(defun zfs ()
  (interactive)
  (let ((buffer (get-buffer-create zfs-buffer-name)))
    (with-current-buffer buffer
      (unless (eq major-mode 'zfs-mode)
        (zfs-mode)
        (vui-mount (vui-component 'zfs-app) buffer)
        (vui-rerender-on-resize)))
    (pop-to-buffer buffer)))

(provide 'zfs)
;;; zfs.el ends here