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>

1 files changed, 664 insertions, 0 deletions

diff --git a/gnu/machine/hetzner/http.scm b/gnu/machine/hetzner/http.scm
new file mode 100644
index 00000000000..bfd65554721
--- /dev/null
+++ b/gnu/machine/hetzner/http.scm
@@ -0,0 +1,664 @@
+;;; 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 (gnu machine hetzner http)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (json)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
+  #:use-module (ssh key)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:export (%hetzner-default-api-token
+            %hetzner-default-server-image
+            %hetzner-default-server-location
+            %hetzner-default-server-type
+            hetzner-action
+            hetzner-action-command
+            hetzner-action-error
+            hetzner-action-finished
+            hetzner-action-id
+            hetzner-action-progress
+            hetzner-action-resources
+            hetzner-action-started
+            hetzner-action-status
+            hetzner-action?
+            hetzner-api
+            hetzner-api-action-wait
+            hetzner-api-actions
+            hetzner-api-create-ssh-key
+            hetzner-api-locations
+            hetzner-api-request-body
+            hetzner-api-request-headers
+            hetzner-api-request-method
+            hetzner-api-request-params
+            hetzner-api-request-send
+            hetzner-api-request-url
+            hetzner-api-request?
+            hetzner-api-response
+            hetzner-api-response-body
+            hetzner-api-response-headers
+            hetzner-api-response-status
+            hetzner-api-response?
+            hetzner-api-server-create
+            hetzner-api-server-delete
+            hetzner-api-server-enable-rescue-system
+            hetzner-api-server-power-off
+            hetzner-api-server-power-on
+            hetzner-api-server-reboot
+            hetzner-api-server-types
+            hetzner-api-servers
+            hetzner-api-ssh-key-create
+            hetzner-api-ssh-key-delete
+            hetzner-api-ssh-keys
+            hetzner-api-token
+            hetzner-api?
+            hetzner-error-code
+            hetzner-error-message
+            hetzner-error?
+            hetzner-ipv4-blocked?
+            hetzner-ipv4-dns-ptr
+            hetzner-ipv4-id
+            hetzner-ipv4-ip
+            hetzner-ipv4?
+            hetzner-ipv6-blocked?
+            hetzner-ipv6-dns-ptr
+            hetzner-ipv6-id
+            hetzner-ipv6-ip
+            hetzner-ipv6?
+            hetzner-location
+            hetzner-location-city
+            hetzner-location-country
+            hetzner-location-description
+            hetzner-location-id
+            hetzner-location-latitude
+            hetzner-location-longitude
+            hetzner-location-name
+            hetzner-location-network-zone
+            hetzner-location?
+            hetzner-public-net
+            hetzner-public-net-ipv4
+            hetzner-public-net-ipv6
+            hetzner-resource
+            hetzner-resource-id
+            hetzner-resource-type
+            hetzner-resource?
+            hetzner-server-architecture
+            hetzner-server-created
+            hetzner-server-id
+            hetzner-server-labels
+            hetzner-server-name
+            hetzner-server-public-ipv4
+            hetzner-server-public-net
+            hetzner-server-rescue-enabled?
+            hetzner-server-system
+            hetzner-server-type
+            hetzner-server-type-architecture
+            hetzner-server-type-cores
+            hetzner-server-type-cpu-type
+            hetzner-server-type-deprecated
+            hetzner-server-type-deprecation
+            hetzner-server-type-description
+            hetzner-server-type-disk
+            hetzner-server-type-id
+            hetzner-server-type-memory
+            hetzner-server-type-name
+            hetzner-server-type-storage-type
+            hetzner-server-type?
+            hetzner-server?
+            hetzner-ssh-key-created
+            hetzner-ssh-key-fingerprint
+            hetzner-ssh-key-id
+            hetzner-ssh-key-labels
+            hetzner-ssh-key-name
+            hetzner-ssh-key-public-key
+            hetzner-ssh-key-read-file
+            hetzner-ssh-key?
+            make-hetzner-action
+            make-hetzner-error
+            make-hetzner-ipv4
+            make-hetzner-ipv6
+            make-hetzner-location
+            make-hetzner-public-net
+            make-hetzner-resource
+            make-hetzner-server
+            make-hetzner-server-type
+            make-hetzner-ssh-key))
+
+;;; Commentary:
+;;;
+;;; This module implements a lower-level interface for interacting with the
+;;; Hetzner Cloud API https://docs.hetzner.cloud.
+;;;
+
+(define %hetzner-default-api-token
+  (make-parameter (getenv "GUIX_HETZNER_API_TOKEN")))
+
+;; Ideally this would be a Guix image. Maybe one day.
+(define %hetzner-default-server-image "debian-11")
+
+;; Falkenstein, Germany
+(define %hetzner-default-server-location "fsn1")
+
+;; x86, 8 VCPUs, 16 GB mem, 160 GB disk
+(define %hetzner-default-server-type "cx42")
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (format-query-param param)
+  "Format the query PARAM as a string."
+  (string-append (uri-encode (format #f "~a" (car param))) "="
+                 (uri-encode (format #f "~a" (cdr param)))))
+
+(define (format-query-params params)
+  "Format the query PARAMS as a string."
+  (if (> (length params) 0)
+      (string-append
+       "?"
+       (string-join
+        (map format-query-param params)
+        "&"))
+      ""))
+
+(define (json->maybe-hetzner-error json)
+  (and (list? json) (json->hetzner-error json)))
+
+(define (string->time s)
+  (when (string? s) (car (strptime "%FT%T%z" s))))
+
+(define (json->hetzner-dnses vector)
+  (map json->hetzner-dns (vector->list vector)))
+
+(define (json->hetzner-resources vector)
+  (map json->hetzner-resource (vector->list vector)))
+
+
+;;;
+;;; Domain models.
+;;;
+
+(define-json-mapping <hetzner-action>
+  make-hetzner-action hetzner-action? json->hetzner-action
+  (command hetzner-action-command) ; string
+  (error hetzner-action-error "error"
+         json->maybe-hetzner-error) ; <hetzner-error> | #f
+  (finished hetzner-action-finished "finished" string->time) ; time
+  (id hetzner-action-id) ; integer
+  (progress hetzner-action-progress) ; integer
+  (resources hetzner-action-resources "resources"
+             json->hetzner-resources) ; list of <hetzner-resource>
+  (started hetzner-action-started "started" string->time) ; time
+  (status hetzner-action-status))
+
+(define-json-mapping <hetzner-deprecation>
+  make-hetzner-deprecation hetzner-deprecation? json->hetzner-deprecation
+  (announced hetzner-deprecation-announced) ; string
+  (unavailable-after hetzner-deprecation-unavailable-after
+                     "unavailable_after")) ; string
+
+(define-json-mapping <hetzner-dns>
+  make-hetzner-dns hetzner-dns? json->hetzner-dns
+  (ip hetzner-dns-ip) ; string
+  (ptr hetzner-dns-ptr "dns_ptr")) ; string
+
+(define-json-mapping <hetzner-error>
+  make-hetzner-error hetzner-error? json->hetzner-error
+  (code hetzner-error-code) ; string
+  (message hetzner-error-message)) ; <string>
+
+(define-json-mapping <hetzner-ipv4>
+  make-hetzner-ipv4 hetzner-ipv4? json->hetzner-ipv4
+  (blocked? hetzner-ipv4-blocked? "blocked") ; boolean
+  (dns-ptr hetzner-ipv4-dns-ptr "dns_ptr") ; string
+  (id hetzner-ipv4-id) ; integer
+  (ip hetzner-ipv4-ip)) ; string
+
+(define-json-mapping <hetzner-ipv6>
+  make-hetzner-ipv6 hetzner-ipv6? json->hetzner-ipv6
+  (blocked? hetzner-ipv6-blocked? "blocked") ; boolean
+  (dns-ptr hetzner-ipv6-dns-ptr "dns_ptr"
+           json->hetzner-dnses) ; list of <hetzner-dns>
+  (id hetzner-ipv6-id) ; integer
+  (ip hetzner-ipv6-ip)) ; string
+
+(define-json-mapping <hetzner-location>
+  make-hetzner-location hetzner-location? json->hetzner-location
+  (city hetzner-location-city) ; string
+  (country hetzner-location-country) ; string
+  (description hetzner-location-description) ; string
+  (id hetzner-location-id) ; integer
+  (latitude hetzner-location-latitude) ; decimal
+  (longitude hetzner-location-longitude) ; decimal
+  (name hetzner-location-name) ; string
+  (network-zone hetzner-location-network-zone "network_zone"))
+
+(define-json-mapping <hetzner-public-net>
+  make-hetzner-public-net hetzner-public-net? json->hetzner-public-net
+  (ipv4 hetzner-public-net-ipv4 "ipv4" json->hetzner-ipv4) ; <hetzner-ipv4>
+  (ipv6 hetzner-public-net-ipv6 "ipv6" json->hetzner-ipv6)) ; <hetzner-ipv6>
+
+(define-json-mapping <hetzner-resource>
+  make-hetzner-resource hetzner-resource? json->hetzner-resource
+  (id hetzner-resource-id) ; integer
+  (type hetzner-resource-type)) ; string
+
+(define-json-mapping <hetzner-server>
+  make-hetzner-server hetzner-server? json->hetzner-server
+  (created hetzner-server-created) ; time
+  (id hetzner-server-id) ; integer
+  (labels hetzner-server-labels) ; alist of string/string
+  (name hetzner-server-name) ; string
+  (public-net hetzner-server-public-net "public_net"
+              json->hetzner-public-net) ; <hetzner-public-net>
+  (rescue-enabled? hetzner-server-rescue-enabled? "rescue_enabled") ; boolean
+  (server-type hetzner-server-type "server_type"
+               json->hetzner-server-type)) ; <hetzner-server-type>
+
+(define-json-mapping <hetzner-server-type>
+  make-hetzner-server-type hetzner-server-type? json->hetzner-server-type
+  (architecture hetzner-server-type-architecture) ; string
+  (cores hetzner-server-type-cores) ; integer
+  (cpu-type hetzner-server-type-cpu-type "cpu_type") ; string
+  (deprecated hetzner-server-type-deprecated) ; boolean
+  (deprecation hetzner-server-type-deprecation
+               json->hetzner-deprecation) ; <hetzner-deprecation>
+  (description hetzner-server-type-description) ; string
+  (disk hetzner-server-type-disk) ; integer
+  (id hetzner-server-type-id) ; integer
+  (memory hetzner-server-type-memory) ; integer
+  (name hetzner-server-type-name) ; string
+  (storage-type hetzner-server-type-storage-type "storage_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
+  (fingerprint hetzner-ssh-key-fingerprint) ; string
+  (id hetzner-ssh-key-id) ; integer
+  (labels hetzner-ssh-key-labels) ; alist of string/string
+  (name hetzner-ssh-key-name) ; string
+  (public_key hetzner-ssh-key-public-key "public_key")) ; string
+
+(define (hetzner-server-architecture server)
+  "Return the architecture of the Hetzner SERVER."
+  (hetzner-server-type-architecture (hetzner-server-type server)))
+
+(define* (hetzner-server-path server #:optional (path ""))
+  "Return the PATH of the Hetzner SERVER."
+  (format #f "/servers/~a~a" (hetzner-server-id server) path))
+
+(define (hetzner-server-public-ipv4 server)
+  "Return the public IPv4 address of the SERVER."
+  (and-let* ((public-net (hetzner-server-public-net server))
+             (ipv4 (hetzner-public-net-ipv4 public-net)))
+    (hetzner-ipv4-ip ipv4)))
+
+(define (hetzner-server-system server)
+  "Return the Guix system architecture of the Hetzner SERVER."
+  (match (hetzner-server-architecture server)
+    ("arm" "aarch64-linux")
+    ("x86" "x86_64-linux")))
+
+(define* (hetzner-ssh-key-path ssh-key #:optional (path ""))
+  "Return the PATH of the Hetzner SSH-KEY."
+  (format #f "/ssh_keys/~a~a" (hetzner-ssh-key-id ssh-key) path))
+
+(define (hetzner-ssh-key-read-file file)
+  "Read the SSH private key from FILE and return a Hetzner SSH key."
+  (let* ((privkey (private-key-from-file file))
+         (pubkey (private-key->public-key privkey))
+         (hash (get-public-key-hash pubkey 'md5))
+         (fingerprint (bytevector->hex-string hash))
+         (public-key (format #f "ssh-~a ~a" (get-key-type pubkey)
+                             (public-key->string pubkey))))
+    (make-hetzner-ssh-key #f fingerprint #f '() (basename file) public-key)))
+
+
+;;;
+;;; Hetzner API response.
+;;;
+
+(define-record-type* <hetzner-api-response>
+  hetzner-api-response make-hetzner-api-response hetzner-api-response?
+  (body hetzner-api-response-body (default *unspecified*))
+  (headers hetzner-api-response-headers (default '()))
+  (status hetzner-api-response-status (default 200)))
+
+(define (hetzner-api-response-meta response)
+  "Return the meta information of the Hetzner API response."
+  (assoc-ref (hetzner-api-response-body response) "meta"))
+
+(define (hetzner-api-response-pagination response)
+  "Return the meta information of the Hetzner API response."
+  (assoc-ref (hetzner-api-response-meta response) "pagination"))
+
+(define (hetzner-api-response-pagination-combine resource responses)
+  "Combine multiple Hetzner API pagination responses into a single response."
+  (if (positive? (length responses))
+      (let* ((response (car responses))
+             (pagination (hetzner-api-response-pagination response))
+             (total-entries (assoc-ref pagination "total_entries")))
+        (hetzner-api-response
+         (inherit response)
+         (body `(("meta"
+                  ("pagination"
+                   ("last_page" . 1)
+                   ("next_page" . null)
+                   ("page" . 1)
+                   ("per_page" . ,total-entries)
+                   ("previous_page" . null)
+                   ("total_entries" . ,total-entries)))
+                 (,resource . ,(append-map
+                                (lambda (body)
+                                  (vector->list (assoc-ref body resource)))
+                                (map hetzner-api-response-body responses)))))))
+      (raise-exception
+       (formatted-message
+        (G_ "expected a list of Hetzner API responses")))))
+
+(define (hetzner-api-body-action body)
+  "Return the Hetzner API action from BODY."
+  (let ((json (assoc-ref body "action")))
+    (and json (json->hetzner-action json))))
+
+(define (hetzner-api-response-read port)
+  "Read the Hetzner API response from PORT."
+  (let* ((response (read-response port))
+         (body (read-response-body response)))
+    (hetzner-api-response
+     (body (and body (json-string->scm (utf8->string body))))
+     (headers (response-headers response))
+     (status (response-code response)))))
+
+(define (hetzner-api-response-validate-status response expected)
+  "Raise an error if the HTTP status code of RESPONSE is not in EXPECTED."
+  (when (not (member (hetzner-api-response-status response) expected))
+    (raise-exception
+     (formatted-message
+      (G_ "unexpected HTTP status code: ~a, expected: ~a~%~a")
+      (hetzner-api-response-status response)
+      expected
+      (with-output-to-string
+        (lambda ()
+          (pretty-print (hetzner-api-response-body response))))))))
+
+
+;;;
+;;; Hetzner API request.
+;;;
+
+(define-record-type* <hetzner-api-request>
+  hetzner-api-request make-hetzner-api-request hetzner-api-request?
+  (body hetzner-api-request-body (default *unspecified*))
+  (headers hetzner-api-request-headers (default '()))
+  (method hetzner-api-request-method (default 'GET))
+  (params hetzner-api-request-params (default '()))
+  (url hetzner-api-request-url))
+
+(define (hetzner-api-request-uri request)
+  "Return the URI object of the Hetzner API request."
+  (let ((params (hetzner-api-request-params request)))
+    (string->uri (string-append (hetzner-api-request-url request)
+                                (format-query-params params)))))
+
+(define (hetzner-api-request-body-bytevector request)
+  "Return the body of the Hetzner API REQUEST as a bytevector."
+  (let ((body (hetzner-api-request-body request)))
+    (string->utf8 (if (unspecified? body) "" (scm->json-string body)))))
+
+(define (hetzner-api-request-write port request)
+  "Write the Hetzner API REQUEST to PORT."
+  (let* ((body (hetzner-api-request-body-bytevector request))
+         (request (build-request
+                   (hetzner-api-request-uri request)
+                   #:method (hetzner-api-request-method request)
+                   #:version '(1 . 1)
+                   #:headers (cons* `(Content-Length
+                                      . ,(number->string
+                                          (if (unspecified? body)
+                                              0 (bytevector-length body))))
+                                    (hetzner-api-request-headers request))
+                   #:port port))
+         (request (write-request request port)))
+    (unless (unspecified? body)
+      (write-request-body request body))
+    (force-output (request-port request))))
+
+(define* (hetzner-api-request-send request #:key (expected (list 200 201 204)))
+  "Send the Hetzner API REQUEST via HTTP."
+  (let ((port (open-socket-for-uri (hetzner-api-request-uri request))))
+    (hetzner-api-request-write port request)
+    (let ((response (hetzner-api-response-read port)))
+      (close-port port)
+      (hetzner-api-response-validate-status response expected)
+      response)))
+
+;; Prevent compiler from inlining this function, so we can mock it in tests.
+(set! hetzner-api-request-send hetzner-api-request-send)
+
+(define (hetzner-api-request-next-params request)
+  "Return the pagination params for the next page of the REQUEST."
+  (let* ((params (hetzner-api-request-params request))
+         (page (or (assoc-ref params "page") 1)))
+    (map (lambda (param)
+           (if (equal? "page" (car param))
+               (cons (car param) (+ page 1))
+               param))
+         params)))
+
+(define (hetzner-api-request-paginate request)
+  "Fetch all pages of the REQUEST via pagination and return all responses."
+  (let* ((response (hetzner-api-request-send request))
+         (pagination (hetzner-api-response-pagination response))
+         (next-page (assoc-ref pagination "next_page")))
+    (if (number? next-page)
+        (cons response
+              (hetzner-api-request-paginate
+               (hetzner-api-request
+                (inherit request)
+                (params (hetzner-api-request-next-params request)))))
+        (list response))))
+
+
+
+;;;
+;;; Hetzner API.
+;;;
+
+(define-record-type* <hetzner-api>
+  hetzner-api make-hetzner-api hetzner-api?
+  (base-url hetzner-api-base-url ; string
+            (default "https://api.hetzner.cloud/v1"))
+  (token hetzner-api-token ; string
+         (default (%hetzner-default-api-token))))
+
+(define (hetzner-api-authorization-header api)
+  "Return the authorization header for the Hetzner API."
+  (format #f "Bearer ~a" (hetzner-api-token api)))
+
+(define (hetzner-api-default-headers api)
+  "Returns the default headers of the Hetzner API."
+  `((user-agent . "Guix Deploy")
+    (Accept . "application/json")
+    (Authorization . ,(hetzner-api-authorization-header api))
+    (Content-Type . "application/json")))
+
+(define (hetzner-api-url api path)
+  "Append PATH to the base url of the Hetzner API."
+  (string-append (hetzner-api-base-url api) path))
+
+(define (hetzner-api-delete api path)
+  "Delelte the resource at PATH with the Hetzner API."
+  (hetzner-api-response-body
+   (hetzner-api-request-send
+    (hetzner-api-request
+     (headers (hetzner-api-default-headers api))
+     (method 'DELETE)
+     (url (hetzner-api-url api path))))))
+
+(define* (hetzner-api-list api path resources json->object #:key (params '()))
+  "Fetch all objects of RESOURCE from the Hetzner API."
+  (let ((body (hetzner-api-response-body
+               (hetzner-api-response-pagination-combine
+                resources (hetzner-api-request-paginate
+                           (hetzner-api-request
+                            (url (hetzner-api-url api path))
+                            (headers (hetzner-api-default-headers api))
+                            (params (cons '("page" . 1) params))))))))
+    (map json->object (assoc-ref body resources))))
+
+(define* (hetzner-api-post api path #:key (body *unspecified*))
+  "Send a POST request to the Hetzner API at PATH using BODY."
+  (hetzner-api-response-body
+   (hetzner-api-request-send
+    (hetzner-api-request
+     (body body)
+     (method 'POST)
+     (url (hetzner-api-url api path))
+     (headers (hetzner-api-default-headers api))))))
+
+(define (hetzner-api-actions api ids)
+  "Get actions from the Hetzner API."
+  (if (zero? (length ids))
+      (raise-exception
+       (formatted-message
+        (G_ "expected at least one action id, but got '~a'")
+        (length ids)))
+      (hetzner-api-list
+       api "/actions" "actions" json->hetzner-action
+       #:params `(("id" . ,(string-join (map number->string ids) ","))))))
+
+(define* (hetzner-api-action-wait api action #:optional (status "success"))
+  "Wait until the ACTION has reached STATUS on the Hetzner API."
+  (let ((id (hetzner-action-id action)))
+    (let loop ()
+      (let ((actions (hetzner-api-actions api (list id))))
+        (cond
+         ((zero? (length actions))
+          (raise-exception
+           (formatted-message (G_ "server action '~a' not found") id)))
+         ((not (= 1 (length actions)))
+          (raise-exception
+           (formatted-message
+            (G_ "expected one server action, but got '~a'")
+            (length actions))))
+         ((string= status (hetzner-action-status (car actions)))
+          (car actions))
+         (else
+          (sleep 5)
+          (loop)))))))
+
+(define* (hetzner-api-locations api . options)
+  "Get deployment locations from the Hetzner API."
+  (apply hetzner-api-list api "/locations" "locations" json->hetzner-location options))
+
+(define* (hetzner-api-server-create
+          api name ssh-keys
+          #:key
+          (enable-ipv4? #t)
+          (enable-ipv6? #t)
+          (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."
+  (let ((body (hetzner-api-post
+               api "/servers"
+               #:body `(("image" . ,image)
+                        ("labels" . ,labels)
+                        ("name" . ,name)
+                        ("public_net"
+                         . (("enable_ipv4" . ,enable-ipv4?)
+                            ("enable_ipv6" . ,enable-ipv6?)))
+                        ("location" . ,location)
+                        ("server_type" . ,server-type)
+                        ("ssh_keys" . ,(apply vector (map hetzner-ssh-key-id ssh-keys)))
+                        ("start_after_create" . ,start-after-create?)))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))
+    (json->hetzner-server (assoc-ref body "server"))))
+
+(define (hetzner-api-server-delete api server)
+  "Delete the SERVER with the Hetzner API."
+  (let ((body (hetzner-api-delete api (hetzner-server-path server))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))))
+
+(define* (hetzner-api-server-enable-rescue-system
+          api server ssh-keys #:key (type "linux64"))
+  "Enable the rescue system for SERVER with the Hetzner API."
+  (let* ((ssh-keys (apply vector (map hetzner-ssh-key-id ssh-keys)))
+         (body (hetzner-api-post
+                api (hetzner-server-path server "/actions/enable_rescue")
+                #:body `(("ssh_keys" . ,ssh-keys)
+                         ("type" . ,type)))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))))
+
+(define* (hetzner-api-servers api . options)
+  "Get servers from the Hetzner API."
+  (apply hetzner-api-list api "/servers" "servers" json->hetzner-server options))
+
+(define (hetzner-api-server-power-on api server)
+  "Send a power on request for SERVER to the Hetzner API."
+  (let ((body (hetzner-api-post api (hetzner-server-path server "/actions/poweron"))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))))
+
+(define (hetzner-api-server-power-off api server)
+  "Send a power off request for SERVER to the Hetzner API."
+  (let ((body (hetzner-api-post api (hetzner-server-path server "/actions/poweroff"))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))))
+
+(define (hetzner-api-server-reboot api server)
+  "Send a reboot request for SERVER to the Hetzner API."
+  (let ((body (hetzner-api-post api (hetzner-server-path server "/actions/reboot"))))
+    (hetzner-api-action-wait api (hetzner-api-body-action body))))
+
+(define* (hetzner-api-ssh-key-create api name public-key #:key (labels '()))
+  "Create a SSH key with the Hetzner API."
+  (let ((body (hetzner-api-post
+               api "/ssh_keys"
+               #:body `(("name" . ,name)
+                        ("public_key" . ,public-key)
+                        ("labels" . ,labels)))))
+    (json->hetzner-ssh-key (assoc-ref body "ssh_key"))))
+
+(define (hetzner-api-ssh-key-delete api ssh-key)
+  "Delete the SSH key on the Hetzner API."
+  (hetzner-api-delete api (hetzner-ssh-key-path ssh-key))
+  #t)
+
+(define* (hetzner-api-ssh-keys api . options)
+  "Get SSH keys from the Hetzner API."
+  (apply hetzner-api-list api "/ssh_keys" "ssh_keys"
+         json->hetzner-ssh-key options))
+
+(define* (hetzner-api-server-types api . options)
+  "Get server types from the Hetzner API."
+  (apply hetzner-api-list api "/server_types" "server_types"
+         json->hetzner-server-type options))