~hutzdog/guix-dotfiles

249e47577617ece647562de027494a89fdb32ec3 — Danielle Hutzley 8 months ago f1d4f1a
pre-init: work on user account
M Makefile => Makefile +34 -2
@@ 1,8 1,40 @@
.PHONY: tangle install

VERBOSE ?= 1
tangle:
	./scripts/tangle.pl

repl: tangle
	./scripts/guix-wrapped.sh repl

define COMPILE_OS
(begin
	(use-modules (hutzdog guix lib))
	(composed-system-os (load "./out/configs/<GUIX_CONFIG>.scm")))
endef
export COMPILE_OS

build-system: tangle
	./scripts/guix-wrapped.sh system build -v $(VERBOSE) -e \
		"$$(echo "$$COMPILE_OS" | sed -e "s/<GUIX_CONFIG>/$(GUIX_CONFIG)/")"

build-system-vm: tangle
	./scripts/guix-wrapped.sh system vm -v $(VERBOSE) -e \
		"$$(echo "$$COMPILE_OS" | sed -e "s/<GUIX_CONFIG>/$(GUIX_CONFIG)/")"

define COMPILE_USER
(begin
	(use-modules (hutzdog guix lib))
	(user-environment
		(composed-system-user
			(load "./out/configs/<GUIX_CONFIG>.scm")
			"<USER_NAME>")))
endef
export COMPILE_USER

build-user: tangle
	./scripts/guix-wrapped.sh home build -v $(VERBOSE) -e \
		"$$(echo "$$COMPILE_USER" | sed -e "s/<GUIX_CONFIG>/$(GUIX_CONFIG)/" | sed -e "s/<USER_NAME>/$(USER)/")"


~/.config/guix/channels.scm: tangle
	mkdir -p `dirname $@`
	cp out/channels.scm $@

M NOTES => NOTES +1 -0
@@ 1,2 1,3 @@
- I intend to set up a pinephone in the future with this config
  + see https://github.com/Schroedinger50PCT/guix-pinephone/blob/f8c91db8aac2c034bdd3613e52f3cae8d65a5df5/pinephone_config.scm for a POC
- I intend to implement my own terminal emulator with swallowing built in

A channel/hutzdog/guix/lib.scm => channel/hutzdog/guix/lib.scm +34 -0
@@ 0,0 1,34 @@
(define-module (hutzdog guix packages lib)
               #:use-module (ice-9 optargs)
               #:use-module (gnu packages shells)
               #:use-module (guix packages)
               #:use-module (guix build-system trivial))

(define*-public (write-shell-script-bin
                  name source
                  #:key (version "0.1.0")
                        (extra-inputs '())
                        (synopsis "A shell script written to /bin")
                        (description #f))
  (package
   (name name)
   (version version)
   (source source)
   (build-system trivial-build-system)
   (arguments
     `(#:modules ((guix build utils))
       #:builder
       (begin
         (use-modules (guix build utils))
         (let* ((bin-dir (string-append %output "/bin"))
                (bin-file (string-append bin-dir "/" ,name))
                (dash-bin (string-append (assoc-ref %build-inputs "dash"))))
           (mkdir-p bin-dir)
           (copy-file (assoc-ref %build-inputs "source") bin-file)
           (patch-shebang bin-file (list dash-bin))
           (chmod bin-file #o555)))))
   (inputs (cons dash extra-inputs))
   (home-page #f)
   (synopsis synopsis)
   (description description)
   (license #f)))

A channel/hutzdog/guix/wm.scm => channel/hutzdog/guix/wm.scm +56 -0
@@ 0,0 1,56 @@
(define-module (hutzdog guix packages wm)
               #:use-module (gnu packages bash)
               #:use-module (gnu packages freedesktop)
               #:use-module (gnu packages gl)
               #:use-module (gnu packages linux)
               #:use-module (gnu packages man)
               #:use-module (gnu packages pkg-config)
               #:use-module (gnu packages wm)
               #:use-module (gnu packages xdisorg)
               #:use-module (gnu packages xorg)
               #:use-module (gnu packages zig)
               #:use-module (guix build-system trivial)
               #:use-module (guix gexp)
               #:use-module (guix git-download)
               #:use-module (guix licenses)
               #:use-module (guix packages)
               #:use-module (srfi srfi-1))

; TODO: make this better
(define river-build-gexp
  (with-imported-modules '((guix build utils) (srfi srfi-1))
   #~(begin
      (use-modules (guix build utils) (srfi srfi-1))
      (setenv "HOME" (getenv "TMPDIR"))

      (let ((dep-paths (reduce (lambda (it acc) (string-append it"/bin:"acc)) "" (map cdr %build-inputs))))
        (setenv "PATH" (string-append (getenv "PATH") dep-paths)))

      (let ((dep-libs (reduce (lambda (it acc) (string-append it"/share/pkgconfig:"it"/lib/pkgconfig:"acc)) "" (map cdr %build-inputs))))
        (setenv "PKG_CONFIG_PATH" dep-libs))

      (let ((src (assoc-ref %build-inputs "source")))
        (copy-recursively src ".")
        (invoke (string-append #$zig-0.10 "/bin/zig") "build"
                "-Drelease-safe" "-Dcpu=baseline" "-Dxwayland" "-Dman-pages"
                "--prefix" #$output
                "install"))
      (install-file "contrib/river.desktop" (string-append #$output "/share/wayland-sessions")))))

(define-public river
 (package
   (name "river")
   (version "0.2.4")
   (source (origin (method git-fetch)
                   (uri (git-reference (url "https://github.com/riverwm/river.git")
                                       (commit (string-append "v" version))
                                       (recursive? #t)))
                   (sha256 (base32 "1nvhqs6wwisf8ama7y1y3q3nf2jm9sh5bn46z8kyds8cikm0x1vh"))))
   (build-system trivial-build-system)
   (arguments `(#:builder ,river-build-gexp))
   (synopsis "The River tiling Wayland compositor")
   (description "A tiling Wayland compositor written in Zig and configured via script")
   (license gpl3+)
   (inputs (list wayland-protocols wlroots libxkbcommon pixman eudev libevdev libinput mesa libx11))
   (native-inputs (list zig-0.10 bash wayland xorg-server-xwayland scdoc pkg-config))
   (home-page "https://github.com/riverwm/river")))

A channel/hutzdog/guix/wrappers.scm => channel/hutzdog/guix/wrappers.scm +21 -0
@@ 0,0 1,21 @@
(define-module (hutzdog guix packages wrappers)
               #:use-module (guix gexp)
               #:use-module (gnu packages shells)
               #:use-module (hutzdog guix packages lib)
               #:export (rc-init
                         rc-login))

(define rc-init
  (write-shell-script-bin "rc-init"
   (program-file "rc-init"
                 #~(begin
                     (setenv "RC_INIT" "1")
                     (execl #$(file-append rc "/bin/rc") "-l" (command-line))))
   #:extra-inputs (list rc)))

(define rc-login
  (write-shell-script-bin "rc-login"
   (program-file "rc-login"
                 #~(execl #$(file-append rc "/bin/rc") "-l" (command-line)))
   #:extra-inputs (list rc)))


M configs/index.norg => configs/index.norg +3 -4
@@ 7,11 7,10 @@ This file defines the configurations, comprised of the portions in this repo
* Soyuz
  #tangle soyuz.scm
  @code scheme
  (define-module (hutzdog guixsd soyuz))
  (use-modules (hutzdog guix lib))

  (compose-system
    "../hardware/soyuz.scm" 
    "../systems/sputnik.scm"
    '())
   (load "../hardware/soyuz.scm") 
   (load "../systems/sputnik.scm")
   (list (load "../users/enderger.scm")))
  @end

M hardware/soyuz.norg => hardware/soyuz.norg +41 -44
@@ 17,8 17,10 @@ tangle: ./soyuz.scm

  (use-modules
   (gnu)
   (gnu packages admin)
   (gnu packages hardware)
   (gnu services networking)
   (gnu system setuid)
   (hutzdog guix lib)

   ; Needed for a few otherwise unavailable firmware blobs


@@ 41,9 43,9 @@ tangle: ./soyuz.scm
  @code scheme
  (define %kernel linux)
  (define %kernel.initrd microcode-initrd)
  (define %kernel.firmware (cons*
   (list iwlwifi-firmware i915-firmware) 
  %base-firmware))
  (define %kernel.firmware (append
   (list iwlwifi-firmware i915-firmware)
   %base-firmware))
  (define %kernel.arguments
   '("processor.max_cstate=5" "intel_idle.max_cstate=1"
     "video=DP-1:1920x1080@60" "video=HDMI-2:1440x900"))


@@ 60,74 62,69 @@ tangle: ./soyuz.scm
* Networking
  @code scheme
  (define %networking.dhcpd-sv
   (service dhcp-client-service-type
    (dhcp-client-configuration)))
   (service dhcp-client-service-type))

  (define %networking.wpa-supplicant-sv
   (service wpa-supplicant-service-type
    (wpa-supplicant-configuration
    (interface "wlp4s0")
    (config-file secrets.network-config))))

  (define %networking.name-server-switch
   (list %files
    (name-service
     (name "mdns_minimal")
     (reaction (lookup-specification (not-found => return)))
    (name-service (name "dns"))
    (name-service (name "mdns")))))
  @end

* File Systems
  @code scheme
  (define %filesystems
   (let ((ssd "/dev/disk/by-uuid/fba8d45b-7aae-456a-9608-89118bb8b73e")
         (hdd "/dev/disk/by-uuid/bb3f96fb-4676-439b-a695-60f1c871c80c"))
   (let ((ssd "fba8d45b-7aae-456a-9608-89118bb8b73e")
         (hdd "bb3f96fb-4676-439b-a695-60f1c871c80c"))
    (append
     (list (file-system
            (device (uuid ssd)
            (device (uuid ssd))
            (mount-point "/")
            (options "subvol=@root")))
            (options "subvol=@root")
            (type "btrfs"))
           (file-system
            (device (uuid ssd))
            (mount-point "/data/ssd")
            (options "subvol=@data"))
            (options "subvol=@data")
            (type "btrfs"))
           (file-system
            (device (uuid hdd))
            (mount-point "/gnu/store")
            (options "subvol=@guix"))
            (options "subvol=@guix") 
            (type "btrfs"))
           (file-system
            (device (uuid hdd))
            (mount-point "/home")
            (options "subvol=@home,compress-force=zstd,space_cache=v2"))
            (options "subvol=@home,compress-force=zstd,space_cache=v2")
            (type "btrfs"))
           (file-system
            (device (uuid "9E17-46DA")
            (mount-point "/boot/efi"))))
            (device (uuid "9E17-46DA" 'fat))
            (mount-point "/boot/efi")
            (type "vfat")))
     %base-file-systems)))
  @end

* Implementation
  @code scheme
  (define-hardware
   (operating-system
    (host-name %host-name)
    (timezone secrets.timezone)
    (locale %locale)
    (keyboard-layout %keyboard-layout)

    (kernel %kernel)
    (initrd %kernel.initrd)
    (firmware %kernel.firmware)
    (kernel-arguments %kernel.arguments)

    (bootloader %bootloader)
    (file-systems %file-systems)

    (setuid-programs
     (append (list (setuid-program (program (file-append opendoas "/bin/doas"))))
             %setuid-programs))

    (packages '(openrgb opendoas)))
    (name-service-switch (hosts %networking.name-server-switch))
   (services %networking.dhcp-sv %networking.wpa-supplicant-sv))
  (make-hardware
   '((host-name %host-name)
     (timezone secrets.time-zone)
     (locale %locale)
     (keyboard-layout %keyboard-layout)

     (kernel %kernel)
     (initrd %kernel.initrd)
     (firmware %kernel.firmware)
     (kernel-arguments %kernel.arguments)

     (bootloader %bootloader)
     (file-systems %filesystems)

     (setuid-programs
      (append (list (setuid-program (program (file-append opendoas "/bin/doas"))))
              %setuid-programs))

     (packages (list openrgb opendoas))
     (name-service-switch %mdns-host-lookup-nss))
   (list %networking.dhcpd-sv %networking.wpa-supplicant-sv))
  @end

M modules/hutzdog/guix/lib.scm => modules/hutzdog/guix/lib.scm +91 -52
@@ 2,8 2,41 @@
; (Neorg scheme indentation is a PITA at the moment)

(define-module (hutzdog guix lib)
               #:export (define-hardware
                         define-system
               #:use-module (rnrs base)
               #:use-module (srfi srfi-1)
               #:use-module (srfi srfi-9)
               #:use-module (gnu services configuration)
               #:use-module (gnu system)
               #:use-module (gnu system shadow)
               #:export (uglify-field-name
                         make-configuration-serializer

                         hardware-module
                         make-hardware
                         hardware-module?
                         hardware-operating-system
                         hardware-services

                         system-module
                         make-system
                         system-module?
                         system-operating-system
                         system-services
                         system-users

                         user-module
                         make-user
                         user-module?
                         user-mod-account
                         user-environment

                         composed-system
                         composed-system?
                         composed-system-os
                         composed-system-users
                         composed-system-user-list
                         composed-system-user

                         compose-system))

(define (uglify-field-name field-name)


@@ 12,59 45,65 @@
        (string-append "is-" (string-drop-right str 1))
        str)))

(define-syntax define-hardware
  (syntax-rules (operating-system services)
    ((define-hardware (operating-system system) ...)
     (define %hardware-operating-system system)
     (define-hardware ...))

    ((define-hardware (services sv))
     (set! %hardware-services sv)
     (define-hardware ...))

    ((define-hardware))))

(define-syntax define-system
  (syntax-rules (operating-system services users)
    ((define-system (operating-system system) ...)
     (define %system-operating-system system)
     (define-system ...))

    ((define-system (services sv))
     (set! %system-services sv)
     (define-system ...))

    ((define-system (users users) ...)
     (set! %system-users users)
     (define-system ...))

    ((define-system))))

(define-syntax define-user
  (syntax-rules (define-user account home-environment)
    ((define-user (account acc) ...)
     (set! %user-list (cons acc %user-list))
     (define-user ...))
    ((define-user (home-environment env))
     (define %user-home-environment env)
     (define-user ...))
    ((define-user)
     (home-environment %user-home-environment))))
(define (make-configuration-serializer typ)
 (lambda (cfg field)
   (serialize-configuration cfg (filter-configuration-fields typ (list field)))))

(define-record-type <hardware-module>
  (make-hardware operating-system services)
  hardware-module?
  (operating-system hardware-operating-system)
  (services hardware-services))

(define-record-type <system-module>
  (make-system operating-system services users)
  system-module?
  (operating-system system-operating-system)
  (services system-services)
  (users system-users))

(define-record-type <user-module>
  (make-user account environment)
  user-module?
  (account user-mod-account)
  (environment user-environment))

(define (user-operating-system user-list)
  (list 'users user-list))
  (let ((user-accounts (map user-mod-account user-list)))
    (or user-accounts '())))

(define (compose-system hardware system users)
  (load hardware)
(define-record-type <composed-system>
 (make-composed-system os users)
 composed-system?
 (os composed-system-os)
 (users composed-system-users))

(define (composed-system-user-list sys)
 (map (lambda (usr) (user-account-name (user-mod-account usr)))
      (composed-system-users sys)))

  (define %system-users '())
  (load system)
(define (composed-system-user sys name)
 (find (lambda (usr) (string=? name (user-account-name (user-mod-account usr))))
       (composed-system-users sys)))

(define (compose-operating-system hardware system users)
  (let ((user-list `(users ,(append (user-operating-system users)
                                    (system-users system)
                                    %base-user-accounts))))
    (eval (cons 'operating-system
                (append (hardware-operating-system hardware)
                        (system-operating-system system)
                        (list `(services 
                                 (quote ,(append (hardware-services hardware)
                                                 (system-services system)))))))
          (interaction-environment))))

(define (compose-system hardware system users)
  (assert (hardware-module? hardware))
  (assert (system-module? system))
  (assert (every user-module? users))

  (define %user-list '())
  (make-composed-system
    (compose-operating-system hardware system users)
    users))

  (let
    ((user-list `(users ,(append %user-list %system-users %base-user-accounts))))
    (apply operating-system
      (append %hardware-operating-system %system-operating-system
              (user-operating-system user-list)
              (services (append %hardware-services %system-services))))))

D modules/hutzdog/guix/services/greetd.scm => modules/hutzdog/guix/services/greetd.scm +0 -118
@@ 1,118 0,0 @@
(define-module (hutzdog guix services greetd)
               #:use-module (hutzdog guix lib)
               #:use-module (gnu packages admin)
               #:use-module (gnu services base)
               #:use-module (gnu system shadow)
               #:use-module (guix gexp)
               #:use-module (srfi srfi-9)
               #:export (make-agreety-greeter
                         agreety-greeter

                         greetd-greeter-configuration
                         greetd-command-configuration
                         greetd-default-session-configuration
                         greetd-configuration

                         greetd-service-type))

;; Greeters
(define (make-agreety-greeter cmd)
  (greetd-greeter-configuration
    (package greetd)
    (command (string-append "agreety --cmd " cmd))))

(define agreety-greeter
  (make-agreety-greeter "/bin/sh"))

;; Configuration
(define (serialize-item field-name value)
  #~(string-append #$(uglify-field-name field-name) " = " #$value "\n"))

(define (serialize-string field-name str)
  (serialize-item field-name (string "\"" str "\"")))

(define (serialize-integer field-name int)
  (serialize-item field-name (number->string int)))

(define (serialize-greetd-greeter-configuration field-name cfg)
  #~(#$(serialize-configuration cfg greetd-greeter-configuration-fields)))

(define (make-heading str)
  (string-append "[" (string-replace #\- #\_ (uglify-field-name str)) "]\n"))

(define (serialize-heading field-name value)
  #~(string-append #$(make-heading field-name) #$value))

(define (serialize-greetd-terminal-configuration field-name cfg)
  (serialize-heading field-name
                     (serialize-configuration cfg greetd-terminal-configuration-fields)))

(define (serialize-greetd-default-session-configuration field-name cfg)
  (serialize-heading field-name
                     (serialize-configuration
                       cfg greetd-default-session-configuration-fields)))

(define-configuration greetd-greeter-configuration
  (package package "The package to use for the greeter"
           (no-serialization))
  (command string "The command to run for the greeter"))

(define-configuration greetd-terminal-configuration
  (vt (integer 1) "The virtual terminal to use"))

(define-configuration greetd-default-session-configuration
  (greeter (greetd-greeter-configuration agreety-greeter) "The greeter to use")
  (user (string "greeter") "The user to run the greeter as"))

(define-configuration greetd-configuration
  (package (package greetd) "The greetd package to use"
           (no-serialization))
  (terminal (greetd-terminal-configuration (greetd-terminal-configuration))
            "The greetd terminal configuration to use")
  (default-session
    (greetd-default-session-configuration (greetd-default-session-configuration))
    "The default session to use"))

;; Service
(define (greetd-etc-sv cfg)
  (validate-greetd-configuration cfg)
  (list `("greetd.toml" ,(mixed-text-file
                           "greetd.toml"
                           (serialize-configuration cfg greetd-configuration-fields)))))

(define (greetd-shepherd-sv cfg)
  (validate-greetd-configuration cfg)

  (list (shepherd-service
          (documentation "greeter daemon")
          (requirement '(dbus-system user-processes host-name))
          (provision '(greetd display-manager xorg-server))
          (respawn? #f)
          (start
            #~(lambda ()
                (fork+exec-command #$(file-append (greetd-configuration-package cfg)
                                                  "/sbin/greetd"))))
          (stop #~(make-kill-destructor)))))

(define %greetd-accounts
  (list (user-group 
         (name "greeter")
         (system #t))
        (user-account
         (name "greeter")
         (group "greeter")
         (supplementary-groups '("video"))
         (comment "greetd user")
         (system? #t)
         (home-directory "/etc/greetd")
         (shell (file-append shadow "/sbin/nologin")))))

(define greetd-service-type
  (service-type
    (name 'greetd)
    (default-value (greetd-configuration))
    (extensions
      (list (service-extension etc-service-type greetd-etc-sv)
            (service-extension account-service-type (const %greetd-accounts))
            (service-extension shepherd-root-service-type greetd-shepherd-service))))
  (description "Run @{greetd}, a lightweight system for logging in users"))

A modules/hutzdog/guix/services/home/shells.scm => modules/hutzdog/guix/services/home/shells.scm +91 -0
@@ 0,0 1,91 @@
(define-module (hutzdog guix services home shells)
               #:use-module (gnu home services)
               #:use-module (gnu packages shells)
               #:use-module (gnu services configuration)
               #:use-module (guix gexp)
               #:use-module (guix packages)
               #:use-module (guix records)
               #:use-module (hutzdog guix lib)
               #:use-module (ice-9 match)
               #:export (home-rc-configuration
                         home-rc-service-type))

(define (rc-serialize-environment-variables field value)
  #~(string-append
      #$@(let ((env-var (lambda (k v) #~(string-append #$k "=" #$v "\n"))))
           (map (match-lambda
                  (key #f) (env-var key "()")
                  (key #t) (env-var key "1")
                  (key ('local val)) (env-var key (string-append "local" val))
                  (key val) (env-var key val))
                value))))

(define (serialize-boolean field val) "")
(define-configuration home-rc-configuration
  (package (package rc)
           "The Plan 9 RC package to use")
  (posix-sh-package (package dash)
                    "The POSIX compliant shell used to load Guix environment info")
  (guix-defaults? (boolean #t)
                  "Use sane defaults (tries to be equivalent to the Bash counterpart)")
  (environment-variables (alist '())
                         "Association list of environment variables to set"
                         (serializer rc-serialize-environment-variables))
  (profile (text-config '())
           "List of file-like objects to load exclusively on login.
            Loaded by the rc-init wrapper script, roughly equivalent to .bash-profile")
  (rcrc (text-config '())
        "List of file-like objects to load at shell startup, roughly equivalent to .bashrc"))


(define serialize-rc-configuration-field
 (make-configuration-serializer home-rc-configuration-fields))

(define (rc-file-rcrc cfg)
  (mixed-text-file "rcrc" "\
if (~ $RC_INIT 1) {
  if (~ $rc_guix_env_sourced) {
    rc_guix_env_sourced=1
    exec "(home-rc-configuration-posix-sh-package cfg)"/bin/sh -lc '"(home-rc-configuration-package cfg)"/bin/rc -l '^$\"*
  }
  "(serialize-rc-configuration-field cfg 'profile)"
}
"
(if (home-rc-configuration-guix-defaults? cfg) "\
fn set_prompt {
  env=local ()
  if (~ $GUIX_ENVIRONMENT) {
    env=' '$GUIX_ENVIRONMENT' [env] '
  }

  prompt=`{whoami}@{hostname}: {pwd | sed -e 's|/home/$USER|~|'}$env%`
}

fn cd {
  builtin cd $*
  set_prompt
}

fn ls {
  env ls -lh --color $*
}
")"

"
(serialize-rc-configuration-field cfg 'environment)
(serialize-rc-configuration-field cfg 'rcrc)))

(define (rc-files-sv cfg)
  `((".rcrc" ,(rc-file-rcrc cfg))))

(define (rc-packages-sv cfg)
  (list (home-rc-configuration-package cfg)
        (home-rc-configuration-posix-sh-package cfg)))

(define home-rc-service-type
 (service-type (name 'home-rc)
               (extensions
                (list (service-extension home-files-service-type rc-files-sv)
                      (service-extension home-profile-service-type rc-packages-sv)))
               (default-value (home-rc-configuration))
               (description "Install and configure RC, the Plan 9 shell")))

A modules/hutzdog/guix/services/home/wm.scm => modules/hutzdog/guix/services/home/wm.scm +43 -0
@@ 0,0 1,43 @@
; Window manager services
(define-module (hutzdog guix services home wm)
               #:use-module (gnu home services)
               #:use-module (gnu services configuration)
               #:use-module (guix gexp)
               #:use-module (guix packages)
               #:use-module (hutzdog guix packages wm)
               #:use-module (hutzdog guix lib)
               #:export (package-list?
                         home-river-configuration
                         home-river-service-type))

(define (package-list? cfg)
 (list-of package?))
(define (serialize-package-list name val) "")

(define-configuration home-river-configuration
 (package (package river) "The River package to use")
 (extra-packages (package-list '())
                 "Additional packages to install (e.g. script interpreter)")
 (config (text-config '()) "The file to use as an init script"))

(define serialize-river-configuration-fields
 (make-configuration-serializer home-river-configuration-fields))

(define (river-file-init cfg)
 (mixed-text-file "river-init"
  (serialize-river-configuration-fields cfg '(config))))

(define (river-files-sv cfg)
 `(("river/init" ,(river-file-init cfg))))

(define (river-packages-sv cfg)
 (cons (home-river-configuration-package cfg)
       (home-river-configuration-extra-packages cfg)))

(define home-river-service-type
 (service-type (name 'home-river)
               (extensions (list (service-extension home-xdg-configuration-files-service-type
                                                    river-files-sv)
                                 (service-extension home-profile-service-type
                                                    river-packages-sv)))
               (description "Install and configure the River wayland compositor")))

A out/channel/hutzdog/guix/lib.scm => out/channel/hutzdog/guix/lib.scm +34 -0
@@ 0,0 1,34 @@
(define-module (hutzdog guix packages lib)
               #:use-module (ice-9 optargs)
               #:use-module (gnu packages shells)
               #:use-module (guix packages)
               #:use-module (guix build-system trivial))

(define*-public (write-shell-script-bin
                  name source
                  #:key (version "0.1.0")
                        (extra-inputs '())
                        (synopsis "A shell script written to /bin")
                        (description #f))
  (package
   (name name)
   (version version)
   (source source)
   (build-system trivial-build-system)
   (arguments
     `(#:modules ((guix build utils))
       #:builder
       (begin
         (use-modules (guix build utils))
         (let* ((bin-dir (string-append %output "/bin"))
                (bin-file (string-append bin-dir "/" ,name))
                (dash-bin (string-append (assoc-ref %build-inputs "dash"))))
           (mkdir-p bin-dir)
           (copy-file (assoc-ref %build-inputs "source") bin-file)
           (patch-shebang bin-file (list dash-bin))
           (chmod bin-file #o555)))))
   (inputs (cons dash extra-inputs))
   (home-page #f)
   (synopsis synopsis)
   (description description)
   (license #f)))

A out/channel/hutzdog/guix/wm.scm => out/channel/hutzdog/guix/wm.scm +56 -0
@@ 0,0 1,56 @@
(define-module (hutzdog guix packages wm)
               #:use-module (gnu packages bash)
               #:use-module (gnu packages freedesktop)
               #:use-module (gnu packages gl)
               #:use-module (gnu packages linux)
               #:use-module (gnu packages man)
               #:use-module (gnu packages pkg-config)
               #:use-module (gnu packages wm)
               #:use-module (gnu packages xdisorg)
               #:use-module (gnu packages xorg)
               #:use-module (gnu packages zig)
               #:use-module (guix build-system trivial)
               #:use-module (guix gexp)
               #:use-module (guix git-download)
               #:use-module (guix licenses)
               #:use-module (guix packages)
               #:use-module (srfi srfi-1))

; TODO: make this better
(define river-build-gexp
  (with-imported-modules '((guix build utils) (srfi srfi-1))
   #~(begin
      (use-modules (guix build utils) (srfi srfi-1))
      (setenv "HOME" (getenv "TMPDIR"))

      (let ((dep-paths (reduce (lambda (it acc) (string-append it"/bin:"acc)) "" (map cdr %build-inputs))))
        (setenv "PATH" (string-append (getenv "PATH") dep-paths)))

      (let ((dep-libs (reduce (lambda (it acc) (string-append it"/share/pkgconfig:"it"/lib/pkgconfig:"acc)) "" (map cdr %build-inputs))))
        (setenv "PKG_CONFIG_PATH" dep-libs))

      (let ((src (assoc-ref %build-inputs "source")))
        (copy-recursively src ".")
        (invoke (string-append #$zig-0.10 "/bin/zig") "build"
                "-Drelease-safe" "-Dcpu=baseline" "-Dxwayland" "-Dman-pages"
                "--prefix" #$output
                "install"))
      (install-file "contrib/river.desktop" (string-append #$output "/share/wayland-sessions")))))

(define-public river
 (package
   (name "river")
   (version "0.2.4")
   (source (origin (method git-fetch)
                   (uri (git-reference (url "https://github.com/riverwm/river.git")
                                       (commit (string-append "v" version))
                                       (recursive? #t)))
                   (sha256 (base32 "1nvhqs6wwisf8ama7y1y3q3nf2jm9sh5bn46z8kyds8cikm0x1vh"))))
   (build-system trivial-build-system)
   (arguments `(#:builder ,river-build-gexp))
   (synopsis "The River tiling Wayland compositor")
   (description "A tiling Wayland compositor written in Zig and configured via script")
   (license gpl3+)
   (inputs (list wayland-protocols wlroots libxkbcommon pixman eudev libevdev libinput mesa libx11))
   (native-inputs (list zig-0.10 bash wayland xorg-server-xwayland scdoc pkg-config))
   (home-page "https://github.com/riverwm/river")))

A out/channel/hutzdog/guix/wrappers.scm => out/channel/hutzdog/guix/wrappers.scm +21 -0
@@ 0,0 1,21 @@
(define-module (hutzdog guix packages wrappers)
               #:use-module (guix gexp)
               #:use-module (gnu packages shells)
               #:use-module (hutzdog guix packages lib)
               #:export (rc-init
                         rc-login))

(define rc-init
  (write-shell-script-bin "rc-init"
   (program-file "rc-init"
                 #~(begin
                     (setenv "RC_INIT" "1")
                     (execl #$(file-append rc "/bin/rc") "-l" (command-line))))
   #:extra-inputs (list rc)))

(define rc-login
  (write-shell-script-bin "rc-login"
   (program-file "rc-login"
                 #~(execl #$(file-append rc "/bin/rc") "-l" (command-line)))
   #:extra-inputs (list rc)))


M out/configs/soyuz.scm => out/configs/soyuz.scm +3 -4
@@ 1,7 1,6 @@
(define-module (hutzdog guixsd soyuz))
(use-modules (hutzdog guix lib))

(compose-system
  "../hardware/soyuz.scm" 
  "../systems/sputnik.scm"
  '())
\ No newline at end of file
 (load "../hardware/soyuz.scm") 
 (load "../systems/sputnik.scm")
 (list (load "../users/enderger.scm")))
\ No newline at end of file

M out/hardware/soyuz.scm => out/hardware/soyuz.scm +37 -40
@@ 3,8 3,10 @@

(use-modules
 (gnu)
 (gnu packages admin)
 (gnu packages hardware)
 (gnu services networking)
 (gnu system setuid)
 (hutzdog guix lib)

 ; Needed for a few otherwise unavailable firmware blobs


@@ 16,9 18,9 @@
(define %locale "en_US.utf-8")
(define %kernel linux)
(define %kernel.initrd microcode-initrd)
(define %kernel.firmware (cons*
 (list iwlwifi-firmware i915-firmware) 
%base-firmware))
(define %kernel.firmware (append
 (list iwlwifi-firmware i915-firmware)
 %base-firmware))
(define %kernel.arguments
 '("processor.max_cstate=5" "intel_idle.max_cstate=1"
   "video=DP-1:1920x1080@60" "video=HDMI-2:1440x900"))


@@ 27,65 29,60 @@
  (bootloader grub-efi-bootloader)
  (targets '("/boot/efi"))))
(define %networking.dhcpd-sv
 (service dhcp-client-service-type
  (dhcp-client-configuration)))
 (service dhcp-client-service-type))

(define %networking.wpa-supplicant-sv
 (service wpa-supplicant-service-type
  (wpa-supplicant-configuration
  (interface "wlp4s0")
  (config-file secrets.network-config))))

(define %networking.name-server-switch
 (list %files
  (name-service
   (name "mdns_minimal")
   (reaction (lookup-specification (not-found => return)))
  (name-service (name "dns"))
  (name-service (name "mdns")))))
(define %filesystems
 (let ((ssd "/dev/disk/by-uuid/fba8d45b-7aae-456a-9608-89118bb8b73e")
       (hdd "/dev/disk/by-uuid/bb3f96fb-4676-439b-a695-60f1c871c80c"))
 (let ((ssd "fba8d45b-7aae-456a-9608-89118bb8b73e")
       (hdd "bb3f96fb-4676-439b-a695-60f1c871c80c"))
  (append
   (list (file-system
          (device (uuid ssd)
          (device (uuid ssd))
          (mount-point "/")
          (options "subvol=@root")))
          (options "subvol=@root")
          (type "btrfs"))
         (file-system
          (device (uuid ssd))
          (mount-point "/data/ssd")
          (options "subvol=@data"))
          (options "subvol=@data")
          (type "btrfs"))
         (file-system
          (device (uuid hdd))
          (mount-point "/gnu/store")
          (options "subvol=@guix"))
          (options "subvol=@guix") 
          (type "btrfs"))
         (file-system
          (device (uuid hdd))
          (mount-point "/home")
          (options "subvol=@home,compress-force=zstd,space_cache=v2"))
          (options "subvol=@home,compress-force=zstd,space_cache=v2")
          (type "btrfs"))
         (file-system
          (device (uuid "9E17-46DA")
          (mount-point "/boot/efi"))))
          (device (uuid "9E17-46DA" 'fat))
          (mount-point "/boot/efi")
          (type "vfat")))
   %base-file-systems)))
(define-hardware
 (operating-system
  (host-name %host-name)
  (timezone secrets.timezone)
  (locale %locale)
  (keyboard-layout %keyboard-layout)
(make-hardware
 '((host-name %host-name)
   (timezone secrets.time-zone)
   (locale %locale)
   (keyboard-layout %keyboard-layout)

  (kernel %kernel)
  (initrd %kernel.initrd)
  (firmware %kernel.firmware)
  (kernel-arguments %kernel.arguments)
   (kernel %kernel)
   (initrd %kernel.initrd)
   (firmware %kernel.firmware)
   (kernel-arguments %kernel.arguments)

  (bootloader %bootloader)
  (file-systems %file-systems)
   (bootloader %bootloader)
   (file-systems %filesystems)

  (setuid-programs
   (append (list (setuid-program (program (file-append opendoas "/bin/doas"))))
           %setuid-programs))
   (setuid-programs
    (append (list (setuid-program (program (file-append opendoas "/bin/doas"))))
            %setuid-programs))

  (packages '(openrgb opendoas)))
  (name-service-switch (hosts %networking.name-server-switch))
 (services %networking.dhcp-sv %networking.wpa-supplicant-sv))
\ No newline at end of file
   (packages (list openrgb opendoas))
   (name-service-switch %mdns-host-lookup-nss))
 (list %networking.dhcpd-sv %networking.wpa-supplicant-sv))
\ No newline at end of file

M out/modules/hutzdog/guix/lib.scm => out/modules/hutzdog/guix/lib.scm +91 -53
@@ 2,8 2,41 @@
; (Neorg scheme indentation is a PITA at the moment)

(define-module (hutzdog guix lib)
               #:export (define-hardware
                         define-system
               #:use-module (rnrs base)
               #:use-module (srfi srfi-1)
               #:use-module (srfi srfi-9)
               #:use-module (gnu services configuration)
               #:use-module (gnu system)
               #:use-module (gnu system shadow)
               #:export (uglify-field-name
                         make-configuration-serializer

                         hardware-module
                         make-hardware
                         hardware-module?
                         hardware-operating-system
                         hardware-services

                         system-module
                         make-system
                         system-module?
                         system-operating-system
                         system-services
                         system-users

                         user-module
                         make-user
                         user-module?
                         user-mod-account
                         user-environment

                         composed-system
                         composed-system?
                         composed-system-os
                         composed-system-users
                         composed-system-user-list
                         composed-system-user

                         compose-system))

(define (uglify-field-name field-name)


@@ 12,60 45,65 @@
        (string-append "is-" (string-drop-right str 1))
        str)))

(define-syntax define-hardware
  (syntax-rules (operating-system services)
    ((define-hardware (operating-system system) ...)
     (define %hardware-operating-system system)
     (define-hardware ...))

    ((define-hardware (services sv))
     (set! %hardware-services sv)
     (define-hardware ...))

    ((define-hardware))))

(define-syntax define-system
  (syntax-rules (operating-system services users)
    ((define-system (operating-system system) ...)
     (define %system-operating-system system)
     (define-system ...))

    ((define-system (services sv))
     (set! %system-services sv)
     (define-system ...))

    ((define-system (users users) ...)
     (set! %system-users users)
     (define-system ...))

    ((define-system))))

(define-syntax define-user
  (syntax-rules (define-user account home-environment)
    ((define-user (account acc) ...)
     (set! %user-list (cons acc %user-list))
     (define-user ...))
    ((define-user (home-environment env))
     (define %user-home-environment env)
     (define-user ...))
    ((define-user)
     (home-environment %user-home-environment))))
(define (make-configuration-serializer typ)
 (lambda (cfg field)
   (serialize-configuration cfg (filter-configuration-fields typ (list field)))))

(define-record-type <hardware-module>
  (make-hardware operating-system services)
  hardware-module?
  (operating-system hardware-operating-system)
  (services hardware-services))

(define-record-type <system-module>
  (make-system operating-system services users)
  system-module?
  (operating-system system-operating-system)
  (services system-services)
  (users system-users))

(define-record-type <user-module>
  (make-user account environment)
  user-module?
  (account user-mod-account)
  (environment user-environment))

(define (user-operating-system user-list)
  (list 'users user-list))
  (let ((user-accounts (map user-mod-account user-list)))
    (or user-accounts '())))

(define (compose-system hardware system users)
  (load hardware)
(define-record-type <composed-system>
 (make-composed-system os users)
 composed-system?
 (os composed-system-os)
 (users composed-system-users))

(define (composed-system-user-list sys)
 (map (lambda (usr) (user-account-name (user-mod-account usr)))
      (composed-system-users sys)))

  (define %system-users '())
  (load system)
(define (composed-system-user sys name)
 (find (lambda (usr) (string=? name (user-account-name (user-mod-account usr))))
       (composed-system-users sys)))

(define (compose-operating-system hardware system users)
  (let ((user-list `(users ,(append (user-operating-system users)
                                    (system-users system)
                                    %base-user-accounts))))
    (eval (cons 'operating-system
                (append (hardware-operating-system hardware)
                        (system-operating-system system)
                        (list `(services 
                                 (quote ,(append (hardware-services hardware)
                                                 (system-services system)))))))
          (interaction-environment))))

(define (compose-system hardware system users)
  (assert (hardware-module? hardware))
  (assert (system-module? system))
  (assert (every user-module? users))

  (define %user-list '())
  (for-each load users)
  (make-composed-system
    (compose-operating-system hardware system users)
    users))

  (let
    ((user-list `(users ,(append %user-list %system-users %base-user-accounts))))
    (apply operating-system
      (append %hardware-operating-system %system-operating-system
              (user-operating-system user-list)
              (services (append %hardware-services %system-services))))))

A out/modules/hutzdog/guix/packages/lib.scm => out/modules/hutzdog/guix/packages/lib.scm +34 -0
@@ 0,0 1,34 @@
(define-module (hutzdog guix packages lib)
               #:use-module (ice-9 optargs)
               #:use-module (gnu packages shells)
               #:use-module (guix packages)
               #:use-module (guix build-system trivial))

(define*-public (write-shell-script-bin
                  name source
                  #:key (version "0.1.0")
                        (extra-inputs '())
                        (synopsis "A shell script written to /bin")
                        (description #f))
  (package
   (name name)
   (version version)
   (source source)
   (build-system trivial-build-system)
   (arguments
     `(#:modules ((guix build utils))
       #:builder
       (begin
         (use-modules (guix build utils))
         (let* ((bin-dir (string-append %output "/bin"))
                (bin-file (string-append bin-dir "/" ,name))
                (dash-bin (string-append (assoc-ref %build-inputs "dash"))))
           (mkdir-p bin-dir)
           (copy-file (assoc-ref %build-inputs "source") bin-file)
           (patch-shebang bin-file (list dash-bin))
           (chmod bin-file #o555)))))
   (inputs (cons dash extra-inputs))
   (home-page #f)
   (synopsis synopsis)
   (description description)
   (license #f)))

A out/modules/hutzdog/guix/packages/wm.scm => out/modules/hutzdog/guix/packages/wm.scm +56 -0
@@ 0,0 1,56 @@
(define-module (hutzdog guix packages wm)
               #:use-module (gnu packages bash)
               #:use-module (gnu packages freedesktop)
               #:use-module (gnu packages gl)
               #:use-module (gnu packages linux)
               #:use-module (gnu packages man)
               #:use-module (gnu packages pkg-config)
               #:use-module (gnu packages wm)
               #:use-module (gnu packages xdisorg)
               #:use-module (gnu packages xorg)
               #:use-module (gnu packages zig)
               #:use-module (guix build-system trivial)
               #:use-module (guix gexp)
               #:use-module (guix git-download)
               #:use-module (guix licenses)
               #:use-module (guix packages)
               #:use-module (srfi srfi-1))

; TODO: make this better
(define river-build-gexp
  (with-imported-modules '((guix build utils) (srfi srfi-1))
   #~(begin
      (use-modules (guix build utils) (srfi srfi-1))
      (setenv "HOME" (getenv "TMPDIR"))

      (let ((dep-paths (reduce (lambda (it acc) (string-append it"/bin:"acc)) "" (map cdr %build-inputs))))
        (setenv "PATH" (string-append (getenv "PATH") dep-paths)))

      (let ((dep-libs (reduce (lambda (it acc) (string-append it"/share/pkgconfig:"it"/lib/pkgconfig:"acc)) "" (map cdr %build-inputs))))
        (setenv "PKG_CONFIG_PATH" dep-libs))

      (let ((src (assoc-ref %build-inputs "source")))
        (copy-recursively src ".")
        (invoke (string-append #$zig-0.10 "/bin/zig") "build"
                "-Drelease-safe" "-Dcpu=baseline" "-Dxwayland" "-Dman-pages"
                "--prefix" #$output
                "install"))
      (install-file "contrib/river.desktop" (string-append #$output "/share/wayland-sessions")))))

(define-public river
 (package
   (name "river")
   (version "0.2.4")
   (source (origin (method git-fetch)
                   (uri (git-reference (url "https://github.com/riverwm/river.git")
                                       (commit (string-append "v" version))
                                       (recursive? #t)))
                   (sha256 (base32 "1nvhqs6wwisf8ama7y1y3q3nf2jm9sh5bn46z8kyds8cikm0x1vh"))))
   (build-system trivial-build-system)
   (arguments `(#:builder ,river-build-gexp))
   (synopsis "The River tiling Wayland compositor")
   (description "A tiling Wayland compositor written in Zig and configured via script")
   (license gpl3+)
   (inputs (list wayland-protocols wlroots libxkbcommon pixman eudev libevdev libinput mesa libx11))
   (native-inputs (list zig-0.10 bash wayland xorg-server-xwayland scdoc pkg-config))
   (home-page "https://github.com/riverwm/river")))

A out/modules/hutzdog/guix/packages/wrappers.scm => out/modules/hutzdog/guix/packages/wrappers.scm +21 -0
@@ 0,0 1,21 @@
(define-module (hutzdog guix packages wrappers)
               #:use-module (guix gexp)
               #:use-module (gnu packages shells)
               #:use-module (hutzdog guix packages lib)
               #:export (rc-init
                         rc-login))

(define rc-init
  (write-shell-script-bin "rc-init"
   (program-file "rc-init"
                 #~(begin
                     (setenv "RC_INIT" "1")
                     (execl #$(file-append rc "/bin/rc") "-l" (command-line))))
   #:extra-inputs (list rc)))

(define rc-login
  (write-shell-script-bin "rc-login"
   (program-file "rc-login"
                 #~(execl #$(file-append rc "/bin/rc") "-l" (command-line)))
   #:extra-inputs (list rc)))


D out/modules/hutzdog/guix/services/greetd.scm => out/modules/hutzdog/guix/services/greetd.scm +0 -118
@@ 1,118 0,0 @@
(define-module (hutzdog guix services greetd)
               #:use-module (hutzdog guix lib)
               #:use-module (gnu packages admin)
               #:use-module (gnu services base)
               #:use-module (gnu system shadow)
               #:use-module (guix gexp)
               #:use-module (srfi srfi-9)
               #:export (make-agreety-greeter
                         agreety-greeter

                         greetd-greeter-configuration
                         greetd-command-configuration
                         greetd-default-session-configuration
                         greetd-configuration

                         greetd-service-type))

;; Greeters
(define (make-agreety-greeter cmd)
  (greetd-greeter-configuration
    (package greetd)
    (command (string-append "agreety --cmd " cmd))))

(define agreety-greeter
  (make-agreety-greeter "/bin/sh"))

;; Configuration
(define (serialize-item field-name value)
  #~(string-append #$(uglify-field-name field-name) " = " #$value "\n"))

(define (serialize-string field-name str)
  (serialize-item field-name (string "\"" str "\"")))

(define (serialize-integer field-name int)
  (serialize-item field-name (number->string int)))

(define (serialize-greetd-greeter-configuration field-name cfg)
  #~(#$(serialize-configuration cfg greetd-greeter-configuration-fields)))

(define (make-heading str)
  (string-append "[" (string-replace #\- #\_ (uglify-field-name str)) "]\n"))

(define (serialize-heading field-name value)
  #~(string-append #$(make-heading field-name) #$value))

(define (serialize-greetd-terminal-configuration field-name cfg)
  (serialize-heading field-name
                     (serialize-configuration cfg greetd-terminal-configuration-fields)))

(define (serialize-greetd-default-session-configuration field-name cfg)
  (serialize-heading field-name
                     (serialize-configuration
                       cfg greetd-default-session-configuration-fields)))

(define-configuration greetd-greeter-configuration
  (package package "The package to use for the greeter"
           (no-serialization))
  (command string "The command to run for the greeter"))

(define-configuration greetd-terminal-configuration
  (vt (integer 1) "The virtual terminal to use"))

(define-configuration greetd-default-session-configuration
  (greeter (greetd-greeter-configuration agreety-greeter) "The greeter to use")
  (user (string "greeter") "The user to run the greeter as"))

(define-configuration greetd-configuration
  (package (package greetd) "The greetd package to use"
           (no-serialization))
  (terminal (greetd-terminal-configuration (greetd-terminal-configuration))
            "The greetd terminal configuration to use")
  (default-session
    (greetd-default-session-configuration (greetd-default-session-configuration))
    "The default session to use"))

;; Service
(define (greetd-etc-sv cfg)
  (validate-greetd-configuration cfg)
  (list `("greetd.toml" ,(mixed-text-file
                           "greetd.toml"
                           (serialize-configuration cfg greetd-configuration-fields)))))

(define (greetd-shepherd-sv cfg)
  (validate-greetd-configuration cfg)

  (list (shepherd-service
          (documentation "greeter daemon")
          (requirement '(dbus-system user-processes host-name))
          (provision '(greetd display-manager xorg-server))
          (respawn? #f)
          (start
            #~(lambda ()
                (fork+exec-command #$(file-append (greetd-configuration-package cfg)
                                                  "/sbin/greetd"))))
          (stop #~(make-kill-destructor)))))

(define %greetd-accounts
  (list (user-group 
         (name "greeter")
         (system #t))
        (user-account
         (name "greeter")
         (group "greeter")
         (supplementary-groups '("video"))
         (comment "greetd user")
         (system? #t)
         (home-directory "/etc/greetd")
         (shell (file-append shadow "/sbin/nologin")))))

(define greetd-service-type
  (service-type
    (name 'greetd)
    (default-value (greetd-configuration))
    (extensions
      (list (service-extension etc-service-type greetd-etc-sv)
            (service-extension account-service-type (const %greetd-accounts))
            (service-extension shepherd-root-service-type greetd-shepherd-service))))
  (description "Run @{greetd}, a lightweight system for logging in users"))

A out/modules/hutzdog/guix/services/home/shells.scm => out/modules/hutzdog/guix/services/home/shells.scm +91 -0
@@ 0,0 1,91 @@
(define-module (hutzdog guix services home shells)
               #:use-module (gnu home services)
               #:use-module (gnu packages shells)
               #:use-module (gnu services configuration)
               #:use-module (guix gexp)
               #:use-module (guix packages)
               #:use-module (guix records)
               #:use-module (hutzdog guix lib)
               #:use-module (ice-9 match)
               #:export (home-rc-configuration
                         home-rc-service-type))

(define (rc-serialize-environment-variables field value)
  #~(string-append
      #$@(let ((env-var (lambda (k v) #~(string-append #$k "=" #$v "\n"))))
           (map (match-lambda
                  (key #f) (env-var key "()")
                  (key #t) (env-var key "1")
                  (key ('local val)) (env-var key (string-append "local" val))
                  (key val) (env-var key val))
                value))))

(define (serialize-boolean field val) "")
(define-configuration home-rc-configuration
  (package (package rc)
           "The Plan 9 RC package to use")
  (posix-sh-package (package dash)
                    "The POSIX compliant shell used to load Guix environment info")
  (guix-defaults? (boolean #t)
                  "Use sane defaults (tries to be equivalent to the Bash counterpart)")
  (environment-variables (alist '())
                         "Association list of environment variables to set"
                         (serializer rc-serialize-environment-variables))
  (profile (text-config '())
           "List of file-like objects to load exclusively on login.
            Loaded by the rc-init wrapper script, roughly equivalent to .bash-profile")
  (rcrc (text-config '())
        "List of file-like objects to load at shell startup, roughly equivalent to .bashrc"))


(define serialize-rc-configuration-field
 (make-configuration-serializer home-rc-configuration-fields))

(define (rc-file-rcrc cfg)
  (mixed-text-file "rcrc" "\
if (~ $RC_INIT 1) {
  if (~ $rc_guix_env_sourced) {
    rc_guix_env_sourced=1
    exec "(home-rc-configuration-posix-sh-package cfg)"/bin/sh -lc '"(home-rc-configuration-package cfg)"/bin/rc -l '^$\"*
  }
  "(serialize-rc-configuration-field cfg 'profile)"
}
"
(if (home-rc-configuration-guix-defaults? cfg) "\
fn set_prompt {
  env=local ()
  if (~ $GUIX_ENVIRONMENT) {
    env=' '$GUIX_ENVIRONMENT' [env] '
  }

  prompt=`{whoami}@{hostname}: {pwd | sed -e 's|/home/$USER|~|'}$env%`
}

fn cd {
  builtin cd $*
  set_prompt
}

fn ls {
  env ls -lh --color $*
}
")"

"
(serialize-rc-configuration-field cfg 'environment)
(serialize-rc-configuration-field cfg 'rcrc)))

(define (rc-files-sv cfg)
  `((".rcrc" ,(rc-file-rcrc cfg))))

(define (rc-packages-sv cfg)
  (list (home-rc-configuration-package cfg)
        (home-rc-configuration-posix-sh-package cfg)))

(define home-rc-service-type
 (service-type (name 'home-rc)
               (extensions
                (list (service-extension home-files-service-type rc-files-sv)
                      (service-extension home-profile-service-type rc-packages-sv)))
               (default-value (home-rc-configuration))
               (description "Install and configure RC, the Plan 9 shell")))

A out/modules/hutzdog/guix/services/home/wm.scm => out/modules/hutzdog/guix/services/home/wm.scm +43 -0
@@ 0,0 1,43 @@
; Window manager services
(define-module (hutzdog guix services home wm)
               #:use-module (gnu home services)
               #:use-module (gnu services configuration)
               #:use-module (guix gexp)
               #:use-module (guix packages)
               #:use-module (hutzdog guix packages wm)
               #:use-module (hutzdog guix lib)
               #:export (package-list?
                         home-river-configuration
                         home-river-service-type))

(define (package-list? cfg)
 (list-of package?))
(define (serialize-package-list name val) "")

(define-configuration home-river-configuration
 (package (package river) "The River package to use")
 (extra-packages (package-list '())
                 "Additional packages to install (e.g. script interpreter)")
 (config (text-config '()) "The file to use as an init script"))

(define serialize-river-configuration-fields
 (make-configuration-serializer home-river-configuration-fields))

(define (river-file-init cfg)
 (mixed-text-file "river-init"
  (serialize-river-configuration-fields cfg '(config))))

(define (river-files-sv cfg)
 `(("river/init" ,(river-file-init cfg))))

(define (river-packages-sv cfg)
 (cons (home-river-configuration-package cfg)
       (home-river-configuration-extra-packages cfg)))

(define home-river-service-type
 (service-type (name 'home-river)
               (extensions (list (service-extension home-xdg-configuration-files-service-type
                                                    river-files-sv)
                                 (service-extension home-profile-service-type
                                                    river-packages-sv)))
               (description "Install and configure the River wayland compositor")))

M out/systems/sputnik.scm => out/systems/sputnik.scm +33 -13
@@ 2,28 2,48 @@
(load "./sputnik.secret.scm")

(use-modules
 (srfi srfi-1)
 (gnu)
 (gnu packages hardware)
 (gnu services base)
 (gnu services networking)
 (hutzdog guix lib)
 (hutzdog guix services greetd))
 (hutzdog guix packages wrappers)
 (hutzdog guix lib))

(define %system-base-services %base-services)
(define %networking.ntp-sv
 (service ntp-service-type
  (ntp-configuration
   (ruleset %secrets.firewall-config))))
  (ntp-configuration)))

(define %networking.nftables-sv
 (service nftables-service-type))
 (service nftables-service-type
  (nftables-configuration (ruleset %secrets.firewall-config))))
(define %system-users.root
 (user-account
  (name "root")
  (shell (file-append rc "/bin/rc"))))
  (group "root")
  (shell (file-append rc-login "/bin/rc-login"))))
(define %gui.greetd-sv
 (service greetd-service-type
  (greetd-service-configuration
   (default-session (greetd-default-session-configuration
                     (greeter (make-agreety-greeter (file-append rc "/bin/rc"))))))))
(define-system
 (operating-system)
 (services %networking.ntp-sv %networking.nftables-sv %gui.greetd-sv)
 (users %system-users.root))
\ No newline at end of file
  (greetd-configuration
   (terminals
    (cons
     (greetd-terminal-configuration 
      (terminal-vt "1")
      (terminal-switch #t)
      (default-session-command
       (greetd-agreety-session (command (file-append rc-init "/bin/rc-init")))))
    (map
     (lambda (i)
             (greetd-terminal-configuration (terminal-vt (number->string i))))
     (iota 7 2)))))))

(set! %system-base-services
 (modify-services %system-base-services
  (delete login-service-type)
  (delete mingetty-service-type)))
(make-system
 '()
 (append (list %networking.ntp-sv %networking.nftables-sv %gui.greetd-sv)
         %system-base-services)
 (list %system-users.root))
\ No newline at end of file

A out/users/enderger.scm => out/users/enderger.scm +49 -0
@@ 0,0 1,49 @@
(use-modules
 (srfi srfi-1)
 (gnu)
 (gnu home)
 (gnu packages shells)
 (gnu packages terminals)
 (hutzdog guix packages wrappers)
 (hutzdog guix services home shells)
 (hutzdog guix services home wm)
 (hutzdog guix lib))

(define %user-packages '())
(define* (add-user-packages! #:rest pkgs)
  (set! %user-packages (append pkgs %user-packages)))
(define %user-account
 (user-account
  (name "enderger")
  (group "enderger")
  (shell (file-append rc-login "/bin/rc-login"))))
(define %rc-sv
 (service home-rc-service-type))

(add-user-packages! foot rc)
(define %river-config
 #~(begin
    (define* (riverctl #:rest args)
     (apply system* (cons "riverctl" args)))

    (define (river-map mode modifiers key action)
     (riverctl "map" (symbol->string mode) modifier (symbol->string key) action))

    (define %mod 'Super)
    (define* (modifier #:optional (key #f) #:key (mod %mod))
     (let ((pre (if key (string-append "+" (symbol->string key)) ""))
      (string-append (symbol->string mod) key))))

    (river-map 'normal (modifier) 'Return "spawn foot")
    (river-map 'normal (modifier 'Shift) 'C "close")
    (river-map 'normal (modifier 'Shift) 'Q "exit")))

(define %river-sv
 (service home-river-service-type
  (home-river-configuration
   (config (list (program-file "river-init" %river-config))))))
(make-user
 %user-account
 (home-environment
  (services (list %rc-sv %river-sv))
  (packages %user-packages)))
\ No newline at end of file

M scripts/guix-wrapped.sh => scripts/guix-wrapped.sh +5 -0
@@ 1,5 1,10 @@
#!/usr/bin/env sh
REPO_PATH="$(dirname "$(readlink -f "$(dirname $0)")")"
export GUILE_LOAD_PATH="$REPO_PATH/out/modules:$GUILE_LOAD_PATH"
export GUILE_PACKAGE_PATH="$REPO_PATH/out/channel:$GUILE_PACKAGE_PATH"
export GUILE_BUILD_OPTIONS="-L '$REPO_PATH/out/modules'"

GUIX_PROFILE="$HOME/.config/guix/current"
. "$GUIX_PROFILE/etc/profile"

guix "$@"

M scripts/tangle.pl => scripts/tangle.pl +9 -6
@@ 39,11 39,14 @@ foreach my $file (@norg_files) {
}

my @scm_files;
find(sub {
    return unless -f;
    return unless /\.scm$/;
    return if $File::Find::dir =~ /out/;
    push @scm_files, $File::Find::name;
find({
    wanted => sub {
      return unless -f;
      return unless /\.scm$/;
      return if $File::Find::dir =~ /out/;
      push @scm_files, $File::Find::name;
    },
    follow_fast => 1,
  }, ".");

foreach my $file (@scm_files) {


@@ 53,7 56,7 @@ foreach my $file (@scm_files) {

my @outdirs;
find(sub {
    return unless -d;
    return unless -d or -l;
    push @outdirs, $File::Find::name;
  }, "out");


M systems/sputnik.norg => systems/sputnik.norg +33 -13
@@ 9,22 9,26 @@ tangle: ./sputnik.scm
  (load "./sputnik.secret.scm")

  (use-modules
   (srfi srfi-1)
   (gnu)
   (gnu packages hardware)
   (gnu services base)
   (gnu services networking)
   (hutzdog guix lib)
   (hutzdog guix services greetd))
   (hutzdog guix packages wrappers)
   (hutzdog guix lib))

  (define %system-base-services %base-services)
  @end

* Networking / Security
  @code scheme
  (define %networking.ntp-sv
   (service ntp-service-type
    (ntp-configuration
     (ruleset %secrets.firewall-config))))
    (ntp-configuration)))

  (define %networking.nftables-sv
   (service nftables-service-type))
   (service nftables-service-type
    (nftables-configuration (ruleset %secrets.firewall-config))))
  @end

* Users


@@ 32,21 36,37 @@ tangle: ./sputnik.scm
  (define %system-users.root
   (user-account
    (name "root")
    (shell (file-append rc "/bin/rc"))))
    (group "root")
    (shell (file-append rc-login "/bin/rc-login"))))
  @end

* GUI
  @code scheme
  (define %gui.greetd-sv
   (service greetd-service-type
    (greetd-service-configuration
     (default-session (greetd-default-session-configuration
                       (greeter (make-agreety-greeter (file-append rc "/bin/rc"))))))))
    (greetd-configuration
     (terminals
      (cons
       (greetd-terminal-configuration 
        (terminal-vt "1")
        (terminal-switch #t)
        (default-session-command
         (greetd-agreety-session (command (file-append rc-init "/bin/rc-init")))))
      (map
       (lambda (i)
               (greetd-terminal-configuration (terminal-vt (number->string i))))
       (iota 7 2)))))))

  (set! %system-base-services
   (modify-services %system-base-services
    (delete login-service-type)
    (delete mingetty-service-type)))
  @end
* Implementation
  @code scheme
  (define-system
   (operating-system)
   (services %networking.ntp-sv %networking.nftables-sv %gui.greetd-sv)
   (users %system-users.root))
  (make-system
   '()
   (append (list %networking.ntp-sv %networking.nftables-sv %gui.greetd-sv)
           %system-base-services)
   (list %system-users.root))
  @end

A users/enderger.norg => users/enderger.norg +73 -0
@@ 0,0 1,73 @@
@document.meta
title: "User : Enderger"
tangle: ./enderger.scm
@end

* Prelude
  @code scheme
  (use-modules
   (srfi srfi-1)
   (gnu)
   (gnu home)
   (gnu packages shells)
   (gnu packages terminals)
   (hutzdog guix packages wrappers)
   (hutzdog guix services home shells)
   (hutzdog guix services home wm)
   (hutzdog guix lib))

  (define %user-packages '())
  (define* (add-user-packages! #:rest pkgs)
    (set! %user-packages (append pkgs %user-packages)))
  @end

* Account
  @code scheme
  (define %user-account
   (user-account
    (name "enderger")
    (group "enderger")
    (shell (file-append rc-login "/bin/rc-login"))))
  @end

* Shell
  @code scheme
  (define %rc-sv
   (service home-rc-service-type))

  (add-user-packages! foot rc)
  @end

* Window Manager
  @code scheme
  (define %river-config
   #~(begin
      (define* (riverctl #:rest args)
       (apply system* (cons "riverctl" args)))

      (define (river-map mode modifiers key action)
       (riverctl "map" (symbol->string mode) modifier (symbol->string key) action))

      (define %mod 'Super)
      (define* (modifier #:optional (key #f) #:key (mod %mod))
       (let ((pre (if key (string-append "+" (symbol->string key)) ""))
        (string-append (symbol->string mod) key))))

      (river-map 'normal (modifier) 'Return "spawn foot")
      (river-map 'normal (modifier 'Shift) 'C "close")
      (river-map 'normal (modifier 'Shift) 'Q "exit")))

  (define %river-sv
   (service home-river-service-type
    (home-river-configuration
     (config (list (program-file "river-init" %river-config))))))
  @end

* Implementation
  @code scheme
  (make-user
   %user-account
   (home-environment
    (services (list %rc-sv %river-sv))
    (packages %user-packages)))
  @end