;; -*- mode: scheme; -*-
;; This is an operating system configuration template
;; for a "desktop" setup with GNOME and Xfce where the
;; root partition is encrypted with LUKS, and a swap file.
(define-module (config))

(use-modules
 (nongnu packages linux)
 (nongnu system linux-initrd)
 (gnu)
 (gnu system privilege)
 (gnu packages admin)
 (gnu system nss)
 (guix derivations)
 (guix store)
 (guix monads)
 (guix utils)
 (guix packages)
 (guix build-system gnu)
 (ruther services system)
 (ruther bootloader grub))
(use-service-modules desktop sddm xorg base nix pm virtualization vpn sound dbus cups docker security-token)
(use-package-modules gnome package-management shells networking wm
                     vim wget curl bash compression glib
                     linux embedded finance python-xyz freedesktop
                     python-build haskell-apps commencement)

(define wireshark-patched
  (package/inherit wireshark
                  (source (origin
                            (inherit (package-source wireshark))
                            (patches (cons*
                                      (local-file "patches/wireshark.patch")
                                      (origin-patches (package-source wireshark))))))
                  (arguments
                   (substitute-keyword-arguments (package-arguments wireshark)
                     ((#:phases original-phases)
                      #~(modify-phases #$original-phases
                          (add-after 'qt-wrap 'unwrap-dumpcap
                            (lambda _
                              (delete-file (string-append #$output "/bin/dumpcap"))
                              (copy-file
                               (string-append #$output "/bin/.dumpcap-real")
                               (string-append #$output "/bin/dumpcap"))))))))))

(define %ruther/user
  (user-account
   (name "ruther")
   (comment "Rutherther")
   (group "users")
   (supplementary-groups '("wheel" "netdev"
                           "audio" "video"
                           "libvirt" "dialout"
                           "kvm"))
   (shell (file-append zsh "/bin/zsh"))))

;; Obsolete, only useful if just part of package's udev rules is desirable
;; (define (ruther/udev-rules-service name package rules-file)
;;   (udev-rules-service
;;    name
;;    (file->udev-rule rules-file
;;                     (file-append package "/lib/udev/rules.d/" rules-file))))

(define %ruther/udev-services
  (list
   (udev-rules-service 'kmonad kmonad)
   (udev-rules-service 'trezord trezord-udev-rules)
   (udev-rules-service 'openocd openocd)
   (udev-rules-service
    'brightness brightnessctl
    #:groups '("video"))

   (udev-rules-service
    'quartus-usbblaster
    (file->udev-rule "51-usbblaster.rules" (local-file "udev/51-usbblaster.rules")))
   (udev-rules-service
    'ftdi
    (file->udev-rule "51-ftdi.rules" (local-file "udev/51-ftdi.rules")))))

(define %ruther/container-virt-services
  (list
   (service containerd-service-type)
   (service docker-service-type)
   (service libvirt-service-type)
   (service qemu-binfmt-service-type
            (qemu-binfmt-configuration
             (platforms (lookup-qemu-platforms "arm" "aarch64"))))))

(define %ruther/network-services
  (list
   (service wireguard-service-type
            (wireguard-configuration
             (private-key "/etc/wireguard/private.key")
             (addresses '("192.168.32.25/32"))
             (peers
              (list
               (wireguard-peer
                (name "server")
                (endpoint "78.46.201.50:51820")
                (keep-alive 25)
                (public-key "ZOVjmgUak67kLhNVgZwyb0bro3Yi4vCJbGArv+35IWQ=")
                (allowed-ips '("192.168.32.0/24")))))))))

(define %ruther/laptop-gui-essential-services
  (list
   (service bluetooth-service-type)
   (service cups-service-type
            (cups-configuration
             (web-interface? #t)))
   (service power-profiles-daemon-service-type)

   (service screen-locker-service-type
            (screen-locker-configuration
             (name "swaylock")
             (program (file-append swaylock "/bin/swaylock"))
             (using-pam? #t)
             (using-setuid? #f)))
   ;; For starting blueman mechanism.
   ;; It needs privileges, so cannot be started from a user dbus session.
   (simple-service 'dbus-extras
                   dbus-root-service-type
                   (list blueman))))

(define %ruther/base-laptop-os
  (operating-system
    (kernel linux)
    (initrd microcode-initrd)
    (firmware (cons* linux-firmware
                     %base-firmware))
    (host-name "laptop-ruther")
    (timezone "Europe/Prague")
    (locale "en_US.utf8")

    ;; Choose US English keyboard layout.  The "altgr-intl"
    ;; variant provides dead keys for accented characters.
    (keyboard-layout (keyboard-layout "us" "altgr-intl"))

    ;; Use the UEFI variant of GRUB with the EFI System
    ;; Partition mounted on /boot/efi.
    (bootloader (bootloader-configuration
                 (bootloader grub-efi-copy-bootloader)
                 (targets '("/boot"))
                 (keyboard-layout keyboard-layout)))

    ;; Specify a mapped device for the encrypted root partition.
    ;; The UUID is that returned by 'cryptsetup luksUUID'.
    (mapped-devices
     (list (mapped-device
            (source (uuid "55787ccb-decb-46b6-a190-6597dff68c68"))
            (target "cryptedguix")
            (type luks-device-mapping))))

    (file-systems (append
                   (list (file-system
                           (device (file-system-label "guix-root"))
			                     ;; (device "/dev/mapper/cryptedguix")
                           (mount-point "/")
                           (type "ext4")
                           (dependencies mapped-devices))
                         (file-system
                           (device (file-system-label "BOOT"))
                           (mount-point "/boot")
                           (type "vfat")))
                   %base-file-systems))

    ;; Create user `bob' with `alice' as its initial password.
    (users (cons* %ruther/user
                  %base-user-accounts))

    ;; Add the `students' group
    (groups %base-groups)

    (privileged-programs
     (cons*
      (privileged-program
       (program
        (file-append wireshark-patched "/bin/dumpcap"))
       (capabilities "cap_net_raw,cap_net_admin=eip"))
      %default-privileged-programs))

    ;; This is where we specify system-wide packages.
    (packages (append (list
                       ;; for user mounts
                       gvfs
                       zip unzip
                       wget curl
                       vim
                       nix
                       wireshark-patched)
                      %base-packages))

    (services
     (append (list
              (service core-dumps-service-type)

              (service nix-service-type
                       (nix-configuration
                        (extra-config
                         '("experimental-features = nix-command flakes\n"
                           "extra-platforms = aarch64-linux"))))

              ;; Vivado or Matlab can crash because they open too many files
              (service pam-limits-service-type
                       (list
                        (pam-limits-entry "@wheel" 'hard 'nofile '50000)
                        (pam-limits-entry "@wheel" 'soft 'nofile '10000)
                        (pam-limits-entry "@wheel" 'both 'core 'unlimited)))
              (service pcscd-service-type)

              (simple-service 'nonguix-substitute
                              guix-service-type
                              (guix-extension
                               (authorized-keys (list (local-file "keys/nonguix-signing-key.pub")))
                               (substitute-urls '("https://substitutes.nonguix.org")))))

             %ruther/udev-services
             %ruther/container-virt-services
             %ruther/network-services
             %ruther/laptop-gui-essential-services

             (modify-services %desktop-services
               (delete gdm-service-type)
               (delete screen-locker-service-type)
               (mingetty-service-type config => (if (string=? (mingetty-configuration-tty config) "tty1")
                                                    (mingetty-configuration
                                                     (inherit config)
                                                     (auto-login "ruther")
                                                     (login-pause? #t))
                                                    config))
               (elogind-service-type config => (elogind-configuration
                                                (handle-lid-switch-external-power 'ignore)))
               (pulseaudio-service-type config => (pulseaudio-configuration
                                                   (inherit config)
                                                   (client-conf
                                                    (append
                                                     (pulseaudio-configuration-client-conf config)
                                                     '((autospawn . no)))))))))


    ;; Allow resolution of '.local' host names with mDNS.
    (name-service-switch %mdns-host-lookup-nss)))

(define (derivation->drv-name drv)
  (mlet* %store-monad
      ((drv drv))
    (return (derivation-file-name drv))))

(use-modules (srfi srfi-9)
             (ice-9 match)
             (guix records))

(define-record-type <non-grafted>
  (non-grafted derivation)
  non-grafted?
  (derivation non-grafted-derivation))

(define-gexp-compiler (non-grafted-compiler (non-grafted <non-grafted>) system target)
  (without-grafting (non-grafted-derivation non-grafted)))

(define-record-type* <drv-name>
  drv-name-record drv-name
  drv-name?
  (derivation drv-name-derivation)
  (override-grafts? drv-name-override-grafts?
                    (default #f)))

(define-gexp-compiler (drv-name-compiler (drv-name <drv-name>) system target)
  (let ((drv-name-store (derivation->drv-name (drv-name-derivation drv-name))))
    (if (drv-name-override-grafts? drv-name)
        (without-grafting drv-name-store)
        drv-name-store)))

(define <operating-system> (@@ (gnu system) <operating-system>))
(define-gexp-compiler (os-compiler (os <operating-system>) system target)
  (operating-system-derivation os))

;; Takes an operating system and gc roots its derivation
(define (operating-system-with-build-inputs os)
  (operating-system
    (inherit os)
    (services (operating-system-user-services os))
    (services
     (cons*
      (simple-service 'gc-root-system-derivation
                      gc-root-service-type
                      (list
                       (drv-name (operating-system-derivation os) #t)
                       (non-grafted (operating-system-derivation os))))
      (operating-system-user-services os)))))

(operating-system-with-build-inputs %ruther/base-laptop-os)