;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix 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.
;;;
;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services backup)
  #:use-module (gnu packages backup)
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services mcron)
  #:use-module (guix build-system copy)
  #:use-module (guix gexp)
  #:use-module ((guix licenses)
                #:prefix license:)
  #:use-module (guix modules)
  #:use-module (guix packages)
  #:use-module (srfi srfi-1)
  #:export (restic-backup-job
            restic-backup-job?
            restic-backup-job-fields
            restic-backup-job-restic
            restic-backup-job-user
            restic-backup-job-name
            restic-backup-job-repository
            restic-backup-job-password-file
            restic-backup-job-schedule
            restic-backup-job-files
            restic-backup-job-init?
            restic-backup-job-verbose?
            restic-backup-job-extra-flags

            restic-backup-configuration
            restic-backup-configuration?
            restic-backup-configuration-fields
            restic-backup-configuration-jobs

            restic-backup-job-program
            restic-backup-job->mcron-job
            restic-guix
            restic-guix-wrapper-package
            restic-backup-service-profile
            restic-backup-service-type))

(define (gexp-or-string? value)
  (or (gexp? value)
      (string? value)))

(define (lowerable? value)
  (or (file-like? value)
      (gexp-or-string? value)))

(define list-of-lowerables?
  (list-of lowerable?))

(define-maybe/no-serialization string)
(define-maybe/no-serialization file-like)

