(define-module (tw services dns)
  #:use-module (gnu)
  #:use-module ((gnu packages guile) #:select (guile-json-4))
  #:use-module ((gnu packages tls) #:select (guile-gnutls))
  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services mcron)
  #:use-module (guix gexp)
  #:use-module ((guix records) #:select (match-record))
  #:export (mythic-dynamic-dns-configuration
            mythic-dynamic-dns-service-type))

(define (string-or-gexp? thing)
  (or (string? thing) (gexp? thing)))

(define-configuration/no-serialization mythic-dynamic-dns-configuration
  (schedule (string-or-gexp "*/15 * * * *") "The mcron schedule on which to
update the machine's IP address.")
  (credential-file (string "/etc/mythic-dns.scm") "The name of a file
containing authentication parameters as two Lisp strings, the first being a
username and the second being a password.  This file will be parsed using two
Guile @code{read} calls.")
  (host-name string "The host name to update with this device's public IP.")
  (ipv4? (boolean #t) "Whether to update the specified host's A record.")
  (ipv6? (boolean #t) "Whether to update the specified host's AAAA record."))

(define (mythic-dynamic-dns-cronjob config api-host)
  (match-record config <mythic-dynamic-dns-configuration> (schedule host-name credential-file)
    #~(job #$schedule
           #$(program-file (string-append "dynamic-dns-" api-host "-command")
               (with-extensions (list guile-json-4 guile-gnutls)  ; guile-gnutls needed by (web client)
                 #~(begin
                     (use-modules (srfi srfi-11)  ; `let*-values'
                                  (ice-9 iconv)
                                  (web client)
                                  (web response)
                                  (web uri)
                                  (json))
                     (let*-values
                         (((update-url)
                           (format #f "https://~a/dns/v2/dynamic/~a" #$api-host #$host-name))
                          ((auth-body)
                           (call-with-input-file #$credential-file
                             (lambda (port)
                               (string-append "username=" (uri-encode (read port))
                                              "&password=" (uri-encode (read port))))))
                          ((response body)
                           (http-post update-url #:body auth-body #:decode-body? #t
                                      #:headers '((content-type application/x-www-form-urlencoded))))
                          ;; For some reason, the body is not decoded, even with `#:decode-body? #t'.
                          ((decoded-body)
                           (and body (bytevector->string body "utf-8"))))
                       (if (= 200 (response-code response))
                           (format (current-error-port) "Success: ~a\n"
                                   (assoc-ref (json-string->scm decoded-body) "message"))
                           (format (current-error-port) "Got error response ~a: ~a\n"
                                   response decoded-body)))))))))

(define (mythic-dynamic-dns-cronjobs config)
  (match-record config <mythic-dynamic-dns-configuration> (ipv4? ipv6?)
    (append (if ipv4? (list (mythic-dynamic-dns-cronjob config "ipv4.api.mythic-beasts.com")) '())
            (if ipv6? (list (mythic-dynamic-dns-cronjob config "ipv6.api.mythic-beasts.com")) '()))))

(define mythic-dynamic-dns-service-type
  (service-type
   (name 'mythic-dynamic-dns)
   (extensions
    (list (service-extension mcron-service-type mythic-dynamic-dns-cronjobs)))
   (description "Periodically update the host's DNS records with Mythic Beasts.")))