(define-module (tw services restic)
  #:use-module (gnu)
  #:use-module (gnu home services mcron)
  #:use-module ((gnu packages admin)
                #:select (shadow))
  #:use-module (gnu packages backup)
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services mcron)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (srfi srfi-1)
  #:export (restic-server-service-type
            restic-server-configuration
            restic-cleanup-service-type
            restic-cleanup-repository
            home-restic-backup-service-type
            restic-backup-repository))

(define %restic-user "restic")
(define %restic-group "restic")


;; Restic REST server

(define-maybe/no-serialization integer)
(define-maybe/no-serialization string)

;; TODO: implement --tls, --tls-cert and --tls-key, maybe using certbot-service-type?
;; TODO: implement --log
(define-configuration/no-serialization restic-server-configuration
  (repository-path (string "/var/lib/restic") "The directory containing
restic's repositories and @code{.htpasswd} file, unless otherwise configured
using @code{htpasswd-file}.")
  (restic-server (package restic-rest-server) "The restic REST server package to use.")
  (bind-address (string ":8000") "The listen address (including port) to bind to.")
  (htpasswd-file (maybe-string) "Location of @code{.htpasswd} file (default:
@code{REPOSITORY-PATH/.htpasswd}).  Use @code{htpasswd} from the @code{httpd}
package to create and/or update this file.")
  (auth? (boolean #t) "Whether to authenticate users at all (using .htpasswd).")
  (verify-upload? (boolean #t) "Whether to verify the integrity of uploaded
data.  @emph{Do not disable} unless the restic server is to be run on a very
low-power device.")
  (append-only? (boolean #f) "Whether to run the restic server in append-only mode.")
  (max-repository-size (maybe-integer) "Maximum repository size in bytes, if any.")
  (private-repos-only? (boolean #f) "Whether to let users only access their
private restic repos.")
  (prometheus? (boolean #f) "Whether to serve Prometheus metrics.")
  (prometheus-auth? (boolean #t) "Whether to require authentication as the
@code{metrics} user to access the Prometheus /metrics endpoint."))

(define (restic-server-arguments config)
  "Turn CONFIG into a list of arguments to the restic-rest-server executable."
  `("--path" ,(restic-server-configuration-repository-path config)
    "--listen" ,(restic-server-configuration-bind-address config)
    ,@(let ((htpasswd-file (restic-server-configuration-htpasswd-file config)))
        (if (string? htpasswd-file) `("--htpasswd-file" ,htpasswd-file) '()))
    ,@(if (restic-server-configuration-auth? config) '() '("--no-auth"))
    ,@(if (restic-server-configuration-verify-upload? config) '() '("--no-verify-upload"))
    ,@(if (restic-server-configuration-append-only? config) '("--append-only") '())
    ,@(let ((max-size (restic-server-configuration-max-repository-size config)))
        (if (integer? max-size) `("--max-size" ,max-size) '()))
    ,@(if (restic-server-configuration-private-repos-only? config) '("--private-repos") '())
    ,@(if (restic-server-configuration-prometheus? config) '("--prometheus") '())
    ,@(if (restic-server-configuration-prometheus-auth? config) '() '("--prometheus-no-auth"))))

(define (restic-server-service config)
  "Create a `shepherd-service' for the restic REST server from CONFIG."
  (list (shepherd-service
         (provision '(restic-server))
         (requirement '(networking))
         (documentation "Run the Restic REST server to serve backup repositories via HTTP.")
         (start #~(make-forkexec-constructor
                   (list #$(file-append (restic-server-configuration-restic-server config)
                                        "/bin/restic-rest-server")
                         #$@(restic-server-arguments config))
                   #:user #$%restic-user #:group #$%restic-group))
         (stop #~(make-kill-destructor)))))

(define (restic-server-accounts config)
  "Create user accounts and groups for the restic REST server defined in CONFIG."
  (list (user-account
         (name %restic-user)
         (group %restic-group)
         (comment "Restic server user")
         (system? #t)
         (home-directory (restic-server-configuration-repository-path config))
         (shell (file-append shadow "/sbin/nologin")))
        (user-group
         (name %restic-group)
         (system? #t))))

(define restic-server-service-type
  (service-type
   (name 'restic-server)
   (extensions
    (list (service-extension shepherd-root-service-type restic-server-service)
          (service-extension account-service-type restic-server-accounts)))
   (description
    "Restic REST server, running as a service user instead of root.")))


;; Restic cleanup cronjobs

(define-maybe list-of-strings)

(define-configuration/no-serialization restic-cleanup-repository
  (schedule gexp "An mcron schedule, specified as a gexp (@pxref{G-Expressions}),
 to use for the cleanup job.  String, list or lambda syntax is fine
(@pxref{Syntax, mcron job specifications,, mcron,GNU@tie{}mcron}).")
  (url string "The directory path (or URL) of the restic repository to clean up.")
  (password-file string "The file name containing the repository password.
Must be readable by the @code{%restic-user}.")
  (restic (package restic) "The restic package to use.")
  (snapshot-host (maybe-string) "Only consider snapshots from this host.")
  (snapshot-paths (maybe-list-of-strings) "Only consider snapshots which
include these paths.")
  (prune? (boolean #t) "Immediately prune the repo after deleting snapshots.")
  (keep-last (maybe-integer) "Keep the last N snapshots.")
  (keep-hourly (maybe-integer) "Keep the last N hourly snapshots.")
  (keep-daily (maybe-integer) "Keep the last N daily snapshots.")
  (keep-weekly (maybe-integer) "Keep the last N weekly snapshots.")
  (keep-monthly (maybe-integer) "Keep the last N monthly snapshots.")
  (keep-yearly (maybe-integer) "Keep the last N yearly snapshots.")
  (keep-within (maybe-string) "Keep snapshots newer than the given duration
relative to the latest snapshot."))

(define (restic-cleanup-cronjobs repositories)
  (define (arg-with-value arg value)
    "Produce a list for the given command-line argument with optional value.
The result is inteded to be substituted into a `gexp' using `#$@', e.g. into
an `execl' call.  Numbers are converted to strings as if by `display'.  Lists
are turned into multiple arguments.  For booleans, ARG is returned if VALUE is
true."
    (define (to-string thing)
      (format #f "~a" thing))
    (cond
     ((not (maybe-value-set? value))
      '())
     ((boolean? value)
      (if value (list arg) '()))
     ((list? value)
      (append-map (lambda (item)
                    (list arg (to-string item)))
                  value))
     (else
      (list arg (to-string value)))))

  (define (cronjob repo)
    #~(job #$(restic-cleanup-repository-schedule repo)
           #$(program-file
                 ;; Make cron commands for different repos easier to distinguish.
                 (format #f "restic-cleanup-~a-command"
                         (string-trim-right (basename (restic-cleanup-repository-url repo)) #\/))
               #~(begin
                   ;; `setgid' first, while we're still root.
                   (setgid (group:gid (getgr #$%restic-group)))
                   (setuid (passwd:uid (getpw #$%restic-user)))
                   (setenv "RESTIC_REPOSITORY" '#$(restic-cleanup-repository-url repo))
                   (setenv "RESTIC_PASSWORD_FILE" '#$(restic-cleanup-repository-password-file repo))
                   (execl #$(file-append (restic-cleanup-repository-restic repo) "/bin/restic")
                          "restic" "forget" "--no-cache"
                          #$@(arg-with-value "--prune" (restic-cleanup-repository-prune? repo))
                          #$@(arg-with-value "--host" (restic-cleanup-repository-snapshot-host repo))
                          #$@(arg-with-value "--path" (restic-cleanup-repository-snapshot-paths repo))
                          #$@(arg-with-value "--keep-within" (restic-cleanup-repository-keep-within repo))
                          #$@(arg-with-value "--keep-last" (restic-cleanup-repository-keep-last repo))
                          #$@(arg-with-value "--keep-hourly" (restic-cleanup-repository-keep-hourly repo))
                          #$@(arg-with-value "--keep-daily" (restic-cleanup-repository-keep-daily repo))
                          #$@(arg-with-value "--keep-weekly" (restic-cleanup-repository-keep-weekly repo))
                          #$@(arg-with-value "--keep-monthly" (restic-cleanup-repository-keep-monthly repo))
                          #$@(arg-with-value "--keep-yearly" (restic-cleanup-repository-keep-yearly repo)))))))

  (map cronjob repositories))

(define restic-cleanup-service-type
  (service-type
   (name 'restic-cleanup)
   (extensions
    (list (service-extension mcron-service-type restic-cleanup-cronjobs)))
   (compose concatenate)
   (extend append)
   (default-value '())
   (description "Clean up old restic snapshots on a schedule.")))


;; Restic scheduled backup jobs

(define (nonempty-list-of-strings? thing)
  (and (pair? thing) (list-of-strings? thing)))

(define-configuration/no-serialization restic-backup-repository
  (schedule gexp "An mcron schedule, specified as a gexp
(@pxref{G-Expressions}), to use for the backup job.  String, list or lambda
syntax is fine (@pxref{Syntax, mcron job specifications,, mcron,
GNU@tie{}mcron}).")
  (paths nonempty-list-of-strings "List of paths to back up.  At least one
must be given.  Leading @code{~/} are replaced with @code{$HOME}.")
  (url-command string "Run this command (inside @code{sh -c}) to obtain the
directory or URL of the repo to back up to.  This allows you to substitute
passwords in @code{rest:} URLs.")
  (password-command string "Run this command to obtain the repository password.")
  (tags (list-of-strings '()) "Optional tags to add to the snapshot.")
  (restic (package restic) "The restic package to use."))

(define (restic-backup-cronjobs repositories)
  (define (cronjob repo)
    #~(job #$(restic-backup-repository-schedule repo)
           #$(program-file "restic-backup-command"
               #~(begin
                   (use-modules (ice-9 popen)
                                (ice-9 textual-ports)
                                (srfi srfi-1))
                   (define (replace-home path)
                     (if (string-prefix? "~/" path)
                         (string-replace path (getenv "HOME") 0 1)
                         path))
                   (setenv "RESTIC_PASSWORD_COMMAND"
                           '#$(restic-backup-repository-password-command repo))
                   (let ((pipe (open-pipe '#$(restic-backup-repository-url-command repo) OPEN_READ)))
                     (setenv "RESTIC_REPOSITORY" (string-trim-right (get-string-all pipe) #\newline))
                     (close-pipe pipe))
                   (apply execl #$(file-append (restic-backup-repository-restic repo) "/bin/restic")
                          "restic" "backup" "--cleanup-cache"
                          #$@(append-map (lambda (tag) (list "--tag" tag))
                                         (restic-backup-repository-tags repo))
                          (map replace-home '#$(restic-backup-repository-paths repo)))))))
  (map cronjob repositories))

(define home-restic-backup-service-type
  (service-type
   (name 'restic-backup)
   (extensions
    (list (service-extension home-mcron-service-type restic-backup-cronjobs)))
   (compose concatenate)
   (extend append)
   (default-value '())
   (description "Back up local directories on a schedule.")))