Toggle diff (237 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index e5894931ff..9352c56563 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -45962,6 +45962,16 @@ Invoking guix deploy
provisioning phase. If false, the server will be kept in order to debug
any issues.
+@item @code{ipv4} (default: @code{'create})
+When false, no public IPv4 address is going to be attached. Specify the
+name of an existing primary ip to attach it to the machine. Other values
+would create a new address automatically.
+
+@item @code{ipv6} (default: @code{'create})
+When false, no public IPv6 address is going to be attached. Specify the
+name of an existing primary ip to attach it to the machine. Other values
+would create a new address automatically.
+
@item @code{labels} (default: @code{'()})
A user defined alist of key/value pairs attached to the SSH key and the
server on the Hetzner API. Keys and values must be strings,
diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
index e8484e4d51..c1ccab54ae 100644
--- a/gnu/machine/hetzner.scm
+++ b/gnu/machine/hetzner.scm
@@ -73,6 +73,8 @@ (define-module (gnu machine hetzner)
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 @@ (define-record-type* <hetzner-configuration> hetzner-configuration
(default "fsn1"))
(server-type hetzner-configuration-server-type ; string
(default "cx42"))
+ (ipv4 hetzner-configuration-ipv4
+ (default 'create))
+ (ipv6 hetzner-configuration-ipv6
+ (default 'create))
(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 @@ (define (hetzner-machine-server machine)
(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 @@ (define (hetzner-machine-create-server machine)
(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))
+ ipv4)
#: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..33f501f53a 100644
--- a/gnu/machine/hetzner/http.scm
+++ b/gnu/machine/hetzner/http.scm
@@ -52,6 +52,7 @@ (define-module (gnu machine hetzner http)
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 @@ (define-module (gnu machine hetzner http)
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 @@ (define-module (gnu machine hetzner http)
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,15 @@ (define-json-mapping <hetzner-server-type>
(name hetzner-server-type-name) ; string
(storage-type hetzner-server-type-storage-type "storage_type")) ; string
+(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 +599,11 @@ (define* (hetzner-api-locations api . options)
(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 +612,11 @@ (define* (hetzner-api-server-create
#: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 +677,11 @@ (define* (hetzner-api-ssh-keys api . options)
(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"
diff --git a/tests/machine/hetzner/http.scm b/tests/machine/hetzner/http.scm
index 618d9a4c94..6c6d848a57 100644
--- a/tests/machine/hetzner/http.scm
+++ b/tests/machine/hetzner/http.scm
@@ -239,6 +239,30 @@ (define server-x86-alist
("status" . "running")
("volumes" . #())))
+(define primary-ip
+ (make-hetzner-primary-ip
+ #(55 2 19 28 9 123 6 300 -1 0 #f)
+ 42
+ "131.232.99.1"
+ '()
+ "static-ip"
+ "ipv4"))
+
+(define primary-ip-alist
+ `(("created" . "2023-10-28T19:02:55+00:00")
+ ("id" . 42)
+ ("labels")
+ ("name" . "static-ip")
+ ("blocked" . #f)
+ ("ip" . "131.232.99.1")
+ ("datacenter")
+ ("dns_ptr")
+ ("protection" . (("delete" . #f)))
+ ("type" . "ipv4")
+ ("auto_delete" . #t)
+ ("assignee_type" . "server")
+ ("assignee_id" . 17)))
+
(define ssh-key-root
(make-hetzner-ssh-key
#(55 2 19 28 9 123 6 300 -1 0 #f)
@@ -512,6 +536,20 @@ (define-syntax-rule (with-cleanup-api (api-sym api-init) body ...)
("ssh_keys" . #(,ssh-key-root-alist)))))))
(hetzner-api-ssh-keys (hetzner-api))))
+(test-equal "hetzner-api-primary-ips-unit"
+ (list primary-ip)
+ (mock ((gnu machine hetzner http) hetzner-api-request-send
+ (lambda* (request #:key expected)
+ (assert (equal? 'GET (hetzner-api-request-method request)))
+ (assert (equal? "https://api.hetzner.cloud/v1/primary_ips"
+ (hetzner-api-request-url request)))
+ (assert (unspecified? (hetzner-api-request-body request)))
+ (assert (equal? '(("page" . 1)) (hetzner-api-request-params request)))
+ (hetzner-api-response
+ (body `(("meta" . ,meta-page-alist)
+ ("primary_ips" . #(,primary-ip-alist)))))))
+ (hetzner-api-primary-ips (hetzner-api))))
+
;; Integration tests
(test-skip %when-no-token)
base-commit: 77ff73a920759437639e8eb77601e51409fefefa
prerequisite-patch-id: f9cc903b8048c8c6fde576fbf38ab110263020e3
prerequisite-patch-id: 220ddf11addf3a6c7ab3b349077bca6849241556
--
2.48.1
