[bug#40207] [PATCH 2/2] tests: install: Add %test-gui-installed-desktop-os-encrypted.

[Mathieu Othacehe]

* gnu/tests/install.scm (run-install): Make sure that the default target-size
is used if #f is passed,
(gui-test-program): add a desktop? argument, and pass it to choose-services,
(guided-installation-test): add desktop? and target-size arguments. If
desktop? is #t, make sure that all desktop-environments are available. Pass
target-size to run-install call and desktop? to gui-test-program call.
(%test-gui-installed-desktop-os-encrypted): New variable.
---
 gnu/tests/install.scm | 90 +++++++++++++++++++++++++++++++++++--------
 1 file changed, 73 insertions(+), 17 deletions(-)

diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 83988873c2..9a4b36d5e7 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -32,15 +32,23 @@
   #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages ocr)
+  #:use-module (gnu packages openbox)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages ratpoison)
+  #:use-module (gnu packages suckless)
   #:use-module (gnu packages virtualization)
+  #:use-module (gnu packages wm)
+  #:use-module (gnu packages xorg)
+  #:use-module (gnu services desktop)
   #:use-module (gnu services networking)
+  #:use-module (gnu services xorg)
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix grafts)
   #:use-module (guix gexp)
   #:use-module (guix utils)
+  #:use-module (srfi srfi-1)
   #:export (%test-installed-os
             %test-installed-extlinux-os
             %test-iso-image-installer
@@ -52,7 +60,8 @@
             %test-jfs-root-os
 
             %test-gui-installed-os
-            %test-gui-installed-os-encrypted))
+            %test-gui-installed-os-encrypted
+            %test-gui-installed-desktop-os-encrypted))
 
 ;;; Commentary:
 ;;;
@@ -203,13 +212,14 @@ reboot\n")
                                                 (gnu installer tests)
                                                 (guix combinators))))
                       (installation-disk-image-file-system-type "ext4")
-                      (target-size (* 2200 MiB)))
+                      (target-size #f))
   "Run SCRIPT (a shell script following the system installation procedure) in
 OS to install TARGET-OS.  Return a VM image of TARGET-SIZE bytes containing
 the installed system.  The packages specified in PACKAGES will be appended to
 packages defined in installation-os."
 
-  (mlet* %store-monad ((_      (set-grafting #f))
+  (mlet* %store-monad ((target-size -> (or target-size (* 2200 MiB)))
+                       (_      (set-grafting #f))
                        (system (current-system))
                        (target (operating-system-derivation target-os))
 
@@ -941,7 +951,10 @@ build (current-guix) and then store a couple of full 
system images.")
 
 (define %root-password "foo")
 
-(define* (gui-test-program marionette #:key (encrypted? #f))
+(define* (gui-test-program marionette
+                           #:key
+                           (desktop? #f)
+                           (encrypted? #f))
   #~(let ()
       (define (screenshot file)
         (marionette-control (string-append "screendump " file)
@@ -998,7 +1011,8 @@ build (current-guix) and then store a couple of full 
system images.")
       (screenshot "installer-services.ppm")
 
       (marionette-eval* '(choose-services installer-socket
-                                          #:desktop-environments '()
+                                          #:choose-desktop-environment?
+                                          (const #$desktop?)
                                           #:choose-network-service?
                                           (const #f))
                         #$marionette)
@@ -1038,7 +1052,11 @@ build (current-guix) and then store a couple of full 
system images.")
                         (gnu installer tests)
                         (guix combinators))))
 
-(define* (guided-installation-test name #:key encrypted?)
+(define* (guided-installation-test name
+                                   #:key
+                                   (desktop? #f)
+                                   encrypted?
+                                   (target-size #f))
   (define os
     (operating-system
       (inherit %minimal-os)
@@ -1055,26 +1073,56 @@ build (current-guix) and then store a couple of full 
system images.")
                             (supplementary-groups
                              '("wheel" "audio" "video"))))
                      %base-user-accounts))
+      (keyboard-layout (and desktop?
+                            (keyboard-layout "us" "altgr-intl")))
       ;; The installer does not create a swap device in guided mode with
       ;; encryption support.
       (swap-devices (if encrypted? '() '("/dev/vdb2")))
-      (services (cons (service dhcp-client-service-type)
-                      (operating-system-user-services %minimal-os)))))
+
+      ;; Make sure that all the packages and services that may be used by the
+      ;; graphical installer are available.
+      (packages (append
+                 (if desktop?
+                     (list openbox awesome i3-wm i3status
+                           dmenu st ratpoison xterm)
+                     '())
+                 %base-packages))
+      (services
+       (if desktop?
+           (append
+            (list (service gnome-desktop-service-type)
+                  (service xfce-desktop-service-type)
+                  (service mate-desktop-service-type)
+                  (service enlightenment-desktop-service-type)
+                  (set-xorg-configuration
+                   (xorg-configuration
+                    (keyboard-layout keyboard-layout)))
+                  (service marionette-service-type
+                           (marionette-configuration
+                            (imported-modules '((gnu services herd)
+                                                (guix build utils)
+                                                (guix combinators))))))
+            %desktop-services)
+           (cons (service dhcp-client-service-type)
+                 (operating-system-user-services %minimal-os))))))
 
   (system-test
    (name name)
    (description
     "Install an OS using the graphical installer and test it.")
    (value
-    (mlet* %store-monad ((image   (run-install os '(this is unused)
-                                               #:script #f
-                                               #:os 
installation-os-for-gui-tests
-                                               #:gui-test
-                                               (lambda (marionette)
-                                                 (gui-test-program
-                                                  marionette
-                                                  #:encrypted? encrypted?))))
-                         (command (qemu-command/writable-image image)))
+    (mlet* %store-monad
+        ((image   (run-install os '(this is unused)
+                               #:script #f
+                               #:os installation-os-for-gui-tests
+                               #:target-size target-size
+                               #:gui-test
+                               (lambda (marionette)
+                                 (gui-test-program
+                                  marionette
+                                  #:desktop? desktop?
+                                  #:encrypted? encrypted?))))
+         (command (qemu-command/writable-image image)))
       (run-basic-test os command name
                       #:initialization (and encrypted? enter-luks-passphrase)
                       #:root-password %root-password)))))
@@ -1087,4 +1135,12 @@ build (current-guix) and then store a couple of full 
system images.")
   (guided-installation-test "gui-installed-os-encrypted"
                             #:encrypted? #t))
 
+;; Building a desktop image is very time and space consuming. Install all
+;; desktop environments in a single test to reduce the overhead.
+(define %test-gui-installed-desktop-os-encrypted
+  (guided-installation-test "gui-installed-desktop-os-encrypted"
+                            #:desktop? #t
+                            #:encrypted? #t
+                            #:target-size (* 9000 MiB)))
+
 ;;; install.scm ends here
-- 
2.25.1