(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 build utils)
  (guix packages))
(use-package-modules
  admin
  ssh
  version-control)
(use-service-modules
  admin
  certbot
  cgit
  dns
  mail
  mcron
  networking
  security
  ssh
  version-control
  vpn
  web)
(heredoc:enable-syntax)


(define ipv4 "216.238.68.100")
(define ipv6 "2001:19f0:b400:1f0c:5400:04ff:fe35:8c89")
(define tld "euandre.org")

(define users
  '(("andreh" "EuAndreh" ("wheel" "become-deployer" "become-secrets-keeper"))))


(define working-dir
  (if (directory-exists? "/opt/deploy/current")
    "/opt/deploy/current"
    (canonicalize-path ".")))

(add-to-load-path
 (string-append working-dir "/src/infrastructure/guix"))
(use-modules
  ((packages) #:prefix packages:))


(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 s)
  (slurp (path s)))

(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 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/infrastructure/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 ns (fmt "ns1.~a." tld))
(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"    (fmt "ns1.~a." tld))
  ("@"         ""   "IN"   "NS"    (fmt "ns2.~a." tld))
  ("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"   "0 iodef \"mailto:eu@euandre.org\"")

  ("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"    (fmt "ns1.~a." tld))
  ("@"         ""   "IN"   "NS"    (fmt "ns2.~a." tld)))

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

(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 "fr_FR.UTF-8")
  (timezone "America/Sao_Paulo")
  (host-name tld)
  (skeletons
    `((".profile"
       ,(plain-file "user-profile"
                    (file "src/infrastructure/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
            parted
            acl
            bind:utils
            tcpdump
            knot:tools
            file
            git
            guile-heredoc
            entr
            lsof
            jq
            moreutils
            mailutils-sendmail
            curl
            make
            gnupg
            borg
            rsync
            sqlite
            strace
            rlwrap
            trash-cli
            tree))
     (list
      packages:server
      (script "gc"          (file "src/infrastructure/scripts/gc.sh"))
      (script "cicd"        (file "src/infrastructure/scripts/cicd.sh"))
      (script "check"       (file "src/infrastructure/scripts/check.sh"))
      (script "backup"      (file "src/infrastructure/scripts/backup.sh"))
      (script "deploy"      (file "src/infrastructure/scripts/deploy.sh"))
      (script "report"      (file "src/infrastructure/scripts/report.sh"))
      (script "cronjob"     (file "src/infrastructure/scripts/cronjob.sh"))
      (script "reconfigure" (file "src/infrastructure/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 "/r/velhinho/")
                    (body
                      '(#"-
                          rewrite /r/velhinho(.*) $1 break;
                          proxy_pass http://velhinho:4219;
                          "#)))
                  (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 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 compression altogether due to BREACH
                     include /opt/secrets/nginx.conf.txt;
                     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/infrastructure/config/rc.sh")))
          ("known_hosts" ,(plain-file "known_hosts" (file "src/infrastructure/config/known_hosts.txt")))
          ("id_rsa.pub"  ,(plain-file "id_rsa.pub"  (file (fmt "src/infrastructure/keys/SSH/root@~a.id_rsa.pub.stripped" tld))))
          ("ssh.conf"    ,(plain-file "ssh.conf"    (file "src/infrastructure/config/ssh.conf")))
          ("init.scm"    ,(plain-file "init.scm"    (file "src/infrastructure/config/init.scm")))
          ("conf.env"    ,(plain-file "conf.env"    (file "src/infrastructure/config/conf.env")))
          ("gitconfig"   ,(plain-file "gitconfig"   (file "src/infrastructure/config/gitconfig")))))
      (service git-daemon-service-type)
      (simple-service 'add-wireguard-aliases hosts-service-type
        (list
         (host "10.0.0.0" "toph")
         (host "10.0.0.1" "velhinho")
         (host "10.0.0.2" "azula")))
      (service wireguard-service-type
        (wireguard-configuration
          (addresses '("10.0.0.0/32"))
          (peers
            (list
             (wireguard-peer
               (name "velhinho")
               (public-key "Mhv8KxB/QXQpNKNtqD57PoFv43TXJ1lg52PJd6TmtwI=")
               (allowed-ips '("10.0.0.1/32"))
               (keep-alive 25))
             (wireguard-peer
               (name "azula")
               (public-key "8IxSFlJoFuTzLtIkoKZH4CkUbIxd6++E0lBOin/7rT8=")
               (allowed-ips '("10.0.0.2/32"))
               (keep-alive 25))))))
      (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"         "andreh")
          ("eu"           "andreh")
          ("mailing-list" "andreh"))))
     (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 "94b47d91-3542-438a-84a9-859fe347ce09")))))
  (file-systems
    (append
     (list
      (file-system
        (mount-point "/")
        (device
          (uuid "4c36d5ad-f996-413e-a55c-c05b7e1876f2" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/production")
        (needed-for-boot? #t)
        (device
          (uuid "b1a7e4a1-a8ea-48a4-ab8b-884a1b6a9c11" 'btrfs))
        (type "btrfs"))
      (file-system
        (mount-point "/mnt/backup")
        (device
          (uuid "6632849d-f180-4740-86e6-a519d43ab75a" 'btrfs))
        (type "btrfs")))
     %base-file-systems)))