(define-configuration/no-serialization restic-backup-job
  (restic
   (package restic)
   "The restic package to be used for the current job.")
  (user
   (string "root")
   "The user used for running the current job.")
  (name
   (string)
   "A string denoting a name for this job.")
  (repository
   (string)
   "The restic repository target of this job.")
  (password-file
   (maybe-string)
   "Name of the password file, readable by the configured @code{user}, that
will be used to set the @code{RESTIC_PASSWORD} environment variable for the
current job.")
  (password-command
   (maybe-file-like)
   "An executable file who's path is stored in @code{RESTIC_PASSWORD_COMMAND}.
When run, the file writes the password to standard output. Due to the nature
of the store this command will be globally executable and should have external
protections to ensure unauthorized users cannot retrieve the password.")
  (schedule
   (gexp-or-string)
   "A string or a gexp that will be passed as time specification in the mcron
job specification (@pxref{Syntax, mcron job specifications,, mcron,
GNU@tie{}mcron}).")
  (files
   (list-of-lowerables '())
   "The list of files or directories to be backed up.  It must be a list of
values that can be lowered to strings.")
  (verbose?
   (boolean #f)
   "Whether to enable verbose output for the current backup job.")
  (init?
   (boolean #f)
   "Whether to attempt to initialize a new repository for automated bootstrap purposes.")
  (extra-flags
   (list-of-lowerables '())
   "A list of values that are lowered to strings.  These will be passed as
command-line arguments to the current job @command{restic backup} invokation."))

(define (verify-restic-backup-job-configuration config)
  (unless (or (maybe-value-set? (restic-backup-job-password-file config))
              (maybe-value-set? (restic-backup-job-password-command config)))
    (error "either password-file or password-command must be configured."))
  (when (and (maybe-value-set? (restic-backup-job-password-file config))
             (maybe-value-set? (restic-backup-job-password-command config)))
    (error "password-file and password-command can not be configured simultaneously.")))

(define list-of-restic-backup-jobs?
  (list-of restic-backup-job?))

(define-configuration/no-serialization restic-backup-configuration
  (jobs
   (list-of-restic-backup-jobs '())
   "The list of backup jobs for the current system."))

(define (restic-backup-job-program config)
  (define (maybe-value-or-false maybe)
    (if (maybe-value-set? maybe)
        maybe
        #f))

  (verify-restic-backup-job-configuration config)

  (let ((restic
         (file-append (restic-backup-job-restic config) "/bin/restic"))
        (repository
         (restic-backup-job-repository config))
        (password-file
         (maybe-value-or-false (restic-backup-job-password-file config)))
        (password-command
         (maybe-value-or-false (restic-backup-job-password-command config)))
        (files
         (restic-backup-job-files config))
        (extra-flags
         (restic-backup-job-extra-flags config))
        (init?
         (restic-backup-job-init? config))
        (verbose
         (if (restic-backup-job-verbose? config)
             '("--verbose")
             '())))
    (program-file
     "restic-backup-job.scm"
     #~(begin
         (use-modules (ice-9 popen)
                      (ice-9 rdelim))
         (or (and=> #$password-file (lambda (x)
                                      (setenv "RESTIC_PASSWORD"
                                              (with-input-from-file x read-line))))
             (and=> #$password-command (lambda (x)
                                         (setenv "RESTIC_PASSWORD_COMMAND" x)))
             ;; Have a backup error message in case
             ;; verify-restic-backup-job-configuration is messed with
             (error "Neither password-file or password-command set"))
         (when #$init?
           ;; Use cat config to check if the repository exists. See
           ;; https://github.com/restic/restic/issues/1690 and
           ;; https://github.com/NixOS/nixpkgs/pull/307962.
           ;;
           ;; XXX: restic returns values other than 1 on failure. Check
           ;; EXIT_SUCCESS instead of EXIT_FAILURE.
           (unless (or (equal? EXIT_SUCCESS (system* #$restic "cat" "config"
                                                     "-r" #$repository))
                       (equal? EXIT_SUCCESS (system* #$restic "init"
                                                     "-r" #$repository)))
             (error "Failed to initialize restic repository: " #$repository)))
         (execlp #$restic #$restic #$@verbose
                 "-r" #$repository
                 #$@extra-flags
                 "backup" #$@files)))))

(define (restic-guix jobs)
  (program-file
   "restic-guix"
   #~(begin
       (use-modules (ice-9 match)
                    (srfi srfi-1))

       (define names '#$(map restic-backup-job-name jobs))
       (define programs '#$(map restic-backup-job-program jobs))

       (define (get-program name)
         (define idx
           (list-index (lambda (n) (string=? n name)) names))
         (unless idx
           (error (string-append "Unknown job name " name "\n\n"
                                 "Possible job names are: "
                                 (string-join names " "))))
         (list-ref programs idx))

       (define (backup args)
         (define name (third args))
         (define program (get-program name))
         (execlp program program))

       (define (validate-args args)
         (when (not (>= (length args) 3))
           (error (string-append "Usage: " (basename (car args))
                                 " backup NAME"))))

       (define (main args)
         (validate-args args)
         (define action (second args))
         (match action
           ("backup"
            (backup args))
           (_
            (error (string-append "Unknown action: " action)))))

       (main (command-line)))))

(define (restic-backup-job->mcron-job config)
  (let ((user
         (restic-backup-job-user config))
        (schedule
         (restic-backup-job-schedule config))
        (name
         (restic-backup-job-name config)))
    #~(job #$schedule
           #$(string-append "restic-guix backup " name)
           #:user #$user)))

(define (restic-guix-wrapper-package jobs)
  (package
    (name "restic-backup-service-wrapper")
    (version "0.0.0")
    (source (restic-guix jobs))
    (build-system copy-build-system)
    (arguments
     (list #:install-plan #~'(("./" "/bin"))))
    (home-page "https://restic.net")
    (synopsis
     "Easily interact from the CLI with Guix configured backups")
    (description
     "This package provides a simple wrapper around @code{restic}, handled
by the @code{restic-backup-service-type}.  It allows for easily interacting
with Guix configured backup jobs, for example for manually triggering a backup
without waiting for the scheduled job to run.")
    (license license:gpl3+)))

(define restic-backup-service-profile
  (lambda (config)
    (define jobs (restic-backup-configuration-jobs config))
    (if (> (length jobs) 0)
        (list
         (restic-guix-wrapper-package jobs))
        '())))

(define restic-backup-service-type
  (service-type (name 'restic-backup)
                (extensions
                 (list
                  (service-extension profile-service-type
                                     restic-backup-service-profile)
                  (service-extension mcron-service-type
                                     (lambda (config)
                                       (map restic-backup-job->mcron-job
                                            (restic-backup-configuration-jobs
                                             config))))))
                (compose concatenate)
                (extend
                 (lambda (config jobs)
                   (restic-backup-configuration
                    (inherit config)
                    (jobs (append (restic-backup-configuration-jobs config)
                                  jobs)))))
                (default-value (restic-backup-configuration))
                (description
                 "This service configures @code{mcron} jobs for running backups
with @code{restic}.")))