(use-modules
  ((ice-9 textual-ports) #:prefix textual-ports:)
  ((srfi srfi-1) #:prefix s1:)
  ((xyz euandreh heredoc) #:prefix heredoc:)
  ((org euandre queue) #:prefix queue:)
  (gnu)
  (guix build-system trivial)
  (guix packages))
(use-package-modules
  admin
  ssh
  version-control)
(use-service-modules
  admin
  certbot
  cgit
  dns
  mail
  mcron
  networking
  security
  ssh
  web)
(heredoc:enable-syntax)


(define +working-dir+
  (canonicalize-path "."))

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

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

(define (path s)
  (str +working-dir+ "/" s))

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

(define file
  (compose slurp path))

(define +tld+
  (string-trim-right
   (slurp (path "tld.txt"))))

(define +ipv4+ "216.238.73.1")
(define +ipv6+ "2001:19f0:b400:1582:5400:04ff:fea9:370e")

(define +users+
  '(("andre"  "EuAndreh" ("wheel" "become-deployer" "become-secrets-keeper"))
    ("laisse" "Laísses"  ())))

(define +user-accounts+
  (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 (ssh-file-for user)
  (let ((name (s1:first user)))
    (path (fmt "src/keys/SSH/~a.pub.txt" name))))

(define +authorized-keys+
  (let ((users-with-keys
         (map (lambda (user)
                `(,@user ,(slurp (ssh-file-for user))))
              (filter (lambda (user)
                        (file-exists? (ssh-file-for user)))
                      +users+))))
    (append
     (map (lambda (user)
            (let ((name (s1:first  user))
                  (key  (s1:fourth user)))
              `(,name ,(plain-file (str name "-id_rsa.pub")
                                   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")
                                     key)))
                     users-with-keys))))))

(define (script name content)
  (package
    (name name)
    (version "latest")
    (source #f)
    (build-system trivial-build-system)
    (arguments
      (list
       #:modules '((guix build utils))
       #:builder
       #~(begin
           (use-modules (guix build utils))
           (let* ((bin  (string-append %output "/bin"))
                  (prog (string-append bin "/" #$name)))
             (mkdir-p bin)
             (call-with-output-file prog
              (lambda (port)
                (display #$content port)))
             (chmod prog #o755)))))
    (home-page   #f)
    (synopsis    #f)
    (description #f)
    (license     #f)))


(define ns1 (fmt "ns1.~a." +tld+))
(define ns2 (fmt "ns2.~a." +tld+))
(define ns ns1)
(define mail (fmt "hostmaster.~a." +tld+))
(define dkim-selector "dkimproxyout")
(define dkim-public-key-path "/var/lib/dkimproxyout/public.key")

(define dkim-name (str dkim-selector "._domainkey"))
(define dkim-public-key
  (if (file-exists? dkim-public-key-path)
    (string-join
     (reverse
      (cdr
       (reverse
        (cdr
         (string-split (slurp dkim-public-key-path)
                       #\newline)))))
     "")
    "stub-public-key-for-building"))

(define ipv4-reverse-domain
  (str
   (string-join (reverse
                 (string-split +ipv4+
                               #\.))
                ".")
   ".in-addr.arpa"))

(define ipv6-reverse-domain
  (str
   (string-join (reverse
                 (map (lambda (s) (fmt "~a" s))
                      (string->list
                       (string-delete #\: +ipv6+))))
                ".")
   ".ip6.arpa"))

(define-zone-entries tld-zone
  ("@"         ""   "IN"   "NS"    ns1)
  ("@"         ""   "IN"   "NS"    ns2)
  ("ns1"       ""   "IN"   "A"     +ipv4+)
  ("ns1"       ""   "IN"   "AAAA"  +ipv6+)
  ("ns2"       ""   "IN"   "A"     +ipv4+)
  ("ns2"       ""   "IN"   "AAAA"  +ipv6+)

  ("@"         ""   "IN"   "A"     +ipv4+)
  ("@"         ""   "IN"   "AAAA"  +ipv6+)

  ("@"         ""   "IN"   "CAA"   "0 issue \"letsencrypt.org\"")
  ("@"         ""   "IN"   "CAA"   "0 issuewild \";\"")
  ("@"         ""   "IN"   "CAA"   (fmt "0 iodef \"mailto:root@~a\"" +tld+))

  ("mta-sts"   ""   "IN"   "A"     +ipv4+)
  ("mta-sts"   ""   "IN"   "AAAA"  +ipv6+)
  ("_mta-sts"  ""   "IN"   "TXT"   "\"v=STSv1; id=20230314\"")
  ("@"         ""   "IN"   "MX"    (fmt "10 ~a." +tld+))
  ("_dmarc"    ""   "IN"   "TXT"   "\"v=DMARC1; p=quarantine\"")
  ("@"         ""   "IN"   "TXT"   (fmt "\"v=spf1 a:~a -all\"" +tld+))
  (dkim-name   ""   "IN"   "TXT"   (fmt "\"v=DKIM1; k=rsa; t=s; p=~a\"" dkim-public-key)))

(define-zone-entries ipv4-reverse-domain-zone
  ("@"         ""   "IN"   "PTR"   (str +tld+ "."))
  ("@"         ""   "IN"   "NS"    ns1)
  ("@"         ""   "IN"   "NS"    ns2))

(define-zone-entries ipv6-reverse-domain-zone
  ("@"         ""   "IN"   "PTR"   (str +tld+ "."))
  ("@"         ""   "IN"   "NS"    ns1)
  ("@"         ""   "IN"   "NS"    ns2))

(define zones
  (list
   (knot-zone-configuration
     (domain +tld+)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin +tld+)
         (ns ns)
         (mail mail)
         (entries tld-zone))))
   (knot-zone-configuration
     (domain ipv4-reverse-domain)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin ipv4-reverse-domain)
         (ns ns)
         (mail mail)
         (entries ipv4-reverse-domain-zone))))
   (knot-zone-configuration
     (domain ipv6-reverse-domain)
     (semantic-checks? #t)
     (zone
       (zone-file
         (origin ipv6-reverse-domain)
         (ns ns)
         (mail mail)
         (entries ipv6-reverse-domain-zone))))))


(operating-system
  (locale "en_GB.UTF-8")
  (timezone "America/Sao_Paulo")
  (host-name +tld+)
  (skeletons
    `((".profile"
       ,(plain-file
         "user-profile"
         (file "src/config/profile.sh")))))
  (users
    (append
     (list
      (user-account
        (name  "git")
        (group "git")
        (system? #t)
        (comment "External SSH Git user")
        (home-directory "/srv/git")
        (create-home-directory? #f)
        (shell
          (file-append git "/bin/git-shell")))
      (user-account
        (name  "deployer")
        (group "deployer")
        (system? #t)
        (comment "The account used to run deployment commands")
        (home-directory "/var/empty")
        (create-home-directory? #f)
        (shell
          (file-append shadow "/sbin/nologin")))
      (user-account
        (name  "secrets-keeper")
        (group "secrets-keeper")
        (system? #t)
        (comment "The account used to manage production secrets")
        (home-directory "/var/empty")
        (create-home-directory? #f)
        (shell
          (file-append shadow "/sbin/nologin"))))
     +user-accounts+
     %base-user-accounts))
  (groups
    (append
     (list
      (user-group
        (name "git")
        (system? #t))
      (user-group
        (name "deployer")
        (system? #t))
      (user-group
        (name "become-deployer")
        (system? #t))
      (user-group
        (name "secrets-keeper")
        (system? #t))
      (user-group
        (name "become-secrets-keeper")
        (system? #t)))
     %base-groups))
  (sudoers-file
    (plain-file "sudoers" #"-
      root                   ALL=(ALL)                      ALL
      %wheel                 ALL=                           ALL
      %become-deployer       ALL=(deployer)       NOPASSWD: ALL
      %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=                 NOPASSWD: /run/current-system/profile/bin/reconfigure, /run/current-system/profile/bin/cicd
      git                    ALL=(deployer)       NOPASSWD: /run/current-system/profile/bin/rsync, /run/current-system/profile/bin/mkdir
      "#))
  (packages
    (append
     (map
      (compose list specification->package+output symbol->string)
      '(nss-certs
        guile-heredoc
        parted
        acl
        bind:utils
        knot:tools
        file
        git
        lsof
        mailutils-sendmail
        curl
        make
        borg
        rsync
        sqlite
        strace
        rlwrap
        trash-cli
        tree))
     (list
      (script "gc"          (file "src/scripts/gc.sh"))
      (script "cicd"        (file "src/scripts/cicd.sh"))
      (script "check"       (file "src/scripts/check.sh"))
      (script "backup"      (file "src/scripts/backup.sh"))
      (script "deploy"      (file "src/scripts/deploy.sh"))
      (script "report"      (file "src/scripts/report.sh"))
      (script "cronjob"     (file "src/scripts/cronjob.sh"))
      (script "reconfigure" (file "src/scripts/reconfigure.sh")))
     %base-packages))
  (services
    (append
     (list
      (service ntp-service-type)
      (service dhcp-client-service-type)
      (service knot-service-type
        (knot-configuration
          (zones zones)))
      (service openssh-service-type
        (openssh-configuration
          (openssh openssh-sans-x)
          (password-authentication? #f)
          (authorized-keys +authorized-keys+)
          (extra-content #"-
            ClientAliveInterval 30
            ClientAliveCountMax 20
            MaxSessions 20
            SetEnv GIT_CONFIG_GLOBAL=/etc/gitconfig
            "#)))
      (simple-service 'extra-rottlog-rotations rottlog-service-type
        (list
         (log-rotation
           (frequency 'weekly)
           (files '("/var/log/cronjobs.log"))
           (options '("rotate 52")))))
      (service fail2ban-service-type)
      (service mcron-service-type
        (mcron-configuration
          (jobs
            (list
             #~(job "0 0 * * *" "cronjob check")
             #~(job "0 1 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backup -q cron")
             #~(job "0 2 * * *" "cronjob                                backup -q cron")
             #~(job "0 3 * * 0" "cronjob gc")
             #~(job "0 4 * * *" "cronjob reconfigure -U")))))
      (service certbot-service-type
        (certbot-configuration
          (email (str "root@" +tld+))
          (certificates
            (list
             (certificate-configuration
               (domains (list +tld+))
               (deploy-hook
                 (program-file
                  "nginx-deploy-hook"
                  #~(let ((pid (call-with-input-file "/var/run/nginx/pid" read)))
                      (kill pid SIGHUP)))))))))
      (service nginx-service-type
        (nginx-configuration
          (server-blocks
            (list
             (nginx-server-configuration
               (server-name (list +tld+))
               (listen '("[::]:443 ssl http2" "443 ssl http2"))
               (root "/srv/www")
               (ssl-certificate     (fmt "/etc/letsencrypt/live/~a/fullchain.pem" +tld+))
               (ssl-certificate-key (fmt "/etc/letsencrypt/live/~a/privkey.pem"   +tld+))
               (locations
                 (list
                  (nginx-location-configuration
                    (uri "/api/")
                    (body
                      (list
#;
                       (fmt "include /var/run/~a/curr.conf;~%" +tld+))))
                  (nginx-location-configuration
                    (uri "/git/static/")
                    (body
                      (list
                       (list "alias " cgit "/share/cgit/;"))))
                  (nginx-location-configuration
                    (uri "/git/")
                    (body
                      (list
                       (list "fastcgi_param SCRIPT_FILENAME " cgit "/lib/cgit/cgit.cgi;")
                       #"-
                         fastcgi_param PATH_INFO    $uri;
                         fastcgi_param QUERY_STRING $args;
                         fastcgi_param HTTP_HOST    $server_name;
                         fastcgi_pass localhost:9000;
                         rewrite /git(.*) $1 break;
                         "#)))))
               (raw-content
                 '(#"-
                     # BearSSL still doesn't do TLSv1.3, so we deem TLSv1.2 as
                     # acceptable
                     ssl_protocols TLSv1.2 TLSv1.3;
                     ssl_ciphers EECDH+AESGCM:EDH+AESGCM:AES256+EECDH:AES256+EDH;
                     ssl_prefer_server_ciphers on;
                     gzip off;  # Disable catch-all compression due to BREACH
                     charset UTF-8;
                     autoindex on;
                     add_header Strict-Transport-Security 'max-age=31536000; includeSubdomains' always;
                     "#)))))))
      (service cgit-service-type queue:cgit-pre-configuration)
      (simple-service 'extra-etc-file etc-service-type
        `(("rc"          ,(plain-file "rc.sh"       (file "src/config/rc.sh")))
          ("known_hosts" ,(plain-file "known_hosts" (file "src/config/known_hosts.txt")))
          ("id_rsa.pub"  ,(plain-file "id_rsa.pub"  (file (fmt "src/keys/SSH/root@~a.id_rsa.pub.stripped" +tld+))))
          ("ssh.conf"    ,(plain-file "ssh.conf"    (file "src/config/ssh.conf")))
          ("init.scm"    ,(plain-file "init.scm"    (file "src/config/init.scm")))
          ("conf.env"    ,(plain-file "conf.env"    (file "src/config/conf.env")))
          ("gitconfig"   ,(plain-file "gitconfig"   (file "src/config/gitconfig")))))
      (service queue:shadow-group-service-type)
      (service queue:dkimproxyout-service-type)
      (service queue:cyrus-sasl-service-type)
      (service queue:dovecot-service-type)
      (service queue:internet-postfix-service-type
        (queue:postfix-configuration
          (enable-submission? #t)
          (main.cf-extra #"-
            message_size_limit = 102400000
            mailbox_size_limit = 5120000000
            "#)))
      (service mail-aliases-service-type
        `(("root" "andre")
          ("support" ,@(map s1:first +users+)))))
     (modify-services %base-services
       (rottlog-service-type config =>
         (rottlog-configuration
           (inherit config)
           (rc-file
             (file-append queue:rottlog-mailutils-sendmail "/etc/rc")))))))
  (bootloader
    (bootloader-configuration
      (bootloader grub-bootloader)
      (targets '("/dev/vda"))))
  (swap-devices
    (list
     (swap-space
       (target
         (uuid "fde5e4a8-acc2-4c9a-9712-5494724c2c04")))))
  (file-systems
    (append
     (list
      (file-system
        (mount-point "/")
        (device
          (uuid "da72be6a-0c6b-4874-a57f-2046fcba13af" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/production")
        (needed-for-boot? #t)
        (device
          (uuid "c50ad9fa-c7a1-49a1-93d2-6633f3cf929f" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/backup")
        (device
          (uuid "d675e98c-3f48-44d1-b085-36c476d9313f" 'btrfs))
        (type "btrfs")))
     %base-file-systems)))