(define-module (users id1000)
  ;; home-environment
  #:use-module (gnu home)

  ;; home-profile-service-type
  ;; home-xdg-configuration-files-service-type
  #:use-module (gnu home services)

  ;; gparted
  #:use-module (gnu packages disk)

  ;; emacs
  #:use-module (gnu packages emacs)

  ;; emacs-org-roam
  ;; emacs-paredit
  #:use-module (gnu packages emacs-xyz)

  ;; git
  #:use-module (gnu packages version-control)

  ;; simple-service
  #:use-module (gnu services)

  ;; user-account
  #:use-module (gnu system shadow)

  ;; local-file
  #:use-module (guix gexp)

  ;; %suweren-home-services
  #:use-module (suweren home)

  #:use-module (guix records)
  #:use-module (ice-9 match))

(define-record-type* <dkimproxy-out-signature-configuration>
  dkimproxy-out-signature-configuration
  make-dkimproxy-out-signature-configuration
  dkimproxy-out-signature-configuration?
  (type dkimproxy-out-signature-configuration-type
	(default 'dkim))
  (key dkimproxy-out-signature-configuration-key
       (default #f))
  (algorithm dkimproxy-out-signature-configuration-algorithm
	     (default #f))
  (method dkimproxy-out-signature-configuration-method
	  (default #f))
  (domain dkimproxy-out-signature-configuration-domain
	  (default #f))
  (identity dkimproxy-out-signature-configuration-identity
	    (default #f))
  (selector dkimproxy-out-signature-configuration-selector
	    (default #f)))

(define-public generate-dkimproxy-out-signature-configuration
  (match-lambda
    (($
      <dkimproxy-out-signature-configuration>
      type
      key
      algorithm
      method
      domain
      identity
      selector )
     (string-append
      (match type
        ('dkim "dkim")
        ('domainkeys "domainkeys"))
      (if (or key algorithm method domain identity selector)
          (string-append
           "("
           (string-join
            `(,@ (if key
                     (list (string-append "key=" key))
                     '())
                 ,@ (if algorithm
                        (list (string-append "a=" algorithm))
                        '())
                 ,@ (if method
                        (list (string-append "c=" method))
                        '())
                 ,@ (if domain
                        (list (string-append "d=" domain))
                        '())
                 ,@ (if identity
                        (list (string-append "i=" identity))
                        '())
                 ,@ (if selector
                        (list (string-append "s=" selector))
                        '()))
            ",")
           ")")
          "")))))

(define-record-type* <dkimproxy-out-configuration>
  dkimproxy-out-configuration
  make-dkimproxy-out-configuration
  dkimproxy-out-configuration?
  (package dkimproxy-out-configuration-package
	   (default (@ (gnu packages mail) dkimproxy)))
  (listen dkimproxy-out-configuration-listen
	  (default #f))
  (relay dkimproxy-out-configuration-relay
	 (default #f))
  (list-id-map dkimproxy-out-configuration-list-id-map
	       (default '()))
  (sender-map dkimproxy-out-configuration-sender-map
	      (default '()))
  (reject-error? dkimproxy-out-configuration-sender-reject-error?
		 (default #f))
  (config-file dkimproxy-out-configuration-config-file
	       (default #f)))

(define (generate-map-file config filename)
  (apply
   plain-file
   filename
   (map (lambda (config)
           (match config
             ((selector (config ...))
               (string-append
                 selector " "
                 (string-join
                   (map
                     generate-dkimproxy-out-signature-configuration
                     config)
                   "\n")))
             ((selector config)
               (string-append
                 selector " "
                 (generate-dkimproxy-out-signature-configuration
                   config)))))
     config)))

(define dkimproxy-out-shepherd-service
  (match-lambda
    (($
      <dkimproxy-out-configuration>
      package
      listen
      relay
      list-id-map
      sender-map
      reject-error?
      config-file)
     (list
      ((@ (gnu services shepherd) shepherd-service)
       (provision '(dkimproxy-out))
       (requirement '(loopback))
       (documentation "Outbound DKIM proxy.")
       (start
        (let ((proxy (file-append package "/bin/dkimproxy.out")))
          (if config-file
              #~
              (make-forkexec-constructor
               (list
                #$
                proxy
                (string-append "--conf_file=" #$ config-file)
                "--pidfile=/var/run/dkimproxy.out.pid"
                "--user=dkimproxy" "--group=dkimproxy")
               #:pid-file "/var/run/dkimproxy.out.pid")
              (let*
                  ((first-signature
                    (match sender-map
                      (((sender (signature _ ...)) _ ...) signature)
                      (((sender signature) _ ...) signature)))
                   (domains
                    (apply append
                           (map
                            (lambda (sender)
                              (match sender
                                (((domains ...) config) domains)
                                ((domain config) domain)))
                            sender-map)))
                   (sender-map
                    (generate-map-file sender-map "sender.map"))
                   (listid-map
                    (if (null? list-id-map)
                        #f
                        (generate-map-file list-id-map "listid.map")))
                   (keyfile
                    (dkimproxy-out-signature-configuration-key
                     first-signature))
                   (selector
                    (dkimproxy-out-signature-configuration-selector
                     first-signature))
                   (method
                    (dkimproxy-out-signature-configuration-method
                     first-signature))
                   (signature
                    (match (dkimproxy-out-signature-configuration-type
                            first-signature)
                      ('dkim "dkim")
                      ('domainkeys "domainkeys"))))
                #~
                (make-forkexec-constructor
                 `(,#$
                   proxy
                   "--pidfile=/var/run/dkimproxy.out.pid"
                   "--user=dkimproxy" "--group=dkimproxy"
                   ,(string-append "--listen=" #$ listen)
                   ,(string-append "--relay=" #$ relay)
                   ,(string-append "--sender_map=" #$ sender-map)
                   ,@ (if #$ listid-map
                          (list
                           (string-append "--listid_map=" #$ listid-map))
                          '())
                   ,(string-append "--domain=" #$ domains)
                   ,(string-append "--keyfile=" #$ keyfile)
                   ,(string-append "--selector=" #$ selector)
                   ,@ (if #$ method
                          (list
                           (string-append "--method=" #$ method))
                          '())
                   ,@ (if #$ reject-error?
                          '("--reject_error")
                          '())
                   ,@ (if #$ signature
                          (list
                           (string-append "--signature=" #$ signature))
                          '())))))))
       (stop #~ (make-kill-destructor)))))))

(define %dkimproxy-accounts
  (list (user-group (name "dkimproxy")
		    (system? #t))
	(user-account (name "dkimproxy")
		      (group "dkimproxy")
		      (system? #t)
		      (comment "Dkimproxy user")
		      (home-directory "/var/empty")
		      (shell (file-append (@ (gnu packages admin)
					     shadow)
					  "/sbin/nologin")))))

(define dkimproxy-out-service-type
  (service-type
   (name 'dkimproxy-out)
   (description "stub")
   (extensions
    (list
     (service-extension
      account-service-type
      (const %dkimproxy-accounts))
     (service-extension
      (@ (gnu services shepherd) shepherd-root-service-type)
      dkimproxy-out-shepherd-service)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define dkimproxy-signature-dkim
  (dkimproxy-out-signature-configuration
   (algorithm "rsa-sha256")
   (key "/etc/mail/dkim/marekpasnikowski.pl.key")
   (method "relaxed")
   (selector "dkim")
   (type 'dkim)))

(define dkimproxy-signature-domainkeys
  (dkimproxy-out-signature-configuration
   (method "mofws")
   (type 'domainkeys)))

;;;;;

(define aliases-file
  ((@ (guix gexp) mixed-text-file)
   "aliases"
   "@ vmail\n"))

(define blacklist-file
  ((@ (guix gexp) mixed-text-file)
   "blacklist"
   "@yahoo.com.cn\n"
   "@qq.com\n"
   "@fnac.com\n"
   "@just-aero.us\n"
   "@elitetorrent1.com\n"))

(define dkimproxy-signatures-marekpasnikowski
  (list dkimproxy-signature-dkim
	dkimproxy-signature-domainkeys))

(define dovecot-imap-login-inet-configuration
  ((@ (gnu services mail) inet-listener-configuration)
   (address "192.168.10.2")
   (port 993)
   (protocol "imaps")))

(define dovecot-lmtp-inet-configuration
  ((@ (gnu services mail) inet-listener-configuration)
   (address "192.168.10.2 127.0.0.1")
   (port 24)
   (protocol "lmtp")))

(define dovecot-lmtp-unix-configuration
  ((@ (gnu services mail) unix-listener-configuration)
   (group "vmail")
   (mode "0666")
   (path "lmtp")
   (user "vmail")))

(define mailbox-marekpasnikowski-archive
  ((@ (gnu services mail) mailbox-configuration)
   (name "Archive")
   (auto "subscribe")
   (special-use (list "\\Archive"))))

(define mailbox-marekpasnikowski-drafts
  ((@ (gnu services mail) mailbox-configuration)
   (name "Drafts")
   (auto "subscribe")
   (special-use (list "\\Drafts"))))

(define mailbox-marekpasnikowski-junk
  ((@ (gnu services mail) mailbox-configuration)
   (name "Junk")
   (auto "subscribe")
   (special-use (list "\\Junk"))))

(define mailbox-marekpasnikowski-sent
  ((@ (gnu services mail) mailbox-configuration)
   (name "Sent")
   (auto "subscribe")
   (special-use (list "\\Sent"))))

(define mailbox-marekpasnikowski-trash
  ((@ (gnu services mail) mailbox-configuration)
   (name "Trash")
   (auto "subscribe")
   (special-use (list "\\Trash"))))

(define relays-file
  ((@ (guix gexp) mixed-text-file)
   "other-relays"
   "mx1.forwardemail.net\n"
   "mx2.forwardemail.net\n"))

(define smtpd-keys
  "/secrets/smtpd")

;;;

(define dkimproxy-sender-marekpasnikowski
  `("marekpasnikowski.pl" ,dkimproxy-signatures-marekpasnikowski))

(define dovecot-imap
  ((@ (gnu services mail) protocol-configuration)
   (name "imap")))

(define dovecot-imap-login-configuration
  ((@ (gnu services mail) service-configuration)
   (kind "imap-login")
   (listeners (list dovecot-imap-login-inet-configuration))))

(define dovecot-lmtp
  ((@ (gnu services mail) protocol-configuration)
   (name "lmtp")))

(define dovecot-lmtp-configuration
  ((@ (gnu services mail) service-configuration)
   (kind "lmtp")
   (listeners (list dovecot-lmtp-inet-configuration
		    dovecot-lmtp-unix-configuration))))

(define dovecot-passwd-file
  ((@ (gnu services mail) passdb-configuration)
   (args (list "username_format=%n"
	       "/secrets/dovecot"))
   (driver "passwd-file")))

(define dovecot-namespace-marekpasnikowski
  ((@ (gnu services mail) namespace-configuration)
   (name "inbox")
   (inbox? #t)
   (mailboxes (list mailbox-marekpasnikowski-archive
		    mailbox-marekpasnikowski-drafts
		    mailbox-marekpasnikowski-junk
		    mailbox-marekpasnikowski-sent
		    mailbox-marekpasnikowski-trash))))

(define dovecot-userdb-static-configuration
  ((@ (gnu services mail) userdb-configuration)
   (args (list "gid=vmail"
	       "home=/home/vmail/%n"
	       "uid=vmail"))
   (driver "static")))

(define (opensmtpd-config interface
			  domain)
  ((@ (guix gexp) mixed-text-file)
   "smtpd.conf"
   "# This is the smtpd server system-wide configuration file.\n"
   "# See smtpd.conf(5) for more information.\n"
   "\n"
   "# My TLS certificate and key\n"
   "pki marekpasnikowski.pl cert \"/etc/letsencrypt/live/" domain "/fullchain.pem\"\n"
   "pki marekpasnikowski.pl key \"/etc/letsencrypt/live/" domain "/privkey.pem\"\n"
   "\n"
   "# Edit this file to add add more virtual users (passwords are read in that file\n"
   "# instead of /etc/passwd\n"
   "table passwd file:" smtpd-keys "\n"
   "\n"
   "table other-relays file:" relays-file "\n"
   "table blacklist file:" blacklist-file "\n"
   "\n"
   "# A simple spam filter\n"
   "# filter spam-filter phase mail-from match mail-from <blacklist> reject \"555\"\n"
   "\n"
   "# port 25 is used only for receiving from external servers, and they may start\n"
   "# a TLS session if they want.\n"
   "listen on " interface " port 25 # tls pki marekpasnikowski.pl filter spam-filter\n"
   "\n"
   "# For sending messages from outside of this server, you need to authenticate and\n"
   "# use TLS.\n"
   "listen on " interface " port 465 smtps pki marekpasnikowski.pl mask-src auth <passwd>\n"
   "\n"
   "# Localhost is used by the .onion, so we use the same configuration for \n"
   "# local connections."
   "listen on lo port 25 tls pki marekpasnikowski.pl filter spam-filter\n"
   "# Since incoming connection uses tor, we don't need tls, but still require\n"
   "# authentication; we're not a relay\n"
   "# listen on lo port 587 tls pki marekpasnikowski.pl mask-src auth <passwd>\n"
   "\n"
   "# DKIMproxy\n"
   "listen on lo port 10028 tag DKIM_OUT\n"
   "\n"
   "# The socket is considered an internal connection\n"
   "listen on socket mask-src\n"
   "\n"
   "# Maybe it'll work better if we connect to gmail only with v4?\n"
   "# limit mta for domain gmail.com inet4\n"
   "\n"
   "# TODO: manage these files directly in the configuration?\n"
   "# If you edit the file, you have to run \"smtpctl update table aliases\"\n"
   "table aliases file:" aliases-file "\n"
   "\n"
   "# We define some actions\n"
   "action receive lmtp \"/var/run/dovecot/lmtp\" rcpt-to virtual <aliases>\n"
   "action outbound relay helo \"" domain "\"\n"
   "action godkim relay host smtp://127.0.0.1:10027\n"
   "\n"
   "# We accept to relay any mail from authenticated users\n"
   "match for any from any auth action godkim\n"
   "match tag DKIM_OUT for any action outbound\n"
   "\n"
   "# Then, we reject on some other conditions:\n"
   "\n"
   "# If the mail tries to impersonate us\n"
   "# match !from src <other-relays> mail-from \"@marekpasnikowski.pl\" for any reject\n"
   "\n"
   "# If it comes from someone on the blacklist\n"
   "match from any mail-from <blacklist> reject\n"
   "\n"
   "# Finally, if we accept incoming messages\n"
   "match from any for domain \"marekpasnikowski.pl\" action receive\n"
   "match for local action receive\n" ))

(define ssl-cert-path
  (string-append "</etc/letsencrypt/live/"
		 "marekpasnikowski.pl"
		 "/fullchain.pem"))

(define ssl-key-path
  (string-append "</etc/letsencrypt/live/"
		 "marekpasnikowski.pl"
		 "/privkey.pem"))

;;;

(define dkimproxy-out-configuration*
  (dkimproxy-out-configuration
   (listen "127.0.0.1:10027")
   (relay "172.0.0.1:10028")
   (sender-map `(,dkimproxy-sender-marekpasnikowski))))

(define dovecot-configuration*
  ((@ (gnu services mail) dovecot-configuration)
   (disable-plaintext-auth? #t)
   (mail-location "maildir:~/Maildir")
   (namespaces (list dovecot-namespace-marekpasnikowski))
   (passdbs (list dovecot-passwd-file))
   (protocols (list dovecot-imap
		    dovecot-lmtp))
   (services (list dovecot-lmtp-configuration
		   dovecot-imap-login-configuration))
   (ssl? "required")
   (ssl-cert ssl-cert-path)
   (ssl-key ssl-key-path)
   (ssl-min-protocol "TLSv1.2")
   (userdbs (list dovecot-userdb-static-configuration))))

(define groups
  (list "kvm"
	"wheel"))

(define opensmtpd-configuration*
  ((@ (gnu services mail) opensmtpd-configuration)
   (config-file (opensmtpd-config "enp1s0"
				  "marekpasnikowski.pl"))))

;;;

(define-public dkim-service
  (service dkimproxy-out-service-type
	   dkimproxy-out-configuration*))

(define-public dovecot-service
  (service (@ (gnu services mail) dovecot-service-type)
	   dovecot-configuration*))

(define-public smtp-service
  (service (@ (gnu services mail) opensmtpd-service-type)
	   opensmtpd-configuration*))

(define-public uid1000-name
  "marek")

(define-public uid1000-account
  (user-account (name uid1000-name)
		(group "users")
		(supplementary-groups groups)
		(uid 1000)
		(comment "Marek Paśnikowski")
		(home-directory "/home/marek")))

(define-public uid1000-home-environment
  (lambda (host-name*)
    (let* ((gitconfig-file (local-file "uid1000-gitconfig")) ; TODO modularize
	   (gitignore-file (local-file "uid1000-gitignore")) ; TODO review the contents

	   (gitconfig (list "git/config"
			    gitconfig-file))
	   (gitignore (list "git/ignore"
			    gitignore-file))

	   (emacs-packages (list emacs
				 emacs-org-roam
				 emacs-paredit))
	   (git-configuration-files (list gitconfig
					  gitignore))
	   (git-packages (list git))
	   (packages (list gparted))

	   (emacs-software (simple-service 'emacs-packages
					   home-profile-service-type
					   emacs-packages))
	   (git-configuration (simple-service 'git-configuration
					      home-xdg-configuration-files-service-type
					      git-configuration-files))
	   (git-software (simple-service 'git-packages
					 home-profile-service-type
					 git-packages))
	   (profile (simple-service 'user-packages
				    home-profile-service-type
				    packages))

	   (%suweren-home-services* (%suweren-home-services host-name*))
	   (user-services (list emacs-software
				git-configuration
				git-software
				profile))

	   (services* (append %suweren-home-services*
			      user-services)))
      (home-environment (services services*)))))