(define-module (ruther services bind)
  #:use-module (srfi srfi-1)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services)
  #:use-module (gnu packages file-systems)
  #:use-module (gnu packages linux)
  #:export (%default-guix-shared-users
            user-info
            user-info?
            user-info-user
            user-info-home

            guix-shared-cache-config
            guix-shared-cache-config-bindfs
            guix-shared-cache-config-main-user
            guix-shared-cache-config-shared-directory
            guix-shared-cache-config-users

            guix-shared-cache-service-type))

(define-record-type* <user-info>
  user-info make-user-info
  user-info?
  (user user-info-user)
  (group user-info-group (default "users"))
  (home user-info-home)
  (files user-info-files (default '("authentication" "checkouts" "http" "inferiors" "locate" "profiles" "substitute"))))

(define (list-of-user-info? lst)
  (every user-info? lst))

(define %default-guix-shared-users
  (list
   (user-info
    (user "root")
    (group "root")
    (home "/root"))))

(define-configuration/no-serialization guix-shared-cache-config
  (bindfs (file-like bindfs) "The bindfs package to use.")
  (fuse (file-like fuse-2) "The fuse package to use")

  (main-user (string "root") "The user that owns the main shared directory")
  (main-group (string "root") "The group that owns the main shared directory")
  (shared-directory (string "/shared/guix-cache") "The directory that is shared between users")
  (users (list-of-user-info %default-guix-shared-users) "The users that have the directory shared"))

(define (shared-guix-cache-shepherd-services config)
  (map
   (lambda (user)
     (let* ((fuse (guix-shared-cache-config-fuse config))
            (bindfs (guix-shared-cache-config-bindfs config))
            (user-name (user-info-user user))
            (user-home (user-info-home user))
            (user-group (user-info-group user))
            (user-files (user-info-files user))
            (main-group (guix-shared-cache-config-main-group config))
            (main-user (guix-shared-cache-config-main-user config))
            (shared-dir-base (guix-shared-cache-config-shared-directory config))
            (mount-dir-base (string-append user-home "/.cache/guix")))
       (shepherd-service
        ;; Each user has their own service
        (provision (list (symbol-append 'shared-guix-cache-
                                        (string->symbol user-name))))
        ;; Make sure the homes are already present
        (requirement '(file-systems user-homes))
        (stop #~(lambda args
                  ;; For each mounted directory, unmount it
                  (for-each
                   (lambda (dir)
                     (let ((mount-dir (string-append #$mount-dir-base "/" dir) ))
                       (invoke
                        #$(file-append fuse "/bin/fusermount")
                        "-u"
                        mount-dir)))
                   '#$user-files)
                  #f))
        (start #~(lambda args
                   ;; Like mkdir-p, but chown all created directories
                   ;; by the user specified.
                   (define (mkdir-recursively dir user group)
                     (unless (eq? dir "/")
                       (when (not (file-exists? dir))
                         (mkdir-recursively (dirname dir) user group)

                         (mkdir dir)
                         (let* ((pw (getpw user))
                                (uid (passwd:uid pw))
                                (gid (passwd:gid pw)))
                           (chown dir uid gid)))))

                   ;; For each mount directory, mount it to the shared directory
                   (for-each
                    (lambda (dir)
                      (let ((mount-dir (string-append #$mount-dir-base "/" dir))
                            (shared-dir (string-append #$shared-dir-base "/" dir)))
                        (mkdir-recursively shared-dir #$main-user #$main-group)
                        (mkdir-recursively mount-dir #$user-name #$user-group)
                        (invoke
                         #$(file-append bindfs "/bin/bindfs")
                         (string-append "--create-for-group=" #$main-group)
                         (string-append "--create-for-user=" #$main-user)
                         (string-append "--force-user=" #$user-name)
                         (string-append "--force-group=" #$user-group)
                         "-o" "nonempty"
                         shared-dir mount-dir)))
                    '#$user-files)
                   #t)))))
   (guix-shared-cache-users config)))

(define guix-shared-cache-service-type
  (service-type
   (name 'shared-guix-cache)
   (extensions (list
                (service-extension shepherd-root-service-type
                                   shared-guix-cache-shepherd-services)))
   (compose append)
   (extend (lambda (original extensions)
             (guix-shared-cache-config
              (inherit original)
              (users (append (guix-shared-cache-users original))))))
   (default-value (guix-shared-cache-config))
   (description "Share ~/.cache/guix between
multiple users. The root user is going to own the shared checkout,
and will be part of the users who can use the shared checkout.
If you want to change the default user, set main-user of the
configuration. This user owns the shared checkout folder.")))