(define-module (services concourse)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services databases)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages base)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages virtualization)
  #:use-module (gnu packages linux)
  #:use-module ((gnu packages docker) #:select (containerd))
  #:use-module (vup concourse)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:export (concourse-web-configuration
            concourse-web-service-type
            concourse-worker-configuration
            concourse-worker-service-type))

(define-record-type* <concourse-web-configuration>
  concourse-web-configuration make-concourse-web-configuration
  concourse-web-configuration?
  ;; <package>
  (concourse              concourse-web-configuration-concourse
                          (default concourse))

  ;; user to run it under
  (user                   concourse-web-configuration-user
                          (default "concourse"))

  ;; list of (user, password), password can be a bcrypt hash
  (local-users            concourse-web-configuration-local-users
                          (default '()))

  ;; string
  (main-team-local-user   concourse-web-configuration-main-team-local-user)

  ;; path
  (session-singing-key    concourse-web-configuration-session-signing-key)

  ;; path
  (tsa-host-key           concourse-web-configuration-tsa-host-key)

  ;; string
  (external-url           concourse-web-configuration-external-url)

  ;; path
  (vault-role-id-file     concourse-web-configuration-vault-role-id-file
                          (default #f))

  ;; path
  (vault-secret-id-file   concourse-web-configuration-vault-secret-id-file
                          (default #f))

  ;; string
  (vault-url              concourse-web-configuration-vault-url
                          (default #f))

  ;; string
  (vault-ca-dir           concourse-web-configuration-vault-ca-dir
                          (default #f))

  ;; influxdb url for metrics
  (influxdb-url           concourse-web-configuration-influxdb-url
                          (default #f))

  ;; influxdb database
  (influxdb-database      concourse-web-configuration-influxdb-database
                          (default #f))

  ;; influxdb username
  (influxdb-username      concourse-web-configuration-influxdb-username
                          (default #f))

  ;; influxdb password
  (influxdb-password-file concourse-web-configuration-influxdb-password-file
                          (default #f))

  ;; prometheus bind ip
  (prometheus-bind-ip     concourse-web-configuration-prometheus-bind-ip
                          (default #f))

  ;; prometheus bind port
  (prometheus-bind-port   concourse-web-configuration-prometheus-bind-port
                          (default #f))

  ;; list of string
  (authorized-worker-keys concourse-web-configuration-authorized-worker-keys
                          (default '())))


(define (concourse-web-shepherd-service config)
  "Return a <shepherd-service> for concourse web with CONFIG."

  (define tsa-authorized-worker-keys
    (computed-file
     "tsa-authorized-worker-keys"
     #~(begin
         (use-modules (ice-9 match))
         (use-modules (guix build utils))
         (call-with-output-file #$output
            (lambda (port)
              (display "# Generated by 'concourse-web-service'.\n" port)
              (for-each
                (lambda (authorized-worker-key)
                  (format port "~a\n" authorized-worker-key))
                '#$(concourse-web-configuration-authorized-worker-keys config))
              #t)))
     #:options '(#:local-build? #t
                 #:modules ((guix build utils)))))

  (define args
    `(,@(map (lambda (local-user)
               (string-append "--add-local-user=" (car local-user) ":" (cadr local-user)))
             (concourse-web-configuration-local-users config))
      ,(string-append "--main-team-local-user=" (concourse-web-configuration-main-team-local-user config))
      ,(string-append "--metrics-attribute=source:concourse-web")
      ,(string-append "--session-signing-key=" (concourse-web-configuration-session-signing-key config))
      ,(string-append "--tsa-host-key=" (concourse-web-configuration-tsa-host-key config))
      ,#~(string-append "--tsa-authorized-keys=" #$tsa-authorized-worker-keys)
      ,(string-append "--postgres-database=" (concourse-web-configuration-user config))
      ,(string-append "--postgres-user=" (concourse-web-configuration-user config))
      ,(string-append "--postgres-socket=/tmp")
      ,(string-append "--external-url=" (concourse-web-configuration-external-url config))))

  (list (shepherd-service
         (documentation "concourse web node")
         (requirement '(networking))
         (provision '(concourse-web))
         (start #~(lambda _
                    (let* ((vault-extra-args
                            (if #$(concourse-web-configuration-vault-url config)
                                (list
                                 (string-append "--vault-url=" #$(concourse-web-configuration-vault-url config))
                                 (string-append "--vault-ca-path=" #$(concourse-web-configuration-vault-ca-dir config))
                                 "--vault-auth-backend=approle")
                                '()))
                           (prometheus-extra-args
                            (if #$(concourse-web-configuration-prometheus-bind-ip config)
                                (list
                                 (string-append "--prometheus-bind-ip=" #$(concourse-web-configuration-prometheus-bind-ip config))
                                 (string-append "--prometheus-bind-port=" #$(concourse-web-configuration-prometheus-bind-port config)))
                                '()))
                           (extra-args (append vault-extra-args prometheus-extra-args))
                           (vault-env-vars
                            (if #$(concourse-web-configuration-vault-url config)
                                (list
                                 (string-append
                                  "CONCOURSE_VAULT_AUTH_PARAM=role_id:"
                                  (call-with-input-file #$(concourse-web-configuration-vault-role-id-file config) (lambda (port) (get-string-all port)))
                                  ",secret_id:" (call-with-input-file #$(concourse-web-configuration-vault-secret-id-file config) (lambda (port) (get-string-all port)))))
                                '()))
                           (influxdb-env-vars
                            (if #$(concourse-web-configuration-influxdb-url config)
                                (list
                                 (string-append "CONCOURSE_INFLUXDB_URL=" #$(concourse-web-configuration-influxdb-url config))
                                 (string-append "CONCOURSE_INFLUXDB_DATABASE=" #$(concourse-web-configuration-influxdb-database config))
                                 (string-append "CONCOURSE_INFLUXDB_USERNAME=" #$(concourse-web-configuration-influxdb-username config))
                                 (string-append "CONCOURSE_INFLUXDB_PASSWORD=" (call-with-input-file #$(concourse-web-configuration-influxdb-password-file config) (lambda (port) (get-string-all port)))))
                                '()))
                           (env-vars (append vault-env-vars influxdb-env-vars))
                           (ctor (make-forkexec-constructor
                                  (append (list #$(file-append (concourse-web-configuration-concourse config)
                                                               "/bin/concourse") "web") (list #$@args) extra-args)
                                  #:environment-variables env-vars
                                  #:user #$(concourse-web-configuration-user config)
                                  #:log-file "/var/log/concourse-web.log")))
                      (ctor))))
         (stop #~(make-kill-destructor))
         (auto-start? #t)
         (modules `((ice-9 textual-ports))))))

(define* (concourse-web-accounts config)
  (list
    (user-group (name (concourse-web-configuration-user config)) (system? #t))
    (user-account
     (name (concourse-web-configuration-user config))
     (group (concourse-web-configuration-user config))
     (system? #t)
     (comment "concourse web node user")
     (home-directory "/var/empty")
     (shell (file-append shadow "/sbin/nologin")))))

(define concourse-web-service-type
  (service-type (name 'concourse-web)
                (description
                 "run concourse web node")
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          concourse-web-shepherd-service)
                       (service-extension account-service-type
                                          concourse-web-accounts)
                                           
                       (service-extension postgresql-role-service-type
                                          (lambda (config)
                                            (list (postgresql-role
                                                    (name (concourse-web-configuration-user config))
                                                    (create-database? #t)))))))))

(define-record-type* <concourse-worker-configuration>
  concourse-worker-configuration make-concourse-worker-configuration
  concourse-worker-configuration?
  ;; <package>
  (concourse              concourse-worker-configuration-concourse
                          (default concourse))

  ;; user to run it under
  (user                   concourse-worker-configuration-user
                          (default "concourse"))
  ;; string
  (tsa-host               concourse-worker-configuration-tsa-host
                          (default "127.0.0.1:2222"))

  ;; path
  (tsa-public-key         concourse-worker-configuration-tsa-public-key)

  ;; path
  (private-key            concourse-worker-configuration-private-key)

  ;; string
  (work-dir               concourse-worker-configuration-work-dir)

  ;; string
  (runtime                concourse-worker-configuration-runtime
                          (default 'containerd))

  ;; string
  (team                   concourse-worker-configuration-team
                          (default "main"))
  ;; number
  (mtu                    concourse-worker-configuration-mtu
                          (default #f))

  ;; list of items
  (tags                   concourse-worker-configuration-tags
                          (default '())))


(define (concourse-worker-shepherd-service config)
  "Return a <shepherd-service> for concourse worker with CONFIG."

  (define tsa-public-key
    (computed-file
     "tsa-public-key"
     #~(begin
         (use-modules (ice-9 match))
         (use-modules (guix build utils))
         (call-with-output-file #$output
            (lambda (port)
              (display "# Generated by 'concourse-worker-service'.\n" port)
              (format port "~a\n" #$(concourse-worker-configuration-tsa-public-key config))
              #t)))
     #:options '(#:local-build? #t
                 #:modules ((guix build utils)))))
  (define args
    `(,(string-append "--tsa-host=" (concourse-worker-configuration-tsa-host config))
      ,#~(string-append "--tsa-public-key=" #$tsa-public-key)
      ,(string-append "--tsa-worker-private-key=" (concourse-worker-configuration-private-key config))
      ,(string-append "--work-dir=" (concourse-worker-configuration-work-dir config))
      ,(string-append "--runtime=" (format #f "~a" (concourse-worker-configuration-runtime config)))
      ,(string-append "--team=" (format #f "~a" (concourse-worker-configuration-team config)))
      ,@(if (concourse-worker-configuration-mtu config)
            `(,(string-append "--containerd-mtu=" (format #f "~a" (concourse-worker-configuration-mtu config))))
            `())
      ,@(if (eq? (concourse-worker-configuration-runtime config) 'containerd)
            `(,#~(string-append "--containerd-init-bin=" #$(file-append (concourse-worker-configuration-concourse config) "/bin/init"))
              ,#~(string-append "--containerd-cni-plugins-dir=" #$(file-append (concourse-worker-configuration-concourse config) "/bin/"))
              ,(string-append "--containerd-dns-server=8.8.8.8")
              ,#~(string-append "--containerd-bin=" #$(file-append containerd "/bin/containerd")))
            '())
      ,@(map (lambda (tag)
               (string-append "--tag=" (format #f "~a" tag)))
             (concourse-worker-configuration-tags config))))

  (list (shepherd-service
         (documentation "concourse worker node")
         (requirement '(networking))
         (provision '(concourse-worker))
         (start #~(make-forkexec-constructor
                   (append (list #$(file-append (concourse-worker-configuration-concourse config)
                                                "/bin/concourse") "worker") (list #$@args))
                   #:log-file "/var/log/concourse-worker.log"
                   #:environment-variables (list (string-append "PATH=" #$iptables "/sbin:" #$tar "/bin:" #$gzip "/bin:" #$runc "/sbin"))))
                   ;; #:user #$(concourse-worker-configuration-user config)))
         (stop #~(make-kill-destructor))
         (auto-start? #t))))

(define* (concourse-worker-accounts config)
  (list
    (user-group (name (concourse-worker-configuration-user config)) (system? #t))
    (user-account
     (name (concourse-worker-configuration-user config))
     (group (concourse-worker-configuration-user config))
     (system? #t)
     (comment "concourse worker node user")
     (home-directory "/var/empty")
     (shell (file-append shadow "/sbin/nologin")))))

(define (concourse-worker-activation config)
  #~(begin
      (use-modules (guix build utils))
      (let* ((work-dir #$(concourse-worker-configuration-work-dir config))
             (username #$(concourse-worker-configuration-user config))
             (user (getpwnam username)))
        (mkdir-p work-dir))))
        ;; (chown work-dir (passwd:uid user) (passwd:gid user)))))

(define concourse-worker-service-type
  (service-type (name 'concourse-worker)
                (description
                 "run concourse worker node")
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          concourse-worker-shepherd-service)
                       (service-extension account-service-type
                                          concourse-worker-accounts)
                       (service-extension activation-service-type
                                          concourse-worker-activation)))))
