[PATCH 0/1] home-state-service-type and tests suite

OpenSubmitted by Oleg Pykhalov.
Details
4 participants
  • Andrew Tropin
  • Oleg Pykhalov
  • Ludovic Courtès
  • Xinglu Chen
Owner
unassigned
Severity
normal
O
O
Oleg Pykhalov wrote on 23 Oct 2021 20:04
(address . guix-patches@gnu.org)(name . Oleg Pykhalov)(address . go.wigust@gmail.com)
20211023180446.3362-1-go.wigust@gmail.com
Hi Guix,

This patch adds support for home-state-service-type which copied from the rde
project [1]. The introduction to home state services in documentation is
copied from discussion [2].

Tests passed:

make check-system TESTS="home-state-git"
make check-system TESTS="home-state-rsync"


Oleg Pykhalov (1):
home: services: Add state services.

doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm

--
2.33.1
O
O
Oleg Pykhalov wrote on 23 Oct 2021 20:06
[PATCH 1/1] home: services: Add state services.
(address . 51359@debbugs.gnu.org)(name . Oleg Pykhalov)(address . go.wigust@gmail.com)
20211023180654.3760-1-go.wigust@gmail.com
* gnu/home.scm (home-environment-compiler): New procedure.
* gnu/home/services/state.scm: New file.
* doc/guix.texi (State Home Services): Document this.
* gnu/home/services/version-control.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add those.
* gnu/home/services/utils.scm
(ini-config?, default-ini-format-section, generic-serialize-ini-config,
generic-serialize-git-ini-config): New procedures.
* gnu/tests/version-control.scm (run-home-state-git-test): New procedure.
(%home-state-git-os, %test-home-state-git): New variables.
* guix/scripts/home.scm
(not-config?, switch-home-program, switch-to-home, local-eval): New procedures.
(save-load-path-excursion): New macro.
(switch-home-program): Use switch-to-home procedure.
* gnu/tests/rsync.scm (run-home-state-rsync-test): New procedures.
(%home-state-rsync-os, %test-home-state-rsync): New variables.
---
doc/guix.texi | 32 ++
gnu/home.scm | 12 +
gnu/home/services/state.scm | 210 ++++++++++++
gnu/home/services/utils.scm | 81 ++++-
gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
gnu/local.mk | 2 +
gnu/tests/rsync.scm | 158 ++++++++-
gnu/tests/version-control.scm | 140 +++++++-
guix/scripts/home.scm | 100 +++++-
9 files changed, 1163 insertions(+), 14 deletions(-)
create mode 100644 gnu/home/services/state.scm
create mode 100644 gnu/home/services/version-control.scm

Toggle diff (1342 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 63bb22764a..c79f3acfa3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35548,6 +35548,7 @@ services)}.
 * Shells: Shells Home Services.          POSIX shells, Bash, Zsh.
 * Mcron: Mcron Home Service.             Scheduled User's Job Execution.
 * Shepherd: Shepherd Home Service.       Managing User's Daemons.
+* State: State Home Services.            Managing User's states.
 @end menu
 @c In addition to that Home Services can provide
 
@@ -35875,6 +35876,37 @@ mechanism instead (@pxref{Shepherd Services}).
 @end table
 @end deftp
 
+@node State Home Services
+@subsection Managing User's states
+
+@cindex state
+@cindex rsync
+@cindex git
+@cindex hg
+
+@command{herd init state} will create all the neccessary dirs, will clone the
+Git repos with projects you work on, restore wallpapers dir from backup
+server via Rsync and so on.  That helps at least control and init state
+your software depends on, when you switching to new machine for example.
+
+@defvr {Scheme Variable} home-state-service-type
+This is the type of the @code{state} home service, whose value is a list
+of @code{shepherd-service} objects.
+@end defvr
+
+The following examples demonstrate Git and Rsync configuration:
+
+@example
+(home-environment
+ (services
+  (list
+   (service home-state-service-type
+            (list (state-git "/home/alice/guix-maintenance"
+                             "https://git.savannah.gnu.org/git/guix/maintenance.git")
+                  (state-rsync "/home/alice/output"
+                               "rsync://localhost:873/files/input"))))))
+@end example
+
 @node Invoking guix home
 @section Invoking @code{guix home}
 
diff --git a/gnu/home.scm b/gnu/home.scm
index d8134693e5..87d4d54b8e 100644
--- a/gnu/home.scm
+++ b/gnu/home.scm
@@ -23,8 +23,10 @@ (define-module (gnu home)
   #:use-module (gnu home services xdg)
   #:use-module (gnu home services fontutils)
   #:use-module (gnu services)
+  #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (guix diagnostics)
+  #:use-module (guix store)
 
   #:export (home-environment
             home-environment?
@@ -104,3 +106,13 @@ (define* (home-environment-with-provenance he config-file)
     (inherit he)
     (services (cons (service home-provenance-service-type config-file)
                     (home-environment-user-services he)))))
+
+(define-gexp-compiler (home-environment-compiler (he <home-environment>)
+                                                 system target)
+  ((store-lift
+    (lambda (store)
+      ;; XXX: This is not super elegant but we can't pass SYSTEM and TARGET to
+      ;; 'home-environment-derivation'.
+      (run-with-store store (home-environment-derivation he)
+                      #:system system
+                      #:target target)))))
diff --git a/gnu/home/services/state.scm b/gnu/home/services/state.scm
new file mode 100644
index 0000000000..f78751b10f
--- /dev/null
+++ b/gnu/home/services/state.scm
@@ -0,0 +1,210 @@
+(define-module (gnu home services state)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services utils)
+  #:use-module (gnu home services shepherd)
+  #:use-module (gnu home services version-control)
+  #:use-module (gnu packages rsync)
+  #:use-module (gnu packages version-control)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu packages ssh)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix modules)
+  #:use-module (guix records)
+
+  #:export (home-state-service-type
+            state-generic
+            state-git
+            state-hg
+	    state-rsync))
+
+(define* (state-hg path remote #:key (config #f))
+  (state-generic
+   path
+   #:init-gexp
+   #~(lambda* (_ self)
+       (let* ((meta (car (action self 'metadata)))
+              (path (assoc-ref meta 'path))
+              (remote (assoc-ref meta 'remote)))
+         (format #t "Initializing ~a.\n" self)
+         (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+                       #$(file-append mercurial "/bin/hg") "clone" remote path)))
+           (waitpid WAIT_ANY)
+           (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+           (close-port port))
+
+         (when '#$config
+           (call-with-output-file (string-append path "/.hg/hgrc")
+             (lambda (port) (display (string-append
+                                      #$@(serialize-hg-config config)) port))))))
+   #:additional-metadata `((remote . ,remote)
+                           (general-sync? . #f))))
+
+(define* (state-git path remote #:key (config #f))
+  (state-generic
+   path
+   #:init-gexp
+   #~(lambda* (_ self)
+       (let* ((meta (car (action self 'metadata)))
+	      (path (assoc-ref meta 'path))
+	      (remote (assoc-ref meta 'remote)))
+	 (format #t "Initializing ~a.\n" self)
+	 ;; TODO: revisit git clone implementation
+	 ;; FIXME: Hang up shepherd if username/password asked
+	 (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+		       #$(file-append git "/bin/git") "clone" remote path)))
+	   (waitpid WAIT_ANY)
+	   (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+	   (close-port port))
+
+	 (when #$config
+	   (call-with-output-file (string-append path "/.git/config")
+	     (lambda (port) (display #$config port))))))
+   #:additional-metadata `((remote . ,remote)
+			   (general-sync? . #f))))
+
+(define* (state-rsync path remote)
+  (state-generic
+   path
+   #:init-gexp
+   #~(lambda* (_ self)
+       (let* ((meta (car (action self 'metadata)))
+	      (path (assoc-ref meta 'path))
+	      (remote (assoc-ref meta 'remote)))
+	 (format #t "Initializing ~a.\n" self)
+	 ;; TODO: revisit git clone implementation
+	 (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+		       #$(file-append rsync "/bin/rsync") "-aP" remote path)))
+	   (waitpid WAIT_ANY)
+	   (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+	   (close-port port))))
+   #:sync-gexp
+   #~(lambda* (_ self)
+       (let* ((meta (car (action self 'metadata)))
+	      (path (assoc-ref meta 'path))
+	      (remote (assoc-ref meta 'remote)))
+	 (format #t "Synchronizing ~a.\n" self)
+	 (let* ((port ((@@ (guix build utils) open-pipe-with-stderr)
+		       #$(file-append rsync "/bin/rsync") "-aP" path remote)))
+	   (waitpid WAIT_ANY)
+	   (display ((@@ (ice-9 rdelim) read-delimited) "" port))
+	   (close-port port))))
+   #:additional-metadata `((remote . ,remote)
+			   (general-sync? . #t))))
+
+(define* (state-generic
+	  path
+	  #:key
+	  (init-gexp
+	   #~(lambda* (_ self)
+	       (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+		 (format #t "Initializing ~a.\n" self)
+		 (format #t "Creating ~a directory..." path)
+		 (mkdir-p path)
+		 (display " done\n"))))
+	  (sync-gexp
+	   #~(lambda* (_ self)
+	       (let ((path (assoc-ref (car (action self 'metadata)) 'path)))
+		 (format #t "Synchronizing ~a.\n" self)
+		 (format #t "Nothing to synchronize.\n"))))
+	  (additional-metadata '((general-sync? . #f))))
+  "A function which returns a shepherd-service with all required
+actions for state management, should be used as a basis for other
+state related items like git-state, rsync-state, etc."
+  (let ((self (string->symbol
+	       (format #f "state-~a" path))))
+    (shepherd-service
+     (documentation (format #f "Managing state at ~a." path))
+     (provision (list self))
+     (auto-start? #f)
+     (start #~(lambda ()
+		(if (car (action '#$self 'state-exists?))
+		    #t
+		    (begin
+		      (format #t "~a is not initilized yet." '#$self)
+		      #f))))
+     (actions (list
+	       (shepherd-action
+		(name 'state-exists?)
+		(documentation "Check if state file/directory exists.")
+		(procedure #~(lambda* (#:rest rest)
+			       (file-exists? #$path))))
+	       (shepherd-action
+		(name 'unchecked-init)
+		(documentation "Do not use this action directly.")
+		(procedure init-gexp))
+	       (shepherd-action
+		(name 'metadata)
+		(documentation "Returns metadata related to the state.")
+		(procedure #~(lambda* _
+			       (append
+				'((path . #$path)
+				  (self . #$self))
+				'#$additional-metadata))))
+	       (shepherd-action
+		(name 'sync)
+		(documentation "Sync the state.")
+		(procedure sync-gexp))
+	       (shepherd-action
+		(name 'init)
+		(documentation "Generic initialize.")
+		(procedure #~(lambda* (#:rest rest)
+			       (if (car (action '#$self 'state-exists?))
+				   (format #t "~a already initialized.\n" '#$self)
+				   (begin
+				     (action '#$self 'unchecked-init '#$self)
+				     (start '#$self)))))))))))
+
+(define (add-shepherd-services services)
+  (let* ((service-names
+	  (map
+	   (lambda (service) (car (shepherd-service-provision service)))
+	   services)))
+    (append
+     services
+     (list
+      (shepherd-service
+       (documentation "Init, update and maybe destroy state.")
+       (provision '(state))
+       (auto-start? #t)
+       (start #~(lambda ()
+		  (map (lambda (name)
+			 (when (car (action name 'state-exists?))
+			   (start name)))
+		       '#$service-names)))
+       (actions (list
+		 (shepherd-action
+		  (name 'sync)
+		  (documentation
+                   "Sync all the state. Highly dependent on state type.")
+		  (procedure
+		   #~(lambda _
+		       (map (lambda (name)
+			      (when (assoc-ref (car (action name 'metadata))
+					       'general-sync?)
+				(action name 'sync name)))
+			    '#$service-names))))
+		 (shepherd-action
+		  (name 'init)
+		  (documentation "Initialize all the state.")
+		  (procedure #~(lambda _
+				 (map (lambda (name)
+					(when (not (car (action name 'state-exists?)))
+					  (action name 'init)
+					  (start name)))
+				      '#$service-names)))))))))))
+
+(define home-state-service-type
+  (service-type (name 'home-state)
+                (extensions
+                 (list (service-extension
+                        home-shepherd-service-type
+                        add-shepherd-services)))
+                (default-value '())
+		(compose concatenate)
+		(extend append)
+                (description "A toolset for initializing state.")))
diff --git a/gnu/home/services/utils.scm b/gnu/home/services/utils.scm
index cea75ee896..8f2122dda9 100644
--- a/gnu/home/services/utils.scm
+++ b/gnu/home/services/utils.scm
@@ -21,11 +21,17 @@ (define-module (gnu home services utils)
   #:use-module (ice-9 string-fun)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (gnu services configuration)
 
   #:export (maybe-object->string
             object->snake-case-string
             object->camel-case-string
-            list->human-readable-list))
+            list->human-readable-list
+
+            ini-config?
+            generic-serialize-ini-config
+            generic-serialize-git-ini-config))
 
 (define (maybe-object->string object)
   "Like @code{object->string} but don't do anyting if OBJECT already is
@@ -103,3 +109,76 @@ (define* (list->human-readable-list lst
                      word
                      (maybe-object->string (proc (last lst)))))))
 
+
+;;;
+;;; Serializers.
+;;;
+
+(define ini-config? list?)
+(define (generic-serialize-ini-config-section section proc)
+  "Format a section from SECTION for an INI configuration.
+Apply the procedure PROC on SECTION after it has been converted to a string"
+  (format #f "[~a]\n" (proc section)))
+
+(define default-ini-format-section
+  (match-lambda
+    ((section subsection)
+     (string-append (maybe-object->string section) " "
+                    (maybe-object->string subsection)))
+    (section
+     (maybe-object->string section))))
+
+(define* (generic-serialize-ini-config
+          #:key
+          (combine-ini string-join)
+          (combine-alist string-append)
+          (combine-section-alist string-append)
+          (format-section default-ini-format-section)
+          serialize-field
+          fields)
+  "Create an INI configuration from nested lists FIELDS.  This uses
+@code{generic-serialize-ini-config-section} and @{generic-serialize-alist} to
+serialize the section and the association lists, respectively.
+
+@example
+(generic-serialize-ini-config
+ #:serialize-field (lambda (a b) (format #f \"~a = ~a\n\" a b))
+ #:format-section (compose string-capitalize symbol->string)
+ #:fields '((application ((key . value)))))
+@end example
+
+@result{} \"[Application]\nkey = value\n\""
+  (combine-ini
+   (map (match-lambda
+          ((section alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section section format-section)
+            (generic-serialize-alist combine-alist serialize-field alist))))
+        fields)
+   "\n"))
+
+(define* (generic-serialize-git-ini-config
+          #:key
+          (combine-ini string-join)
+          (combine-alist string-append)
+          (combine-section-alist string-append)
+          (format-section default-ini-format-section)
+          serialize-field
+          fields)
+  "Like @code{generic-serialize-ini-config}, but the section can also
+have a @dfn{subsection}.  FORMAT-SECTION will take a list of two
+elements: the section and the subsection."
+  (combine-ini
+   (map (match-lambda
+          ((section subsection alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section
+             (list section subsection) format-section)
+            (generic-serialize-alist combine-alist serialize-field alist)))
+          ((section alist)
+           (combine-section-alist
+            (generic-serialize-ini-config-section section format-section)
+            (generic-serialize-alist combine-alist serialize-field alist))))
+        fields)
+   "\n"))
+
diff --git a/gnu/home/services/version-control.scm b/gnu/home/services/version-control.scm
new file mode 100644
index 0000000000..afc9c539a7
--- /dev/null
+++ b/gnu/home/services/version-control.scm
@@ -0,0 +1,442 @@
+(define-module (gnu home services version-control)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services utils)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu packages version-control)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module ((guix import utils) #:select (flatten))
+
+  #:export (home-git-configuration
+            home-git-extension
+            home-git-service-type
+            serialize-git-config
+
+            home-hg-configuration
+            home-hg-extension
+            serialize-hg-config
+            home-hg-service-type))
+
+;;; Commentary:
+;;;
+;;; Version control related services.
+;;;
+;;; Code:
+
+;;;
+;;; Git.
+;;;
+;;; (service home-git-service-type
+;;;      (home-git-configuration
+;;;       (attributes
+;;;        '((* . text=auto)
+;;;          (*.sh . "text eol=lf")))
+;;;       (ignore
+;;;        '("*.so" "*.o"))
+;;;       (ignore-extra-content
+;;;        "*.dll\n*.exe\n")
+;;;       (config
+;;;        `((http "https://weak.example.com"
+;;;                ((ssl-verify . #f)))
+;;;          (gpg
+;;;           ((program . ,(file-append gnupg "/bin/gpg"))))
+;;;          (sendmail
+;;;           ((annotate . #t))))
+;;;        (config-extra-content (slurp-file-gexp
+;;;                                (local-file "./gitconfig")))))
+;;;
+;;; (simple-service
+;;;  'add-something-to-git
+;;;  home-git-service-type
+;;;  (home-git-extension
+;;;   (config
+;;;     `((sendmail
+;;;        ((annotate . #t)))))))
+
+
+(define (uglify-field-name field-name)
+  "Convert symbol FIELD-NAME to a camel case string.
+@code{symbol-name} => \"@code{symbolName}\"."
+  (let* ((str (symbol->string field-name))
+         (spl-str (string-split str #\-)))
+    (apply string-append
+           (car spl-str)
+           (map string-capitalize (cdr spl-str)))))
+
+(define (serialize-field field-name val)
+   (cond
+    ((boolean? val) (serialize-boolean field-name val))
+    (else
+     (list (format #f "\t~a = " (uglify-field-name field-name))
+           val "\n"))))
+
+(define (serialize-alist field-name val)
+  (generic-serialize-alist append serialize-field val))
+
+(define (serialize-boolean field-name val)
+  (serialize-field field-name (if val "true" "false")))
+
+(define serialize-string serialize-field)
+(define git-config? list?)
+
+(define (serialize-git-section-header name value)
+  (format #f "[~a~a]\n" (uglify-field-name name)
+          (if value (format #f " \"~a\"" value) "")))
+
+(define serialize-git-section
+  (match-lambda
+    ((name options)
+     (cons
+      (serialize-git-section-header name #f)
+      (serialize-alist #f options)))
+    ((name value options)
+     (cons
+      (serialize-git-section-header name value)
+      (serialize-alist #f options)))))
+
+;; TODO: cover it with tests
+(define (serialize-git-config field-name val)
+  #~(string-append #$@(append-map serialize-git-section val)))
+
+(define (git-ignore? patterns)
+  (list-of-strings? patterns))
+(define (serialize-git-ignore field-name val)
+  (string-join val "\n" 'suffix))
+
+(define (git-attributes? attrs)
+  (list? attrs))
+(define (serialize-git-attributes field-name val)
+  (string-join
+   (map
+    (match-lambda
+      ((key . value) (format #f "~a\t~a" key value)))
+    val)
+   "\n"
+   'suffix))
+
+(define-configuration home-git-extension
+  (attributes
+   (git-attributes '())
+   "Alist of pattern attribute pairs for @file{git/attributes.}")
+  (ignore
+   (git-ignore '())
+   "List of patterns for @file{git/ignore.}")
+  (config
+   (git-config '())
+   "List of git sections.  The same format as in
+@code{home-git-configuration}."))
+
+(define-configuration home-git-configuration
+  (package
+   (package git)
+   "The Git package to use.")
+  (attributes
+   (git-attributes '())
+   "Alist of pattern attribute pairs for @file{git/attributes.}")
+  (attributes-extra-content
+   (text-config "")
+    "String or value of string-valued g-exps will be added to the end
+of the @file{git/attributes} file.")
+  (ignore
+   (git-ignore '())
+   "List of patterns for git/ignore.")
+  (ignore-extra-content
+   (text-config "")
+    "String or value of string-valued g-exps will be added to the end
+of the git/ignore file.")
+  (config
+   (git-config '())
+   "List of sections and corresponding options.  Something like this:
+
+@lisp
+`((sendmail
+   ((annotate . #t))))
+@end lisp
+
+will turn into this:
+
+@example
+[sendmail]
+        annotate = true
+@end example")
+  (config-extra-content
+   (text-config "")
+   "String or value of string-valued g-exps will be added to the end
+of the configuration file."))
+
+(define (add-git-configuration config)
+  (define (filter-fields fields)
+    (filter-configuration-fields home-git-configuration-fields fields))
+  `(("config/git/attributes"
+     ,(mixed-text-file
+       "git-attributes"
+       (serialize-configuration
+        config
+	(filter-fields '(attributes)))
+       (home-git-configuration-attributes-extra-content config)))
+    ("config/git/ignore"
+     ,(mixed-text-file
+       "git-ignore"
+       (serialize-configuration
+        config
+	(filter-fields '(ignore)))
+       (home-git-configuration-ignore-extra-content config)))
+    ("config/git/config"
+     ,(mixed-text-file
+	     "git-config"
+	     (serialize-configuration
+              config
+	      (filter-fields '(config)))
+	     (home-git-configuration-config-extra-content config)))))
+
+(define (add-git-packages config)
+  (list (home-git-configuration-package config)))
+
+(define (home-git-extensions original-config extension-configs)
+  (home-git-configuration
+   (inherit original-config)
+   (attributes
+    (append (home-git-configuration-attributes original-config)
+	    (append-map
+	     home-git-extension-attributes extension-configs)))
+   (ignore
+    (append (home-git-configuration-ignore original-config)
+	    (append-map
+	     home-git-extension-ignore extension-configs)))
+   (config
+    (append (home-git-configuration-config original-config)
+	    (append-map
+	     home-git-extension-config extension-configs)))))
+
+(define home-git-service-type
+  (service-type (name 'home-git)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        add-git-configuration)
+                       (service-extension
+                        home-profile-service-type
+                        add-git-packages)))
+		(compose identity)
+		(extend home-git-extensions)
+                (default-value (home-git-configuration))
+                (description "Install and configure Git.")))
+
+(define (generate-home-git-documentation)
+  (generate-documentation
+   `((home-git-configuration
+      ,home-git-configuration-fields))
+   'home-git-configuration))
+
+
+;;;
+;;; Mercurial.
+;;;
+;;; (home-hg-configuration
+;;;   (regexp-ignore '("^\\.pc/"))
+;;;   (glob-ignore '("*.elc" "*~"))
+;;;   (config
+;;;    '((commands
+;;;       ((commit.post-status . #t)))
+;;;      (ui
+;;;       ((username . "Alice Bobson <charlie@example.org")))
+;;;      (defaults
+;;;        (log . "-v")))))
+;;;
+
+;; TODO: Add separate field for name and email?
+(define-configuration/no-serialization home-hg-configuration
+  (package
+    (package mercurial)
+    "The Mercurial package to use.")
+  (regexp-ignore
+   (list-of-strings '())
+   "List of regular expressions to ignore globally.  The default syntax
+is Python/Perl-style regular expression (see @command{man 5 hgignore}).
+
+The @code{*-ignore} fields are equivalent to adding @code{ui.ignore =
+/file/with/ignore/rules} in your @file{hgrc}.")
+  (glob-ignore
+   (list-of-strings '())
+   "List of globs to ignore globally.")
+  (rootglob-ignore
+   (list-of-strings '())
+   "List of @dfn{rootglobs} to ignore globally.")
+  (config
+   (ini-config '())
+   "List of list representing the contents of the @file{hgrc}
+configuration file.  The syntax is similar to that of the Git service.
+The key of a pair can be a symbol or string, and the value can be a
+boolean, string, symbol, number, gexp (@pxref{gexp,,,guix.info}), or a
+list of one the above.
+
+@lisp
+(config
+ `((commands
+    ((commit.post-status . #t)))
+   (graph
+    ((width . 4)))
+   (hooks
+    ((incoming.email . ,(local-file \"/path/to/email/hook\"))))))
+@end lisp
+
+will turn into this:
+
+@example
+[commands]
+    commit.post-status = True
+[graph]
+    width = 4
+[hooks]
+  incoming.email = /gnu/store/123...-email-hook
+@end example"))
+
+(define (serialize-hg-config config)
+  (define (serialize-boolean val)
+    (list (if val "True" "False")))
+
+  (define (serialize-list val)
+    (interpose (map serialize-val val) ", "))
+
+  (define (serialize-val val)
+    (cond
+     ((list? val) (serialize-list val))
+     ((boolean? val) (serialize-boolean val))
+     ((or (number? val) (symbol? val)) (list (maybe-object->string val)))
+     (else (list val))))
+
+  (define (serialize-field key val)
+    (let ((val (serialize-val val))
+          (key (symbol->string key)))
+      `(,key " = " ,@val "\n")))
+
+  (flatten (generic-serialize-ini-config
+            #:combine-ini interpose
+            #:combine-alist list
+            #:combine-section-alist cons
+            #:serialize-field serialize-field
+            #:fields config)))
+
+(define* (serialize-hg-ignores #:key regexp glob rootglob)
+  (define (add-ignore lst type)
+    (if (not (null? lst))
+        (string-append (format #f "syntax: ~a\n" type)
+                       (string-join lst "\n" 'suffix))
+        ""))
+
+  (string-join (map (cut add-ignore <> <>)
+                    (list regexp glob rootglob)
+                         '(regexp glob rootglob))
+               "\n"))
+
+(define (home-hg-files-service config)
+  (define rest cdr)
+
+  (define (compare-sections section1 section2)
+    (string<? (symbol->string (first section1))
+              (symbol->string (first section2))))
+
+  (define (fold-sections section1 section2)
+    (cond
+     ((equal? (first section1) (first section2))
+      (list (list (first section1)
+                  (append (second section1) (second section2)))))
+     (else
+      (list section1 section2))))
+
+  (define (merge-sections config)
+    (let ((sorted-config (sort config compare-sections)))
+      (fold (lambda (section acc)
+              (if (null? acc)
+                  (list section)
+                  (append (fold-sections section (first acc))
+                          (rest acc))))
+            '()
+            sorted-config)))
+
+  (let* ((ignores (serialize-hg-ignores
+                   #:regexp
+                   (home-hg-configuration-regexp-ignore config)
+                   #:glob
+                   (home-hg-configuration-glob-ignore config)
+                   #:rootglob
+                   (home-hg-configuration-rootglob-ignore config)))
+         (final-config (merge-sections
+                        (append (home-hg-configuration-config config)
+                                `((ui
+                                   ((ignore . ,(plain-file "hg-ignores"
+                                                           ignores)))))))))
+    `(("config/hg/hgrc"
+       ,(apply mixed-text-file
+               "hgrc"
+               (serialize-hg-config final-config))))))
+
+(define-configuration/no-serialization home-hg-extension
+  (regexp-ignore
+   (list-of-strings '())
+   "List of regular expressions to ignore globally.")
+  (glob-ignore
+   (list-of-strings '())
+   "List of glob expressions to ignore globally.")
+  (rootglob-ignore
+   (list-of-strings '())
+   "List of @dfn{rootglobs} to ignore globally.")
+  (config
+   (ini-config '())
+   "List of lists representing the contents of the @file{hgrc} file."))
+
+(define (home-hg-extensions original-config extension-configs)
+  (home-hg-configuration
+   (inherit original-config)
+   (regexp-ignore
+    (append (home-hg-configuration-regexp-ignore original-config)
+            (append-map
+             home-hg-extension-regexp-ignore extension-configs)))
+   (glob-ignore
+    (append (home-hg-configuration-glob-ignore original-config)
+            (append-map
+             home-hg-extension-glob-ignore extension-configs)))
+   (rootglob-ignore
+    (append (home-hg-configuration-rootglob-ignore original-config)
+            (append-map
+             home-hg-extension-rootglob-ignore extension-configs)))
+   (config
+    (append (home-hg-configuration-config original-config)
+            (append-map
+             home-hg-extension-config extension-configs)))))
+
+(define (home-hg-profile-service config)
+  (list (home-hg-configuration-package config)))
+
+(define home-hg-service-type
+  (service-type (name 'home-hg)
+                (extensions
+                 (list (service-extension
+                        home-files-service-type
+                        home-hg-files-service)
+                       (service-extension
+                        home-profile-service-type
+                        home-hg-profile-service)))
+                (compose identity)
+                (extend home-hg-extensions)
+                (default-value (home-hg-configuration))
+                (description "\
+Install and configure the Mercurial version control system.")))
+
+(define (generate-home-hg-documentation)
+  (string-append
+   (generate-documentation
+    `((home-hg-configuration
+       ,home-hg-configuration-fields))
+    'home-hg-configuration)
+   "\n\n"
+   (generate-documentation
+    `((home-hg-extension
+       ,home-hg-extension-fields))
+    'home-hg-extension)))
diff --git a/gnu/local.mk b/gnu/local.mk
index d432829e2d..4ac1083158 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -79,7 +79,9 @@ GNU_SYSTEM_MODULES =				\
   %D%/home/services/fontutils.scm		\
   %D%/home/services/shells.scm			\
   %D%/home/services/shepherd.scm		\
+  %D%/home/services/state.scm			\
   %D%/home/services/mcron.scm			\
+  %D%/home/services/version-control.scm	\
   %D%/home/services/utils.scm			\
   %D%/home/services/xdg.scm			\
   %D%/image.scm					\
diff --git a/gnu/tests/rsync.scm b/gnu/tests/rsync.scm
index 24e60d9d9d..8b4768a38a 100644
--- a/gnu/tests/rsync.scm
+++ b/gnu/tests/rsync.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,7 +30,13 @@ (define-module (gnu tests rsync)
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:export (%test-rsync))
+  #:use-module (gnu home)
+  #:use-module (gnu services)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services state)
+  #:use-module (guix scripts home)
+  #:export (%test-rsync
+            %test-home-state-rsync))
 
 (define* (run-rsync-test rsync-os #:optional (rsync-port 873))
   "Run tests in %RSYNC-OS, which has rsync running and listening on
@@ -127,3 +134,152 @@ (define %test-rsync
    (name "rsync")
    (description "Connect to a running RSYNC server.")
    (value (run-rsync-test %rsync-os))))
+
+
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-rsync-test home-state-rsync-os #:optional (rsync-port 873))
+  "Run tests in %HOME-STATE-RSYNC-OS, which has rsync running and listening on
+PORT."
+  (define os
+    (marionette-operating-system
+     home-state-rsync-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define he
+    (home-environment
+     (services
+      (list
+       (service home-state-service-type
+                (list
+                 (state-rsync "/home/alice/test"
+                              (string-append "rsync://localhost:"
+                                             (number->string rsync-port)
+                                             "/files/input"))))))))
+
+  (define (test script)
+    (with-imported-modules '((gnu build marionette)
+                             (guix build utils))
+      #~(begin
+          (use-modules (srfi srfi-11)
+                       (srfi srfi-64)
+                       (gnu build marionette)
+                       (guix build utils))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "home-state-rsync")
+
+          ;; Wait for rsync to be up and running.
+          (test-assert "service running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+
+                ;; Make sure the 'rsync' command is found.
+                (setenv "PATH" "/run/current-system/profile/bin")
+
+                (start-service 'rsync))
+             marionette))
+
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/rsyncd/rsyncd.pid")
+             marionette))
+
+          (test-assert "Test file copied to share"
+            (marionette-eval
+             '(begin
+                (call-with-output-file "/tmp/input"
+                  (lambda (port)
+                    (display "test-file-contents\n" port)))
+                (zero?
+                 (system* "rsync" "/tmp/input"
+                          (string-append "rsync://localhost:"
+                                         (number->string #$rsync-port)
+                                         "/files/input"))))
+             marionette))
+
+          ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+          ;; directories.
+          (test-assert "profile and XDG_RUNTIME_DIR directories"
+            (marionette-eval
+             '(begin
+                (for-each (lambda (directory)
+                            (mkdir directory)
+                            (chown directory
+                                   (passwd:uid (getpw "alice"))
+                                   (group:gid (getpw "alice"))))
+                          '("/var/guix/profiles/per-user/alice"
+                            "/run/user"
+                            "/run/user/1000")))
+             marionette))
+
+          ;; Add /run/setuid-programs to $PATH so that the scripts
+          ;; can find 'env' and 'sudo'.
+          (marionette-eval
+           '(setenv "PATH"
+                    "/run/setuid-programs:/run/current-system/profile/bin")
+           marionette)
+
+          (test-assert "script successfully evaluated"
+            (marionette-eval
+             '(begin
+                (system* "sudo" "--user" "alice" "--login"
+                         "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+             marionette))
+
+          ;; Clone the repo.
+          (test-assert "herd init state"
+            (marionette-eval
+             '(begin
+                (invoke "sudo" "--user" "alice" "--login"
+                        "--" "herd" "init" "state"))
+             marionette))
+
+          (test-equal "Test file correctly received from share"
+            "test-file-contents"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 rdelim))
+                (call-with-input-file "/home/alice/test"
+                  (lambda (port)
+                    (read-line port))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "home-state-rsync-test"
+    (test
+     (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-rsync-os
+  ;; Return operating system under test.
+  (let ((base-os
+         (simple-operating-system
+          (service dhcp-client-service-type)
+          (service rsync-service-type))))
+    (operating-system
+      (inherit base-os)
+      (packages (cons* rsync
+                       (operating-system-packages base-os))))))
+
+(define %test-home-state-rsync
+  (system-test
+   (name "home-state-rsync")
+   (description "Connect to a running RSYNC server.")
+   (value (run-home-state-rsync-test %home-state-rsync-os))))
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index a7cde1f163..9b461d3877 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2017, 2018, 2021 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2017, 2018, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Christopher Baines <mail@cbaines.net>
@@ -36,10 +36,16 @@ (define-module (gnu tests version-control)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix modules)
+  #:use-module (gnu home)
+  #:use-module (gnu services)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services state)
+  #:use-module (guix scripts home)
   #:export (%test-cgit
             %test-git-http
             %test-gitolite
-            %test-gitile))
+            %test-gitile
+            %test-home-state-git))
 
 (define README-contents
   "Hello!  This is what goes inside the 'README' file.")
@@ -550,3 +556,133 @@ (define %test-gitile
    (name "gitile")
    (description "Connect to a running Gitile server.")
    (value (run-gitile-test))))
+
+
+;;;
+;;; Home
+;;;
+
+(define* (run-home-state-git-test home-state-git-os)
+  "Run tests in %HOME-STATE-GIT-OS, which has Guix home configuration with
+service for Git repository management."
+  (define os
+    (marionette-operating-system
+     home-state-git-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define he
+    (home-environment
+     (services
+      (list
+       (service home-state-service-type
+                (list (state-git "/home/alice/test"
+                                 "file:///srv/git/test")))))))
+
+  (define (test script)
+    (with-imported-modules '((gnu build marionette)
+                             (guix build utils))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (guix build utils)
+                       (ice-9 popen)
+                       (ice-9 rdelim)
+                       (rnrs io ports)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "home-state-git")
+
+          ;; Make sure Git test repository is created.
+          (test-assert "Git test repository"
+            (marionette-eval
+             '(file-exists? "/srv/git/test")
+             marionette))
+
+          ;; XXX: Create /run/user/1000 and /var/guix/profiles/per-user/alice
+          ;; directories.
+          (test-assert "profile and XDG_RUNTIME_DIR directories"
+            (marionette-eval
+             '(begin
+                (for-each (lambda (directory)
+                            (mkdir directory)
+                            (chown directory
+                                   (passwd:uid (getpw "alice"))
+                                   (group:gid (getpw "alice"))))
+                          '("/var/guix/profiles/per-user/alice"
+                            "/run/user"
+                            "/run/user/1000")))
+             marionette))
+
+          ;; Add /run/setuid-programs to $PATH so that the scripts
+          ;; can find 'env' and 'sudo'.
+          (marionette-eval
+           '(setenv "PATH"
+                    "/run/setuid-programs:/run/current-system/profile/bin")
+           marionette)
+
+          (test-assert "script successfully evaluated"
+            (marionette-eval
+             '(begin
+                (system* "sudo" "--user" "alice" "--login"
+                         "XDG_RUNTIME_DIR=/run/user/1000" "--" #$script))
+             marionette))
+
+          ;; Clone the repo.
+          (test-assert "herd init state"
+            (marionette-eval
+             '(begin
+                (invoke "sudo" "--user" "alice" "--login"
+                        "--" "herd" "init" "state"))
+             marionette))
+
+          (test-equal "repo clonned"
+            '#$README-contents
+            (marionette-eval
+             '(begin
+                (call-with-input-file "/home/alice/test/README"
+                  get-string-all))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "home-state-git-test"
+    (test
+     (switch-home-program he "/var/guix/profiles/per-user/alice/guix-home"))))
+
+(define* %home-state-git-os
+  ;; Return operating system under test.
+  (let ((base-os
+         (simple-operating-system
+          (service dhcp-client-service-type)
+          %test-repository-service)))
+    (operating-system
+      (inherit base-os)
+
+      ;; Set a user account; the test needs it.
+      (users (cons (user-account
+                    (name "alice")
+                    (group "users")
+                    (uid 1000)
+                    (home-directory "/home/alice"))
+                   %base-user-accounts))
+
+      (packages (cons* git
+                       (operating-system-packages base-os))))))
+
+(define %test-home-state-git
+  (system-test
+   (name "home-state-git")
+   (description "Manage Git repository via Guix home.")
+   (value (run-home-state-git-test %home-state-git-os))))
diff --git a/guix/scripts/home.scm b/guix/scripts/home.scm
index 55e7b436c1..0136dd3afc 100644
--- a/guix/scripts/home.scm
+++ b/guix/scripts/home.scm
@@ -25,9 +25,12 @@ (define-module (guix scripts home)
   #:use-module (gnu packages)
   #:use-module (gnu home)
   #:use-module (gnu home services)
+  #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module (gnu packages gnupg)
   #:use-module (guix channels)
   #:use-module (guix derivations)
   #:use-module (guix ui)
+  #:use-module (guix modules)
   #:use-module (guix grafts)
   #:use-module (guix packages)
   #:use-module (guix profiles)
@@ -47,7 +50,8 @@ (define-module (guix scripts home)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:export (guix-home))
+  #:export (guix-home
+            switch-home-program))
 
 
 ;;;
@@ -139,11 +143,94 @@ (define %default-options
     (verbosity . 3)
     (debug . 0)))
 
+
+;;;
+;;; Profile creation.
+;;;
+
+(define not-config?
+  ;; Select (guix …) and (gnu …) modules, except (guix config).
+  (match-lambda
+    (('guix 'config) #f)
+    (('guix rest ...) #t)
+    (('gnu rest ...) #t)
+    (_ #f)))
+
+(define* (switch-home-program he-out-path #:optional (profile %guix-home))
+  "Return an executable store item that, upon being evaluated, will create a
+new generation of PROFILE pointing to the directory of HOME, switch to it
+atomically, and run HOME's activation script."
+  (program-file
+   "switch-to-home.scm"
+   (with-extensions (list guile-gcrypt)
+     (with-imported-modules `(,@(source-module-closure
+                                 '((guix profiles)
+                                   (guix utils))
+                                 #:select? not-config?)
+                              ((guix config) => ,(make-config.scm)))
+       #~(begin
+           (use-modules (guix config)
+                        (guix profiles)
+                        (guix utils))
+           (let* ((number (generation-number #$profile))
+                  (generation (generation-file-name
+                               #$profile (+ 1 number))))
+             (use-modules (ice-9 rdelim)
+                          (ice-9 popen))
+             (with-output-to-file "/tmp/out.txt"
+               (lambda ()
+                 (display "he-out-path:\n")
+                 (display #$he-out-path)
+                 (display "\nprofile:\n")
+                 (display #$profile)
+                 (display "\ngeneration:\n")
+                 (display generation)
+                 (let* ((port
+                         (open-pipe (format #f "/run/current-system/profile/bin/ls -laR ~a" #$he-out-path)
+                                           OPEN_READ))
+                        (output (read-string port)))
+                   (close-port port)
+                   (pk (string-trim-right output #\newline)))))
+             (switch-symlinks generation #$he-out-path)
+             (switch-symlinks #$profile generation)
+             (setenv "GUIX_NEW_HOME" #$he-out-path)
+             (primitive-load (string-append #$he-out-path "/activate"))
+             (setenv "GUIX_NEW_HOME" #f)))))))
+
+(define* (switch-to-home eval he-out-path)
+  "Using EVAL, a monadic procedure taking a single G-Expression as an argument,
+create a new generation of PROFILE pointing to the directory of HOME, switch to
+it atomically, and run HOME's activation script."
+  (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
+            (primitive-load #$(switch-home-program he-out-path)))))
+
 
 ;;;
 ;;; Actions.
 ;;;
 
+(define-syntax-rule (save-load-path-excursion body ...)
+  "Save the current values of '%load-path' and '%load-compiled-path', run
+BODY..., and restore them."
+  (let ((path %load-path)
+        (cpath %load-compiled-path))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        body ...)
+      (lambda ()
+        (set! %load-path path)
+        (set! %load-compiled-path cpath)))))
+
+(define (local-eval exp)
+  "Evaluate EXP, a G-Expression, in-place."
+  (mlet* %store-monad ((lowered (lower-gexp exp))
+                       (_ (built-derivations (lowered-gexp-inputs lowered))))
+    (save-load-path-excursion
+     (set! %load-path (lowered-gexp-load-path lowered))
+     (set! %load-compiled-path (lowered-gexp-load-compiled-path lowered))
+     (return (primitive-eval (lowered-gexp-sexp lowered))))))
+
 (define* (perform-action action he
                          #:key
                          dry-run?
@@ -170,15 +257,8 @@ (define println
 
           (case action
             ((reconfigure)
-             (let* ((number (generation-number %guix-home))
-                    (generation (generation-file-name
-                                 %guix-home (+ 1 number))))
-
-               (switch-symlinks generation he-out-path)
-               (switch-symlinks %guix-home generation)
-               (setenv "GUIX_NEW_HOME" he-out-path)
-               (primitive-load (string-append he-out-path "/activate"))
-               (setenv "GUIX_NEW_HOME" #f)
+             (mbegin %store-monad
+               (switch-to-home local-eval he-out-path)
                (return he-out-path)))
             (else
              (newline)
-- 
2.33.1
X
X
Xinglu Chen wrote on 30 Oct 2021 13:10
Re: [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
(name . Oleg Pykhalov)(address . go.wigust@gmail.com)
87h7cy7op1.fsf@disroot.org
On Sat, Oct 23 2021, Oleg Pykhalov wrote:

Toggle quote (6 lines)
> Hi Guix,
>
> This patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].

There are still quite a few things that have to be fixed with Guix
Home[1][2][3][4], so I suggest we fix those before adding new services.

Also, Andrew mentioned a while a go that he was going to re-design the
state services; maybe he has some updates on that.

[1]: https://issues.guix.gnu.org/50945 and https://issues.guix.gnu.org/50941
-----BEGIN PGP SIGNATURE-----

iQJJBAEBCAAzFiEEAVhh4yyK5+SEykIzrPUJmaL7XHkFAmF9KDoVHHB1YmxpY0B5
b2N0b2NlbGwueHl6AAoJEKz1CZmi+1x5KnsQALh3PW/BNgTEYKo+69Bh0rWUrZ9o
fBghLvhbvXloqXsZRbsHaIlVMv7Un6ekG/ZM/WCujRmfnr5uHbeRLsPRZZFiOQ3+
kqywVHraY6n/lE4fEZnqiMYww4wdJa+mutZs6z19JZUpBy64QWGHbAPe8gqCNJJV
rY42TyCgH/e2AnDB/48T2r+L6tk0uFE0HWr4nurFWaRCjrDK4hDXyr9bbPRd5dV1
sONaimXCOvwX9IcORhbSYpCJ/tKWWrUM5Z+JIvrdEUaMAW57RYLmrzjNMB2FTMby
dTfPJlJhV0igbjUMdDEIv4R7YBkHcDI9B6+KN4qEJqUPBS4qKNlj+llbuQ3J0PzW
qFoGBMzhKU4UG9RkvTiNZn50cnr5sl8lPdd9mrjivic+IIbtSavHouk243YLOvgl
4grKnNOzuDKZUv85Q4IoyPW1bmIGTNtf/5b44qA38fhVUND876mvn50rfUCFEJ3Y
J1JJLGXoqNXdI8hC+wkfw0Nn5I1D4T2TLYs6LvuhTx48j1amrrZJcVy8x6Iz+VlQ
oH2M9hDmypfx/aSBEINSbYiSzPLPnHKJOCMCk7RD+XKlT2cFjUuJTGczj9wqWjA6
6UtaYerAV0ftMjYvR3lzu7YS3lcpKtDOKxvncU0oQiY8IBXuoaXogpmAxp07cz7z
DZur0acc9Itzf3zl
=wBY0
-----END PGP SIGNATURE-----

L
L
Ludovic Courtès wrote on 10 Mar 00:34 +0100
control message for bug #51359
(address . control@debbugs.gnu.org)
87r17a1z0m.fsf@gnu.org
tags 51359 + moreinfo
quit
A
A
Andrew Tropin wrote on 8 Jun 18:10 +0200
Re: [bug#51359] [PATCH 0/1] home-state-service-type and tests suite
(name . Oleg Pykhalov)(address . go.wigust@gmail.com)
87edzz9lvv.fsf@trop.in
On 2021-10-23 21:04, Oleg Pykhalov wrote:

Toggle quote (30 lines)
> Hi Guix,
>
> This patch adds support for home-state-service-type which copied from the rde
> project [1]. The introduction to home state services in documentation is
> copied from discussion [2].
>
> Tests passed:
>
> make check-system TESTS="home-state-git"
> make check-system TESTS="home-state-rsync"
>
> [1] https://github.com/abcdw/rde/
> [2] https://lists.sr.ht/~abcdw/rde-devel/%3C87pmzze9nn.fsf%40trop.in%3E#%3CCABrWRW1Fq-8mS=MbWJedUpayj1vFg-YE0oNF3zVTYWBMnp29Lg@mail.gmail.com%3E
>
> Oleg Pykhalov (1):
> home: services: Add state services.
>
> doc/guix.texi | 32 ++
> gnu/home.scm | 12 +
> gnu/home/services/state.scm | 210 ++++++++++++
> gnu/home/services/utils.scm | 81 ++++-
> gnu/home/services/version-control.scm | 442 ++++++++++++++++++++++++++
> gnu/local.mk | 2 +
> gnu/tests/rsync.scm | 158 ++++++++-
> gnu/tests/version-control.scm | 140 +++++++-
> guix/scripts/home.scm | 100 +++++-
> 9 files changed, 1163 insertions(+), 14 deletions(-)
> create mode 100644 gnu/home/services/state.scm
> create mode 100644 gnu/home/services/version-control.scm

Hi Oleg!

Thank you for the patch, but states are very WIP and not ready for
upstream yet IMO. Also, I would like to reevaluate implementation of
git service-type and probably merge it separately.

Sorry for replying slowly :)

Hope I will get back to states in foreseable future and will carefully
rethink, refactor and cleanup the code.

BTW, do you use states? Can you share your experience with it?

--
Best regards,
Andrew Tropin
-----BEGIN PGP SIGNATURE-----

iQIzBAEBCgAdFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmKgyfQACgkQIgjSCVjB
3rD4mA/+MZzns8/aijc/JD83z1xIWwgI/Iq6sv/+TPGKEkVPfzzlAI0OqApKsE/m
Sj8H7nnQdbttS/xLp0V5aPC2MZpO1qY10msSi2iFaKSivVgLGVYbOkmdXLqIHgp4
4SXeHQKZ/t19DT3UfoUDGz4eGGjQ38K19qlZdb2GX5K1WdYv5k/TtQRe7bIZGAAh
cYLXv2ShoqghJ0zMkulMfxr2+3mBY4mCnv5d7q7WQQdM+nrtSLT+5SDKgQu5FwRn
d/0kFLk/QwjIpXApeCJWNjp0eF0EsyVQXMNp+aOYdwcR1CfCOtJTWUs5ODR3exb7
/EuXd44fXI1rt46n/XBjFpMPQctH7bpG2NDUNrdzZExBhyFVf57uVO1Sc1TDysUa
uEX0mGT7eq87FJTCFDqF9i4obxlkVZwriIBnJx/UPHxs7s17eXDv7C2yN8wMzP1D
xGeiPwqRQbMnnxFOrAZ8INvaCFjqgErOzak/t3O27zIAv1S9PNUYfwf1tMqqTHit
uZi6f4pc8a8V0F1k7RNtD3N4Ip9OueeZYskf4K+/t3CMTGOqcRcrtZ4itmrMeC6K
8Ybik7t6Q4rSM69YifyJ6/5e0GZDMWLLH21nSG7LwL3CZH6DdPKs91BFCGI7sHmB
ZQi/+0tBTLv1Tgd5Wkx2AgglWzW2F90dbhSsKp7e6cW7E1j/wbU=
=oncn
-----END PGP SIGNATURE-----

O
O
Oleg Pykhalov wrote on 8 Jun 19:02 +0200
(name . Andrew Tropin)(address . andrew@trop.in)(address . 51359@debbugs.gnu.org)
871qvzgkat.fsf@gmail.com
Hi Andrew,

Andrew Tropin <andrew@trop.in> writes:

[…]

Toggle quote (7 lines)
> Thank you for the patch, but states are very WIP and not ready for
> upstream yet IMO. Also, I would like to reevaluate implementation of
> git service-type and probably merge it separately.
>
> Hope I will get back to states in foreseable future and will carefully
> rethink, refactor and cleanup the code.

If the user's configuration will stay the same, we probably could merge.

Toggle quote (2 lines)
> BTW, do you use states? Can you share your experience with it?

I tried the git state and it worked, don't remember rsync. Also I don't
use it since the patch submitting day, because of plans to rewrite it.

Oleg.
-----BEGIN PGP SIGNATURE-----

iQJIBAEBCgAyFiEEcjhxI46s62NFSFhXFn+OpQAa+pwFAmKg1joUHGdvLndpZ3Vz
dEBnbWFpbC5jb20ACgkQFn+OpQAa+pw4kg/+JcyqdlTuvpSOiB+XR4htTaQ6WqqS
dCaQT92As8vnFYGXgclSEdvtlPxiKfUzudvksaZ4FMBhzITzfdVMHupBoORwxem9
oTmnzErEmKwexcMJytoRyiIU/Kbzld1KREmS0f78e2N+d3NJD04fdGsGGrSqgJn2
WA4/Q7Zm7HIkMmeBrSY284aQ5oFuW9rNHjKVV7erSQoPqytfSa7wYq3e2RENu9jt
LTkxE1HQ5cTyvk9kciXOnBJBjnZw0VcZAeXUwRFDriEDJM7TXDxserCd2EZATACg
oFxRR6OPgTeXrfTxW/nDnSaj0rVjmMmj4UgPuyYSSniZMBw6wc2gDbb5Ing2qihG
GkujXbDuUP5z+OWN6VaDyIU/idIZVXuGFNKj5eU75SNpDSt/VoWvw37bSrBKrd/C
zXQcf4hVC7Z7sP3yHdO+CzZHTWQ+W0bfqqJ6lvMQ4yf/WAgSOr+wVPteovMCiQu1
YWz8+YElccp3QcMy9FLOes7iGjg4Vssr4z5UcbhIozRvSV9D694lZ5mu4RQutlkU
BSIejd632t/tuqtVKelV8zs90biRMHIii0sHsDFv51MhATzY6R+yFCXo3/sqRnAR
ThJds3BIkzz37x9Q4StWIqTzac9MAJ1zk8J3bWf80J3Is3FxiHiXjlXLV7xDdGMk
b+LAJ+hJ4RnJHLA=
=5Kuq
-----END PGP SIGNATURE-----

A
A
Andrew Tropin wrote on 8 Jun 20:23 +0200
(name . Oleg Pykhalov)(address . go.wigust@gmail.com)(address . 51359@debbugs.gnu.org)
878rq7ggk9.fsf@trop.in
On 2022-06-08 20:02, Oleg Pykhalov wrote:

Toggle quote (16 lines)
> Hi Andrew,
>
> Andrew Tropin <andrew@trop.in> writes:
>
> […]
>
>> Thank you for the patch, but states are very WIP and not ready for
>> upstream yet IMO. Also, I would like to reevaluate implementation of
>> git service-type and probably merge it separately.
>>
>> Hope I will get back to states in foreseable future and will carefully
>> rethink, refactor and cleanup the code.
>
> If the user's configuration will stay the same, we probably could merge.
>

Not sure if it will stay the same. The implementation is quite fragile
and for sure should be revisited, maybe the user facing interface can be
organized better as well.

Toggle quote (5 lines)
>> BTW, do you use states? Can you share your experience with it?
>
> I tried the git state and it worked, don't remember rsync. Also I don't
> use it since the patch submitting day, because of plans to rewrite it.

Ok. I think I'll experiment with a new version of states in rde project
first and later will come back to merging it to Guix. It seems as an
important feature, but it's hard to say when I'll get to it.

--
Best regards,
Andrew Tropin
-----BEGIN PGP SIGNATURE-----

iQIzBAEBCgAdFiEEKEGaxlA4dEDH6S/6IgjSCVjB3rAFAmKg6SYACgkQIgjSCVjB
3rDHHhAAlgYrlbNThVC6fjb+ETyZV4j1M7aOtH+Lx+KMta388lziG6aKhlgNnYkY
lxnlFtOOnAlf3cuJHHjwnDzmZ/hJX0nb+HYiEG4pUsoUNqv8SDYocLFnw2X2lLWh
ecwxbdEeJzxpzNRWrMYvV1YF48B+Aw0WidSgF9TwTDlnxcPq8CgCssgcKOLo9ZnZ
zpcPmjLn69hZfFRVKWFiWOXWkUirMr1hS5Ma9I4ptVyAI3gXKMfR/uMaxVbjb2CA
yZI5jifQFY5Nj9IWs9/REiwNpEKWPs/H20iEcvtReVqgB/uAb1xYWR6G/p93a+wh
FXZuVHIRvlPUnLXEg2t2qflrjhHD1m5FoDqFyPUnagH3h4r7BXFl6Xq6GdBp3Ecm
gsJw90wxjst1AZxqBooFVusVFuXSFdML0qW7VBA3Mc9ihBJ7z/oFW0n7q6o5Ep1n
Ukq4rsiTV4l2ahtdZx+HqC9BrsNjlSPJ3lP81to/Auv9uJUdYqGCc3WtotqcXWAg
dMGU2opXQSqHdlFq4wUguA3CRG8aQA7G6GCKLPtZxS+3UHfvbllbvX1gc3Fexo1K
FOf//6fCwgPH/qsdU2C3E9lEGmYLzSae+LxrL4RKzP60H/gJGwqavqivZUxYwRej
5P6wEYZ7u+7WzxMblIGAQR4Nrhr1wqsav9DvDi7tqsTTNDVdqx8=
=C37f
-----END PGP SIGNATURE-----

?