mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-01 18:05:17 +00:00
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>
This commit is contained in:
Sergey Trofimov
Ludovic Courtès
parent
5f1ee7ba73
commit
7a4193ec4a
4 changed files with 100 additions and 6 deletions
|
|
@ -46544,6 +46544,12 @@ If true, the server will be deleted when an error happens in the
|
|||
provisioning phase. If false, the server will be kept in order to debug
|
||||
any issues.
|
||||
|
||||
@item @code{ipv4} (default: @code{#t})
|
||||
@itemx @code{ipv6} (default: @code{#t})
|
||||
When false, no public IP address is 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,
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -239,6 +239,30 @@
|
|||
("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 @@
|
|||
("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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue