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>

2 files changed, 898 insertions, 0 deletions

diff --git a/tests/machine/hetzner.scm b/tests/machine/hetzner.scm
new file mode 100644
index 0000000000..39eac4a4d5
--- /dev/null
+++ b/tests/machine/hetzner.scm
@@ -0,0 +1,267 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Roman Scherer <roman@burningswell.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests machine hetzner)
+  #:use-module (gnu machine hetzner http)
+  #:use-module (gnu machine hetzner)
+  #:use-module (gnu machine ssh)
+  #:use-module (gnu machine)
+  #:use-module (gnu system)
+  #:use-module (guix build utils)
+  #:use-module (guix records)
+  #:use-module (guix ssh)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-64)
+  #:use-module (ssh key)
+  #:use-module (ssh session))
+
+;;; Unit and integration tests for the (gnu machine hetzner) module.
+
+;; Integration tests require the GUIX_HETZNER_API_TOKEN environment variable.
+;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
+
+;; The integration tests sometimes fail due to the Hetzner API not being able
+;; to allocate a resource.  Switching to a different location might help.
+
+(define %labels
+  '(("guix.gnu.org/test" . "true")))
+
+(define %ssh-key-name
+  "guix-hetzner-machine-test-key")
+
+(define %ssh-key-file
+  (string-append "/tmp/" %ssh-key-name))
+
+(unless (file-exists? %ssh-key-file)
+  (private-key-to-file (make-keypair 'rsa 2048) %ssh-key-file))
+
+(define %when-no-token
+  (if (hetzner-api-token (hetzner-api)) 0 1))
+
+(define %arm-machine
+  (machine
+   (operating-system
+     (operating-system
+       (inherit %hetzner-os-arm)
+       (host-name "guix-deploy-hetzner-test-arm")))
+   (environment hetzner-environment-type)
+   (configuration (hetzner-configuration
+                   (labels %labels)
+                   (server-type "cax41")
+                   (ssh-key %ssh-key-file)))))
+
+(define %x86-machine
+  (machine
+   (operating-system
+     (operating-system
+       (inherit %hetzner-os-x86)
+       (host-name "guix-deploy-hetzner-test-x86")))
+   (environment hetzner-environment-type)
+   (configuration (hetzner-configuration
+                   (labels %labels)
+                   (server-type "cpx51")
+                   (ssh-key %ssh-key-file)))))
+
+(define (cleanup machine)
+  (let* ((config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (for-each (lambda (server)
+                (hetzner-api-server-delete api server))
+              (hetzner-api-servers
+               api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
+    (for-each (lambda (ssh-key)
+                (hetzner-api-ssh-key-delete api ssh-key))
+              (hetzner-api-ssh-keys
+               api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
+    machine))
+
+(define-syntax-rule (with-cleanup (machine-sym machine-init) body ...)
+  (let ((machine-sym (cleanup machine-init)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        body ...)
+      (lambda ()
+        (cleanup machine-sym)))))
+
+(define (mock-action command)
+  (make-hetzner-action
+   command #f
+   (localtime (current-time))
+   1
+   100
+   '()
+   (localtime (current-time))
+   "success"))
+
+(define (mock-location machine)
+  (let* ((config (machine-configuration machine))
+         (name (hetzner-configuration-location config)))
+    (make-hetzner-location
+     "Falkenstein" "DE" "Falkenstein DC Park 1"
+     1 50.47612 12.370071 name "eu-central")))
+
+(define (mock-server-type machine)
+  (let* ((config (machine-configuration machine))
+         (name (hetzner-configuration-server-type config)))
+    (make-hetzner-server-type
+     "x86" 8 "shared" #f  #f (string-upcase name)
+     160 106 16 name "local")))
+
+(define (mock-server machine)
+  (let* ((config (machine-configuration machine))
+         (name (hetzner-configuration-location config)))
+    (make-hetzner-server
+     1
+     (localtime (current-time))
+     '()
+     (operating-system-host-name (machine-operating-system machine))
+     (make-hetzner-public-net
+      (make-hetzner-ipv4 #f "server.example.com" 1 "1.2.3.4")
+      (make-hetzner-ipv6 #f "server.example.com" 1 "2001:db8::1"))
+     #f
+     (mock-server-type machine))))
+
+(define (mock-ssh-key machine)
+  (let ((config (machine-configuration machine)))
+    (hetzner-ssh-key-read-file  (hetzner-configuration-ssh-key config))))
+
+(define (expected-ssh-machine? machine ssh-machine)
+  (let ((config (machine-configuration machine))
+        (ssh-config (machine-configuration ssh-machine)))
+    (and (equal? (hetzner-configuration-authorize? config)
+                 (machine-ssh-configuration-authorize? ssh-config))
+         (equal? (hetzner-configuration-allow-downgrades? config)
+                 (machine-ssh-configuration-allow-downgrades? ssh-config))
+         (equal? (hetzner-configuration-build-locally? config)
+                 (machine-ssh-configuration-build-locally? ssh-config))
+         (equal? (hetzner-server-public-ipv4 (mock-server machine))
+                 (machine-ssh-configuration-host-name ssh-config)))))
+
+(define-syntax mock*
+  (syntax-rules ()
+    ((mock* () body1 body2 ...)
+     (let () body1 body2 ...))
+    ((mock* ((mod1 sym1 fn1) (mod2 sym2 fn2) ...)
+            body1 body2 ...)
+     (mock (mod1 sym1 fn1)
+           (mock* ((mod2 sym2 fn2) ...)
+                  body1) body2 ...))))
+
+(test-begin "machine-hetzner")
+
+;; The following tests deploy real machines using the Hetzner API and shut
+;; them down afterwards.
+
+(test-skip %when-no-token)
+(test-assert "deploy-arm-machine"
+  (with-cleanup (machine %arm-machine)
+    (deploy-hetzner machine)))
+
+(test-skip %when-no-token)
+(test-assert "deploy-x86-machine"
+  (with-cleanup (machine %x86-machine)
+    (deploy-hetzner machine)))
+
+;; The following tests simulate a deployment, they mock out the actual calls
+;; to the Hetzner API.
+
+;; Note: In order for mocking to work, the Guile compiler should not inline
+;; the mocked functions. To prevent this it was necessary to set!
+;; hetzner-machine-ssh-run-script in (gnu machine hetzner) like this:
+
+;; (set! hetzner-machine-ssh-run-script hetzner-machine-ssh-run-script)
+
+(test-assert "deploy-machine-mock-with-provisioned-server"
+  (let ((machine (machine
+                  (operating-system %hetzner-os-x86)
+                  (environment hetzner-environment-type)
+                  (configuration (hetzner-configuration
+                                  (api (hetzner-api (token "mock")))
+                                  (ssh-key %ssh-key-file))))))
+    (mock* (((gnu machine hetzner http) hetzner-api-locations
+             (lambda* (api . options)
+               (list (mock-location machine))))
+            ((gnu machine hetzner http) hetzner-api-server-types
+             (lambda* (api . options)
+               (list (mock-server-type machine))))
+            ((gnu machine hetzner http) hetzner-api-ssh-keys
+             (lambda* (api . options)
+               (list (mock-ssh-key machine))))
+            ((gnu machine hetzner http) hetzner-api-servers
+             (lambda* (api . options)
+               (list (mock-server machine))))
+            ((gnu machine) deploy-machine
+             (lambda* (ssh-machine)
+               (expected-ssh-machine? machine ssh-machine))))
+           (deploy-hetzner machine))))
+
+(test-assert "deploy-machine-mock-with-unprovisioned-server"
+  (let ((machine (machine
+                  (operating-system %hetzner-os-x86)
+                  (environment hetzner-environment-type)
+                  (configuration (hetzner-configuration
+                                  (api (hetzner-api (token "mock")))
+                                  (ssh-key %ssh-key-file)))))
+        (servers '()))
+    (mock* (((gnu machine hetzner http) hetzner-api-locations
+             (lambda* (api . options)
+               (list (mock-location machine))))
+            ((gnu machine hetzner http) hetzner-api-server-types
+             (lambda* (api . options)
+               (list (mock-server-type machine))))
+            ((gnu machine hetzner http) hetzner-api-ssh-keys
+             (lambda* (api . options)
+               (list (mock-ssh-key machine))))
+            ((gnu machine hetzner http) hetzner-api-servers
+             (lambda* (api . options)
+               servers))
+            ((gnu machine hetzner http) hetzner-api-server-create
+             (lambda* (api name ssh-keys . options)
+               (set! servers (list (mock-server machine)))
+               (car servers)))
+            ((gnu machine hetzner http) hetzner-api-server-enable-rescue-system
+             (lambda (api server ssh-keys)
+               (mock-action "enable_rescue")))
+            ((gnu machine hetzner http) hetzner-api-server-power-on
+             (lambda (api server)
+               (mock-action "start_server")))
+            ((gnu machine hetzner) hetzner-machine-ssh-run-script
+             (lambda (ssh-session name content)
+               #t))
+            ((guix ssh) open-ssh-session
+             (lambda* (host . options)
+               (make-session #:host host)))
+            ((gnu machine hetzner http) hetzner-api-server-reboot
+             (lambda (api server)
+               (mock-action "reboot_server")))
+            ((ssh session) write-known-host!
+             (lambda (session)
+               #t))
+            ((gnu machine) deploy-machine
+             (lambda* (ssh-machine)
+               (expected-ssh-machine? machine ssh-machine))))
+           (deploy-hetzner machine))))
+
+(test-end "machine-hetzner")
+
+;; Local Variables:
+;; eval: (put 'with-cleanup 'scheme-indent-function 1)
+;; End:
diff --git a/tests/machine/hetzner/http.scm b/tests/machine/hetzner/http.scm
new file mode 100644
index 0000000000..618d9a4c94
--- /dev/null
+++ b/tests/machine/hetzner/http.scm
@@ -0,0 +1,631 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Roman Scherer <roman@burningswell.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests machine hetzner http)
+  #:use-module (debugging assert)
+  #:use-module (gnu machine hetzner http)
+  #:use-module (guix build utils)
+  #:use-module (guix tests)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-64)
+  #:use-module (ssh key))
+
+;; Unit and integration tests the (gnu machine hetzner http) module.
+
+;; Integration tests require the GUIX_HETZNER_API_TOKEN environment variable.
+;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
+
+;; The integration tests sometimes fail due to the Hetzner API not being able
+;; to allocate a resource.  Switching to a different location might help.
+
+(define %labels
+  '(("guix.gnu.org/test" . "true")))
+
+(define %server-name
+  "guix-hetzner-api-test-server")
+
+(define %ssh-key-name
+  "guix-hetzner-api-test-key")
+
+(define %ssh-key-file
+  (string-append "/tmp/" %ssh-key-name))
+
+(unless (file-exists? %ssh-key-file)
+  (private-key-to-file (make-keypair 'rsa 2048) %ssh-key-file))
+
+(define %ssh-key
+  (hetzner-ssh-key-read-file %ssh-key-file))
+
+(define %when-no-token
+  (if (hetzner-api-token (hetzner-api)) 0 1))
+
+(define action-create-server
+  (make-hetzner-action
+   "create_server" #f *unspecified* 1896091819 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(0 17 11 2 1 125 0 32 -1 0 #f) "running"))
+
+(define action-create-server-alist
+  '(("command" . "create_server")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091819)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:00+00:00")
+    ("status" . "running")))
+
+(define action-delete-server
+  (make-hetzner-action
+   "delete_server" #f *unspecified* 1896091928 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "running"))
+
+(define action-delete-server-alist
+  '(("command" . "delete_server")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091928)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:10+00:00")
+    ("status" . "running")))
+
+(define action-enable-rescue
+  (make-hetzner-action
+   "enable_rescue" #f  *unspecified* 1896091721 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
+
+(define action-enable-rescue-alist
+  '(("command" . "enable_rescue")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091721)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:10+00:00")
+    ("status" . "running")))
+
+(define action-power-off
+  (make-hetzner-action
+   "stop_server" #f  *unspecified* 1896091721 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
+
+(define action-power-off-alist
+  '(("command" . "stop_server")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091721)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:10+00:00")
+    ("status" . "running")))
+
+(define action-power-on
+  (make-hetzner-action
+   "start_server" #f  *unspecified* 1896091721 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
+
+(define action-power-on-alist
+  '(("command" . "start_server")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091721)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:10+00:00")
+    ("status" . "running")))
+
+(define action-reboot
+  (make-hetzner-action
+   "reboot_server" #f  *unspecified* 1896091721 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "success"))
+
+(define action-reboot-alist
+  '(("command" . "reboot_server")
+    ("error" . null)
+    ("finished" . null)
+    ("id" . 1896091721)
+    ("progress" . 0)
+    ("resources" . #((("type" . "server") ("id" . 59570198))))
+    ("started" . "2025-02-02T11:17:10+00:00")
+    ("status" . "running")))
+
+(define meta-page-alist
+  '("pagination"
+    ("last_page" . 1)
+    ("next_page" . null)
+    ("page" . 1)
+    ("per_page" . 25)
+    ("previous_page" . null)
+    ("total_entries" . 1)))
+
+(define location-falkenstein
+  (make-hetzner-location
+   "Falkenstein" "DE" "Falkenstein DC Park 1"
+   1 50.47612 12.370071 "fsn1" "eu-central"))
+
+(define location-falkenstein-alist
+  `(("city" . "Falkenstein")
+    ("country" . "DE")
+    ("description" . "Falkenstein DC Park 1")
+    ("id" . 1)
+    ("latitude" . 50.47612)
+    ("longitude" . 12.370071)
+    ("name" . "fsn1")
+    ("network_zone" . "eu-central")))
+
+(define server-type-cpx-11
+  (make-hetzner-server-type
+   "x86" 2 "shared" #f *unspecified*
+   "CPX 11" 40 22 2 "cpx11" "local"))
+
+(define server-type-cpx-11-alist
+  `(("architecture" . "x86")
+    ("cores" . 2)
+    ("cpu_type" . "shared")
+    ("deprecated" . #f)
+    ("deprecation" . null)
+    ("description" . "CPX 11")
+    ("disk" . 40)
+    ("id" . 22)
+    ("memory" . 2)
+    ("name" . "cpx11")
+    ("storage_type" . "local")))
+
+(define server-x86
+  (make-hetzner-server
+   "2024-12-30T16:38:11+00:00"
+   59570198
+   '()
+   "guix-x86"
+   (make-hetzner-public-net
+    (make-hetzner-ipv4 #f "static.218.128.13.49.clients.your-server.de" 78014457 "49.13.128.218")
+    (make-hetzner-ipv6 #f '() 78014458 "2a01:4f8:c17:293e::/64"))
+   #f
+   server-type-cpx-11))
+
+(define server-x86-alist
+  `(("backup_window" . null)
+    ("created" . "2024-12-30T16:38:11+00:00")
+    ("id" . 59570198)
+    ("included_traffic" . 21990232555520)
+    ("ingoing_traffic" . 124530000)
+    ("iso" . null)
+    ("labels")
+    ("load_balancers" . #())
+    ("locked" . #f)
+    ("name" . "guix-x86")
+    ("outgoing_traffic" . 1391250000)
+    ("placement_group" . null)
+    ("primary_disk_size" . 320)
+    ("private_net" . #())
+    ("protection" ("rebuild" . #f) ("delete" . #f))
+    ("public_net"
+     ("firewalls" . #())
+     ("floating_ips" . #())
+     ("ipv6"
+      ("id" . 78014458)
+      ("dns_ptr" . #())
+      ("blocked" . #f)
+      ("ip" . "2a01:4f8:c17:293e::/64"))
+     ("ipv4"
+      ("id" . 78014457)
+      ("dns_ptr" . "static.218.128.13.49.clients.your-server.de")
+      ("blocked" . #f)
+      ("ip" . "49.13.128.218")))
+    ("rescue_enabled" . #f)
+    ("server_type" ,@server-type-cpx-11-alist)
+    ("status" . "running")
+    ("volumes" . #())))
+
+(define ssh-key-root
+  (make-hetzner-ssh-key
+   #(55 2 19 28 9 123 6 300 -1 0 #f)
+   "8c:25:09:8f:37:0f:d8:f0:99:4e:ab:c7:5c:1b:c6:53"
+   16510983 '() "root@example.com"
+   "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM"))
+
+(define ssh-key-root-alist
+  `(("created" . "2023-10-28T19:02:55+00:00")
+    ("fingerprint" . "8c:25:09:8f:37:0f:d8:f0:99:4e:ab:c7:5c:1b:c6:53")
+    ("id" . 16510983)
+    ("labels")
+    ("name" . "root@example.com")
+    ("public_key" . "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM")))
+
+(define* (create-ssh-key api ssh-key #:key (labels %labels))
+  (hetzner-api-ssh-key-create
+   api
+   (hetzner-ssh-key-name ssh-key)
+   (hetzner-ssh-key-public-key ssh-key)
+   #:labels labels))
+
+(define* (create-server api ssh-key #:key (labels %labels))
+  (hetzner-api-server-create api %server-name (list ssh-key)
+                             #:labels labels
+                             #:server-type "cpx31"))
+
+(define (cleanup api)
+  (for-each (lambda (server)
+              (hetzner-api-server-delete api server))
+            (hetzner-api-servers
+             api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
+  (for-each (lambda (ssh-key)
+              (hetzner-api-ssh-key-delete api ssh-key))
+            (hetzner-api-ssh-keys
+             api #:params `(("label_selector" . "guix.gnu.org/test=true"))))
+  api)
+
+(define-syntax-rule (with-cleanup-api (api-sym api-init) body ...)
+  (let ((api-sym (cleanup api-init)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        body ...)
+      (lambda ()
+        (cleanup api-sym)))))
+
+(test-begin "machine-hetzner-api")
+
+;; Unit Tests
+
+(test-equal "hetzner-api-actions-unit"
+  (list action-create-server action-delete-server)
+  (let ((actions (list action-create-server-alist action-delete-server-alist)))
+    (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/actions"
+                             (hetzner-api-request-url request)))
+             (assert (unspecified? (hetzner-api-request-body request)))
+             (assert (equal? `(("page" . 1)
+                               ("id" . ,(string-join
+                                         (map (lambda (action)
+                                                (number->string (assoc-ref action "id")))
+                                              actions)
+                                         ",")))
+                             (hetzner-api-request-params request)))
+             (hetzner-api-response
+              (body `(("meta" . ,meta-page-alist)
+                      ("actions" . #(,action-create-server-alist ,action-delete-server-alist)))))))
+          (hetzner-api-actions (hetzner-api)
+                               (map (lambda (action)
+                                      (assoc-ref action "id"))
+                                    actions)))))
+
+(test-equal "hetzner-api-locations-unit"
+  (list location-falkenstein)
+  (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/locations"
+                           (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)
+                    ("locations" . #(,location-falkenstein-alist)))))))
+        (hetzner-api-locations (hetzner-api))))
+
+(test-equal "hetzner-api-server-types-unit"
+  (list server-type-cpx-11)
+  (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/server_types"
+                           (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)
+                    ("server_types" . #(,server-type-cpx-11-alist)))))))
+        (hetzner-api-server-types (hetzner-api))))
+
+(test-equal "hetzner-api-server-create-unit"
+  server-x86
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'POST (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-create-server-alist)
+                      ("server" . ,server-x86-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-create-server-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-create (hetzner-api) %server-name (list ssh-key-root))))
+
+(test-equal "hetzner-api-server-delete-unit"
+  (make-hetzner-action
+   "delete_server" #f *unspecified* 1896091928 0
+   (list (make-hetzner-resource 59570198 "server"))
+   #(10 17 11 2 1 125 0 32 -1 0 #f) "success")
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers/59570198"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'DELETE (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-delete-server-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-delete-server-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-delete (hetzner-api) server-x86)))
+
+(test-equal "hetzner-api-server-enable-rescue-system-unit"
+  action-enable-rescue
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/enable_rescue"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'POST (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-enable-rescue-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-enable-rescue-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-enable-rescue-system (hetzner-api) server-x86 (list ssh-key-root))))
+
+(test-equal "hetzner-api-server-power-on-unit"
+  action-power-on
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/poweron"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'POST (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-power-on-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-power-on-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-power-on (hetzner-api) server-x86)))
+
+(test-equal "hetzner-api-server-power-off-unit"
+  action-power-off
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/poweroff"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'POST (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-power-off-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-power-off-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-power-off (hetzner-api) server-x86)))
+
+(test-equal "hetzner-api-server-reboot-unit"
+  action-reboot
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (cond
+            ((equal? "https://api.hetzner.cloud/v1/servers/59570198/actions/reboot"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'POST (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("action" . ,action-reboot-alist)))))
+            ((equal? "https://api.hetzner.cloud/v1/actions"
+                     (hetzner-api-request-url request))
+             (assert (equal? 'GET (hetzner-api-request-method request)))
+             (hetzner-api-response
+              (body `(("actions" . ,(vector (cons `("status" . "success")
+                                                  action-reboot-alist)))
+                      ("meta" . ,meta-page-alist))))))))
+        (hetzner-api-server-reboot (hetzner-api) server-x86)))
+
+(test-equal "hetzner-api-servers-unit"
+  (list server-x86)
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (hetzner-api-response
+            (body `(("meta" . ,meta-page-alist)
+                    ("servers" . #(,server-x86-alist)))))))
+        (hetzner-api-servers (hetzner-api))))
+
+(test-equal "hetzner-api-ssh-key-create-unit"
+  ssh-key-root
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (assert (equal? 'POST (hetzner-api-request-method request)))
+           (assert (equal? "https://api.hetzner.cloud/v1/ssh_keys"
+                           (hetzner-api-request-url request)))
+           (assert (equal? `(("name" . "guix-hetzner-api-test-key")
+                             ("public_key" . "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM")
+                             ("labels" . (("a" . "1"))))
+                           (hetzner-api-request-body request)))
+           (assert (equal? `() (hetzner-api-request-params request)))
+           (hetzner-api-response
+            (body `(("ssh_key" . ,ssh-key-root-alist))))))
+        (hetzner-api-ssh-key-create
+         (hetzner-api)
+         "guix-hetzner-api-test-key"
+         "ssh-ed25519 ABCAC3NzaC1lZDI1NTE5AAAAIBT3lLYPfOZV9NNrNk0jGCufWmXbFSz+ORxowJdHoSIM"
+         #:labels '(("a" . "1")))))
+
+(test-assert "hetzner-api-ssh-key-delete-unit"
+  (mock ((gnu machine hetzner http) hetzner-api-request-send
+         (lambda* (request #:key expected)
+           (assert (equal? "https://api.hetzner.cloud/v1/ssh_keys/16510983"
+                           (hetzner-api-request-url request)))
+           (assert (equal? 'DELETE (hetzner-api-request-method request)))
+           (hetzner-api-response)))
+        (hetzner-api-ssh-key-delete (hetzner-api) ssh-key-root)))
+
+(test-equal "hetzner-api-ssh-keys-unit"
+  (list ssh-key-root)
+  (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/ssh_keys"
+                           (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)
+                    ("ssh_keys" . #(,ssh-key-root-alist)))))))
+        (hetzner-api-ssh-keys (hetzner-api))))
+
+;; Integration tests
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-actions-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-enable-rescue-system api server (list ssh-key))))
+      (member action (hetzner-api-actions api (list (hetzner-action-id action)))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-locations-integration"
+  (let ((locations (hetzner-api-locations (hetzner-api))))
+    (and (> (length locations) 0)
+         (every hetzner-location? locations))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-types-integration"
+  (let ((server-types (hetzner-api-server-types (hetzner-api))))
+    (and (> (length server-types) 0)
+         (every hetzner-server-type? server-types))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-create-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key)))
+      (and (hetzner-server? server)
+           (equal? %server-name (hetzner-server-name server))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-delete-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-delete api server)))
+      (and (hetzner-action? action)
+           (equal? "delete_server"
+                   (hetzner-action-command action))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-enable-rescue-system-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-enable-rescue-system api server (list ssh-key))))
+      (and (hetzner-action? action)
+           (equal? "enable_rescue"
+                   (hetzner-action-command action))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-power-on-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-power-on api server)))
+      (and (hetzner-action? action)
+           (equal? "start_server"
+                   (hetzner-action-command action))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-power-off-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-power-off api server)))
+      (and (hetzner-action? action)
+           (equal? "stop_server"
+                   (hetzner-action-command action))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-reboot-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key))
+           (action (hetzner-api-server-reboot api server)))
+      (and (hetzner-action? action)
+           (equal? "reboot_server"
+                   (hetzner-action-command action))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-servers-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((ssh-key (create-ssh-key api %ssh-key))
+           (server (create-server api ssh-key)))
+      (member server (hetzner-api-servers api)))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-key-create-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let ((ssh-key (create-ssh-key api %ssh-key)))
+      (and (hetzner-ssh-key? ssh-key)
+           (equal? (hetzner-ssh-key-fingerprint %ssh-key)
+                   (hetzner-ssh-key-fingerprint ssh-key))
+           (equal? (hetzner-ssh-key-name %ssh-key)
+                   (hetzner-ssh-key-name ssh-key))
+           (equal? (hetzner-ssh-key-public-key %ssh-key)
+                   (hetzner-ssh-key-public-key ssh-key))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-key-delete-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let ((ssh-key (create-ssh-key api %ssh-key)))
+      (and (equal? #t (hetzner-api-ssh-key-delete api ssh-key))
+           (not (member ssh-key (hetzner-api-ssh-keys api)))))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-keys-integration"
+  (with-cleanup-api (api (hetzner-api))
+    (let ((ssh-key (create-ssh-key api %ssh-key)))
+      (member ssh-key (hetzner-api-ssh-keys api)))))
+
+(test-end "machine-hetzner-api")
+
+;; Local Variables:
+;; eval: (put 'with-cleanup-api 'scheme-indent-function 1)
+;; End: