path: root/src/org/euandre/packages.scm

(define-module (org euandre packages)
  #:use-module ((guix licenses) #:prefix licenses:)
  #:use-module ((guix transformations) #:prefix transformations:)
  #:use-module ((ice-9 match) #:prefix m:)
  #:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
  #:use-module ((org euandre queue) #:prefix q:)
  #:use-module ((srfi srfi-1) #:prefix s1:)
  #:use-module (gnu)
  #:use-module (guix build-system gnu)
  #:use-module (guix git-download)
  #:use-module (guix least-authority)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix utils)
  #:export (<syskeep-configuration>
             syskeep-configuration
        make-syskeep-configuration
             syskeep-configuration?
             syskeep-configuration-package
             syskeep-configuration-log-file

            <git-configuration>
             git-configuration
        make-git-configuration
             git-configuration?
             git-configuration-package
             git-configuration-user
             git-configuration-group
             git-configuration-export-all?
             git-configuration-base-path
             git-configuration-user-path
             git-configuration-run-in-container?
             git-configuration-container-name

            <binder-configuration>
             binder-configuration
        make-binder-configuration
             binder-configuration?
             binder-configuration-name
             binder-configuration-package
             binder-configuration-user
             binder-configuration-group
             binder-configuration-log-file
             binder-configuration-data-directory
             binder-configuration-run-directory
             binder-configuration-run-in-container?
             binder-configuration-container-name
             binder-configuration-options
             binder-configuration-listen-socket
             binder-configuration-upstream-socket

            <glaze-configuration>
             glaze-configuration
        make-glaze-configuration
             glaze-configuration?
             glaze-configuration-name
             glaze-configuration-package
             glaze-configuration-user
             glaze-configuration-group
             glaze-configuration-log-file
             glaze-configuration-data-directory
             glaze-configuration-run-directory
             glaze-configuration-run-in-container?
             glaze-configuration-container-name
             glaze-configuration-options
             glaze-configuration-listen-socket
             glaze-configuration-upstream-socket

            <hsts-configuration>
             hsts-configuration
        make-hsts-configuration
             hsts-configuration?
             hsts-configuration-name
             hsts-configuration-package
             hsts-configuration-user
             hsts-configuration-group
             hsts-configuration-log-file
             hsts-configuration-data-directory
             hsts-configuration-run-directory
             hsts-configuration-run-in-container?
             hsts-configuration-container-name
             hsts-configuration-options
             hsts-configuration-listen-socket
             hsts-configuration-upstream-socket

            <untls-configuration>
             untls-configuration
        make-untls-configuration
             untls-configuration?
             untls-configuration-name
             untls-configuration-package
             untls-configuration-user
             untls-configuration-group
             untls-configuration-log-file
             untls-configuration-data-directory
             untls-configuration-run-directory
             untls-configuration-run-in-container?
             untls-configuration-container-name
             untls-configuration-options
             untls-configuration-listen-socket
             untls-configuration-upstream-socket

            <wscat-configuration>
             wscat-configuration
        make-wscat-configuration
             wscat-configuration?
             wscat-configuration-name
             wscat-configuration-package
             wscat-configuration-user
             wscat-configuration-group
             wscat-configuration-log-file
             wscat-configuration-data-directory
             wscat-configuration-run-directory
             wscat-configuration-run-in-container?
             wscat-configuration-container-name
             wscat-configuration-options
             wscat-configuration-listen-socket
             wscat-configuration-upstream-socket

            <cicd-configuration>
             cicd-configuration
        make-cicd-configuration
             cicd-configuration?
             cicd-configuration-name
             cicd-configuration-package
             cicd-configuration-user
             cicd-configuration-group
             cicd-configuration-log-file
             cicd-configuration-data-directory
             cicd-configuration-run-directory
             cicd-configuration-run-in-container?
             cicd-configuration-container-name

            <papod-configuration>
             papod-configuration
        make-papod-configuration
             papod-configuration?
             papod-configuration-name
             papod-configuration-package
             papod-configuration-user
             papod-configuration-group
             papod-configuration-log-file
             papod-configuration-data-directory
             papod-configuration-run-directory
             papod-configuration-run-in-container?
             papod-configuration-container-name
             papod-configuration-options
             papod-configuration-listen-socket
             papod-configuration-upstream-socket

             fmt
             str
             service-type-for))
(use-package-modules
  admin
  bittorrent
  guile
  texinfo
  version-control)
(use-service-modules
  admin
  mcron
  shepherd
  sysctl)



(define-public (mklist x)
  (if (not x)
    '()
    (if (pair? x)
      x
      (list x))))

(define-public (slurp path)
  (call-with-input-file
   path
   textual-ports:get-string-all))

(define-public (str . rest)
  (apply string-append rest))

