From 5ee2799cabba4b2d462ac064a98789d7bca07923 Mon Sep 17 00:00:00 2001
From: Giacomo Leidi via Guix-patches via <guix-patches@gnu.org>
Date: Tue, 11 Jun 2024 22:05:00 +0200
Subject: [PATCH] services: oci-container: Allow setting Shepherd actions in
 oci-container-configuration.

* gnu/services/docker.scm (oci-container-configuration)
[shepherd-actions]: New field.
(sanitize-shepherd-actions): sanitize it.
(oci-container-shepherd-service): use it.

* doc/guix.texi: Document it.

Change-Id: I0ca9826542be7cb8ca280a07a9bff1a262c2a8a7
Signed-off-by: Zheng Junjie <zhengjunjie@iscas.ac.cn>
---
 doc/guix.texi           |  4 ++++
 gnu/services/docker.scm | 38 +++++++++++++++++++++++++++++---------
 2 files changed, 33 insertions(+), 9 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 13dbe06bb4..7d0824784d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -40898,6 +40898,10 @@ is @code{#f} the service has to be started manually with @command{herd start}.
 Whether to have Shepherd restart the service when it stops, for instance when
 the underlying process dies.
 
+@item @code{shepherd-actions} (default: @code{'()}) (type: list-of-symbols)
+This is a list of @code{shepherd-action} records defining actions supported
+by the service.
+
 @item @code{network} (default: @code{""}) (type: string)
 Set a Docker network for the spawned container.
 
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index f77e348b81..6f91c9659b 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -77,6 +77,7 @@
             oci-container-configuration-log-file
             oci-container-configuration-auto-start?
             oci-container-configuration-respawn?
+            oci-container-configuration-shepherd-actions
             oci-container-configuration-network
             oci-container-configuration-ports
             oci-container-configuration-volumes
@@ -328,6 +329,17 @@ found!")
   ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
   (oci-sanitize-mixed-list "volumes" value ":"))
 
+(define (oci-sanitize-shepherd-actions value)
+  (map
+   (lambda (el)
+     (if (shepherd-action? el)
+         el
+         (raise
+          (formatted-message
+           (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+   value))
+
 (define (oci-sanitize-extra-arguments value)
   (define (valid? member)
     (or (string? member)
@@ -477,6 +489,11 @@ is @code{#f} the service has to be started manually with @command{herd start}.")
    (boolean #f)
    "Whether to restart the service when it stops, for instance when the
 underlying process dies.")
+  (shepherd-actions
+   (list '())
+   "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+   (sanitizer oci-sanitize-shepherd-actions))
   (network
    (maybe-string)
    "Set a Docker network for the spawned container.")
@@ -680,6 +697,7 @@ operating-system, gexp or file-like records but ~a was found")
                             (oci-image-repository image))))))
 
   (let* ((docker (file-append docker-cli "/bin/docker"))
+         (actions (oci-container-configuration-shepherd-actions config))
          (auto-start?
           (oci-container-configuration-auto-start? config))
          (user (oci-container-configuration-user config))
@@ -731,15 +749,17 @@ operating-system, gexp or file-like records but ~a was found")
                       (actions
                        (if (oci-image? image)
                            '()
-                           (list
-                            (shepherd-action
-                             (name 'pull)
-                             (documentation
-                              (format #f "Pull ~a's image (~a)."
-                                      name image))
-                             (procedure
-                              #~(lambda _
-                                  (invoke #$docker "pull" #$image))))))))))
+                           (append
+                            (list
+                             (shepherd-action
+                              (name 'pull)
+                              (documentation
+                               (format #f "Pull ~a's image (~a)."
+                                       name image))
+                              (procedure
+                               #~(lambda _
+                                   (invoke #$docker "pull" #$image)))))
+                            actions))))))
 
 (define %oci-container-accounts
   (list (user-account