diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index efe056dab7..eb8dba3120 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -582,31 +582,29 @@ (define target-generation (define roll-back-failure (condition (&message (message (G_ "could not roll-back machine"))))) - (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine)) - (_ -> (if (< (length boot-alternatives) 2) - (raise roll-back-failure))) - (entries -> (map boot-parameters->menu-entry - (list (second boot-alternatives)))) - (locale -> (boot-parameters-locale - (second boot-alternatives))) - (crypto-dev -> (boot-parameters-store-crypto-devices - (second boot-alternatives))) - (store-dir -> (boot-parameters-store-directory-prefix - (second boot-alternatives))) - (old-entries -> (map boot-parameters->menu-entry - (drop boot-alternatives 2))) - (bootloader -> (operating-system-bootloader - (machine-operating-system machine))) - (bootcfg (lower-object - ((bootloader-configuration-file-generator - (bootloader-configuration-bootloader - bootloader)) - bootloader entries - #:locale locale - #:store-crypto-devices crypto-dev - #:store-directory-prefix store-dir - #:old-entries old-entries))) - (remote-result (machine-remote-eval machine remote-exp))) + (mlet* %store-monad + ((boot-alternatives (machine->boot-alternatives machine)) + (_ -> (when (< (length boot-alternatives) 2) + (raise roll-back-failure))) + (parameters (second boot-alternatives)) + (entries -> (list (boot-parameters->menu-entry parameters))) + (locale -> (boot-parameters-locale parameters)) + (crypto-dev -> (boot-parameters-store-crypto-devices parameters)) + (store-dir -> (boot-parameters-store-directory-prefix parameters)) + (old-entries -> (map boot-parameters->menu-entry + (drop boot-alternatives 2))) + (bootloader -> (operating-system-bootloader + (machine-operating-system machine))) + (bootcfg (lower-object + ((bootloader-configuration-file-generator + (bootloader-configuration-bootloader + bootloader)) + bootloader entries + #:locale locale + #:store-crypto-devices crypto-dev + #:store-directory-prefix store-dir + #:old-entries old-entries))) + (remote-result (machine-remote-eval machine remote-exp))) (when (eqv? 'error remote-result) (raise roll-back-failure))))