(define-public (fmt . rest)
  (apply format #f rest))



(define-public mktorrent-latest
  ((transformations:options->transformation
    '((with-commit . "mktorrent=de7d011b35458de1472665f50b96c9cf6c303f39")))
   mktorrent))


(define-public (pkg name version checksum)
  (package
    (name name)
    (version version)
    (source
      (origin
        (method git-fetch)
        (uri
          (git-reference
            (url
              (str "git://euandre.org/" name))
            (commit version)))
        (sha256
          (base32 checksum))
        (file-name
          (git-file-name name version))))
    (build-system gnu-build-system)
    (arguments
      (list
       #:strip-binaries? #f
       #:make-flags
       #~(list
          "-e"
          (string-append "CC="      #$(cc-for-target))
          (string-append "PREFIX="  #$output)
          (string-append "VERSION=" #$version))
       #:phases
       #~(modify-phases %standard-phases
           (delete 'configure))))
    (synopsis    #f) ;; FIXME: get
    (description #f) ;;        from tarball!
    (home-page (str "https://euandre.org/s/" name "/"))
    (license licenses:agpl3+)))


(define-public eut
  (pkg
   "eut"
   "ec7e36c2eb4a05c188fd222a1a775ef6f55be6b8"
   "1knz14jkx8yc7fv5m2apshfsn3xym55vb78wx3kgq061jy58nxfd"))

(define-public remembering
  (pkg
   "remembering"
   "e1570edd3cdaa040f9664adb315f72e33f8b67c2"
   "0y20flrbjh5gbbzl7h3rimg8jwy2ikgkj03yxclj8qg8mq2f9f4a"))

(define-public cage
  (pkg
   "cage"
   "c0482531fc16a55715b759b695d27d555d927ab8"
   "1v5m7xqfb14y283mlc2kd714hnih1dwcmjcf4i6j52pphjscilys"))

(define-public nicely
  (pkg
   "nicely"
   "ea9716ff211699b19493ffdcab3778b1b21c2ad3"
   "027vv0bgw4hd9m20bw77c14hqgh1ihvl92bvg89678zxsnmi3ai4"))

(define-public q
  (pkg
   "q"
   "d13bcb36bc84de95ebb9e8c27605c09b08c35cc5"
   "1jbg9f6dwkkcjxbhc3a1pnaas6xgd1f0hiv95h6hchgs88phwssl"))

(define-public syskeep
  (pkg
   "syskeep"
   "2215cc0999e43b32751bc493f2fe9d2e8c822170"
   "0p38fb8m35kjp9fj7bmwcayf9r4638q5fcin18ny7y65scij4jbb"))

(define-public backupit
  (pkg
   "backupit"
   "3e9c89562d566e72cbaa53db3b1d0dfa8050b1f9"
   "0ayfp9564jggf02zniqay1sb0q0ff94zwxp6p7ps1g2ir2bxm4nm"))

(define-public cicd
  (pkg
   "cicd"
   "63d46fe31f3ae7b7eed1a2c801448160fe9e77d8"
   "00brrbm6s45nqpbw2sigcwjwj2dgyl0rvagmgrgj930y9qv2nn31"))

(define-public guile-heredoc
  (package
    (inherit
      (pkg
       "guile-heredoc"
       "065435cdce609604e33b879b9be3e81ab89f3e7b"
       "179qq17mgi4kakhj9w1dk26afljh5yad4j9ih9d8wms70x6h211m"))
    (native-inputs
      (list
       guile-3.0
       texinfo))))

(define-public adoc
  (package
    (inherit
      (pkg
       "adoc"
       "fab32a816259c943802ffa4c041ac63ac34e646a"
       "04sk5bafw2h969v4fl9qzc67m4sjdlrw87xdliv7rny7v9d53zi8"))
    (propagated-inputs
      (append
       (format-inputs     (list eut))
       (normalize-inputs '(ruby-asciidoctor tidy-html))))))

(define-public eslaides
  (pkg
   "eslaides"
   "40eb0452fd7689d1c40e4d53c1473fd42195cc49"
   "0g4qdcfmk8asi1fzr1yk8khpngg9cg21i14xblxfisqsfaq5jycb"))

(define-public mkwb
  (package
    (inherit
      (pkg
       "mkwb"
       "1c36a265c6b34c28c424eb0bc11ba3b0f9b932d0"
       "1w8f3rsncxrb383i7pwg8bxrijvvg7q2l6b0fgjfdv1rs4xzlmqw"))
    (propagated-inputs
      (format-inputs (list eut adoc eslaides)))))

(define-public (mkwbsite pkg)
  (package
    (inherit pkg)
    (native-inputs
      (append
       (format-inputs     (list mkwb mktorrent-latest))
       (normalize-inputs '(gnupg jq rsync po4a gettext ghostscript moreutils))))
    (arguments
      (substitute-keyword-arguments (package-arguments pkg)
        ((#:phases phases)
         #~(modify-phases #$phases
             (add-before 'build 'sethome-ghostscript
               (lambda _
                 (setenv "HOME" (getcwd))))))))))

(define-public euandre.org
  (mkwbsite
   (pkg
    "euandre.org"
    "6e493d66649925fccaa351f65ee6cac2dedf264f"
    "05isnj2mmwg6k1qd94r3yaycy556f5d7br3f2vdmriqazrgj0grg")))

(define-public papo.im
  (mkwbsite
   (pkg
    "papo.im"
    "fa07fa576e07b4cc6b7c9123bd3a6c91e6afc609"
    "084w89v15nmr45nv9av8pz7iq99aw3ggaxr0gzqfjbskb3wvvkml")))


(define-public (format-inputs l)
  (map (lambda (p)
         (list (package-name p)
               p
               "out"))
       l))

(define-public (normalize-inputs l)
  (map (compose (lambda (l)
                  (cons (package-name (car l))
                        l))
                list
                specification->package+output
                symbol->string)
       l))

(define-public (gopkgbs name inputs version checksum)
  (let ((p (pkg name version checksum)))
    (package
      (inherit p)
      (arguments
        (substitute-keyword-arguments (package-arguments p)
          ((#:phases phases)
           #~(modify-phases #$phases
               (add-before 'build 'setenv-golang
                 (lambda _
                   (define (path->flags option)
                     (let ((search-path (getenv "GOLIBPACKPATH")))
                       (string-join
                        (map (lambda (path)
                               (string-append option " " path))
                             (if search-path
                               (string-split search-path #\:)
                               '()))
                        " ")))
                   (setenv "GOCFLAGS"  (path->flags "-I"))
                   (setenv "GOLDFLAGS" (path->flags "-L"))))))))
      (native-inputs
        (append
         (format-inputs
          (list
           eut
           q:gol))
         (normalize-inputs
          '(gettext
            po4a
            ruby-asciidoctor))
         inputs))
      (native-search-paths
        (list
         (search-path-specification
           (variable "GOLIBPACKPATH")
           (files
             (list "lib/go"))))))))


(define-public gotext
  (gopkgbs
   "gotext"
   (format-inputs (list))
   "3556c9e1160d7df98cc3c2cf0664dbaed0463ee9"
   "0cjxl85hn7lwcghx5y5z80nz1ph3dgqb735w0cn7bnnmvjx2gdik"))

(define-public uuid
  (gopkgbs
   "uuid"
   (format-inputs (list gotext))
   "2684130e288a59edafa9ba86dadcfaa5e6aeb11e"
   "0r21lp7cvba00fxakxvx56xz9295z01az48h16bqxh94811fp1nw"))

(define-public gobang
  (gopkgbs
   "gobang"
   (format-inputs (list gotext uuid))
   "841e469c27de156bb956532c4724500eb1630e4b"
   "1amsmwzgbgy8x0rk2pz3nj0fiwkvvin1sqihf6pgbxa53v72hpal"))


(define-public (gopkg name inputs version checksum)
  (gopkgbs
   name
   (append inputs (format-inputs (list gotext uuid gobang)))
   version
   checksum))


(define-public pds
  (gopkg
   "pds"
   (format-inputs (list))
   "a45c6775b73fbd3ae609023056d28f0f71177ee9"
   "01pdfssmf8wlcgk4k0lrsd86bk4psw3dap2b9n22fgmi21gxlm3i"))

(define-public urubu
  (gopkg
   "urubu"
   (format-inputs (list))
   "0a31f4cf617a1c8b0ccce4d96d314c889dea849c"
   "0vksj4nlllib6szxq1pnz8hi873kjlfvflibgya2bvzpmlywx56k"))

(define-public stm
  (gopkg
   "stm"
   (format-inputs (list pds))
   "9087ba4198c81d7e2730783dbf270d86413ae9c8"
   "10x52w1p7yzpkr6dsi5m0h1689y9hd51n311vrlj4k4q8r09dhza"))

(define-public scrypt
  (gopkg
   "scrypt"
   (format-inputs (list q:scryptkdf))
   "eb9b9245bf39df8a785e5b83e7b3745ea9d4d10f"
   "03bzxswhwjm7yxlrqiip3jil8spa07fi6a5z78ashrr0mc96n1s6"))

(define-public golite
  (gopkg
   "golite"
   (format-inputs (list q:sqlitex))
   "daf867ca73d0aca6f772d5116d8488dfe020faaf"
   "1aj83anig5s9ifbv4cw6f0wsv3fhhldf4hzk7g2ii0cbznckmqzs"))

(define-public fiinha
  (gopkg
   "fiinha"
   (format-inputs (list q:sqlitex golite))
   "f5f3e314355f752b1f39bfd479fe5ab5a81033b5"
   "0icvq228spi1qgw52pvnv2h0hlj5rxbvv8ii6ldrf95cgivg86hy"))

(define-public cracha
  (gopkg
   "cracha"
   (format-inputs (list q:sqlitex golite q:scryptkdf scrypt fiinha))
   "564f9a7f3ba11cfa0a7bca0e56ad6f24f90f3467"
   "1q9hjphvwzn0ng715f3j6p2gdzgmh0dfra0az6cn49ifaby845r5"))

(define-public binder
  (gopkg
   "binder"
   (normalize-inputs '(socat lsof))
   "ea54b066c8af604c0ba0aa4146c1eb93f1ed1d7b"
   "1kvkqk0k24b39yjii04vm8b8xvw18dllxra4239zb3mf87d5x3j3"))

(define-public glaze
  (gopkg
   "glaze"
   (format-inputs (list))
   "8e60a5a0cb59850b040f379b2b2e63fc761e48dc"
   "0pa063yzhvd1mzvcvxpl8rldkh6jblww4rncv28wdmbwi27bbbac"))

(define-public hsts
  (gopkg
   "hsts"
   (format-inputs (list))
   "68e6fb58a0f2e69500d716a68c7aa8c97be33d87"
   "069v8pwd8c6r803ya5r4bgfxj6mgll5xbmch0dlbn71gh2ps0mak"))

(define-public untls
  (gopkg
   "untls"
   (format-inputs (list))
   "435186b68541103c73c6a4653a814d1ed6a80152"
   "06c06qy6vh6gfk42brv3zrx6sd6n5wi1sgb1918cqbcmylhygp7y"))

(define-public wscat
  (gopkg
   "wscat"
   (format-inputs (list))
   "093aae2c0fd5af0afd51d4e1bab2677891248acd"
   "0z69az2a89n22v5f5pisajbf51whr33a43vbmc0jyzdlschn5hvl"))

(define-public gistatic
  (gopkg
   "gistatic"
   (format-inputs (list))
   "2171a9ce7d03c75e20754536c603cad401919dfa"
   "10459is48i21iry3kamdl7cr88smw172bw7s0s8k30n9b4sm6f0q"))

(define-public chat.papo.im
  (package
    (inherit
      (pkg
       "chat.papo.im"
       "f9c959b2d8e36460395a425a51d480fac635c5ec"
       "0h2y0kdfzpsgi64zi7brnj1p0dqz0fx4ksvy57wakr7pvv6rpf64"))
    (native-inputs
      (normalize-inputs '(node)))))

(define-public papod
  (gopkg
   "papod"
   (format-inputs
    (list stm pds golite q:sqlitex scrypt q:scryptkdf fiinha cracha))
   "ecd7797abb3b43226532b0bace7ba9f1e5ac277d"
   "1570gn5rqx8h84jf3qb0qxdb08449ig26vsyj6ccp3m4h8z0vcfn"))



(define-public (user-accounts users)
  (map (lambda (user)
         (let ((name    (s1:first  user))
               (comment (s1:second user))
               (groups  (s1:third  user)))
           (user-account
             (name name)
             (comment comment)
             (group "users")
             (supplementary-groups groups))))
       users))

(define-public (users->keys users)
  (let ((users-with-keys (filter (compose not null? cdddr)
                                 users)))
    (append
     (map (lambda (user)
            (let ((name (s1:first  user))
                  (key  (s1:fourth user)))
              `(,name ,(plain-file (str name "-id_rsa.pub")
                                   (slurp key)))))
          users-with-keys)
    `(("git" ,@(map (lambda (user)
                      (let ((name (s1:first  user))
                            (key  (s1:fourth user)))
                        (plain-file (str name "-git-id_rsa.pub")
                                    (slurp key))))
                    users-with-keys))))))

(define (tuple->entry tuple)
  (let* ((name    (s1:first  tuple))
         (package (s1:second tuple))
         (path    (str "/etc/" name)))
    (list
     name
     (computed-file
      (str "syskeep-" name)
      #~(begin
          (use-modules
            ((ice-9 textual-ports) #:prefix textual-ports:))

          (define (slurp p)
            (call-with-input-file p textual-ports:get-string-all))

          (define (spit p s)
            (call-with-output-file
             p
             (lambda (port)
               (display s port))))

          (spit #$output
                (slurp #$(file-append package path))))))))

(define (etc-entries package paths)
  (let ((tuples (map (lambda (path)
                       (list path package))
                     paths)))
    (map tuple->entry tuples)))

(define-public (package-set symbols records)
  (append
   %base-packages
   records
   (map
    (compose list specification->package+output symbol->string)
    symbols)))

(define-public skeletons
  (etc-entries
   syskeep
   '(".profile")))

(define-public base-services
  (append
   (list
#;
    (service fail2ban-service-type))
   %base-services))

(define-public (activation-gexp name user log-file data-directory run-directory)
  #~(begin
      (use-modules (guix build utils))
      (when #$log-file
        (format (current-error-port)
         "Creating ~a log directory for \"~a\".~%" #$name #$log-file)
        (mkdir-p (dirname #$log-file))
        (when (not (file-exists? #$log-file))
          (call-with-output-file #$log-file (const #t)))
        (chmod #$log-file #o644))
      (let ((user (getpwnam #$user)))
        (when #$data-directory
          (format (current-error-port)
           "Creating ~a data directory \"~a\".~%" #$name #$data-directory)
          (mkdir-p #$data-directory)
          (chown #$data-directory (passwd:uid user) (passwd:gid user))
          (chmod #$data-directory #o750))
        (when #$run-directory
          (format (current-error-port)
           "Creating ~a run directory \"~a\".~%" #$name #$run-directory)
          (mkdir-p #$run-directory)
          (chown #$run-directory (passwd:uid user) (passwd:gid user))
          (chmod #$run-directory #o755)))))



(define-record-type* <syskeep-configuration>
  syskeep-configuration
  make-syskeep-configuration
  syskeep-configuration?
  (package              syskeep-configuration-package              (default syskeep))
  (tld                  syskeep-configuration-tld                  (default #f))
  (secrets-user         syskeep-configuration-secrets-user         (default        "secrets-keeper"))
  (secrets-group        syskeep-configuration-secrets-group        (default        "secrets-keeper"))
  (become-secrets-group syskeep-configuration-become-secrets-group (default "become-secrets-keeper"))
  (log-file             syskeep-configuration-log-file             (default "/var/log/cronjobs/cronjobs.log")))

(define (syskeep-profile config)
  (match-record config <syskeep-configuration>
      (package)
    (package-set
     '(parted
       glibc-locales
       guile-heredoc
       acl
       bind:utils
       knot:tools
       certbot
       jq
       file
       git
       lsof
       moreutils
       mailutils-sendmail
       curl
       make
       borg
       pv
       rsync
       sqlite
       strace
       rlwrap
       trash-cli
       tree)
      (list
       backupit
       eut
       nicely
       package))))

(define (syskeep-rotations config)
  (match-record config <syskeep-configuration>
      (log-file)
    (list
#;
     (log-rotation
       (frequency 'weekly)
       (files (list log-file))
       (options '("rotate 52"))))))

(define (syskeep-cronjobs config)
  (match-record config <syskeep-configuration>
      ()
    (list
     #~(job "0 0 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backupit -q cron")
     #~(job "0 1 * * *" "cronjob                                backupit -q cron")
     #~(job "0 2 * * *" "cronjob reconfigure")
     #~(job "0 3 * * 0" "cronjob gc")
     #~(job "0 4 * * *" "cronjob guix pull -v3")
     #~(job "0 5 * * 0" "cronjob reconfigure")
     #~(job "0 5 * * *" "cronjob check"))))

(define (syskeep-etc-files config)
  (match-record config <syskeep-configuration>
      (package)
    (etc-entries
     package
     '("rc.sh"
       "backupit.txt"
       "ssh.conf"
       "init.scm"
       "gitconfig"))))

(define (syskeep-accounts config)
  (match-record config <syskeep-configuration>
      (secrets-user secrets-group become-secrets-group)
    (list
     (user-account
       (name secrets-user)
       (group secrets-group)
       (system? #t)
       (comment "System account used to manage production secrets")
       (home-directory "/var/empty")
       (create-home-directory? #f)
       (shell
         (file-append shadow "/sbin/nologin")))
     (user-group
       (name secrets-group)
       (system? #t))
     (user-group
       (name become-secrets-group)
       (system? #t)))))

(define (syskeep-activation config)
  (match-record config <syskeep-configuration>
      (tld log-file)
    (let ((privkey-path (fmt "../../opt/secrets/root@~a.id_rsa.txt" tld)))
      #~(begin
          #$(activation-gexp "syskeep" "root" log-file #f #f)
          (define (dir target)
            (format (current-error-port)
             "Creating directory: \"~a\".~%" target)
            (mkdir-p target))
          (define (link from to)
            (format (current-error-port)
             "Symlink: \"~a\" -> \"~a\".~%" to from)
            (when (file-exists? to)
              (delete-file to))
            (symlink from to))
          (dir "/var/crash")
          (chmod "/var/crash" #o777)
          (link    "mnt/production/opt"  "/opt")
          (link    "mnt/production/srv"  "/srv")
          (link "../mnt/production/mail" "/var/mail")
          (dir "/root/.ssh")
          (link #$privkey-path          "/root/.ssh/id_rsa")
          (link "../../etc/ssh.conf"    "/root/.ssh/config")
          (link "../../etc/id_rsa.pub"  "/root/.ssh/id_rsa.pub")
          (link "../../etc/known_hosts" "/root/.ssh/known_hosts")))))

(define-public (syskeep-sysctl _config)
  '(("kernel/core_pattern" . "/var/crash/core-%t-%e-%p-%s-%u-%g")))

(define-public syskeep-sudoers-file
  (plain-file "sudoers-syskeep" "\
root                   ALL=(ALL)                      ALL
%wheel                 ALL=                           ALL
%wheel                 ALL=                 NOPASSWD: /run/current-system/profile/bin/reconfigure, /run/current-system/profile/bin/herd
%become-secrets-keeper ALL=(secrets-keeper) NOPASSWD: /run/current-system/profile/bin/rsync, /run/current-system/profile/bin/setfacl, /run/current-system/profile/bin/rm
%git                   ALL=(cicd)           NOPASSWD: /run/current-system/profile/bin/cicd
"))

(define-public syskeep-service-type
  (service-type
    (name 'syskeep)
    (extensions
      (list
       (service-extension log-rotation-service-type
                          syskeep-rotations)
       (service-extension mcron-service-type
                          syskeep-cronjobs)
       (service-extension etc-service-type
                          syskeep-etc-files)
       (service-extension account-service-type
                          syskeep-accounts)
       (service-extension activation-service-type
                          syskeep-activation)
       (service-extension sysctl-service-type
                          syskeep-sysctl)
       (service-extension profile-service-type
                          syskeep-profile)))
    (default-value (syskeep-configuration))
    (description "Common configuration of maintained servers.")))



(define-record-type* <git-configuration>
  git-configuration
  make-git-configuration
  git-configuration?
  (package           git-configuration-package           (default git))
  (user              git-configuration-user              (default "git"))
  (group             git-configuration-group             (default "git"))
  (export-all?       git-configuration-export-all?       (default #f))
  (base-path         git-configuration-base-path         (default "/srv/git"))
  (user-path         git-configuration-user-path         (default #f))
  (run-in-container? git-configuration-run-in-container? (default #f))
  (container-name    git-configuration-container-name    (default "git-container"))
  (run-server?       git-configuration-run-server?       (default #f)))

(define-public (git-command config)
  (match-record config <git-configuration>
      (package user group base-path run-in-container? container-name)
    (let ((bin (file-append package "/bin/git")))
      (if (not run-in-container?)
        bin
        (least-authority-wrapper
         bin
         #:user      user
         #:group     group
         #:name      container-name
         #:directory base-path
         #:preserved-environment-variables
         '()
         #:mappings
         (list
          (file-system-mapping
            (source base-path)
            (target source)
            (writable? #t))))))))

(define-public (git-shepherd-services config)
  (match-record config <git-configuration>
      (user group export-all? base-path user-path run-server?)
    (if (not run-server?)
      (list)
      (list
       (shepherd-service
         (provision '(git))
         (requirement '(networking))
         (start
           #~(make-forkexec-constructor
              (list #$(git-command config)
                    "daemon" "--syslog" "--reuseaddr"
                    #$@(mklist (and export-all? "--export-all"))
                    #$@(mklist (and base-path (str "--base-path=" base-path)))
                    #$@(mklist (and user-path (str "--user-path=" user-path))))
              #:user  #$user
              #:group #$group))
         (documentation "Daemon process of the git:// protocol."))))))

(define-public (git-accounts config)
  (match-record config <git-configuration>
      (user group base-path)
    (list
     (user-account
       (name user)
       (group group)
       (system? #t)
       (comment "External SSH Git service user")
       (home-directory base-path)
       (create-home-directory? #f))
     (user-group
       (name group)
       (system? #t)))))

(define-public git-service-type
  (service-type
    (name 'git)
    (extensions
      (list
       (service-extension shepherd-root-service-type
                          git-shepherd-services)
       (service-extension account-service-type
                          git-accounts)
       (service-extension profile-service-type
                          (compose list git-configuration-package))))
    (default-value (git-configuration))
    (description "Better git:// service.")))



(define-record-type* <binder-configuration>
  binder-configuration
  make-binder-configuration
  binder-configuration?
  (name              binder-configuration-name              (default "binder"))
  (package           binder-configuration-package           (default binder))
  (user              binder-configuration-user              (default "binder"))
  (group             binder-configuration-group             (default "binder"))
  (log-file          binder-configuration-log-file          (default "/var/log/binder/binder.log"))
  (data-directory    binder-configuration-data-directory    (default #f))
  (run-directory     binder-configuration-run-directory     (default "/var/run/binder"))
  (run-in-container? binder-configuration-run-in-container? (default #t))
  (container-name    binder-configuration-container-name    (default "binder-container"))
  (options           binder-configuration-options           (default '()))
  (listen-socket     binder-configuration-listen-socket     (default "0.0.0.0:4443"))
  (upstream-socket   binder-configuration-upstream-socket   (default "/var/run/untls/untls.socket")))

(define-record-type* <glaze-configuration>
  glaze-configuration
  make-glaze-configuration
  glaze-configuration?
  (name              glaze-configuration-name              (default "glaze"))
  (package           glaze-configuration-package           (default glaze))
  (user              glaze-configuration-user              (default "glaze"))
  (group             glaze-configuration-group             (default "glaze"))
  (log-file          glaze-configuration-log-file          (default "/var/log/glaze/glaze.log"))
  (data-directory    glaze-configuration-data-directory    (default "/var/lib/glaze"))
  (run-directory     glaze-configuration-run-directory     (default "/var/run/glaze"))
  (run-in-container? glaze-configuration-run-in-container? (default #t))
  (container-name    glaze-configuration-container-name    (default "glaze-container"))
  (options           glaze-configuration-options           (default '()))
  (listen-socket     glaze-configuration-listen-socket     (default "/var/run/glaze/glaze.socket"))
  (upstream-socket   glaze-configuration-upstream-socket   (default #f)))

(define-record-type* <hsts-configuration>
  hsts-configuration
  make-hsts-configuration
  hsts-configuration?
  (name              hsts-configuration-name              (default "hsts"))
  (package           hsts-configuration-package           (default hsts))
  (user              hsts-configuration-user              (default "hsts"))
  (group             hsts-configuration-group             (default "hsts"))
  (log-file          hsts-configuration-log-file          (default "/var/log/hsts/hsts.log"))
  (data-directory    hsts-configuration-data-directory    (default #f))
  (run-directory     hsts-configuration-run-directory     (default "/var/run/hsts"))
  (run-in-container? hsts-configuration-run-in-container? (default #t))
  (container-name    hsts-configuration-container-name    (default "hsts-container"))
  (options           hsts-configuration-options           (default '()))
  (listen-socket     hsts-configuration-listen-socket     (default "/var/run/hsts/hsts.socket"))
  (upstream-socket   hsts-configuration-upstream-socket   (default #f)))

(define-record-type* <untls-configuration>
  untls-configuration
  make-untls-configuration
  untls-configuration?
  (name              untls-configuration-name              (default "untls"))
  (package           untls-configuration-package           (default untls))
  (user              untls-configuration-user              (default "untls"))
  (group             untls-configuration-group             (default "untls"))
  (log-file          untls-configuration-log-file          (default "/var/log/untls/untls.log"))
  (data-directory    untls-configuration-data-directory    (default #f))
  (run-directory     untls-configuration-run-directory     (default "/var/run/untls"))
  (run-in-container? untls-configuration-run-in-container? (default #t))
  (container-name    untls-configuration-container-name    (default "untls-container"))
  (options           untls-configuration-options           (default '()))
  (listen-socket     untls-configuration-listen-socket     (default "/var/run/untls/untls.socket"))
  (upstream-socket   untls-configuration-upstream-socket   (default #f)))

(define-record-type* <wscat-configuration>
  wscat-configuration
  make-wscat-configuration
  wscat-configuration?
  (name              wscat-configuration-name              (default "wscat"))
  (package           wscat-configuration-package           (default wscat))
  (user              wscat-configuration-user              (default "wscat"))
  (group             wscat-configuration-group             (default "wscat"))
  (log-file          wscat-configuration-log-file          (default "/var/log/wscat/wscat.log"))
  (data-directory    wscat-configuration-data-directory    (default #f))
  (run-directory     wscat-configuration-run-directory     (default "/var/run/wscat"))
  (run-in-container? wscat-configuration-run-in-container? (default #t))
  (container-name    wscat-configuration-container-name    (default "wscat-container"))
  (options           wscat-configuration-options           (default '()))
  (listen-socket     wscat-configuration-listen-socket     (default "/var/run/wscat/wscat.socket"))
  (upstream-socket   wscat-configuration-upstream-socket   (default "/var/run/papod/papod.socket")))

(define-public (profile-for config-type)
  (lambda (config)
    (m:match config
      (($ config-type _name package)
       (list package)))))

(define-public (rotations-for config-type)
  (lambda (config)
    (m:match config
      (($ config-type _name _package _user _group log-file)
       (list
#;
         (log-rotation
           (frequency 'weekly)
           (files (list log-file))
           (options '("rotate 5200"))))))))

(define-public (activation-for config-type)
  (lambda (config)
    (m:match config
      (($ config-type name _package user _group log-file data-directory
          run-directory)
       (activation-gexp name user log-file data-directory run-directory)))))

(define-public (accounts-for config-type)
  (lambda (config)
    (m:match config
      (($ config-type name _package user group)
       (list
        (user-group
          (name group)
          (system? #t))
        (user-account
          (name user)
          (group group)
          (system? #t)
          (comment (format #f "The user for runtime execution of ~a code" name))
          (home-directory "/var/empty")
          (create-home-directory? #f)
          (shell
            (file-append shadow "/sbin/nologin"))))))))

(define-public (cmd-for config-type config)
  (m:match config
    (($ config-type name package user group _log-file data-directory
        _run-directory run-in-container? container-name)
     (let ((bin (file-append package (str "/bin/" name))))
       (if (not run-in-container?)
         bin
         (least-authority-wrapper
          bin
          #:user      user
          #:group     group
          #:name      container-name
          #:directory (or data-directory "/")
          #:preserved-environment-variables
          '()
          #:mappings
          (mklist
           (and data-directory
                (file-system-mapping
                  (source data-directory)
                  (target source)
                  (writable? #t))))))))))

(define-public (shepherd-services-for config-type)
  (lambda (config)
    (m:match config
      (($ config-type name _package user group log-file data-directory
          _run-directory _run-in-container? _container-name options
          listen-socket upstream-socket)
       (list
        (shepherd-service
          (provision (list (string->symbol name)))
          (requirement '(networking))
          (auto-start? #f)
          (start
            #~(make-forkexec-constructor
               (list #$(cmd-for config-type config)
                     #$@options
                     #$@(mklist listen-socket)
                     #$@(mklist upstream-socket))
               #:user      #$user
               #:group     #$group
               #:log-file  #$log-file
               #:directory #$data-directory))
          (documentation
            (fmt "The Shepherd service that runs the server via \"~a\"." name))))))))

(define-public (service-type-for name config-type config extensions)
  (service-type
    (name name)
    (extensions
      (append
       (list
        (service-extension shepherd-root-service-type
                           (shepherd-services-for config-type))
        (service-extension profile-service-type
                           (profile-for config-type))
        (service-extension activation-service-type
                           (activation-for config-type))
        (service-extension account-service-type
                           (accounts-for config-type))
        (service-extension log-rotation-service-type
                           (rotations-for config-type)))
       extensions))
    (default-value config)
    (description
      (fmt "The top-level generic system service, generated for ~a code.

It includes:
- the Shepherd service for starting, stopping and reloading the service;
- activation script for setting up the initial directories and permissions;
- the group and account for running the production service;
- log management (storage and rotation) for logs produced by the running services.

The default configuration should provide sane values for all of these."
       name))))

(define-public (without-shepherd-services lst)
  (filter (lambda (extension)
            (not (eq? shepherd-root-service-type
                      (service-extension-target extension))))
          lst))

(define-public (replacing-shepherd-services service fn)
  (service-type
    (inherit service)
    (extensions
      (append
       (without-shepherd-services
        (service-type-extensions service))
       (list
        (service-extension shepherd-root-service-type
                           fn))))))

(define-public (with-services-from-args service config-type args)
  (replacing-shepherd-services
   service
   (lambda (config)
     (m:match config
       (($ config-type _name _package user group log-file data-directory)
        (map (lambda (tuple)
               (let ((provision (s1:first  tuple))
                     (args      (s1:second tuple)))
                 (shepherd-service
                   (provision provision)
                   (requirement '(networking))
                   (auto-start? #f)
                   (start
                     #~(make-forkexec-constructor
                        (list #$(cmd-for config-type config)
                              #$@args)
                        #:user      #$user
                        #:group     #$group
                        #:log-file  #$log-file
                        #:directory #$data-directory)))))
             args))))))



(define-public binder-service-type
  (service-type-for 'binder <binder-configuration> (binder-configuration) '()))

(define-public glaze-service-type
  (service-type-for 'glaze  <glaze-configuration>  (glaze-configuration)  '()))

(define-public hsts-service-type
  (service-type-for 'hsts   <hsts-configuration>   (hsts-configuration)   '()))

(define-public untls-service-type
  (service-type-for 'untls  <untls-configuration>  (untls-configuration)  '()))

(define-public wscat-service-type
  (service-type-for 'wscat  <wscat-configuration>  (wscat-configuration)  '()))



(define-record-type* <cicd-configuration>
  cicd-configuration
  make-cicd-configuration
  cicd-configuration?
  (name              cicd-configuration-name              (default "cicd"))
  (package           cicd-configuration-package           (default cicd))
  (user              cicd-configuration-user              (default "cicd"))
  (group             cicd-configuration-group             (default "cicd"))
  (log-file          cicd-configuration-log-file          (default "/var/log/cicd/cicd.log"))
  (data-directory    cicd-configuration-data-directory    (default "/var/lib/cicd"))
  (run-directory     cicd-configuration-run-directory     (default "/var/run/cicd"))
  (run-in-container? cicd-configuration-run-in-container? (default #f))
  (container-name    cicd-configuration-container-name    (default "cicd")))

(define (cicd-profile config)
  (match-record config <cicd-configuration>
      (package)
    (list
     q
     package)))

(define (cicd-shepherd-services config)
  (match-record config <cicd-configuration>
      (user group log-file data-directory)
    (list
     (shepherd-service
       (provision '(cicd))
       (requirement '())
       (auto-start? #f)
       (start
         #~(make-forkexec-constructor
            (list
             #$(cmd-for <cicd-configuration> config)
             "daemon")
            #:user      #$user
            #:group     #$group
            #:log-file  #$log-file
            #:directory #$data-directory))
       (documentation "The background daemon service that powers the CI.")))))

(define-public cicd-service-type
  (service-type
    (name 'cicd)
    (extensions
      (list
       (service-extension shepherd-root-service-type
                          cicd-shepherd-services)
       (service-extension profile-service-type
                          cicd-profile)
       (service-extension activation-service-type
                          (activation-for <cicd-configuration>))
       (service-extension account-service-type
                          (accounts-for <cicd-configuration>))
       (service-extension log-rotation-service-type
                          (rotations-for <cicd-configuration>))))
    (default-value (cicd-configuration))
    (description (fmt "The CI agent service that backs a Git server."))))


(define-record-type* <papod-configuration>
  papod-configuration
  make-papod-configuration
  papod-configuration?
  (name              papod-configuration-name
                     (default "papod"))
  (package           papod-configuration-package
                     (default papod))
  (user              papod-configuration-user
                     (default "papod"))
  (group             papod-configuration-group
                     (default "papod"))
  (log-file          papod-configuration-log-file
                     (default "/var/log/papod/papod.log"))
  (data-directory    papod-configuration-data-directory
                     (default "/var/lib/papod"))
  (run-directory     papod-configuration-run-directory
                     (default "/var/run/papod"))
  (run-in-container? papod-configuration-run-in-container?
                     (default #t))
  (container-name    papod-configuration-container-name
                     (default "papod-container"))
  (options           papod-configuration-options
                     (default '()))
  (listen-socket     papod-configuration-listen-socket
                     (default "/var/run/papod/papod.socket"))
  (upstream-socket   papod-configuration-upstream-socket
                     (default #f)))


#;
(define-public papod-service-type
  (pkg:service-type-for 'papod
                        <papod-configuration>
                        (papod-configuration)
                        '()))



(list
 mktorrent-latest
 remembering
 eut
 cage
 backupit
 nicely
 syskeep
 q
 cicd
 guile-heredoc
 adoc
 eslaides
 mkwb
 euandre.org

 gotext
 uuid
 gobang
 pds
 stm
 golite
 binder
 glaze
 hsts
 untls
 wscat
 gistatic
 urubu
 fiinha
 cracha

      papo.im
 chat.papo.im
 papod)