machine: hetzner: Allow attaching existing public IPs.

* gnu/machine/hetzner.scm (hetzner-configuration): Add ipv4 and ipv6
fields. Export accessors.
* gnu/machine/hetzner/http.scm (hetnzer-api-primary-ips): New function.
(<hetzner-primary-ip>): New json mapping.
(hetzner-api-server-create): Pass IP addresses in request.
* doc/guix.texi (Invoking guix deploy): Document it.

Change-Id: I44509cc98e041762dc483e876566e79bde85b26a
Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 56 insertions, 6 deletions

diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
index e8484e4d51..ddac58dda0 100644
--- a/gnu/machine/hetzner.scm
+++ b/gnu/machine/hetzner.scm
@@ -73,6 +73,8 @@
             hetzner-configuration-authorize?
             hetzner-configuration-build-locally?
             hetzner-configuration-delete?
+            hetzner-configuration-ipv4
+            hetzner-configuration-ipv6
             hetzner-configuration-labels
             hetzner-configuration-location
             hetzner-configuration-server-type
@@ -205,6 +207,10 @@ Have you run 'guix archive --generate-key'?")
             (default "fsn1"))
   (server-type hetzner-configuration-server-type ; string
                (default "cx42"))
+  (ipv4 hetzner-configuration-ipv4      ; boolean | string
+        (default #t))
+  (ipv6 hetzner-configuration-ipv6      ; boolean | string
+        (default #t))
   (ssh-public-key hetzner-configuration-ssh-public-key ; public-key | string
                   (thunked)
                   (default (public-key-from-file (hetzner-configuration-ssh-key this-hetzner-configuration)))
@@ -445,6 +451,17 @@ values: list of output lines returned by CMD and its exit code."
            (hetzner-configuration-api config)
            #:params `(("name" . ,(machine-display-name machine)))))))
 
+(define (hetzner-resolve-ip api name)
+  "Find the NAME IP address on the Hetzner API."
+  (or
+   (find (lambda (primary-ip)
+           (equal? name (hetzner-primary-ip-name primary-ip)))
+         (hetzner-api-primary-ips api #:params `(("name" . ,name))))
+
+   (raise-exception
+    (formatted-message (G_ "primary ip '~a' does not exist.")
+                       name))))
+
 (define (hetzner-machine-create-server machine)
   "Create the Hetzner server for MACHINE."
   (let* ((config (machine-configuration machine))
@@ -452,11 +469,19 @@ values: list of output lines returned by CMD and its exit code."
          (server-type (hetzner-configuration-server-type config)))
     (format #t "creating '~a' server for '~a'...\n" server-type name)
     (let* ((ssh-key (hetzner-machine-ssh-key machine))
+           (ipv4 (hetzner-configuration-ipv4 config))
+           (ipv6 (hetzner-configuration-ipv6 config))
            (api (hetzner-configuration-api config))
            (server (hetzner-api-server-create
                     api
                     (machine-display-name machine)
                     (list ssh-key)
+                    #:ipv4 (if (string? ipv4)
+                               (hetzner-primary-ip-id (hetzner-resolve-ip api ipv4))
+                               ipv4)
+                    #:ipv6 (if (string? ipv6)
+                               (hetzner-primary-ip-id (hetzner-resolve-ip api ipv6))
+                               ipv6)
                     #:labels (hetzner-configuration-labels config)
                     #:location (hetzner-configuration-location config)
                     #:server-type (hetzner-configuration-server-type config)))
diff --git a/gnu/machine/hetzner/http.scm b/gnu/machine/hetzner/http.scm
index 51b4bff984..bd12e8ee5e 100644
--- a/gnu/machine/hetzner/http.scm
+++ b/gnu/machine/hetzner/http.scm
@@ -52,6 +52,7 @@
             hetzner-api-actions
             hetzner-api-create-ssh-key
             hetzner-api-locations
+            hetzner-api-primary-ips
             hetzner-api-request-body
             hetzner-api-request-headers
             hetzner-api-request-method
@@ -100,6 +101,13 @@
             hetzner-location-name
             hetzner-location-network-zone
             hetzner-location?
+            hetzner-primary-ip
+            hetzner-primary-ip-created
+            hetzner-primary-ip-id
+            hetzner-primary-ip-ip
+            hetzner-primary-ip-labels
+            hetzner-primary-ip-name
+            hetzner-primary-ip-type
             hetzner-public-net
             hetzner-public-net-ipv4
             hetzner-public-net-ipv6
@@ -144,6 +152,7 @@
             make-hetzner-ipv6
             make-hetzner-location
             make-hetzner-public-net
+            make-hetzner-primary-ip
             make-hetzner-resource
             make-hetzner-server
             make-hetzner-server-type
@@ -296,6 +305,16 @@
   (name hetzner-server-type-name) ; string
   (storage-type hetzner-server-type-storage-type "storage_type")) ; string
 
+;; Reserved IP address. https://docs.hetzner.cloud/#primary-ips
+(define-json-mapping <hetzner-primary-ip>
+  make-hetzner-primary-ip hetzner-primary-ip? json->hetzner-primary-ip
+  (created hetzner-primary-ip-created "created" string->time) ; time
+  (id hetzner-primary-ip-id) ; integer
+  (ip hetzner-primary-ip-ip) ; string
+  (labels hetzner-primary-ip-labels) ; alist of string/string
+  (name hetzner-primary-ip-name) ; string
+  (type hetzner-primary-ip-type))  ; string
+
 (define-json-mapping <hetzner-ssh-key>
   make-hetzner-ssh-key hetzner-ssh-key? json->hetzner-ssh-key
   (created hetzner-ssh-key-created "created" string->time) ; time
@@ -581,12 +600,11 @@
 (define* (hetzner-api-server-create
           api name ssh-keys
           #:key
-          (enable-ipv4? #t)
-          (enable-ipv6? #t)
+          (ipv4 #f)
+          (ipv6 #f)
           (image %hetzner-default-server-image)
           (labels '())
           (location %hetzner-default-server-location)
-          (public-net #f)
           (server-type %hetzner-default-server-type)
           (start-after-create? #f))
   "Create a server with the Hetzner API."
@@ -595,9 +613,11 @@
                #:body `(("image" . ,image)
                         ("labels" . ,labels)
                         ("name" . ,name)
-                        ("public_net"
-                         . (("enable_ipv4" . ,enable-ipv4?)
-                            ("enable_ipv6" . ,enable-ipv6?)))
+                        ("public_net" .
+                         (("enable_ipv4" . ,(and ipv4 #t))
+                          ("enable_ipv6" . ,(and ipv6 #t))
+                          ,@(if (integer? ipv4) `(("ipv4" . ,ipv4)) '())
+                          ,@(if (integer? ipv6) `(("ipv6" . ,ipv6)) '())))
                         ("location" . ,location)
                         ("server_type" . ,server-type)
                         ("ssh_keys" . ,(apply vector (map hetzner-ssh-key-id ssh-keys)))
@@ -658,6 +678,11 @@
   (apply hetzner-api-list api "/ssh_keys" "ssh_keys"
          json->hetzner-ssh-key options))
 
+(define* (hetzner-api-primary-ips api . options)
+  "Get Primary IPs from the Hetzner API."
+  (apply hetzner-api-list api "/primary_ips" "primary_ips"
+         json->hetzner-primary-ip options))
+
 (define* (hetzner-api-server-types api . options)
   "Get server types from the Hetzner API."
   (apply hetzner-api-list api "/server_types" "server_types"