1 files changed, 60 insertions, 0 deletions
diff --git a/guile/email-key-rotation/openstmpd.scm b/guile/email-key-rotation/openstmpd.scm
new file mode 100644
index 0000000..9ca2fab
--- /dev/null
+++ b/guile/email-key-rotation/openstmpd.scm
@@ -0,0 +1,60 @@
+(define-module (email-key-rotation gandi)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (ice-9 optargs)
+  #:export (<opensmtpd-configuration>
+	    make-openstmpd-configuration
+	    opensmtpd-configuration?
+	    api-key set-api-key
+	    domain set-domain
+	    gandi-livedns-request)
+  #:declarative? #t)
+
+(define-immutable-record-type <gandi-configuration>
+  (make-gandi-configuration api-key domain)
+  gandi-configuration?
+  (api-key api-key set-api-key)
+  (domain domain set-domain))
+
+(define* (gandi-livedns-request configuration
+				path-under-domain
+				#:key
+				(headers '())
+				(body #f)
+				(http-request http-request))
+  (with-exception-handler
+      (lambda (exn)
+	(raise-exception
+	 (make-exception
+	  (make-exception-with-origin 'gandi-http-request)
+	  (make-exception-with-irritants (list configuration
+					       path-under-domain
+					       headers
+					       body))
+	  (make-exception-with-message
+	   "cannot request Gandi livedns.")
+	  exn)))
+    (lambda ()
+      (unless (list? path-under-domain)
+	(raise-exception
+	 (make-error)
+	 (make-exception-with-irritants (list path-under-domain))
+	 (make-exception-with-message
+	  "the PATH-UNDER-DOMAIN argument must be a list of path items.")))
+      (let ((uri (build-uri
+		  'https
+		  #:host "api.gandi.net"
+		  #:path
+		  (string-append
+		   "/"
+		   (encode-and-join-uri-path
+		    `("v5"
+		      "livedns"
+		      "domains"
+		      ,domain
+		      ,@path-under-domain)))))
+	    (headers
+	     `((Authorization
+		. ,(string-append "ApiKey " (api-key configuration)))
+	       ,@headers)))
+	(http-request uri #:headers headers #:body body)))))