summaryrefslogtreecommitdiff
path: root/tests/machine
diff options
context:
space:
mode:
authorRoman Scherer <roman@burningswell.com>2025-02-04 20:01:14 +0100
committerLudovic Courtès <ludo@gnu.org>2025-02-09 18:20:42 +0100
commit0753a17ddf6f4fab98b93c25f1a93b97ff9e46bb (patch)
treee56f2bcb4c52186364ee63a065bc6a20a2e252be /tests/machine
parent96f05f003a862c198e803901abf6f50b23969697 (diff)
machine: Implement 'hetzner-environment-type'.
* Makefile.am (SCM_TESTS): Add test modules. * doc/guix.texi: Add documentation. * gnu/local.mk (GNU_SYSTEM_MODULES): Add modules. * gnu/machine/hetzner.scm: Add hetzner-environment-type. * gnu/machine/hetzner/http.scm: Add HTTP API. * po/guix/POTFILES.in: Add Hetzner modules. * tests/machine/hetzner.scm: Add machine tests. * tests/machine/hetzner/http.scm Add HTTP API tests. Change-Id: I276ed5afed676bbccc6c852c56ee4db57ce3c1ea Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'tests/machine')
-rw-r--r--tests/machine/hetzner.scm267
-rw-r--r--tests/machine/hetzner/http.scm631
2 files changed, 898 insertions, 0 deletions
diff --git a/tests/machine/hetzner.scm b/tests/machine/hetzner.scm
new file mode 100644
index 00000000000..39eac4a4d5f
--- /dev/null
+++ b/tests/machine/hetzner.scm
@@ -0,0 +1,267 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Roman Scherer <roman@burningswell.com>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (tests machine hetzner)
20 #:use-module (gnu machine hetzner http)
21 #:use-module (gnu machine hetzner)
22 #:use-module (gnu machine ssh)
23 #:use-module (gnu machine)
24 #:use-module (gnu system)
25 #:use-module (guix build utils)
26 #:use-module (guix records)
27 #:use-module (guix ssh)
28 #:use-module (guix tests)
29 #:use-module (srfi srfi-1)
30 #:use-module (srfi srfi-34)
31 #:use-module (srfi srfi-64)
32 #:use-module (ssh key)
33 #:use-module (ssh session))
34
35;;; Unit and integration tests for the (gnu machine hetzner) module.
36
37;; Integration tests require the GUIX_HETZNER_API_TOKEN environment variable.
38;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
39
40;; The integration tests sometimes fail due to the Hetzner API not being able
41;; to allocate a resource. Switching to a different location might help.
42
43(define %labels
44 '(("guix.gnu.org/test" . "true")))
45
46(define %ssh-key-name
47 "guix-hetzner-machine-test-key")
48
49(define %ssh-key-file
50 (string-append "/tmp/" %ssh-key-name))
51
52(unless (file-exists? %ssh-key-file)
53 (private-key-to-file (make-keypair 'rsa 2048) %ssh-key-file))
54
55(define %when-no-token
56 (if (hetzner-api-token (hetzner-api)) 0 1))
57
58(define %arm-machine
59 (machine
60 (operating-system
61 (operating-system
62 (inherit %hetzner-os-arm)
63 (host-name "guix-deploy-hetzner-test-arm")))
64 (environment hetzner-environment-type)
65 (configuration (hetzner-configuration
66 (labels %labels)
67 (server-type "cax41")
68 (ssh-key %ssh-key-file)))))
69
70(define %x86-machine
71 (machine
72 (operating-system
73 (operating-system
74 (inherit %hetzner-os-x86)
75 (host-name "guix-deploy-hetzner-test-x86")))
76 (environment hetzner-environment-type)
77 (configuration (hetzner-configuration
78 (labels %labels)
79 (server-type "cpx51")
80 (ssh-key %ssh-key-file)))))
81
82(define (cleanup machine)
83 (let* ((config (machine-configuration machine))
84 (api (hetzner-configuration-api config)))
85 (for-each (lambda (server)
86 (hetzner-api-server-delete api server))
87 (hetzner-api-servers
88 api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
89 (for-each (lambda (ssh-key)
90 (hetzner-api-ssh-key-delete api ssh-key))
91 (hetzner-api-ssh-keys
92 api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
93 machine))
94
95(define-syntax-rule (with-cleanup (machine-sym machine-init) body ...)
96 (let ((machine-sym (cleanup machine-init)))
97 (dynamic-wind
98 (const #t)
99 (lambda ()
100 body ...)
101 (lambda ()
102 (cleanup machine-sym)))))
103
104(define (mock-action command)
105 (make-hetzner-action
106 command #f
107 (localtime (current-time))
108 1
109 100
110 '()
111 (localtime (current-time))
112 "success"))
113
114(define (mock-location machine)
115 (let* ((config (machine-configuration machine))
116 (name (hetzner-configuration-location config)))
117 (make-hetzner-location
118 "Falkenstein" "DE" "Falkenstein DC Park 1"
119 1 50.47612 12.370071 name "eu-central")))
120
121(define (mock-server-type machine)
122 (let* ((config (machine-configuration machine))
123 (name (hetzner-configuration-server-type config)))
124 (make-hetzner-server-type
125 "x86" 8 "shared" #f #f (string-upcase name)
126 160 106 16 name "local")))
127
128(define (mock-server machine)
129 (let* ((config (machine-configuration machine))
130 (name (hetzner-configuration-location config)))
131 (make-hetzner-server
132 1
133 (localtime (current-time))
134 '()
135 (operating-system-host-name (machine-operating-system machine))
136 (make-hetzner-public-net
137 (make-hetzner-ipv4 #f "server.example.com" 1 "1.2.3.4")
138 (make-hetzner-ipv6 #f "server.example.com" 1 "2001:db8::1"))
139 #f
140 (mock-server-type machine))))
141
142(define (mock-ssh-key machine)
143 (let ((config (machine-configuration machine)))
144 (hetzner-ssh-key-read-file (hetzner-configuration-ssh-key config))))
145
146(define (expected-ssh-machine? machine ssh-machine)
147 (let ((config (machine-configuration machine))
148 (ssh-config (machine-configuration ssh-machine)))
149 (and (equal? (hetzner-configuration-authorize? config)
150 (machine-ssh-configuration-authorize? ssh-config))
151 (equal? (hetzner-configuration-allow-downgrades? config)
152 (machine-ssh-configuration-allow-downgrades? ssh-config))
153 (equal? (hetzner-configuration-build-locally? config)
154 (machine-ssh-configuration-build-locally? ssh-config))
155 (equal? (hetzner-server-public-ipv4 (mock-server machine))
156 (machine-ssh-configuration-host-name ssh-config)))))
157
158(define-syntax mock*
159 (syntax-rules ()
160 ((mock* () body1 body2 ...)
161 (let () body1 body2 ...))
162 ((mock* ((mod1 sym1 fn1) (mod2 sym2 fn2) ...)
163 body1 body2 ...)
164 (mock (mod1 sym1 fn1)
165 (mock* ((mod2 sym2 fn2) ...)
166 body1) body2 ...))))
167
168(test-begin "machine-hetzner")
169
170;; The following tests deploy real machines using the Hetzner API and shut
171;; them down afterwards.
172
173(test-skip %when-no-token)
174(test-assert "deploy-arm-machine"
175 (with-cleanup (machine %arm-machine)
176 (deploy-hetzner machine)))
177
178(test-skip %when-no-token)
179(test-assert "deploy-x86-machine"
180 (with-cleanup (machine %x86-machine)
181 (deploy-hetzner machine)))
182
183;; The following tests simulate a deployment, they mock out the actual calls
184;; to the Hetzner API.
185
186;; Note: In order for mocking to work, the Guile compiler should not inline
187;; the mocked functions. To prevent this it was necessary to set!
188;; hetzner-machine-ssh-run-script in (gnu machine hetzner) like this:
189
190;; (set! hetzner-machine-ssh-run-script hetzner-machine-ssh-run-script)
191
192(test-assert "deploy-machine-mock-with-provisioned-server"
193 (let ((machine (machine
194 (operating-system %hetzner-os-x86)
195 (environment hetzner-environment-type)
196 (configuration (hetzner-configuration
197 (api (hetzner-api (token "mock")))
198 (ssh-key %ssh-key-file))))))
199 (mock* (((gnu machine hetzner http) hetzner-api-locations
200 (lambda* (api . options)
201 (list (mock-location machine))))
202 ((gnu machine hetzner http) hetzner-api-server-types
203 (lambda* (api . options)
204 (list (mock-server-type machine))))
205 ((gnu machine hetzner http) hetzner-api-ssh-keys
206 (lambda* (api . options)
207 (list (mock-ssh-key machine))))
208 ((gnu machine hetzner http) hetzner-api-servers
209 (lambda* (api . options)
210 (list (mock-server machine))))
211 ((gnu machine) deploy-machine
212 (lambda* (ssh-machine)
213 (expected-ssh-machine? machine ssh-machine))))
214 (deploy-hetzner machine))))
215
216(test-assert "deploy-machine-mock-with-unprovisioned-server"
217 (let ((machine (machine
218 (operating-system %hetzner-os-x86)
219 (environment hetzner-environment-type)
220 (configuration (hetzner-configuration
221 (api (hetzner-api (token "mock")))
222 (ssh-key %ssh-key-file)))))
223 (servers '()))
224 (mock* (((gnu machine hetzner http) hetzner-api-locations
225 (lambda* (api . options)
226 (list (mock-location machine))))
227 ((gnu machine hetzner http) hetzner-api-server-types
228 (lambda* (api . options)
229 (list (mock-server-type machine))))
230 ((gnu machine hetzner http) hetzner-api-ssh-keys
231 (lambda* (api . options)
232 (list (mock-ssh-key machine))))
233 ((gnu machine hetzner http) hetzner-api-servers
234 (lambda* (api . options)
235 servers))
236 ((gnu machine hetzner http) hetzner-api-server-create
237 (lambda* (api name ssh-keys . options)
238 (set! servers (list (mock-server machine)))
239 (car servers)))
240 ((gnu machine hetzner http) hetzner-api-server-enable-rescue-system
241 (lambda (api server ssh-keys)
242 (mock-action "enable_rescue")))
243 ((gnu machine hetzner http) hetzner-api-server-power-on
244 (lambda (api server)
245 (mock-action "start_server")))
246 ((gnu machine hetzner) hetzner-machine-ssh-run-script
247 (lambda (ssh-session name content)
248 #t))
249 ((guix ssh) open-ssh-session
250 (lambda* (host . options)
251 (make-session #:host host)))
252 ((gnu machine hetzner http) hetzner-api-server-reboot
253 (lambda (api server)
254 (mock-action "reboot_server")))
255 ((ssh session) write-known-host!
256 (lambda (session)
257 #t))
258 ((gnu machine) deploy-machine
259 (lambda* (ssh-machine)
260 (expected-ssh-machine? machine ssh-machine))))
261 (deploy-hetzner machine))))
262
263(test-end "machine-hetzner")
264
265;; Local Variables:
266;; eval: (put 'with-cleanup 'scheme-indent-function 1)
267;; End:
diff --git a/tests/machine/hetzner/http.scm b/tests/machine/hetzner/http.scm
new file mode 100644
index 00000000000..618d9a4c94e
--- /dev/null
+++ b/tests/machine/hetzner/http.scm
@@ -0,0 +1,631 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024 Roman Scherer <roman@burningswell.com>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (tests machine hetzner http)
20 #:use-module (debugging assert)
21 #:use-module (gnu machine hetzner http)
22 #:use-module (guix build utils)
23 #:use-module (guix tests)
24 #:use-module (srfi srfi-1)
25 #:use-module (srfi srfi-34)
26 #:use-module (srfi srfi-64)
27 #:use-module (ssh key))
28
29;; Unit and integration tests the (gnu machine hetzner http) module.
30
31;; Integration tests require the GUIX_HETZNER_API_TOKEN environment variable.
32;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
33
34;; The integration tests sometimes fail due to the Hetzner API not being able
35;; to allocate a resource. Switching to a different location might help.
36
37(define %labels
38 '(("guix.gnu.org/test" . "true")))
39
40(define %server-name
41 "guix-hetzner-api-test-server")
42
43(define %ssh-key-name
44 "guix-hetzner-api-test-key")
45
46(define %ssh-key-file
47 (string-append "/tmp/" %ssh-key-name))
48
49(unless (file-exists? %ssh-key-file)
50 (private-key-to-file (make-keypair 'rsa 2048) %ssh-key-file))
51
52(define %ssh-key
53 (hetzner-ssh-key-read-file %ssh-key-file))
54
55(define %when-no-token
56 (if (hetzner-api-token (hetzner-api)) 0 1))
57
58(define action-create-server
59 (make-hetzner-action
60 "create_server" #f *unspecified* 1896091819 0
61 (list (make-hetzner-resource 59570198 "server"))
62 #(0 17 11 2 1 125 0 32 -1 0 #f) "running"))
63
64(define action-create-server-alist
65 '(("command" . "create_server")
66 ("error" . null)
67 ("finished" . null)
68 ("id" . 1896091819)
69 ("progress" . 0)
70 ("resources" . #((("type" . "server") ("id" . 59570198))))
71 ("started" . "2025-02-02T11:17:00+00:00")
72 ("status" . "running")))
73
74(define action-delete-server
75 (make-hetzner-action
76 "delete_server" #f *unspecified* 1896091928 0
77 (list (make-hetzner-resource 59570198 "server"))
78 #(10 17 11 2 1 125 0 32 -1 0 #f) "running"))
79
80(define action-delete-server-alist
81 '(("command" . "delete_server")
82 ("error" . null)
83 ("finished" . null)
84 ("id" . 1896091928)
85 ("progress" . 0)
86 ("resources" . #((("type" . "server") ("id" . 59570198))))
87 ("started" . "2025-02-02T11:17:10+00:00")
88 ("status" . "running")))
89
90(define action-enable-rescue
91 (make-hetzner-action
92 "enable_rescue" #f *unspecified* 1896091721 0
93 (list (make-hetzner-resource 59570198 "server"))
94 #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
95
96(define action-enable-rescue-alist
97 '(("command" . "enable_rescue")
98 ("error" . null)
99 ("finished" . null)
100 ("id" . 1896091721)
101 ("progress" . 0)
102 ("resources" . #((("type" . "server") ("id" . 59570198))))
103 ("started" . "2025-02-02T11:17:10+00:00")
104 ("status" . "running")))
105
106(define action-power-off
107 (make-hetzner-action
108 "stop_server" #f *unspecified* 1896091721 0
109 (list (make-hetzner-resource 59570198 "server"))
110 #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
111
112(define action-power-off-alist
113 '(("command" . "stop_server")
114 ("error" . null)
115 ("finished" . null)
116 ("id" . 1896091721)
117 ("progress" . 0)
118 ("resources" . #((("type" . "server") ("id" . 59570198))))
119 ("started" . "2025-02-02T11:17:10+00:00")
120 ("status" . "running")))
121
122(define action-power-on
123 (make-hetzner-action
124 "start_server" #f *unspecified* 1896091721 0
125 (list (make-hetzner-resource 59570198 "server"))
126 #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
127
128(define action-power-on-alist
129 '(("command" . "start_server")
130 ("error" . null)
131 ("finished" . null)
132 ("id" . 1896091721)
133 ("progress" . 0)
134 ("resources" . #((("type" . "server") ("id" . 59570198))))
135 ("started" . "2025-02-02T11:17:10+00:00")
136 ("status" . "running")))
137
138(define action-reboot
139 (make-hetzner-action
140 "reboot_server" #f *unspecified* 1896091721 0
141 (list (make-hetzner-resource 59570198 "server"))
142 #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
143
144(define action-reboot-alist
145 '(("command" . "reboot_server")
146 ("error" . null)
147 ("finished" . null)
148 ("id" . 1896091721)
149 ("progress" . 0)
150 ("resources" . #((("type" . "server") ("id" . 59570198))))
151 ("started" . "2025-02-02T11:17:10+00:00")
152 ("status" . "running")))
153
154(define meta-page-alist
155 '("pagination"
156 ("last_page" . 1)
157 ("next_page" . null)
158 ("page" . 1)
159 ("per_page" . 25)
160 ("previous_page" . null)
161 ("total_entries" . 1)))
162
163(define location-falkenstein
164 (make-hetzner-location
165 "Falkenstein" "DE" "Falkenstein DC Park 1"
166 1 50.47612 12.370071 "fsn1" "eu-central"))
167
168(define location-falkenstein-alist
169 `(("city" . "Falkenstein")
170 ("country" . "DE")
171 ("description" . "Falkenstein DC Park 1")
172 ("id" . 1)
173 ("latitude" . 50.47612)
174 ("longitude" . 12.370071)
175 ("name" . "fsn1")
176 ("network_zone" . "eu-central")))
177
178(define server-type-cpx-11
179 (make-hetzner-server-type
180 "x86" 2 "shared" #f *unspecified*
181 "CPX 11" 40 22 2 "cpx11" "local"))
182
183(define server-type-cpx-11-alist
184 `(("architecture" . "x86")
185 ("cores" . 2)
186 ("cpu_type" . "shared")
187 ("deprecated" . #f)
188 ("deprecation" . null)
189 ("description" . "CPX 11")
190 ("disk" . 40)
191 ("id" . 22)
192 ("memory" . 2)
193 ("name" . "cpx11")
194 ("storage_type" . "local")))
195
196(define server-x86
197 (make-hetzner-server
198 "2024-12-30T16:38:11+00:00"
199 59570198
200 '()
201 "guix-x86"
202 (make-hetzner-public-net
203 (make-hetzner-ipv4 #f "static.218.128.13.49.clients.your-server.de" 78014457 "49.13.128.218")
204 (make-hetzner-ipv6 #f '() 78014458 "2a01:4f8:c17:293e::/64"))
205 #f
206 server-type-cpx-11))
207
208(define server-x86-alist
209 `(("backup_window" . null)
210 ("created" . "2024-12-30T16:38:11+00:00")
211 ("id" . 59570198)
212 ("included_traffic" . 21990232555520)
213 ("ingoing_traffic" . 124530000)
214 ("iso" . null)
215 ("labels")
216 ("load_balancers" . #())
217 ("locked" . #f)
218 ("name" . "guix-x86")
219 ("outgoing_traffic" . 1391250000)
220 ("placement_group" . null)
221 ("primary_disk_size" . 320)
222 ("private_net" . #())
223 ("protection" ("rebuild" . #f) ("delete" . #f))
224 ("public_net"
225 ("firewalls" . #())
226 ("floating_ips" . #())
227 ("ipv6"
228 ("id" . 78014458)
229 ("dns_ptr" . #())
230 ("blocked" . #f)
231 ("ip" . "2a01:4f8:c17:293e::/64"))
232 ("ipv4"
233 ("id" . 78014457)
234 ("dns_ptr" . "static.218.128.13.49.clients.your-server.de")
235 ("blocked" . #f)
236 ("ip" . "49.13.128.218")))
237 ("rescue_enabled" . #f)
238 ("server_type" ,@server-type-cpx-11-alist)
239 ("status" . "running")
240 ("volumes" . #())))
241
242(define ssh-key-root
243 (make-hetzner-ssh-key
244 #(55 2 19 28 9 123 6 300 -1 0 #f)
245 "8c:25:09:8f:37:0f:d8:f0:99:4e:ab:c7:5c:1b:c6:53"
246 16510983 '() "root@example.com"
247 "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM"))
248
249(define ssh-key-root-alist
250 `(("created" . "2023-10-28T19:02:55+00:00")
251 ("fingerprint" . "8c:25:09:8f:37:0f:d8:f0:99:4e:ab:c7:5c:1b:c6:53")
252 ("id" . 16510983)
253 ("labels")
254 ("name" . "root@example.com")
255 ("public_key" . "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM")))
256
257(define* (create-ssh-key api ssh-key #:key (labels %labels))
258 (hetzner-api-ssh-key-create
259 api
260 (hetzner-ssh-key-name ssh-key)
261 (hetzner-ssh-key-public-key ssh-key)
262 #:labels labels))
263
264(define* (create-server api ssh-key #:key (labels %labels))
265 (hetzner-api-server-create api %server-name (list ssh-key)
266 #:labels labels
267 #:server-type "cpx31"))
268
269(define (cleanup api)
270 (for-each (lambda (server)
271 (hetzner-api-server-delete api server))
272 (hetzner-api-servers
273 api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
274 (for-each (lambda (ssh-key)
275 (hetzner-api-ssh-key-delete api ssh-key))
276 (hetzner-api-ssh-keys
277 api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
278 api)
279
280(define-syntax-rule (with-cleanup-api (api-sym api-init) body ...)
281 (let ((api-sym (cleanup api-init)))
282 (dynamic-wind
283 (const #t)
284 (lambda ()
285 body ...)
286 (lambda ()
287 (cleanup api-sym)))))
288
289(test-begin "machine-hetzner-api")
290
291;; Unit Tests
292
293(test-equal "hetzner-api-actions-unit"
294 (list action-create-server action-delete-server)
295 (let ((actions (list action-create-server-alist action-delete-server-alist)))
296 (mock ((gnu machine hetzner http) hetzner-api-request-send
297 (lambda* (request #:key expected)
298 (assert (equal? 'GET (hetzner-api-request-method request)))
299 (assert (equal? "https://api.hetzner.cloud/v1/actions"
300 (hetzner-api-request-url request)))
301 (assert (unspecified? (hetzner-api-request-body request)))
302 (assert (equal? `(("page" . 1)
303 ("id" . ,(string-join
304 (map (lambda (action)
305 (number->string (assoc-ref action "id")))
306 actions)
307 ",")))
308 (hetzner-api-request-params request)))
309 (hetzner-api-response
310 (body `(("meta" . ,meta-page-alist)
311 ("actions" . #(,action-create-server-alist ,action-delete-server-alist)))))))
312 (hetzner-api-actions (hetzner-api)
313 (map (lambda (action)
314 (assoc-ref action "id"))
315 actions)))))
316
317(test-equal "hetzner-api-locations-unit"
318 (list location-falkenstein)
319 (mock ((gnu machine hetzner http) hetzner-api-request-send
320 (lambda* (request #:key expected)
321 (assert (equal? 'GET (hetzner-api-request-method request)))
322 (assert (equal? "https://api.hetzner.cloud/v1/locations"
323 (hetzner-api-request-url request)))
324 (assert (unspecified? (hetzner-api-request-body request)))
325 (assert (equal? '(("page" . 1)) (hetzner-api-request-params request)))
326 (hetzner-api-response
327 (body `(("meta" . ,meta-page-alist)
328 ("locations" . #(,location-falkenstein-alist)))))))
329 (hetzner-api-locations (hetzner-api))))
330
331(test-equal "hetzner-api-server-types-unit"
332 (list server-type-cpx-11)
333 (mock ((gnu machine hetzner http) hetzner-api-request-send
334 (lambda* (request #:key expected)
335 (assert (equal? 'GET (hetzner-api-request-method request)))
336 (assert (equal? "https://api.hetzner.cloud/v1/server_types"
337 (hetzner-api-request-url request)))
338 (assert (unspecified? (hetzner-api-request-body request)))
339 (assert (equal? '(("page" . 1)) (hetzner-api-request-params request)))
340 (hetzner-api-response
341 (body `(("meta" . ,meta-page-alist)
342 ("server_types" . #(,server-type-cpx-11-alist)))))))
343 (hetzner-api-server-types (hetzner-api))))
344
345(test-equal "hetzner-api-server-create-unit"
346 server-x86
347 (mock ((gnu machine hetzner http) hetzner-api-request-send
348 (lambda* (request #:key expected)
349 (cond
350 ((equal? "https://api.hetzner.cloud/v1/servers"
351 (hetzner-api-request-url request))
352 (assert (equal? 'POST (hetzner-api-request-method request)))
353 (hetzner-api-response
354 (body `(("action" . ,action-create-server-alist)
355 ("server" . ,server-x86-alist)))))
356 ((equal? "https://api.hetzner.cloud/v1/actions"
357 (hetzner-api-request-url request))
358 (assert (equal? 'GET (hetzner-api-request-method request)))
359 (hetzner-api-response
360 (body `(("actions" . ,(vector (cons `("status" . "success")
361 action-create-server-alist)))
362 ("meta" . ,meta-page-alist))))))))
363 (hetzner-api-server-create (hetzner-api) %server-name (list ssh-key-root))))
364
365(test-equal "hetzner-api-server-delete-unit"
366 (make-hetzner-action
367 "delete_server" #f *unspecified* 1896091928 0
368 (list (make-hetzner-resource 59570198 "server"))
369 #(10 17 11 2 1 125 0 32 -1 0 #f) "success")
370 (mock ((gnu machine hetzner http) hetzner-api-request-send
371 (lambda* (request #:key expected)
372 (cond
373 ((equal? "https://api.hetzner.cloud/v1/servers/59570198"
374 (hetzner-api-request-url request))
375 (assert (equal? 'DELETE (hetzner-api-request-method request)))
376 (hetzner-api-response
377 (body `(("action" . ,action-delete-server-alist)))))
378 ((equal? "https://api.hetzner.cloud/v1/actions"
379 (hetzner-api-request-url request))
380 (assert (equal? 'GET (hetzner-api-request-method request)))
381 (hetzner-api-response
382 (body `(("actions" . ,(vector (cons `("status" . "success")
383 action-delete-server-alist)))
384 ("meta" . ,meta-page-alist))))))))
385 (hetzner-api-server-delete (hetzner-api) server-x86)))
386
387(test-equal "hetzner-api-server-enable-rescue-system-unit"
388 action-enable-rescue
389 (mock ((gnu machine hetzner http) hetzner-api-request-send
390 (lambda* (request #:key expected)
391 (cond
392 ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/enable_rescue"
393 (hetzner-api-request-url request))
394 (assert (equal? 'POST (hetzner-api-request-method request)))
395 (hetzner-api-response
396 (body `(("action" . ,action-enable-rescue-alist)))))
397 ((equal? "https://api.hetzner.cloud/v1/actions"
398 (hetzner-api-request-url request))
399 (assert (equal? 'GET (hetzner-api-request-method request)))
400 (hetzner-api-response
401 (body `(("actions" . ,(vector (cons `("status" . "success")
402 action-enable-rescue-alist)))
403 ("meta" . ,meta-page-alist))))))))
404 (hetzner-api-server-enable-rescue-system (hetzner-api) server-x86 (list ssh-key-root))))
405
406(test-equal "hetzner-api-server-power-on-unit"
407 action-power-on
408 (mock ((gnu machine hetzner http) hetzner-api-request-send
409 (lambda* (request #:key expected)
410 (cond
411 ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/poweron"
412 (hetzner-api-request-url request))
413 (assert (equal? 'POST (hetzner-api-request-method request)))
414 (hetzner-api-response
415 (body `(("action" . ,action-power-on-alist)))))
416 ((equal? "https://api.hetzner.cloud/v1/actions"
417 (hetzner-api-request-url request))
418 (assert (equal? 'GET (hetzner-api-request-method request)))
419 (hetzner-api-response
420 (body `(("actions" . ,(vector (cons `("status" . "success")
421 action-power-on-alist)))
422 ("meta" . ,meta-page-alist))))))))
423 (hetzner-api-server-power-on (hetzner-api) server-x86)))
424
425(test-equal "hetzner-api-server-power-off-unit"
426 action-power-off
427 (mock ((gnu machine hetzner http) hetzner-api-request-send
428 (lambda* (request #:key expected)
429 (cond
430 ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/poweroff"
431 (hetzner-api-request-url request))
432 (assert (equal? 'POST (hetzner-api-request-method request)))
433 (hetzner-api-response
434 (body `(("action" . ,action-power-off-alist)))))
435 ((equal? "https://api.hetzner.cloud/v1/actions"
436 (hetzner-api-request-url request))
437 (assert (equal? 'GET (hetzner-api-request-method request)))
438 (hetzner-api-response
439 (body `(("actions" . ,(vector (cons `("status" . "success")
440 action-power-off-alist)))
441 ("meta" . ,meta-page-alist))))))))
442 (hetzner-api-server-power-off (hetzner-api) server-x86)))
443
444(test-equal "hetzner-api-server-reboot-unit"
445 action-reboot
446 (mock ((gnu machine hetzner http) hetzner-api-request-send
447 (lambda* (request #:key expected)
448 (cond
449 ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/reboot"
450 (hetzner-api-request-url request))
451 (assert (equal? 'POST (hetzner-api-request-method request)))
452 (hetzner-api-response
453 (body `(("action" . ,action-reboot-alist)))))
454 ((equal? "https://api.hetzner.cloud/v1/actions"
455 (hetzner-api-request-url request))
456 (assert (equal? 'GET (hetzner-api-request-method request)))
457 (hetzner-api-response
458 (body `(("actions" . ,(vector (cons `("status" . "success")
459 action-reboot-alist)))
460 ("meta" . ,meta-page-alist))))))))
461 (hetzner-api-server-reboot (hetzner-api) server-x86)))
462
463(test-equal "hetzner-api-servers-unit"
464 (list server-x86)
465 (mock ((gnu machine hetzner http) hetzner-api-request-send
466 (lambda* (request #:key expected)
467 (hetzner-api-response
468 (body `(("meta" . ,meta-page-alist)
469 ("servers" . #(,server-x86-alist)))))))
470 (hetzner-api-servers (hetzner-api))))
471
472(test-equal "hetzner-api-ssh-key-create-unit"
473 ssh-key-root
474 (mock ((gnu machine hetzner http) hetzner-api-request-send
475 (lambda* (request #:key expected)
476 (assert (equal? 'POST (hetzner-api-request-method request)))
477 (assert (equal? "https://api.hetzner.cloud/v1/ssh_keys"
478 (hetzner-api-request-url request)))
479 (assert (equal? `(("name" . "guix-hetzner-api-test-key")
480 ("public_key" . "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM")
481 ("labels" . (("a" . "1"))))
482 (hetzner-api-request-body request)))
483 (assert (equal? `() (hetzner-api-request-params request)))
484 (hetzner-api-response
485 (body `(("ssh_key" . ,ssh-key-root-alist))))))
486 (hetzner-api-ssh-key-create
487 (hetzner-api)
488 "guix-hetzner-api-test-key"
489 "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM"
490 #:labels '(("a" . "1")))))
491
492(test-assert "hetzner-api-ssh-key-delete-unit"
493 (mock ((gnu machine hetzner http) hetzner-api-request-send
494 (lambda* (request #:key expected)
495 (assert (equal? "https://api.hetzner.cloud/v1/ssh_keys/16510983"
496 (hetzner-api-request-url request)))
497 (assert (equal? 'DELETE (hetzner-api-request-method request)))
498 (hetzner-api-response)))
499 (hetzner-api-ssh-key-delete (hetzner-api) ssh-key-root)))
500
501(test-equal "hetzner-api-ssh-keys-unit"
502 (list ssh-key-root)
503 (mock ((gnu machine hetzner http) hetzner-api-request-send
504 (lambda* (request #:key expected)
505 (assert (equal? 'GET (hetzner-api-request-method request)))
506 (assert (equal? "https://api.hetzner.cloud/v1/ssh_keys"
507 (hetzner-api-request-url request)))
508 (assert (unspecified? (hetzner-api-request-body request)))
509 (assert (equal? '(("page" . 1)) (hetzner-api-request-params request)))
510 (hetzner-api-response
511 (body `(("meta" . ,meta-page-alist)
512 ("ssh_keys" . #(,ssh-key-root-alist)))))))
513 (hetzner-api-ssh-keys (hetzner-api))))
514
515;; Integration tests
516
517(test-skip %when-no-token)
518(test-assert "hetzner-api-actions-integration"
519 (with-cleanup-api (api (hetzner-api))
520 (let* ((ssh-key (create-ssh-key api %ssh-key))
521 (server (create-server api ssh-key))
522 (action (hetzner-api-server-enable-rescue-system api server (list ssh-key))))
523 (member action (hetzner-api-actions api (list (hetzner-action-id action)))))))
524
525(test-skip %when-no-token)
526(test-assert "hetzner-api-locations-integration"
527 (let ((locations (hetzner-api-locations (hetzner-api))))
528 (and (> (length locations) 0)
529 (every hetzner-location? locations))))
530
531(test-skip %when-no-token)
532(test-assert "hetzner-api-server-types-integration"
533 (let ((server-types (hetzner-api-server-types (hetzner-api))))
534 (and (> (length server-types) 0)
535 (every hetzner-server-type? server-types))))
536
537(test-skip %when-no-token)
538(test-assert "hetzner-api-server-create-integration"
539 (with-cleanup-api (api (hetzner-api))
540 (let* ((ssh-key (create-ssh-key api %ssh-key))
541 (server (create-server api ssh-key)))
542 (and (hetzner-server? server)
543 (equal? %server-name (hetzner-server-name server))))))
544
545(test-skip %when-no-token)
546(test-assert "hetzner-api-server-delete-integration"
547 (with-cleanup-api (api (hetzner-api))
548 (let* ((ssh-key (create-ssh-key api %ssh-key))
549 (server (create-server api ssh-key))
550 (action (hetzner-api-server-delete api server)))
551 (and (hetzner-action? action)
552 (equal? "delete_server"
553 (hetzner-action-command action))))))
554
555(test-skip %when-no-token)
556(test-assert "hetzner-api-server-enable-rescue-system-integration"
557 (with-cleanup-api (api (hetzner-api))
558 (let* ((ssh-key (create-ssh-key api %ssh-key))
559 (server (create-server api ssh-key))
560 (action (hetzner-api-server-enable-rescue-system api server (list ssh-key))))
561 (and (hetzner-action? action)
562 (equal? "enable_rescue"
563 (hetzner-action-command action))))))
564
565(test-skip %when-no-token)
566(test-assert "hetzner-api-server-power-on-integration"
567 (with-cleanup-api (api (hetzner-api))
568 (let* ((ssh-key (create-ssh-key api %ssh-key))
569 (server (create-server api ssh-key))
570 (action (hetzner-api-server-power-on api server)))
571 (and (hetzner-action? action)
572 (equal? "start_server"
573 (hetzner-action-command action))))))
574
575(test-skip %when-no-token)
576(test-assert "hetzner-api-server-power-off-integration"
577 (with-cleanup-api (api (hetzner-api))
578 (let* ((ssh-key (create-ssh-key api %ssh-key))
579 (server (create-server api ssh-key))
580 (action (hetzner-api-server-power-off api server)))
581 (and (hetzner-action? action)
582 (equal? "stop_server"
583 (hetzner-action-command action))))))
584
585(test-skip %when-no-token)
586(test-assert "hetzner-api-server-reboot-integration"
587 (with-cleanup-api (api (hetzner-api))
588 (let* ((ssh-key (create-ssh-key api %ssh-key))
589 (server (create-server api ssh-key))
590 (action (hetzner-api-server-reboot api server)))
591 (and (hetzner-action? action)
592 (equal? "reboot_server"
593 (hetzner-action-command action))))))
594
595(test-skip %when-no-token)
596(test-assert "hetzner-api-servers-integration"
597 (with-cleanup-api (api (hetzner-api))
598 (let* ((ssh-key (create-ssh-key api %ssh-key))
599 (server (create-server api ssh-key)))
600 (member server (hetzner-api-servers api)))))
601
602(test-skip %when-no-token)
603(test-assert "hetzner-api-ssh-key-create-integration"
604 (with-cleanup-api (api (hetzner-api))
605 (let ((ssh-key (create-ssh-key api %ssh-key)))
606 (and (hetzner-ssh-key? ssh-key)
607 (equal? (hetzner-ssh-key-fingerprint %ssh-key)
608 (hetzner-ssh-key-fingerprint ssh-key))
609 (equal? (hetzner-ssh-key-name %ssh-key)
610 (hetzner-ssh-key-name ssh-key))
611 (equal? (hetzner-ssh-key-public-key %ssh-key)
612 (hetzner-ssh-key-public-key ssh-key))))))
613
614(test-skip %when-no-token)
615(test-assert "hetzner-api-ssh-key-delete-integration"
616 (with-cleanup-api (api (hetzner-api))
617 (let ((ssh-key (create-ssh-key api %ssh-key)))
618 (and (equal? #t (hetzner-api-ssh-key-delete api ssh-key))
619 (not (member ssh-key (hetzner-api-ssh-keys api)))))))
620
621(test-skip %when-no-token)
622(test-assert "hetzner-api-ssh-keys-integration"
623 (with-cleanup-api (api (hetzner-api))
624 (let ((ssh-key (create-ssh-key api %ssh-key)))
625 (member ssh-key (hetzner-api-ssh-keys api)))))
626
627(test-end "machine-hetzner-api")
628
629;; Local Variables:
630;; eval: (put 'with-cleanup-api 'scheme-indent-function 1)
631;; End:
generated by cgit v1.2.3 (git 2.25.1) at 2026-09-03 07:25:52 +0000