2 files changed, 109 insertions, 0 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 7f587d73a9a..d3abbf29351 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -27888,6 +27888,29 @@ Package object for GVfs.
 @end table
 @end deftp
 
+@defvar kanata-service-type
+This is the type of the service that runs
+@uref{https://github.com/jtroo/kanata, Kanata}, a keyboard layout
+re-mapper.  Its value is a @code{kanata-configuration} object.  This
+service allows spawning @command{kanata} configurations to manage
+keyboards.
+@end defvar
+
+@deftp {Data Type} kanata-configuration
+Configuration record for the Kanata service.
+
+@table @asis
+@item @code{kanata} (default: @code{kanata}) (type: package)
+The Kanata package to use.
+
+@item @code{keymaps} (default: @code{()}) (type: list-of-file-likes)
+List of @command{kanata} configuration files (file-like objects).  See
+@uref{https://jtroo.github.io/config.html#linux-only-linux-dev, Kanata's
+device specification documentation}.
+
+@end table
+@end deftp
+
 @defvar kmonad-service-type
 This is the type of the service that runs
 @uref{https://github.com/kmonad/kmonad, KMonad}.  Its value is a
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index d4a8878bfd3..d0f56cc434c 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -81,6 +81,7 @@
   #:use-module (gnu packages nfs)
   #:use-module (gnu packages enlightenment)
   #:use-module (gnu packages haskell-apps)
+  #:use-module (gnu packages rust-apps)
   #:use-module (guix deprecation)
   #:use-module (guix i18n)
   #:use-module (guix records)
@@ -130,6 +131,12 @@
             kmonad-configuration?
             kmonad-service-type
 
+            kanata-service-type
+            kanata-configuration
+            kanata-configuration?
+            kanata-configuration-kanata
+            kanata-configuration-keymaps
+
             geoclue-application
             geoclue-configuration
             geoclue-configuration?
@@ -1110,6 +1117,85 @@ and extending the functionalities of different keyboards.")))
 
 
 ;;;
+;;; Kanata.
+;;;
+
+(define-configuration/no-serialization kanata-configuration
+  (kanata
+   (package kanata)
+   "The @code{kanata} package to use.")
+  (keymaps
+   (list-of-file-likes '())
+   "List of @command{kanata} configuration files (file-like objects).  See
+@uref{https://jtroo.github.io/config.html#linux-only-linux-dev, Kanata's
+device specification documentation}."))
+
+(define %kanata-group
+  (user-group
+    (name "kanata")
+    (system? #t)))
+
+(define %kanata-user
+  (user-account
+    (name "kanata")
+    (group "kanata")
+    (supplementary-groups '("input" "uinput"))
+    (system? #t)
+    (comment "Kanata daemon user")
+    (home-directory "/var/empty")
+    (create-home-directory? #f)
+    (shell (file-append shadow "/sbin/nologin"))))
+
+(define %kanata-accounts
+  (list %uinput-group %kanata-group %kanata-user))
+
+;; OPTIONS+="static_node=uinput" triggers kmod to load the uinput module on
+;; boot.
+(define %kanata-udev-rule
+  (udev-rule
+   "99-kanata.rules"
+   "KERNEL==\"uinput\", MODE=\"0660\", GROUP=\"uinput\", OPTIONS+=\"static_node=uinput\"\n"))
+
+(define (kanata-shepherd-services config)
+  "Return a shepherd service for each @command{kanata} configuration."
+  (let* ((kanata  (file-append (kanata-configuration-kanata config)
+                               "/bin/kanata"))
+         (keymaps (kanata-configuration-keymaps config)))
+    (map (lambda (index keymap)
+           (let ((name (string-append "kanata-" (number->string index))))
+             (shepherd-service
+               (provision     (list (string->symbol name)))
+               (requirement   '(user-processes udev))
+               (documentation (string-append "Run kanata process "
+                                             (number->string index) "."))
+               (start         #~(make-forkexec-constructor
+                                 ;; '--no-wait' prevents pausing on exit so
+                                 ;; Shepherd can reliably restart the daemon.
+                                 (list #$kanata "-c" #$keymap "--no-wait")
+                                 #:user "kanata"
+                                 #:group "kanata"
+                                 #:supplementary-groups '("input" "uinput")
+                                 #:log-file #$(string-append "/var/log/" name ".log")))
+               (stop          #~(make-kill-destructor)))))
+         (iota (length keymaps))
+         keymaps)))
+
+(define kanata-service-type
+  (service-type
+    (name 'kanata)
+    (extensions
+     (list (service-extension account-service-type
+                              (const %kanata-accounts))
+           (service-extension shepherd-root-service-type
+                              kanata-shepherd-services)
+           (service-extension udev-service-type
+                              (const (list %kanata-udev-rule)))))
+    (description
+     "Run the @command{kanata} daemon, which allows customizing and extending
+the functionalities of different keyboards.")))
+
+
+;;;
 ;;; UDisks.
 ;;;