;; workaround for https://issues.guix.gnu.org/53005
;;
;; How to use:
;; Run this code in your operating system config file.
;; Then replace `luks-device-mapping' with `alt-luks-device-mapping'.
;;
;; i may have forgotten some use-modules. use your brain if necessary.

;; to-do: it would be better to use package transformation procedures to fix cryptsetup from the current guix
(use-modules (guix inferior) (guix channels) (srfi srfi-1))
(define channels
  (list (channel
         (name 'guix)
         (url "https://git.savannah.gnu.org/git/guix.git")
         (commit
          "0996fcc657593955845c2761d7eb0f656149fe11"))))
(define inferior (inferior-for-channels channels))
(define old-cryptsetup-static (first (lookup-inferior-packages inferior "cryptsetup-static")))

(use-modules (gnu system uuid))
(use-modules (ice-9 match))
(use-modules (guix modules))
;; copied from guix.
;; the whole point is to edit the `file-append' line.
;; (if i knew a way to modify gexp, this could simply modify the output of the old procedure.)
(define (my-open-luks-device source targets)
  "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
'cryptsetup'."
  (with-imported-modules (source-module-closure
                          '((gnu build file-systems)
                            (guix build utils))) ;; For mkdir-p
    (match targets
      ((target)
       #~(let ((source #$(if (uuid? source)
                             (uuid-bytevector source)
                             source)))
           ;; XXX: 'use-modules' should be at the top level.
           (use-modules (rnrs bytevectors) ;bytevector?
                        ((gnu build file-systems)
                         #:select (find-partition-by-luks-uuid
                                   system*/tty))
                        ((guix build utils) #:select (mkdir-p)))
           (mkdir-p "/run/cryptsetup/")
           (zero? (system*/tty
                   #$(file-append old-cryptsetup-static "/sbin/cryptsetup")
                   "open" "--type" "luks"
                   (if (bytevector? source)
                       (or (let loop ((tries-left 10))
                             (and (positive? tries-left)
                                  (or (find-partition-by-luks-uuid source)
                                      (begin (sleep 1)
                                             (loop (- tries-left 1))))))
                           (error "LUKS partition not found" source))
                       source)
                   #$target)))))))
(define alt-luks-device-mapping
  (mapped-device-kind
   (inherit luks-device-mapping)
   (open my-open-luks-device)))