GNU logs - #75144, boring messages

Message sent to guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, maxim.cournoyer@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN:

Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, maxim.cournoyer@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN
Resent-Date: Fri, 27 Dec 2024 16:48:02 +0000
Resent-Message-ID: <handler.75144.B.173531802612495 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: 75144 <at> debbugs.gnu.org
Cc: Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic Court?s <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
From: Roman Scherer <roman@HIDDEN>
Date: Fri, 27 Dec 2024 17:46:39 +0100
Message-ID: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Received-SPF: none client-ip=2a00:1450:4864:20::62b;
 envelope-from=roman@HIDDEN; helo=mail-ej1-x62b.google.com
X-Spam_score_int: -18
X-Spam_score: -1.9
X-Spam_bar: -
X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
 DKIM_VALID=-0.1, RCVD_IN_DNSWL_NONE=-0.0001, SPF_HELO_NONE=0.001,
 SPF_NONE=0.001 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

* gnu/machine/hetzner.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* guix/ssh.scm (open-ssh-session): Add stricthostkeycheck option.
* doc/guix.texi (Invoking guix deploy): Add documentation for
'hetzner-configuration'.

Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41
---
 doc/guix.texi           |   86 ++++
 gnu/local.mk            |    1 +
 gnu/machine/hetzner.scm | 1039 +++++++++++++++++++++++++++++++++++++++
 guix/ssh.scm            |   19 +-
 4 files changed, 1137 insertions(+), 8 deletions(-)
 create mode 100644 gnu/machine/hetzner.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index da4d2f5ebc..020f460327 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44399,6 +44399,92 @@ Invoking guix deploy
 @end table
 @end deftp
 
+@deftp {Data Type} hetzner-configuration
+This is the data type describing the server that should be created for a
+machine with an @code{environment} of @code{hetzner-environment-type}.
+
+@table @asis
+@item @code{allow-downgrades?} (default: @code{#f})
+Whether to allow potential downgrades.
+@item @code{authorize?} (default: @code{#t})
+If true, the coordinator's public signing key
+@code{"/etc/guix/signing-key.pub"} will be added to the server's ACL
+keyring.
+@item @code{build-locally?} (default: @code{#t})
+If false, system derivations will be built on the machine being deployed to.
+@item @code{delete?} (default: @code{#t})
+If true, the server will be deleted when an error happens in the
+provisioning phase. If false, the server will be kept in order to debug
+any issues.
+@item @code{enable-ipv6?} (default: @code{#t})
+If true, attach an IPv6 on the public NIC. If false, no IPv6 address will be attached.
+@item @code{labels} (default: @code{'()})
+A user defined alist of key/value pairs attached to the server. Keys and
+values must be strings. For more information, see
+@uref{https://docs.hetzner.cloud/#labels, Labels}.
+@item @code{location} (default: @code{"fsn1"})
+The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
+location} to create the server in.
+@item @code{cleanup} (default: @code{#t})
+Whether to delete the Hetzner server if provisioning fails or not.
+@item @code{server-type} (default: @code{"cx42"})
+The name of the
+@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
+server type} this server should be created with.
+@item @code{ssh-key}
+The path to the SSH private key to use to authenticate with the remote
+host.
+@end table
+
+When deploying a machine with the @code{hetzner-environment-type} a
+virtual private server (VPS) is created for it on the
+@uref{https://www.hetzner.com/cloud, Hetzner Cloud} service.  The server
+is first booted into the
+@uref{https://docs.hetzner.com/cloud/servers/getting-started/rescue-system,
+Rescue System} to setup the partitions of the server and install a
+minimal Guix system, which is then used with the
+@code{managed-host-environment-type} to complete the deployment.
+
+Servers on the Hetzner Cloud service can be provisioned on the
+@code{aarch64} architecture using UEFI boot mode, or on the
+@code{x86_64} architecture using BIOS boot mode.  The @code{(gnu machine
+hetzner)} module exports the @code{%hetzner-os-arm} and
+@code{%hetzner-os-x86} operating systems that are compatible with those
+2 architectures, and can be used as a base for defining your custom
+operating system.
+
+The following example shows the definition of 2 machines that are
+deployed on the Hetzner Cloud service.  The first one uses the
+@code{%hetzner-os-arm} operating system to run a server with 16 shared
+vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second
+one uses the @code{%hetzner-os-x86} operating system on a server with 16
+shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.
+
+@lisp
+(use-modules (gnu machine)
+             (gnu machine hetzner))
+
+(list (machine
+       (operating-system %hetzner-os-arm)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cax41")
+                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
+      (machine
+       (operating-system %hetzner-os-x86)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cpx51")
+                       (ssh-key "/home/charlie/.ssh/id_rsa")))))
+@end lisp
+
+Passing this file to @command{guix deploy} with the environment variable
+@env{GUIX_HETZNER_API_TOKEN} set to a valid Hetzner
+@uref{https://docs.hetzner.com/cloud/api/getting-started/generating-api-token,
+API key} should provision 2 machines for you.
+
+@end deftp
+
 @node Running Guix in a VM
 @section Running Guix in a Virtual Machine
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 84160f407a..98000766af 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -911,6 +911,7 @@ if HAVE_GUILE_SSH
 
 GNU_SYSTEM_MODULES +=         			\
   %D%/machine/digital-ocean.scm			\
+  %D%/machine/hetzner.scm			\
   %D%/machine/ssh.scm
 
 endif HAVE_GUILE_SSH
diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
new file mode 100644
index 0000000000..9f8c3806b3
--- /dev/null
+++ b/gnu/machine/hetzner.scm
@@ -0,0 +1,1039 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu machine ssh)
+  #:use-module (gnu machine)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu services base)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system image)
+  #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system pam)
+  #:use-module (gnu system)
+  #:use-module (guix base32)
+  #:use-module (guix colors)
+  #:use-module (guix derivations)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix i18n)
+  #:use-module (guix import json)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix pki)
+  #:use-module (guix records)
+  #:use-module (guix ssh)
+  #:use-module (guix store)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 receive)
+  #:use-module (ice-9 string-fun)
+  #: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 (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ssh channel)
+  #:use-module (ssh key)
+  #:use-module (ssh popen)
+  #:use-module (ssh session)
+  #:use-module (ssh sftp)
+  #:use-module (ssh shell)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:export (%hetzner-os-arm
+            %hetzner-os-x86
+            deploy-hetzner
+            hetzner-api
+            hetzner-api-auth-token
+            hetzner-api-base-url
+            hetzner-configuration
+            hetzner-configuration-allow-downgrades?
+            hetzner-configuration-authorize?
+            hetzner-configuration-build-locally?
+            hetzner-configuration-delete?
+            hetzner-configuration-enable-ipv6?
+            hetzner-configuration-labels
+            hetzner-configuration-location
+            hetzner-configuration-networks
+            hetzner-configuration-server-type
+            hetzner-configuration-ssh-key
+            hetzner-configuration?
+            hetzner-environment-type))
+
+;;; Commentary:
+;;;
+;;; This module implements a high-level interface for provisioning "servers"
+;;; from the Hetzner Cloud service.
+;;;
+
+(define %hetzner-api-token
+  (make-parameter (getenv "GUIX_HETZNER_API_TOKEN")))
+
+
+;;;
+;;; Hetzner operating systems.
+;;;
+
+;; Operating system for arm servers using UEFI boot mode.
+
+(define %hetzner-os-arm
+  (operating-system
+    (host-name "guix-arm")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-efi-bootloader)
+      (targets (list "/boot/efi"))
+      (terminal-outputs '(console))))
+    (file-systems
+     (cons* (file-system
+              (mount-point "/")
+              (device "/dev/sda1")
+              (type "ext4"))
+            (file-system
+              (mount-point "/boot/efi")
+              (device "/dev/sda15")
+              (type "vfat"))
+            %base-file-systems))
+    (initrd-modules
+     (cons* "sd_mod" "virtio_scsi" %base-initrd-modules))
+    (services
+     (cons* (service dhcp-client-service-type)
+            (service openssh-service-type
+                     (openssh-configuration
+                      (openssh openssh-sans-x)
+                      (permit-root-login 'prohibit-password)))
+            %base-services))))
+
+;; Operating system for x86 servers using BIOS boot mode.
+
+(define %hetzner-os-x86
+  (operating-system
+    (inherit %hetzner-os-arm)
+    (host-name "guix-x86")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-bootloader)
+      (targets (list "/dev/sda"))
+      (terminal-outputs '(console))))
+    (initrd-modules
+     (cons "virtio_scsi" %base-initrd-modules))
+    (file-systems
+     (cons (file-system
+             (mount-point "/")
+             (device "/dev/sda1")
+             (type "ext4"))
+           %base-file-systems))))
+
+(define (operating-system-authorize os)
+  "Authorize the OS with the public signing key of the current machine."
+  (if (file-exists? %public-key-file)
+      (operating-system
+        (inherit os)
+        (services
+         (modify-services (operating-system-user-services os)
+           (guix-service-type
+            config => (guix-configuration
+                       (inherit config)
+                       (authorized-keys
+                        (cons*
+                         (local-file %public-key-file)
+                         (guix-configuration-authorized-keys config))))))))
+      (raise (formatted-message (G_ "no signing key '~a'. \
+Have you run 'guix archive --generate-key'?")
+                                %public-key-file))))
+
+(define (operating-system-root-file-system-type os)
+  "Return the root file system type of the operating system OS."
+  (let ((root-fs (find (lambda (file-system)
+                         (equal? "/" (file-system-mount-point file-system)))
+                       (operating-system-file-systems os))))
+    (if (file-system? root-fs)
+        (file-system-type root-fs)
+        (raise (formatted-message
+                (G_ "could not determine root file system type"))))))
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (escape-backticks str)
+  "Escape all backticks in STR."
+  (string-replace-substring str "`" "\\`"))
+
+(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)
+        "&"))
+      ""))
+
+
+
+;;;
+;;; Hetzner API response.
+;;;
+
+(define-record-type* <hetzner-api-response> hetzner-api-response
+  make-hetzner-api-response hetzner-api-response? hetzner-api-response
+  (body hetzner-api-response-body)
+  (headers hetzner-api-response-headers)
+  (status hetzner-api-response-status))
+
+(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 (formatted-message
+              (G_ "Expected a list of Hetzner API responses")))))
+
+(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 (json-string->scm (bytevector->string body "UTF-8")))
+     (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 (formatted-message
+            (G_ "Unexpected HTTP status code: ~a, expected: ~a~%~a")
+            (hetzner-api-response-status response)
+            expected
+            (hetzner-api-response-body response)))))
+
+
+
+;;;
+;;; Hetzner API request.
+;;;
+
+(define-record-type* <hetzner-api-request> hetzner-api-request
+  make-hetzner-api-request 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 (if (unspecified? body) "" (scm->json-string body))))
+    (string->bytevector string "UTF-8")))
+
+(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)))
+  "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)))
+
+(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? hetzner-api
+  (auth-token hetzner-api-auth-token ; string
+              (default (%hetzner-api-token)))
+  (base-url hetzner-api-base-url ; string
+            (default "https://api.hetzner.cloud/v1")))
+
+(define (hetzner-api-authorization-header api)
+  "Return the authorization header the Hetzner API."
+  (format #f "Bearer ~a" (hetzner-api-auth-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-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 #:key (params '()))
+  "Fetch all objects of RESOURCE from the Hetzner API."
+  (assoc-ref (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))))))
+             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 . options)
+  "Get actions from the Hetzner API."
+  (apply hetzner-api-list api "/actions" "actions" options))
+
+(define* (hetzner-api-action-wait api action #:optional (status "success"))
+  "Wait until the ACTION has reached STATUS on the Hetzner API."
+  (let ((id (assoc-ref action "id")))
+    (let loop ()
+      (let ((actions (hetzner-api-actions api #:params `(("id" . ,id)))))
+        (cond
+         ((zero? (length actions))
+          (raise (formatted-message (G_ "server action '~a' not found") id)))
+         ((not (= 1 (length actions)))
+          (raise (formatted-message
+                  (G_ "expected one server action, but got '~a'")
+                  (length actions))))
+         ((string= status (assoc-ref (car actions) "status"))
+          (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" options))
+
+(define (hetzner-api-server-create api server)
+  "Create a server on the Hetzner API."
+  (hetzner-api-post api "/servers" #:body server))
+
+(define (hetzner-api-server-delete api server)
+  "Delete the SERVER on the Hetzner API."
+  (hetzner-api-delete api (hetzner-server-path server)))
+
+(define* (hetzner-api-server-enable-rescue-system
+          api server #:key (ssh-keys '()) (type "linux64"))
+  "Enable the rescue system for SERVER on the Hetzner API."
+  (let ((ssh-keys (apply vector (map hetzner-ssh-key-id ssh-keys))))
+    (hetzner-api-post api (hetzner-server-path server "/actions/enable_rescue")
+                      #:body `(("ssh_keys" . ,ssh-keys)
+                               ("type" . ,type)))))
+
+(define* (hetzner-api-servers api . options)
+  "Get servers from the Hetzner API."
+  (apply hetzner-api-list api "/servers" "servers" options))
+
+(define (hetzner-api-server-power-on api server)
+  "Send a power on request for SERVER to the Hetzner API."
+  (hetzner-api-post api (hetzner-server-path server "/actions/poweron")))
+
+(define (hetzner-api-server-power-off api server)
+  "Send a power off request for SERVER to the Hetzner API."
+  (hetzner-api-post api (hetzner-server-path server "/actions/poweroff")))
+
+(define (hetzner-api-server-reboot api server)
+  "Send a reboot request for SERVER to the Hetzner API."
+  (hetzner-api-post api (hetzner-server-path server "/actions/reboot")))
+
+(define (hetzner-api-ssh-key-create api ssh-key)
+  "Create the SSH key on the Hetzner API."
+  (hetzner-api-post api "/ssh_keys" #:body ssh-key))
+
+(define* (hetzner-api-ssh-keys api . options)
+  "Get SSH keys from the Hetzner API."
+  (apply hetzner-api-list api "/ssh_keys" "ssh_keys" options))
+
+(define* (hetzner-api-server-types api . options)
+  "Get server types from the Hetzner API."
+  (apply hetzner-api-list api "/server_types" "server_types" options))
+
+
+
+;;;
+;;; Hetzner SSH key.
+;;;
+
+(define (hetzner-ssh-key-id ssh-key)
+  "Return the id of the SSH-KEY."
+  (assoc-ref ssh-key "id"))
+
+
+
+;;;
+;;; Hetzner server.
+;;;
+
+(define* (hetzner-server-path server #:optional (path ""))
+  "Return the PATH of the Hetzner SERVER."
+  (format #f "/servers/~a~a" (assoc-ref server "id") path))
+
+(define (hetzner-server-type server)
+  "Return the type of the Hetzner SERVER."
+  (assoc-ref server "server_type"))
+
+(define (hetzner-server-architecture server)
+  "Return the architecture of the Hetzner SERVER."
+  (assoc-ref (hetzner-server-type server) "architecture"))
+
+(define (hetzner-server-public-ipv4 server)
+  "Return the public IPv4 address of the SERVER."
+  (and-let* ((public-net (assoc-ref server "public_net"))
+             (network (assoc-ref public-net "ipv4")))
+    (assoc-ref network "ip")))
+
+(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")))
+
+
+;;;
+;;; Hetzner configuration.
+;;;
+
+(define-record-type* <hetzner-configuration> hetzner-configuration
+  make-hetzner-configuration hetzner-configuration? this-hetzner-configuration
+  (api hetzner-configuration-api ; <hetzner-api>
+       (default (hetzner-api)))
+  (allow-downgrades? hetzner-configuration-allow-downgrades? ; boolean
+                     (default #f))
+  (authorize? hetzner-configuration-authorize? ; boolean
+              (default #t))
+  (build-locally? hetzner-configuration-build-locally? ; boolean
+                  (default #t))
+  (delete? hetzner-configuration-delete? ; boolean
+           (default #f))
+  (enable-ipv6? hetzner-configuration-enable-ipv6? ; boolean
+                (default #t))
+  (labels hetzner-configuration-labels ; list of strings
+          (default '()))
+  (location hetzner-configuration-location  ; #f | string
+            (default "fsn1"))
+  (networks hetzner-configuration-networks ; list of integers
+            (default '()))
+  (server-type hetzner-configuration-server-type ; string
+               (default "cx42"))
+  (ssh-key hetzner-configuration-ssh-key)) ; string
+
+(define (hetzner-configuration-public-net config)
+  "Return the public network configuration of a server for CONFIG."
+  `(("enable_ipv6" . ,(hetzner-configuration-enable-ipv6? config))))
+
+(define (hetzner-configuration-ssh-key-fingerprint config)
+  "Return the SSH public key fingerprint of CONFIG as a string."
+  (and-let* ((file-name (hetzner-configuration-ssh-key config))
+             (privkey (private-key-from-file file-name))
+             (pubkey (private-key->public-key privkey))
+             (hash (get-public-key-hash pubkey 'md5)))
+    (bytevector->hex-string hash)))
+
+(define (hetzner-configuration-ssh-key-public config)
+  "Return the SSH public key of CONFIG as a string."
+  (and-let* ((ssh-key (hetzner-configuration-ssh-key config))
+             (public-key (public-key-from-file ssh-key)))
+    (format #f "ssh-~a ~a" (get-key-type public-key)
+            (public-key->string public-key))))
+
+
+;;;
+;;; Hetzner Machine.
+;;;
+
+(define (hetzner-machine-delegate target)
+  "Return the delagate machine that uses SSH for deployment."
+  (let* ((config (machine-configuration target))
+         (server (hetzner-machine-server target))
+         ;; Get the operating system WITHOUT the provenance service to avoid a
+         ;; duplicate symlink conflict in the store.
+         (os ((@@ (gnu machine) %machine-operating-system) target)))
+    (machine
+     (inherit target)
+     (operating-system
+       (if (hetzner-configuration-authorize? config)
+           (operating-system-authorize os)
+           os))
+     (environment managed-host-environment-type)
+     (configuration
+      (machine-ssh-configuration
+       (allow-downgrades? (hetzner-configuration-allow-downgrades? config))
+       (authorize? (hetzner-configuration-authorize? config))
+       (build-locally? (hetzner-configuration-build-locally? config))
+       (host-name (hetzner-server-public-ipv4 server))
+       (identity (hetzner-configuration-ssh-key config))
+       (system (hetzner-server-system server)))))))
+
+(define (hetzner-machine-location machine)
+  "Find the location of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (location (hetzner-configuration-location config)))
+    (find (lambda (type)
+            (equal? location (assoc-ref type "name")))
+          (hetzner-api-locations
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,location))))))
+
+(define (hetzner-machine-server-type machine)
+  "Find the server type of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (server-type (hetzner-configuration-server-type config)))
+    (find (lambda (type)
+            (equal? server-type (assoc-ref type "name")))
+          (hetzner-api-server-types
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,server-type))))))
+
+(define (hetzner-machine-validate-auth-token machine)
+  "Validate the Hetzner API authentication token of MACHINE."
+  (let* ((config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (unless (hetzner-api-auth-token api)
+      (raise (formatted-message
+              (G_ "No Hetzner Cloud access token was provided. \
+This may be fixed by setting the environment variable GUIX_HETZNER_API_TOKEN
+to one procured from \
+https://docs.hetzner.com/cloud/api/getting-started/generating-api-token"))))))
+
+(define (hetzner-machine-validate-configuration-type machine)
+  "Raise an error if MACHINE's configuration is not an instance of
+<hetzner-configuration>."
+  (let ((config (machine-configuration machine))
+        (environment (environment-type-name (machine-environment machine))))
+    (unless (and config (hetzner-configuration? config))
+      (raise (formatted-message (G_ "unsupported machine configuration '~a' \
+for environment of type '~a'")
+                                config
+                                environment)))))
+
+(define (hetzner-machine-validate-server-type machine)
+  "Raise an error if the server type of MACHINE is not supported."
+  (unless (hetzner-machine-server-type machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise (formatted-message
+              (G_ "Server type '~a' not supported~%~%\
+Available server types:~%~%~a")
+              (hetzner-configuration-server-type config)
+              (string-join
+               (map (lambda (type)
+                      (format #f " - ~a: ~a, ~a ~a cores, ~a GB mem, ~a GB disk"
+                              (colorize-string (assoc-ref type "name")
+                                               (color BOLD))
+                              (assoc-ref type "architecture")
+                              (assoc-ref type "cores")
+                              (assoc-ref type "cpu_type")
+                              (assoc-ref type "memory")
+                              (assoc-ref type "disk")))
+                    (hetzner-api-server-types api))
+               "\n"))))))
+
+(define (hetzner-machine-validate-location machine)
+  "Raise an error if the location of MACHINE is not supported."
+  (unless (hetzner-machine-location machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise (formatted-message
+              (G_ "Server location '~a' not supported~%~%\
+Available locations:~%~%~a")
+              (hetzner-configuration-location config)
+              (string-join
+               (map (lambda (location)
+                      (format #f " - ~a: ~a, ~a"
+                              (colorize-string (assoc-ref location "name")
+                                               (color BOLD))
+                              (assoc-ref location "description")
+                              (assoc-ref location "country")))
+                    (hetzner-api-locations api))
+               "\n"))))))
+
+(define (hetzner-machine-validate machine)
+  "Validate the Hetzner MACHINE."
+  (hetzner-machine-validate-configuration-type machine)
+  (hetzner-machine-validate-auth-token machine)
+  (hetzner-machine-validate-location machine)
+  (hetzner-machine-validate-server-type machine))
+
+(define (hetzner-machine-bootstrap-os-form machine server)
+  "Return the form to bootstrap an operating system on SERVER."
+  (let* ((os (machine-operating-system machine))
+         (system (hetzner-server-system server))
+         (arm? (equal? "arm" (hetzner-server-architecture server)))
+         (x86? (equal? "x86" (hetzner-server-architecture server)))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    `(operating-system
+       (host-name ,(operating-system-host-name os))
+       (timezone "Etc/UTC")
+       (bootloader (bootloader-configuration
+                    (bootloader ,(cond (arm? 'grub-efi-bootloader)
+                                       (x86? 'grub-bootloader)))
+                    (targets ,(cond (arm? '(list "/boot/efi"))
+                                    (x86? '(list "/dev/sda"))))
+                    (terminal-outputs '(console))))
+       (initrd-modules (append
+                        ,(cond (arm? '(list "sd_mod" "virtio_scsi"))
+                               (x86? '(list "virtio_scsi")))
+                        %base-initrd-modules))
+       (file-systems ,(cond
+                       (arm? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     (file-system
+                                       (mount-point "/boot/efi")
+                                       (device "/dev/sda15")
+                                       (type "vfat"))
+                                     %base-file-systems))
+                       (x86? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     %base-file-systems))))
+       (services
+        (cons* (service dhcp-client-service-type)
+               (service openssh-service-type
+                        (openssh-configuration
+                         (openssh openssh-sans-x)
+                         (permit-root-login 'prohibit-password)))
+               %base-services)))))
+
+(define (rexec-verbose session cmd)
+  "Execute a command CMD on the remote side and print output.  Return two
+values: list of output lines returned by CMD and its exit code."
+  (let* ((channel (open-remote-input-pipe session cmd))
+         (result  (let loop ((line   (read-line channel))
+                             (result '()))
+                    (if (eof-object? line)
+                        (reverse result)
+                        (begin
+                          (display line)
+                          (newline)
+                          (loop (read-line channel)
+                                (cons line result))))))
+         (exit-status (channel-get-exit-status channel)))
+    (close channel)
+    (values result exit-status)))
+
+(define (hetzner-machine-ssh-key machine)
+  "Find the SSH key for MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (fingerprint (hetzner-configuration-ssh-key-fingerprint config)))
+    (find (lambda (server)
+            (equal? (assoc-ref server "fingerprint") fingerprint))
+          (hetzner-api-ssh-keys
+           (hetzner-configuration-api config)
+           #:params `(("fingerprint" . ,fingerprint))))))
+
+(define (hetzner-machine-ssh-key-create machine)
+  "Create the SSH key for MACHINE on the Hetzner API."
+  (let ((name (machine-display-name machine)))
+    (format #t "creating ssh key for '~a'...\n" name)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config))
+           (body (hetzner-api-ssh-key-create
+                  (hetzner-configuration-api config)
+                  `(("name" . ,(machine-display-name machine))
+                    ("name" .
+                     ,(hetzner-configuration-ssh-key-fingerprint config))
+                    ("public_key" .
+                     ,(hetzner-configuration-ssh-key-public config))
+                    ("labels" . ,(hetzner-configuration-labels config))))))
+      (format #t "successfully created ssh key for '~a'\n" name)
+      (assoc-ref body "ssh_key"))))
+
+(define (hetzner-machine-server machine)
+  "Find the Hetzner server for MACHINE."
+  (let ((config (machine-configuration machine)))
+    (find (lambda (server)
+            (equal? (machine-display-name machine)
+                    (assoc-ref server "name")))
+          (hetzner-api-servers
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,(machine-display-name machine)))))))
+
+(define (hetzner-machine-create-server machine)
+  "Create the Hetzner server for MACHINE."
+  (let* ((config (machine-configuration machine))
+         (name (machine-display-name machine))
+         (server-type (hetzner-configuration-server-type config)))
+    (format #t "creating '~a' server for '~a'...\n" server-type name)
+    (let* ((ssh-key (hetzner-machine-ssh-key machine))
+           (api (hetzner-configuration-api config))
+           (body (hetzner-api-server-create
+                  api
+                  `(("image" . "debian-11")
+                    ("labels" . ,(hetzner-configuration-labels config))
+                    ("name" . ,(machine-display-name machine))
+                    ("public_net" . ,(hetzner-configuration-public-net config))
+                    ("location" . ,(hetzner-configuration-location config))
+                    ("server_type" .
+                     ,(hetzner-configuration-server-type config))
+                    ("ssh_keys" . ,(vector (hetzner-ssh-key-id ssh-key)))
+                    ("start_after_create" . #f))))
+           (server (assoc-ref body "server"))
+           (architecture (hetzner-server-architecture server)))
+      (hetzner-api-action-wait api (assoc-ref body "action"))
+      (format #t "successfully created '~a' ~a server for '~a'\n"
+              server-type architecture name)
+      server)))
+
+(define (wait-for-ssh address ssh-key)
+  "Block until a SSH session can be made as 'root' with SSH-KEY at ADDRESS."
+  (format #t "connecting via SSH to '~a' using '~a'...\n" address ssh-key)
+  (let loop ()
+    (catch #t
+      (lambda ()
+        (open-ssh-session address #:user "root" #:identity ssh-key
+                          #:stricthostkeycheck #f))
+      (lambda args
+        (let ((msg (cadr args)))
+          (if (formatted-message? msg)
+              (format #t "~a\n"
+                      (string-trim-right
+                       (apply format #f
+                              (formatted-message-string msg)
+                              (formatted-message-arguments msg))
+                       #\newline))
+              (format #t "~a" args))
+          (sleep 5)
+          (loop))))))
+
+(define (hetzner-machine-wait-for-ssh machine)
+  "Wait for SSH connection to be established with the specified machine."
+  (let ((server (hetzner-machine-server machine)))
+    (wait-for-ssh (hetzner-server-public-ipv4 server)
+                  (hetzner-configuration-ssh-key
+                   (machine-configuration machine)))))
+
+(define (hetzner-machine-authenticate-host machine)
+  "Add the host key of MACHINE to the list of known hosts."
+  (let ((ssh-session (hetzner-machine-wait-for-ssh machine)))
+    (write-known-host! ssh-session)))
+
+(define (hetzner-machine-enable-rescue-system machine server)
+  "Enable the rescue system on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config))
+         (ssh-keys (list (hetzner-machine-ssh-key machine))))
+    (format #t "enabling rescue system on '~a'...\n" name)
+    (let ((body (hetzner-api-server-enable-rescue-system
+                 api server #:ssh-keys ssh-keys)))
+      (hetzner-api-action-wait api (assoc-ref body "action"))
+      (format #t "successfully enabled rescue system on '~a'\n" name)
+      body)))
+
+(define (hetzner-machine-power-on machine server)
+  "Power on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "powering on server for '~a'...\n" name)
+    (let ((body (hetzner-api-server-power-on api server)))
+      (hetzner-api-action-wait api (assoc-ref body "action"))
+      (format #t "successfully powered on server for '~a'\n" name)
+      body)))
+
+(define (hetzner-machine-ssh-run-script ssh-session name content)
+  (let ((sftp-session (make-sftp-session ssh-session)))
+    (rexec ssh-session (format #f "rm -f ~a" name))
+    (rexec ssh-session (format #f "mkdir -p ~a" (dirname name)))
+    (call-with-remote-output-file
+     sftp-session name
+     (lambda (port)
+       (display content port)))
+    (sftp-chmod sftp-session name 755)
+    (receive (lines exit-code)
+        (rexec-verbose ssh-session (format #f "~a 2>&1" name))
+      (if (zero? exit-code)
+          lines
+          (raise (formatted-message
+                  (G_ "failed to run script '~a' on machine, exit code: '~a'")
+                  name exit-code))))))
+
+(define (hetzner-machine-rescue-install-os machine ssh-session server)
+  (let ((name (machine-display-name machine))
+        (os (hetzner-machine-bootstrap-os-form machine server)))
+    (format #t "installing guix operating system on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-os"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+mount /dev/sda1 /mnt
+mkdir -p /mnt/boot/efi
+mount /dev/sda15 /mnt/boot/efi
+
+mkdir --parents /mnt/root/.ssh
+chmod 700 /mnt/root/.ssh
+cp /root/.ssh/authorized_keys /mnt/root/.ssh/authorized_keys
+chmod 600 /mnt/root/.ssh/authorized_keys
+
+cat > /tmp/guix/deploy/hetzner-os.scm << EOF
+(use-modules (gnu) (guix utils))
+(use-package-modules ssh)
+(use-service-modules base networking ssh)
+(use-system-modules linux-initrd)
+~a
+EOF
+cat /tmp/guix/deploy/hetzner-os.scm
+guix system init --verbosity=2 /tmp/guix/deploy/hetzner-os.scm /mnt"
+             (escape-backticks (format #f "~y" os))))
+    (format #t "successfully installed guix operating system on '~a'\n" name)))
+
+(define (hetzner-machine-reboot machine server)
+  "Reboot the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "rebooting server for '~a'...\n" name)
+    (let ((body (hetzner-api-server-reboot api server)))
+      (hetzner-api-action-wait api (assoc-ref body "action"))
+      (format #t "successfully rebooted server for '~a'\n" name)
+      body)))
+
+(define (hetzner-machine-rescue-partition machine ssh-session)
+  "Setup the partitions of the Hetzner server for MACHINE using SSH-SESSION."
+  (let* ((name (machine-display-name machine))
+         (os (machine-operating-system machine))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    (format #t "setting up partitions on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-partition"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+growpart /dev/sda 1 || true
+~a
+fdisk -l /dev/sda"
+             (cond
+              ((equal? "btrfs" root-fs-type)
+               (format #f "mkfs.btrfs -L ~a -f /dev/sda1" root-label))
+              ((equal? "ext4" root-fs-type)
+               (format #f "mkfs.ext4 -L ~a -F /dev/sda1" root-label))
+              (else (raise (formatted-message
+                            (G_ "unsupported root file system type '~a'")
+                            root-fs-type))))))
+    (format #t "successfully setup partitions on '~a'\n" name)))
+
+(define (hetzner-machine-rescue-install-packages machine ssh-session)
+  "Install packages on the Hetzner server for MACHINE using SSH-SESSION."
+  (let ((name (machine-display-name machine)))
+    (format #t "installing rescue system packages on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-packages"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+apt-get update
+apt-get install guix cloud-initramfs-growroot --assume-yes"))
+    (format #t "successfully installed rescue system packages on '~a'\n" name)))
+
+(define (hetzner-machine-delete machine server)
+  "Delete the Hetzner server for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "deleting server for '~a'...\n" name)
+    (let ((body (hetzner-api-server-delete api server)))
+      (hetzner-api-action-wait api (assoc-ref body "action"))
+      (format #t "successfully deleted server for '~a'\n" name)
+      body)))
+
+(define (hetzner-machine-provision machine)
+  "Provision a server for MACHINE on the Hetzner Cloud service."
+  (with-exception-handler
+      (lambda (exception)
+        (let ((config (machine-configuration machine))
+              (server (hetzner-machine-server machine)))
+          (when (and server (hetzner-configuration-delete? config))
+            (hetzner-machine-delete machine server))
+          (raise-exception exception)))
+    (lambda ()
+      (let ((server (hetzner-machine-create-server machine)))
+        (hetzner-machine-enable-rescue-system machine server)
+        (hetzner-machine-power-on machine server)
+        (let ((ssh-session (hetzner-machine-wait-for-ssh machine)))
+          (hetzner-machine-rescue-install-packages machine ssh-session)
+          (hetzner-machine-rescue-partition machine ssh-session)
+          (hetzner-machine-rescue-install-os machine ssh-session server)
+          (hetzner-machine-reboot machine server)
+          (sleep 5)
+          (hetzner-machine-authenticate-host machine))))
+    #:unwind? #t))
+
+
+;;;
+;;; Remote evaluation.
+;;;
+
+(define (hetzner-remote-eval machine exp)
+  "Internal implementation of 'machine-remote-eval' for MACHINE instances with
+an environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (unless (hetzner-machine-server machine)
+    (raise (formatted-message
+            (G_ "machine '~a' not provisioned on the Hetzner Cloud service")
+            (machine-display-name machine))))
+  (machine-remote-eval (hetzner-machine-delegate machine) exp))
+
+
+
+;;;
+;;; System deployment.
+;;;
+
+(define (deploy-hetzner machine)
+  "Internal implementation of 'deploy-machine' for 'machine' instances with an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (unless (hetzner-machine-ssh-key machine)
+    (hetzner-machine-ssh-key-create machine))
+  (unless (hetzner-machine-server machine)
+    (hetzner-machine-provision machine))
+  (deploy-machine (hetzner-machine-delegate machine)))
+
+
+
+;;;
+;;; Roll-back.
+;;;
+
+(define (roll-back-hetzner machine)
+  "Internal implementation of 'roll-back-machine' for MACHINE instances with an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (roll-back-machine (hetzner-machine-delegate machine)))
+
+
+
+;;;
+;;; Environment type.
+;;;
+
+(define hetzner-environment-type
+  (environment-type
+   (machine-remote-eval hetzner-remote-eval)
+   (deploy-machine deploy-hetzner)
+   (roll-back-machine roll-back-hetzner)
+   (name 'hetzner-environment-type)
+   (description "Provisioning of virtual machine servers on the Hetzner Cloud
+service.")))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index ae506df14c..196a92e813 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port identity
                            host-key
                            (compression %compression)
                            (timeout 3600)
-                           (connection-timeout 10))
+                           (connection-timeout 10)
+                           (stricthostkeycheck #t))
   "Open an SSH session for HOST and return it.  IDENTITY specifies the file
 name of a private key to use for authenticating with the host.  When USER,
 PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
@@ -137,7 +138,8 @@ (define* (open-ssh-session host #:key user port identity
 
                                ;; Speed up RPCs by creating sockets with
                                ;; TCP_NODELAY.
-                               #:nodelay #t)))
+                               #:nodelay #t
+                               #:stricthostkeycheck stricthostkeycheck)))
 
     ;; Honor ~/.ssh/config.
     (session-parse-config! session)
@@ -149,13 +151,14 @@ (define* (open-ssh-session host #:key user port identity
            (authenticate-server* session host-key)
 
            ;; Authenticate against ~/.ssh/known_hosts.
-           (match (authenticate-server session)
-             ('ok #f)
-             (reason
-              (raise (formatted-message (G_ "failed to authenticate \
+           (when stricthostkeycheck
+             (match (authenticate-server session)
+               ('ok #f)
+               (reason
+                (raise (formatted-message (G_ "failed to authenticate \
 server at '~a': ~a")
-                                        (session-get session 'host)
-                                        reason)))))
+                                          (session-get session 'host)
+                                          reason))))))
 
        ;; Use public key authentication, via the SSH agent if it's available.
        (match (userauth-public-key/auto! session)

base-commit: 831b94a1efcea8f793afc949b5123a6235c9bb1a
-- 
2.47.1

Message sent:

Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
MIME-Version: 1.0
X-Mailer: MIME-tools 5.505 (Entity 5.505)
Content-Type: text/plain; charset=utf-8
X-Loop: help-debbugs@HIDDEN
From: help-debbugs@HIDDEN (GNU bug Tracking System)
To: Roman Scherer <roman@HIDDEN>
Subject: bug#75144: Acknowledgement ([PATCH] machine: Implement
 'hetzner-environment-type'.)
Message-ID: <handler.75144.B.173531802612495.ack <at> debbugs.gnu.org>
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
X-Gnu-PR-Message: ack 75144
X-Gnu-PR-Package: guix-patches
X-Gnu-PR-Keywords: patch
Reply-To: 75144 <at> debbugs.gnu.org
Date: Fri, 27 Dec 2024 16:48:02 +0000

Thank you for filing a new bug report with debbugs.gnu.org.

This is an automatically generated reply to let you know your message
has been received.

Your message is being forwarded to the package maintainers and other
interested parties for their attention; they will reply in due course.

As you requested using X-Debbugs-CC, your message was also forwarded to
  Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>,=
 Ludovic Court?s <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Maxim=
 Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@gmai=
l.com>, Tobias Geerinckx-Rice <me@HIDDEN>
(after having been given a bug report number, if it did not have one).

Your message has been sent to the package maintainer(s):
 guix-patches@HIDDEN

If you wish to submit further information on this problem, please
send it to 75144 <at> debbugs.gnu.org.

Please do not send mail to help-debbugs@HIDDEN unless you wish
to report a problem with the Bug-tracking system.

--=20
75144: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3D75144
GNU Bug Tracking System
Contact help-debbugs@HIDDEN with problems

Message sent to guix-patches@HIDDEN:

Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Thu, 16 Jan 2025 21:28:01 +0000
Resent-Message-ID: <handler.75144.B75144.173706284432474 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
In-Reply-To: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 (Roman Scherer's message of "Fri, 27 Dec 2024 17:46:39 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
Date: Thu, 16 Jan 2025 22:26:18 +0100
Message-ID: <8734hi1mdh.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

Hello Roman,

Roman Scherer <roman@HIDDEN> skribis:

> * gnu/machine/hetzner.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * guix/ssh.scm (open-ssh-session): Add stricthostkeycheck option.
> * doc/guix.texi (Invoking guix deploy): Add documentation for
> 'hetzner-configuration'.
>
> Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41

Thumbs up for this big piece of work, one that I think is important for
the project!  =E2=80=98guix deploy=E2=80=99 is a great idea but it desperat=
ely needs
more backends like this one.

I=E2=80=99m not familiar with Hetzner so I=E2=80=99ll comment on more gener=
al aspects.
Chris, perhaps you can provide feedback on Hetzner-specific issues?  I
think we could put this backend to good use for Guix infra since a few
services are running at Hetzner.

> +@deftp {Data Type} hetzner-configuration
> +This is the data type describing the server that should be created for a
> +machine with an @code{environment} of @code{hetzner-environment-type}.

Could you add a sentence providing more context like:

  It allows you to configure deployment to a @acronym{VPS, virtual
  private server} hosted by @uref{https://www.hetzner.com, Hetzner}.

> +@item @code{authorize?} (default: @code{#t})
> +If true, the coordinator's public signing key

=E2=80=9Ccoordinator=E2=80=9D has nothing to do here I guess.

> +@item @code{labels} (default: @code{'()})
> +A user defined alist of key/value pairs attached to the server. Keys and
> +values must be strings. For more information, see
> +@uref{https://docs.hetzner.cloud/#labels, Labels}.

Maybe add a short example?

> +@item @code{location} (default: @code{"fsn1"})
> +The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
> +location} to create the server in.

Maybe add: =E2=80=9CFor example, @code{"fsn1"} corresponds to the Hetzner s=
ite
in Falkenstein, Germany, while @code{"sin"} corresponds to its site in
Singapore.=E2=80=9D

> +@item @code{server-type} (default: @code{"cx42"})
> +The name of the
> +@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
> +server type} this server should be created with.

Likewise, an example would be elcome.

> +@item @code{ssh-key}
> +The path to the SSH private key to use to authenticate with the remote
> +host.

s/path to/file name of/

> +The following example shows the definition of 2 machines that are

s/2/two/

> +vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second

s/@code{aarch64}/AArch64/

> +shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.

Drop @code.

> +@lisp
> +(use-modules (gnu machine)
> +             (gnu machine hetzner))
> +
> +(list (machine
> +       (operating-system %hetzner-os-arm)
> +       (environment hetzner-environment-type)
> +       (configuration (hetzner-configuration
> +                       (server-type "cax41")
> +                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
> +      (machine
> +       (operating-system %hetzner-os-x86)
> +       (environment hetzner-environment-type)
> +       (configuration (hetzner-configuration
> +                       (server-type "cpx51")
> +                       (ssh-key "/home/charlie/.ssh/id_rsa")))))

Nice!

> +API key} should provision 2 machines for you.

s/2/two/

> +  #:use-module (ice-9 receive)

The code base preferable uses SRFI-71 for multiple-value returns.

> +      (raise (formatted-message
> +              (G_ "Expected a list of Hetzner API responses")))))

Messages should start with a lower-case letter (for all the messages in
this file).

Please add the file to =E2=80=98po/guix/POTFILES.in=E2=80=99 so that it=E2=
=80=99s actually
subject to translation.

> +(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 (json-string->scm (bytevector->string body "UTF-8")))

Just =E2=80=98string->utf8=E2=80=99 (shorter).

More importantly: instead of =E2=80=98json-string->scm=E2=80=99 (which give=
s an alist,
leading to =E2=80=98assoc-ref=E2=80=99 calls all over the code base along w=
ith free-form
alists, which is very error-prone), could you use =E2=80=98define-json-mapp=
ing=E2=80=99?

In essence it=E2=80=99s like =E2=80=98define-record-type=E2=80=99 but it ad=
ditionally define how
to map a JSON dictionary to a Scheme record.  There are several examples
in Guix, such as (guix swh).

For clarity, it might be useful to move all the hetzner-api-* bits to a
separate module, for example (gnu machine hetzner http).  WDYT?

The rest of the code looks nice to me (modulo alists :-)) but that=E2=80=99s
about all I can say.  It=E2=80=99s quite a significant body of code.  What =
would
you suggest to prevent bitrot and support maintenance?  Are there parts
of it that could be usefully tested automatically, possibly by mocking
part of the Hetzner API?  Or are there tips on how you tested it that
could be written down in the file itself?

Could you move the (guix ssh) bits to a separate patch?

> +++ b/guix/ssh.scm
> @@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port ident=
ity
>                             host-key
>                             (compression %compression)
>                             (timeout 3600)
> -                           (connection-timeout 10))
> +                           (connection-timeout 10)
> +                           (stricthostkeycheck #t))
>    "Open an SSH session for HOST and return it.  IDENTITY specifies the f=
ile
>  name of a private key to use for authenticating with the host.  When USE=
R,
>  PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'

Please update the docstring.

Rather =E2=80=98strict-host-key-check?=E2=80=99 to match naming conventions=
, even if
Guile-SSH calls it that way.

> @@ -137,7 +138,8 @@ (define* (open-ssh-session host #:key user port ident=
ity
>=20=20
>                                 ;; Speed up RPCs by creating sockets with
>                                 ;; TCP_NODELAY.
> -                               #:nodelay #t)))
> +                               #:nodelay #t
> +                               #:stricthostkeycheck stricthostkeycheck)))

Not sure what this does actually.  Looks like the main part is the
=E2=80=9Cwhen stricthostkeycheck=E2=80=9D condition that comes below, no?

Could you send a second version?

Thank you!

Ludo=E2=80=99.

Message sent to guix-patches@HIDDEN:

Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Thu, 16 Jan 2025 21:28:02 +0000
Resent-Message-ID: <handler.75144.B75144.173706284932486 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
In-Reply-To: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 (Roman Scherer's message of "Fri, 27 Dec 2024 17:46:39 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
Date: Thu, 16 Jan 2025 22:26:55 +0100
Message-ID: <871px21mcg.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
Precedence: list
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

Hello Roman,

Roman Scherer <roman@HIDDEN> skribis:

> * gnu/machine/hetzner.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * guix/ssh.scm (open-ssh-session): Add stricthostkeycheck option.
> * doc/guix.texi (Invoking guix deploy): Add documentation for
> 'hetzner-configuration'.
>
> Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41

Thumbs up for this big piece of work, one that I think is important for
the project!  =E2=80=98guix deploy=E2=80=99 is a great idea but it desperat=
ely needs
more backends like this one.

I=E2=80=99m not familiar with Hetzner so I=E2=80=99ll comment on more gener=
al aspects.
Chris, perhaps you can provide feedback on Hetzner-specific issues?  I
think we could put this backend to good use for Guix infra since a few
services are running at Hetzner.

> +@deftp {Data Type} hetzner-configuration
> +This is the data type describing the server that should be created for a
> +machine with an @code{environment} of @code{hetzner-environment-type}.

Could you add a sentence providing more context like:

  It allows you to configure deployment to a @acronym{VPS, virtual
  private server} hosted by @uref{https://www.hetzner.com, Hetzner}.

> +@item @code{authorize?} (default: @code{#t})
> +If true, the coordinator's public signing key

=E2=80=9Ccoordinator=E2=80=9D has nothing to do here I guess.

> +@item @code{labels} (default: @code{'()})
> +A user defined alist of key/value pairs attached to the server. Keys and
> +values must be strings. For more information, see
> +@uref{https://docs.hetzner.cloud/#labels, Labels}.

Maybe add a short example?

> +@item @code{location} (default: @code{"fsn1"})
> +The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
> +location} to create the server in.

Maybe add: =E2=80=9CFor example, @code{"fsn1"} corresponds to the Hetzner s=
ite
in Falkenstein, Germany, while @code{"sin"} corresponds to its site in
Singapore.=E2=80=9D

> +@item @code{server-type} (default: @code{"cx42"})
> +The name of the
> +@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
> +server type} this server should be created with.

Likewise, an example would be elcome.

> +@item @code{ssh-key}
> +The path to the SSH private key to use to authenticate with the remote
> +host.

s/path to/file name of/

> +The following example shows the definition of 2 machines that are

s/2/two/

> +vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second

s/@code{aarch64}/AArch64/

> +shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.

Drop @code.

> +@lisp
> +(use-modules (gnu machine)
> +             (gnu machine hetzner))
> +
> +(list (machine
> +       (operating-system %hetzner-os-arm)
> +       (environment hetzner-environment-type)
> +       (configuration (hetzner-configuration
> +                       (server-type "cax41")
> +                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
> +      (machine
> +       (operating-system %hetzner-os-x86)
> +       (environment hetzner-environment-type)
> +       (configuration (hetzner-configuration
> +                       (server-type "cpx51")
> +                       (ssh-key "/home/charlie/.ssh/id_rsa")))))

Nice!

> +API key} should provision 2 machines for you.

s/2/two/

> +  #:use-module (ice-9 receive)

The code base preferable uses SRFI-71 for multiple-value returns.

> +      (raise (formatted-message
> +              (G_ "Expected a list of Hetzner API responses")))))

Messages should start with a lower-case letter (for all the messages in
this file).

Please add the file to =E2=80=98po/guix/POTFILES.in=E2=80=99 so that it=E2=
=80=99s actually
subject to translation.

> +(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 (json-string->scm (bytevector->string body "UTF-8")))

Just =E2=80=98string->utf8=E2=80=99 (shorter).

More importantly: instead of =E2=80=98json-string->scm=E2=80=99 (which give=
s an alist,
leading to =E2=80=98assoc-ref=E2=80=99 calls all over the code base along w=
ith free-form
alists, which is very error-prone), could you use =E2=80=98define-json-mapp=
ing=E2=80=99?

In essence it=E2=80=99s like =E2=80=98define-record-type=E2=80=99 but it ad=
ditionally define how
to map a JSON dictionary to a Scheme record.  There are several examples
in Guix, such as (guix swh).

For clarity, it might be useful to move all the hetzner-api-* bits to a
separate module, for example (gnu machine hetzner http).  WDYT?

The rest of the code looks nice to me (modulo alists :-)) but that=E2=80=99s
about all I can say.  It=E2=80=99s quite a significant body of code.  What =
would
you suggest to prevent bitrot and support maintenance?  Are there parts
of it that could be usefully tested automatically, possibly by mocking
part of the Hetzner API?  Or are there tips on how you tested it that
could be written down in the file itself?

Could you move the (guix ssh) bits to a separate patch?

> +++ b/guix/ssh.scm
> @@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port ident=
ity
>                             host-key
>                             (compression %compression)
>                             (timeout 3600)
> -                           (connection-timeout 10))
> +                           (connection-timeout 10)
> +                           (stricthostkeycheck #t))
>    "Open an SSH session for HOST and return it.  IDENTITY specifies the f=
ile
>  name of a private key to use for authenticating with the host.  When USE=
R,
>  PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'

Please update the docstring.

Rather =E2=80=98strict-host-key-check?=E2=80=99 to match naming conventions=
, even if
Guile-SSH calls it that way.

> @@ -137,7 +138,8 @@ (define* (open-ssh-session host #:key user port ident=
ity
>=20=20
>                                 ;; Speed up RPCs by creating sockets with
>                                 ;; TCP_NODELAY.
> -                               #:nodelay #t)))
> +                               #:nodelay #t
> +                               #:stricthostkeycheck stricthostkeycheck)))

Not sure what this does actually.  Looks like the main part is the
=E2=80=9Cwhen stricthostkeycheck=E2=80=9D condition that comes below, no?

Could you send a second version?

Thank you!

Ludo=E2=80=99.

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Sun, 19 Jan 2025 17:00:02 +0000
Resent-Message-ID: <handler.75144.B75144.173730596811263 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Cc: Roman Scherer <roman@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173730596811263
          (code B ref 75144); Sun, 19 Jan 2025 17:00:02 +0000
Received: (at 75144) by debbugs.gnu.org; 19 Jan 2025 16:59:28 +0000
Received: from localhost ([127.0.0.1]:47214 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tZYdt-0002vS-CJ
	for submit <at> debbugs.gnu.org; Sun, 19 Jan 2025 11:59:28 -0500
Received: from mail-ej1-x630.google.com ([2a00:1450:4864:20::630]:52275)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tZYdn-0002v9-W4
 for 75144 <at> debbugs.gnu.org; Sun, 19 Jan 2025 11:59:20 -0500
Received: by mail-ej1-x630.google.com with SMTP id
 a640c23a62f3a-aa6b4cc7270so573799766b.0
 for <75144 <at> debbugs.gnu.org>; Sun, 19 Jan 2025 08:59:15 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1737305950;
 x=1737910750; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=3aoInGV7C34j1TasFocGObkByw+G2Udg800dqUcXhCE=;
 b=Fg3ppyIL9lrkX81iWkevqV3D/y3BrTg9PL5ysker4CNZ0Bmjmu28dCqaHYFpcieb79
 Fwp5n4GP2Idm8/Ex5i2rtX/Xh6xveikVKgn8wt15We842/6Coahkr9+RmBeoEKwm9uw2
 AToZcsY/Jziaf8p/i35AgtZI38OupY1xPFOmr7fXgVPIpgfjiJaOoPdjeDuC2QdbgsbF
 +vec8fi5xWx7WpLcOwX9jPAR+YMcKG786fK3KHKeqdbCM9+yyhmdkL+Whlq2ByRggZtj
 ZTMTXvf5euhZIyeY7ENGLHLBR6nAf0nPItbdJGhZCirezribDXKd10pTrPeepUCQkA3y
 jSmw==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1737305950; x=1737910750;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=3aoInGV7C34j1TasFocGObkByw+G2Udg800dqUcXhCE=;
 b=LSSCWnwkgSiaWg3lobhLxitVMETsyE8tOXnuylFxcvj1DePeuo3399JuYm5hPFpDE3
 q+ke/9q3NS8Tt4SW6daxQMbWHdI3bqWfTzmRy4wnDnhMKXhyy8+45WLYwCBFwEzMmf4a
 vqTPpIUYfm0bazDPhJUvBvwpoaLeaOaiW9ZLsrTKM0B2DfZfehlaQMIC9qVEeTpvESkc
 XfUfEhUc9p2lz+r/AJpiFPclMY4DmHLIYwsuMUnfBMhoh5AkAEGBtzjffXyZk/LhV9/h
 SxbW1v2bGZGWumTZD7RvFVoOrT26qTIkdfgItBeWgF07bWy41lWkgwwzDohBbBwDZL1z
 4s/w==
X-Forwarded-Encrypted: i=1;
 AJvYcCW0L17DTiOQDYuwuB8CoWzMNKBVWSGsBtLztumHogbSsXVK9d4Bj3KmUyRH3cBh1ecDWzgaLg==@debbugs.gnu.org
X-Gm-Message-State: AOJu0Yz2NXghFWyz4mFUDfsvi7PQj41lix8uFBRulnvzWlxXd9zANB8F
 og9i1q1KPNquurdwtTJHq32EQJQCHmmvH+7JpYCWJqPjn1ysHFqlGosBrxCJzLc=
X-Gm-Gg: ASbGncvoA1CP4EUkHPwaGnbs1sw2uj7FGjg0Wb6TL2wwFE1AaFq6AWaXzYNc9r5Wj5a
 zr8hb365rqRXrOKnpWJzk4sMJrGl2zUJQs71XesyaSMQPlKISFoy4UKfbWowLpQouNzTzzsyZ2J
 tTv2hRkqUhMN9Gwr5n4k0FHmFRL+7JH/4NnyjM+g4UVBcL8uafd2jYe78YeOWgy3U8v7Qvfxs+B
 i9zNSBqlAqyhLu5fSfAub7mRtaBl3cy+tKOkzUTEUa09sCBs5ff/YgN9tn4CpM=
X-Google-Smtp-Source: AGHT+IGk660X0dsbnI/3Ex7ORw9nytyaUGRmDbwzNtMpx6BUVtQVo6vbqQEc7V81QR1fLEC2BvjE7g==
X-Received: by 2002:a05:6402:13ca:b0:5d2:7396:b0ed with SMTP id
 4fb4d7f45d1cf-5db7d2f5d30mr24061741a12.14.1737305949386; 
 Sun, 19 Jan 2025 08:59:09 -0800 (PST)
Received: from m1 ([2a01:599:112:8ad9:1a4c:3771:9ae3:ac1f])
 by smtp.gmail.com with ESMTPSA id
 4fb4d7f45d1cf-5db73670cf8sm4690070a12.19.2025.01.19.08.59.07
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Sun, 19 Jan 2025 08:59:08 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <8734hi1mdh.fsf@HIDDEN> ("Ludovic =?UTF-8?Q?Court=C3=A8s?="'s message of "Thu, 16 Jan 2025 22:26:18 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN>
User-Agent: mu4e 1.12.7; emacs 29.4
Date: Sun, 19 Jan 2025 17:59:06 +0100
Message-ID: <868qr6n3j9.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="==-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--==-=-=
Content-Type: multipart/mixed; boundary="=-=-="

--=-=-=
Content-Type: text/plain


Hi Ludo,

thanks for your review. Here is a v2, I hope I addressed your previous
comments with it, but I need some help.

As you suggested I also added some tests. Some use mocking, and some run
against the Hetzner API, if the GUIX_HETZNER_API_TOKEN env var is set.

./pre-inst-env make check TESTS="tests/machine/hetzner/http.scm"
./pre-inst-env make check TESTS="tests/machine/hetzner.scm"

All tests pass when I run them in the Geiser REPL, where I developed them.

But I have some trouble with one test that uses mocking. The
"deploy-machine-mock-with-unprovisioned-server" test in
tests/machine/hetzner.scm only fails when run in the terminal. :?

I'm using the "mock" function from (guix tests) to mock some HTTP and SSH
calls. The issue is that I see different behaviour whether I run the tests in
Geiser vs in the Terminal.

In Geiser I see the following output for this test, in it passes:

-------------------------------------------------------------------------------
creating 'cx42' server for 'guix-x86'...
successfully created 'cx42' x86 server for 'guix-x86'
enabling rescue system on 'guix-x86'...
MOCK ENABLE RESUCE
successfully enabled rescue system on 'guix-x86'
powering on server for 'guix-x86'...
MOCK POWER ON
successfully powered on server for 'guix-x86'
connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key'...
MOCK OPEN SSH SESSION
installing rescue system packages on 'guix-x86'...
MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-install-packages
successfully installed rescue system packages on 'guix-x86'
setting up partitions on 'guix-x86'...
MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-partition
successfully setup partitions on 'guix-x86'
installing guix operating system on 'guix-x86'...
MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-install-os
successfully installed guix operating system on 'guix-x86'
rebooting server for 'guix-x86'...
successfully rebooted server for 'guix-x86'
connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key'...
MOCK OPEN SSH SESSION
-------------------------------------------------------------------------------

You can see that calls to "hetzner-machine-ssh-run-script" are mocked, because
"MOCK RUNNING SCRIPT" is printed multiple times.

But in a "guix shell -D" terminal I see the following output for the test, and
it is failing:

-------------------------------------------------------------------------------

creating 'cx42' server for 'guix-x86'...
successfully created 'cx42' x86 server for 'guix-x86'
enabling rescue system on 'guix-x86'...
MOCK ENABLE RESUCE
successfully enabled rescue system on 'guix-x86'
powering on server for 'guix-x86'...
MOCK POWER ON
successfully powered on server for 'guix-x86'
connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key'...
MOCK OPEN SSH SESSION
installing rescue system packages on 'guix-x86'...
test-name: deploy-machine-mock-with-unprovisioned-server
location: /home/roman/workspace/guix/tests/machine/hetzner.scm:189

actual-value: #f
actual-error:
+ (guile-ssh-error
+   "%gssh-make-sftp-session"
+   "Could not create a SFTP session"
+   #<session #<undefined>@1.2.3.4:22 (disconnected) ffff85596de0>
+   #f)
result: FAIL

;;; [2025/01/19 17:39:16.791023, 0] [GSSH ERROR] Could not create a SFTP session: #<session #<undefined>@1.2.3.4:22 (disconnected) ffff85596de0>

-------------------------------------------------------------------------------

The tests fails here trying to use a disconnected SSH session object, that I
returned in a mocked call. This code should actually never be reached, because
I mock the "hetzner-machine-ssh-run-script" call. But for some reason the mock
is not working here. The "MOCK RUNNING SCRIPT" output is missing.

Do you have any ideas what could be going on here? I suspect this might be due
to some optimization or env issue, but I'm pretty lost.

I attached a WIP v2 for now. Will send a v3 and a separate patch for the ssh
modification once I fixed this mock test.

Thanks, Roman.


--=-=-=
Content-Type: text/x-patch; charset=utf-8
Content-Disposition: attachment;
 filename=v2-0001-machine-Implement-hetzner-environment-type.patch
Content-Transfer-Encoding: quoted-printable

From=20a6290ec9911453a95ed35f11c660bb794f8b3103 Mon Sep 17 00:00:00 2001
Message-ID: <a6290ec9911453a95ed35f11c660bb794f8b3103.1737305428.git.roman@=
burningswell.com>
From: Roman Scherer <roman@HIDDEN>
Date: Tue, 2 Jul 2024 22:43:00 +0200
Subject: [PATCH v2] machine: Implement 'hetzner-environment-type'.

* Makefile.am: Add test files to SCM_TESTS..
* doc/guix.texi (Invoking guix deploy): Add documentation.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add system modules.
* gnu/machine/hetzner.scm: Add machine module.
* gnu/machine/hetzner/http.scm: New HTTP API module.
* guix/ssh.scm (open-ssh-session): Add strict-host-key-check? option.
* po/guix/POTFILES.in: Add hetzner modules.

Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41
=2D--
 Makefile.am                    |   2 +
 doc/guix.texi                  | 122 ++++++
 gnu/local.mk                   |   2 +
 gnu/machine/hetzner.scm        | 700 +++++++++++++++++++++++++++++++++
 gnu/machine/hetzner/http.scm   | 636 ++++++++++++++++++++++++++++++
 guix/ssh.scm                   |  22 +-
 po/guix/POTFILES.in            |   2 +
 tests/machine/hetzner.scm      | 244 ++++++++++++
 tests/machine/hetzner/http.scm | 167 ++++++++
 9 files changed, 1889 insertions(+), 8 deletions(-)
 create mode 100644 gnu/machine/hetzner.scm
 create mode 100644 gnu/machine/hetzner/http.scm
 create mode 100644 tests/machine/hetzner.scm
 create mode 100644 tests/machine/hetzner/http.scm

diff --git a/Makefile.am b/Makefile.am
index f911d432dd..2a4f283dec 100644
=2D-- a/Makefile.am
+++ b/Makefile.am
@@ -561,6 +561,8 @@ SCM_TESTS =3D					\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
+  tests/machine/hetzner.scm                     \
+  tests/machine/hetzner/http.scm                 \
   tests/minetest.scm				\
   tests/modules.scm				\
   tests/monads.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 0015d739bb..7396662404 100644
=2D-- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44744,6 +44744,128 @@ Invoking guix deploy
 @end table
 @end deftp
=20
+@deftp {Data Type} hetzner-configuration
+This is the data type describing the server that should be created for a
+machine with an @code{environment} of
+@code{hetzner-environment-type}. It allows you to configure deployment
+to a @acronym{VPS, virtual private server} hosted by
+@uref{https://www.hetzner.com, Hetzner}.
+
+@table @asis
+
+@item @code{allow-downgrades?} (default: @code{#f})
+Whether to allow potential downgrades.
+
+@item @code{authorize?} (default: @code{#t})
+If true, the public signing key @code{"/etc/guix/signing-key.pub"} of
+the machine that invokes @command{guix deploy} will be added to the
+operating system ACL keyring.
+
+@item @code{build-locally?} (default: @code{#t})
+If false, system derivations will be built on the machine being deployed t=
o.
+
+@item @code{delete?} (default: @code{#t})
+If true, the server will be deleted when an error happens in the
+provisioning phase. If false, the server will be kept in order to debug
+any issues.
+
+@item @code{labels} (default: @code{'()})
+A user defined alist of key/value pairs attached to the SSH key and the
+server on the Hetzner API.  Keys and values must be strings,
+e.g. @code{'(("environment" . "development"))}.  For more information,
+see @uref{https://docs.hetzner.cloud/#labels, Labels}.
+
+@item @code{location} (default: @code{"fsn1"})
+The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
+location} to create the server in.  For example, @code{"fsn1"}
+corresponds to the Hetzner site in Falkenstein, Germany, while
+@code{"sin"} corresponds to its site in Singapore.
+
+@item @code{server-type} (default: @code{"cx42"})
+The name of the
+@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
+server type} this virtual server should be created with.  For example,
+@code{"cx42"} corresponds to a x86_64 server that has 8 CPUs, 16 GB of
+memory and 160 GB of storage, while @code{"cax31"} to the AArch64
+equivalent.  Other server types and their current prices can be found
+@uref{https://www.hetzner.com/cloud/#pricing, here}.
+
+@item @code{ssh-key}
+The file name of the SSH private key to use to authenticate with the
+remote host.
+
+@end table
+
+When deploying a machine for the first time, the following steps are
+taken to provision a server for the machine on the
+@uref{https://www.hetzner.com/cloud, Hetzner Cloud} service:
+
+@itemize
+
+@item
+Create the SSH key of the machine on the Hetzner API.
+
+@item
+Create a server for the machine on the Hetzner API.
+
+@item
+Format the root partition of the disk using the file system of the
+machine's operating system.  Supported file systems are btrfs and ext4.
+
+@item
+Install a minimal Guix operating system on the server using the
+@uref{https://docs.hetzner.com/cloud/servers/getting-started/rescue-system,
+rescue mode}.  This minimal system is used to install the machine's
+operating system, after rebooting.
+
+@item
+Reboot the server and apply the machine's operating system on the
+server.
+
+@end itemize
+
+Once the server has been provisioned and SSH is available, deployment
+continues by delegating it to the @code{managed-host-environment-type}.
+
+Servers on the Hetzner Cloud service can be provisioned on the AArch64
+architecture using UEFI boot mode, or on the x86_64 architecture using
+BIOS boot mode.  The @code{(gnu machine hetzner)} module exports the
+@code{%hetzner-os-arm} and @code{%hetzner-os-x86} operating systems that
+are compatible with those two architectures, and can be used as a base
+for defining your custom operating system.
+
+The following example shows the definition of two machines that are
+deployed on the Hetzner Cloud service.  The first one uses the
+@code{%hetzner-os-arm} operating system to run a server with 16 shared
+vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second
+one uses the @code{%hetzner-os-x86} operating system on a server with 16
+shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.
+
+@lisp
+(use-modules (gnu machine)
+             (gnu machine hetzner))
+
+(list (machine
+       (operating-system %hetzner-os-arm)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cax41")
+                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
+      (machine
+       (operating-system %hetzner-os-x86)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cpx51")
+                       (ssh-key "/home/charlie/.ssh/id_rsa")))))
+@end lisp
+
+Passing this file to @command{guix deploy} with the environment variable
+@env{GUIX_HETZNER_API_TOKEN} set to a valid Hetzner
+@uref{https://docs.hetzner.com/cloud/api/getting-started/generating-api-to=
ken,
+API key} should provision two machines for you.
+
+@end deftp
+
 @node Running Guix in a VM
 @section Running Guix in a Virtual Machine
=20
diff --git a/gnu/local.mk b/gnu/local.mk
index 342beca9f6..a1960d5087 100644
=2D-- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -920,6 +920,8 @@ if HAVE_GUILE_SSH
=20
 GNU_SYSTEM_MODULES +=3D         			\
   %D%/machine/digital-ocean.scm			\
+  %D%/machine/hetzner.scm			\
+  %D%/machine/hetzner/http.scm			\
   %D%/machine/ssh.scm
=20
 endif HAVE_GUILE_SSH
diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
new file mode 100644
index 0000000000..00f61e4ee4
=2D-- /dev/null
+++ b/gnu/machine/hetzner.scm
@@ -0,0 +1,700 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu machine hetzner http)
+  #:use-module (gnu machine ssh)
+  #:use-module (gnu machine)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu services base)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system image)
+  #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system pam)
+  #:use-module (gnu system)
+  #:use-module (guix base32)
+  #:use-module (guix colors)
+  #:use-module (guix derivations)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix i18n)
+  #:use-module (guix import json)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix pki)
+  #:use-module (guix records)
+  #:use-module (guix ssh)
+  #:use-module (guix store)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 pretty-print)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 string-fun)
+  #: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 (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (ssh channel)
+  #:use-module (ssh key)
+  #:use-module (ssh popen)
+  #:use-module (ssh session)
+  #:use-module (ssh sftp)
+  #:use-module (ssh shell)
+  #:use-module (web client)
+  #:use-module (web request)
+  #:use-module (web response)
+  #:use-module (web uri)
+  #:export (%hetzner-os-arm
+            %hetzner-os-x86
+            deploy-hetzner
+            hetzner-configuration
+            hetzner-configuration-allow-downgrades?
+            hetzner-configuration-api
+            hetzner-configuration-authorize?
+            hetzner-configuration-build-locally?
+            hetzner-configuration-delete?
+            hetzner-configuration-labels
+            hetzner-configuration-location
+            hetzner-configuration-server-type
+            hetzner-configuration-ssh-key
+            hetzner-configuration?
+            hetzner-environment-type))
+
+;;; Commentary:
+;;;
+;;; This module implements a high-level interface for provisioning machine=
s on
+;;; the Hetzner Cloud service https://docs.hetzner.cloud.
+;;;
+
+
+;;;
+;;; Hetzner operating systems.
+;;;
+
+;; Operating system for arm servers using UEFI boot mode.
+
+(define %hetzner-os-arm
+  (operating-system
+    (host-name "guix-arm")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-efi-bootloader)
+      (targets (list "/boot/efi"))
+      (terminal-outputs '(console))))
+    (file-systems
+     (cons* (file-system
+              (mount-point "/")
+              (device "/dev/sda1")
+              (type "ext4"))
+            (file-system
+              (mount-point "/boot/efi")
+              (device "/dev/sda15")
+              (type "vfat"))
+            %base-file-systems))
+    (initrd-modules
+     (cons* "sd_mod" "virtio_scsi" %base-initrd-modules))
+    (services
+     (cons* (service dhcp-client-service-type)
+            (service openssh-service-type
+                     (openssh-configuration
+                      (openssh openssh-sans-x)
+                      (permit-root-login 'prohibit-password)))
+            %base-services))))
+
+;; Operating system for x86 servers using BIOS boot mode.
+
+(define %hetzner-os-x86
+  (operating-system
+    (inherit %hetzner-os-arm)
+    (host-name "guix-x86")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-bootloader)
+      (targets (list "/dev/sda"))
+      (terminal-outputs '(console))))
+    (initrd-modules
+     (cons "virtio_scsi" %base-initrd-modules))
+    (file-systems
+     (cons (file-system
+             (mount-point "/")
+             (device "/dev/sda1")
+             (type "ext4"))
+           %base-file-systems))))
+
+(define (operating-system-authorize os)
+  "Authorize the OS with the public signing key of the current machine."
+  (if (file-exists? %public-key-file)
+      (operating-system
+        (inherit os)
+        (services
+         (modify-services (operating-system-user-services os)
+           (guix-service-type
+            config =3D> (guix-configuration
+                       (inherit config)
+                       (authorized-keys
+                        (cons*
+                         (local-file %public-key-file)
+                         (guix-configuration-authorized-keys config))))))))
+      (raise (formatted-message (G_ "no signing key '~a'. \
+Have you run 'guix archive --generate-key'?")
+                                %public-key-file))))
+
+(define (operating-system-root-file-system-type os)
+  "Return the root file system type of the operating system OS."
+  (let ((root-fs (find (lambda (file-system)
+                         (equal? "/" (file-system-mount-point file-system)=
))
+                       (operating-system-file-systems os))))
+    (if (file-system? root-fs)
+        (file-system-type root-fs)
+        (raise (formatted-message
+                (G_ "could not determine root file system type"))))))
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (escape-backticks str)
+  "Escape all backticks in STR."
+  (string-replace-substring str "`" "\\`"))
+
+
+
+;;;
+;;; Hetzner configuration.
+;;;
+
+(define-record-type* <hetzner-configuration> hetzner-configuration
+  make-hetzner-configuration hetzner-configuration? this-hetzner-configura=
tion
+  (allow-downgrades? hetzner-configuration-allow-downgrades? ; boolean
+                     (default #f))
+  (api hetzner-configuration-api ; <hetzner-api>
+       (default (hetzner-api)))
+  (authorize? hetzner-configuration-authorize? ; boolean
+              (default #t))
+  (build-locally? hetzner-configuration-build-locally? ; boolean
+                  (default #t))
+  (delete? hetzner-configuration-delete? ; boolean
+           (default #f))
+  (labels hetzner-configuration-labels ; list of strings
+          (default '()))
+  (location hetzner-configuration-location ; #f | string
+            (default "fsn1"))
+  (server-type hetzner-configuration-server-type ; string
+               (default "cx42"))
+  (ssh-key hetzner-configuration-ssh-key)) ; string
+
+(define (hetzner-configuration-ssh-key-fingerprint config)
+  "Return the SSH public key fingerprint of CONFIG as a string."
+  (and-let* ((file-name (hetzner-configuration-ssh-key config))
+             (privkey (private-key-from-file file-name))
+             (pubkey (private-key->public-key privkey))
+             (hash (get-public-key-hash pubkey 'md5)))
+    (bytevector->hex-string hash)))
+
+(define (hetzner-configuration-ssh-key-public config)
+  "Return the SSH public key of CONFIG as a string."
+  (and-let* ((ssh-key (hetzner-configuration-ssh-key config))
+             (public-key (public-key-from-file ssh-key)))
+    (format #f "ssh-~a ~a" (get-key-type public-key)
+            (public-key->string public-key))))
+
+
+;;;
+;;; Hetzner Machine.
+;;;
+
+(define (hetzner-machine-delegate target server)
+  "Return the delagate machine that uses SSH for deployment."
+  (let* ((config (machine-configuration target))
+         ;; Get the operating system WITHOUT the provenance service to avo=
id a
+         ;; duplicate symlink conflict in the store.
+         (os ((@@ (gnu machine) %machine-operating-system) target)))
+    (machine
+     (inherit target)
+     (operating-system
+       (if (hetzner-configuration-authorize? config)
+           (operating-system-authorize os)
+           os))
+     (environment managed-host-environment-type)
+     (configuration
+      (machine-ssh-configuration
+       (allow-downgrades? (hetzner-configuration-allow-downgrades? config))
+       (authorize? (hetzner-configuration-authorize? config))
+       (build-locally? (hetzner-configuration-build-locally? config))
+       (host-name (hetzner-server-public-ipv4 server))
+       (identity (hetzner-configuration-ssh-key config))
+       (system (hetzner-server-system server)))))))
+
+(define (hetzner-machine-location machine)
+  "Find the location of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-location config)))
+    (find (lambda (location)
+            (equal? expected (hetzner-location-name location)))
+          (hetzner-api-locations
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,expected))))))
+
+(define (hetzner-machine-server-type machine)
+  "Find the server type of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-server-type config)))
+    (find (lambda (server-type)
+            (equal? expected (hetzner-server-type-name server-type)))
+          (hetzner-api-server-types
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,expected))))))
+
+(define (hetzner-machine-validate-api-token machine)
+  "Validate the Hetzner API authentication token of MACHINE."
+  (let* ((config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (unless (hetzner-api-token api)
+      (raise (formatted-message
+              (G_ "Hetzner Cloud access token was not provided. \
+This may be fixed by setting the environment variable GUIX_HETZNER_API_TOK=
EN \
+to one procured from \
+https://docs.hetzner.com/cloud/api/getting-started/generating-api-token"))=
))))
+
+(define (hetzner-machine-validate-configuration-type machine)
+  "Raise an error if MACHINE's configuration is not an instance of
+<hetzner-configuration>."
+  (let ((config (machine-configuration machine))
+        (environment (environment-type-name (machine-environment machine))=
))
+    (unless (and config (hetzner-configuration? config))
+      (raise (formatted-message (G_ "unsupported machine configuration '~a=
' \
+for environment of type '~a'")
+                                config
+                                environment)))))
+
+(define (hetzner-machine-validate-server-type machine)
+  "Raise an error if the server type of MACHINE is not supported."
+  (unless (hetzner-machine-server-type machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise (formatted-message
+              (G_ "server type '~a' not supported~%~%\
+Available server types:~%~%~a~%~%For more details and prices, see: ~a")
+              (hetzner-configuration-server-type config)
+              (string-join
+               (map (lambda (type)
+                      (format #f " - ~a: ~a, ~a ~a cores, ~a GB mem, ~a GB=
 disk"
+                              (colorize-string
+                               (hetzner-server-type-name type)
+                               (color BOLD))
+                              (hetzner-server-type-architecture type)
+                              (hetzner-server-type-cores type)
+                              (hetzner-server-type-cpu-type type)
+                              (hetzner-server-type-memory type)
+                              (hetzner-server-type-disk type)))
+                    (hetzner-api-server-types api))
+               "\n")
+              "https://www.hetzner.com/cloud#pricing")))))
+
+(define (hetzner-machine-validate-location machine)
+  "Raise an error if the location of MACHINE is not supported."
+  (unless (hetzner-machine-location machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise (formatted-message
+              (G_ "server location '~a' not supported~%~%\
+Available locations:~%~%~a~%~%For more details, see: ~a")
+              (hetzner-configuration-location config)
+              (string-join
+               (map (lambda (location)
+                      (format #f " - ~a: ~a, ~a"
+                              (colorize-string
+                               (hetzner-location-name location)
+                               (color BOLD))
+                              (hetzner-location-description location)
+                              (hetzner-location-country location)))
+                    (hetzner-api-locations api))
+               "\n")
+              "https://www.hetzner.com/cloud#locations")))))
+
+(define (hetzner-machine-validate machine)
+  "Validate the Hetzner MACHINE."
+  (hetzner-machine-validate-configuration-type machine)
+  (hetzner-machine-validate-api-token machine)
+  (hetzner-machine-validate-location machine)
+  (hetzner-machine-validate-server-type machine))
+
+(define (hetzner-machine-bootstrap-os-form machine server)
+  "Return the form to bootstrap an operating system on SERVER."
+  (let* ((os (machine-operating-system machine))
+         (system (hetzner-server-system server))
+         (arm? (equal? "arm" (hetzner-server-architecture server)))
+         (x86? (equal? "x86" (hetzner-server-architecture server)))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    `(operating-system
+       (host-name ,(operating-system-host-name os))
+       (timezone "Etc/UTC")
+       (bootloader (bootloader-configuration
+                    (bootloader ,(cond (arm? 'grub-efi-bootloader)
+                                       (x86? 'grub-bootloader)))
+                    (targets ,(cond (arm? '(list "/boot/efi"))
+                                    (x86? '(list "/dev/sda"))))
+                    (terminal-outputs '(console))))
+       (initrd-modules (append
+                        ,(cond (arm? '(list "sd_mod" "virtio_scsi"))
+                               (x86? '(list "virtio_scsi")))
+                        %base-initrd-modules))
+       (file-systems ,(cond
+                       (arm? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     (file-system
+                                       (mount-point "/boot/efi")
+                                       (device "/dev/sda15")
+                                       (type "vfat"))
+                                     %base-file-systems))
+                       (x86? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     %base-file-systems))))
+       (services
+        (cons* (service dhcp-client-service-type)
+               (service openssh-service-type
+                        (openssh-configuration
+                         (openssh openssh-sans-x)
+                         (permit-root-login 'prohibit-password)))
+               %base-services)))))
+
+(define (rexec-verbose session cmd)
+  "Execute a command CMD on the remote side and print output.  Return two
+values: list of output lines returned by CMD and its exit code."
+  (let* ((channel (open-remote-input-pipe session cmd))
+         (result  (let loop ((line   (read-line channel))
+                             (result '()))
+                    (if (eof-object? line)
+                        (reverse result)
+                        (begin
+                          (display line)
+                          (newline)
+                          (loop (read-line channel)
+                                (cons line result))))))
+         (exit-status (channel-get-exit-status channel)))
+    (close channel)
+    (values result exit-status)))
+
+(define (hetzner-machine-ssh-key machine)
+  "Find the SSH key for MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-ssh-key-fingerprint config)))
+    (find (lambda (ssh-key)
+            (equal? expected (hetzner-ssh-key-fingerprint ssh-key)))
+          (hetzner-api-ssh-keys
+           (hetzner-configuration-api config)
+           #:params `(("fingerprint" . ,expected))))))
+
+(define (hetzner-machine-ssh-key-create machine)
+  "Create the SSH key for MACHINE on the Hetzner API."
+  (let ((name (machine-display-name machine)))
+    (format #t "creating ssh key for '~a'...\n" name)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config))
+           (ssh-key (hetzner-api-ssh-key-create
+                     (hetzner-configuration-api config)
+                     (hetzner-configuration-ssh-key-fingerprint config)
+                     (hetzner-configuration-ssh-key-public config)
+                     #:labels (hetzner-configuration-labels config))))
+      (format #t "successfully created ssh key for '~a'\n" name)
+      ssh-key)))
+
+(define (hetzner-machine-server machine)
+  "Find the Hetzner server for MACHINE."
+  (let ((config (machine-configuration machine)))
+    (find (lambda (server)
+            (equal? (machine-display-name machine)
+                    (hetzner-server-name server)))
+          (hetzner-api-servers
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,(machine-display-name machine)))))))
+
+(define (hetzner-machine-create-server machine)
+  "Create the Hetzner server for MACHINE."
+  (let* ((config (machine-configuration machine))
+         (name (machine-display-name machine))
+         (server-type (hetzner-configuration-server-type config)))
+    (format #t "creating '~a' server for '~a'...\n" server-type name)
+    (let* ((ssh-key (hetzner-machine-ssh-key machine))
+           (api (hetzner-configuration-api config))
+           (server (hetzner-api-server-create
+                    api
+                    (machine-display-name machine)
+                    (list ssh-key)
+                    #:labels (hetzner-configuration-labels config)
+                    #:location (hetzner-configuration-location config)
+                    #:server-type (hetzner-configuration-server-type confi=
g)))
+           (architecture (hetzner-server-architecture server)))
+      (format #t "successfully created '~a' ~a server for '~a'\n"
+              server-type architecture name)
+      server)))
+
+(define (wait-for-ssh address ssh-key)
+  "Block until a SSH session can be made as 'root' with SSH-KEY at ADDRESS=
."
+  (format #t "connecting via SSH to '~a' using '~a'...\n" address ssh-key)
+  (let loop ()
+    (catch #t
+      (lambda ()
+        (open-ssh-session address #:user "root" #:identity ssh-key
+                          #:strict-host-key-check? #f))
+      (lambda args
+        (let ((msg (cadr args)))
+          (if (formatted-message? msg)
+              (format #t "~a\n"
+                      (string-trim-right
+                       (apply format #f
+                              (formatted-message-string msg)
+                              (formatted-message-arguments msg))
+                       #\newline))
+              (format #t "~a" args))
+          (sleep 5)
+          (loop))))))
+
+(define (hetzner-machine-wait-for-ssh machine server)
+  "Wait for SSH connection to be established with the specified machine."
+  (wait-for-ssh (hetzner-server-public-ipv4 server)
+                (hetzner-configuration-ssh-key
+                 (machine-configuration machine))))
+
+(define (hetzner-machine-authenticate-host machine server)
+  "Add the host key of MACHINE to the list of known hosts."
+  (let ((ssh-session (hetzner-machine-wait-for-ssh machine server)))
+    (write-known-host! ssh-session)))
+
+(define (hetzner-machine-enable-rescue-system machine server)
+  "Enable the rescue system on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config))
+         (ssh-keys (list (hetzner-machine-ssh-key machine))))
+    (format #t "enabling rescue system on '~a'...\n" name)
+    (let ((action (hetzner-api-server-enable-rescue-system api server ssh-=
keys)))
+      (format #t "successfully enabled rescue system on '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-power-on machine server)
+  "Power on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "powering on server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-power-on api server)))
+      (format #t "successfully powered on server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-ssh-run-script ssh-session name content)
+  (let ((sftp-session (make-sftp-session ssh-session)))
+    (rexec ssh-session (format #f "rm -f ~a" name))
+    (rexec ssh-session (format #f "mkdir -p ~a" (dirname name)))
+    (call-with-remote-output-file
+     sftp-session name
+     (lambda (port)
+       (display content port)))
+    (sftp-chmod sftp-session name 755)
+    (let ((lines exit-code (rexec-verbose ssh-session
+                                          (format #f "~a 2>&1" name))))
+      (if (zero? exit-code)
+          lines
+          (raise (formatted-message
+                  (G_ "failed to run script '~a' on machine, exit code: '~=
a'")
+                  name exit-code))))))
+
+(define (hetzner-machine-rescue-install-os machine ssh-session server)
+  (let ((name (machine-display-name machine))
+        (os (hetzner-machine-bootstrap-os-form machine server)))
+    (format #t "installing guix operating system on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-os"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+mount /dev/sda1 /mnt
+mkdir -p /mnt/boot/efi
+mount /dev/sda15 /mnt/boot/efi
+
+mkdir --parents /mnt/root/.ssh
+chmod 700 /mnt/root/.ssh
+cp /root/.ssh/authorized_keys /mnt/root/.ssh/authorized_keys
+chmod 600 /mnt/root/.ssh/authorized_keys
+
+cat > /tmp/guix/deploy/hetzner-os.scm << EOF
+(use-modules (gnu) (guix utils))
+(use-package-modules ssh)
+(use-service-modules base networking ssh)
+(use-system-modules linux-initrd)
+~a
+EOF
+guix system init --verbosity=3D2 /tmp/guix/deploy/hetzner-os.scm /mnt"
+             (escape-backticks (format #f "~y" os))))
+    (format #t "successfully installed guix operating system on '~a'\n" na=
me)))
+
+(define (hetzner-machine-reboot machine server)
+  "Reboot the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "rebooting server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-reboot api server)))
+      (format #t "successfully rebooted server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-rescue-partition machine ssh-session)
+  "Setup the partitions of the Hetzner server for MACHINE using SSH-SESSIO=
N."
+  (let* ((name (machine-display-name machine))
+         (os (machine-operating-system machine))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    (format #t "setting up partitions on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-partition"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+growpart /dev/sda 1 || true
+~a
+fdisk -l /dev/sda"
+             (cond
+              ((equal? "btrfs" root-fs-type)
+               (format #f "mkfs.btrfs -L ~a -f /dev/sda1" root-label))
+              ((equal? "ext4" root-fs-type)
+               (format #f "mkfs.ext4 -L ~a -F /dev/sda1" root-label))
+              (else (raise (formatted-message
+                            (G_ "unsupported root file system type '~a'")
+                            root-fs-type))))))
+    (format #t "successfully setup partitions on '~a'\n" name)))
+
+(define (hetzner-machine-rescue-install-packages machine ssh-session)
+  "Install packages on the Hetzner server for MACHINE using SSH-SESSION."
+  (let ((name (machine-display-name machine)))
+    (format #t "installing rescue system packages on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-packages"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+apt-get update
+apt-get install guix cloud-initramfs-growroot --assume-yes"))
+    (format #t "successfully installed rescue system packages on '~a'\n" n=
ame)))
+
+(define (hetzner-machine-delete machine server)
+  "Delete the Hetzner server for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "deleting server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-delete api server)))
+      (format #t "successfully deleted server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-provision machine)
+  "Provision a server for MACHINE on the Hetzner Cloud service."
+  (with-exception-handler
+      (lambda (exception)
+        (let ((config (machine-configuration machine))
+              (server (hetzner-machine-server machine)))
+          (when (and server (hetzner-configuration-delete? config))
+            (hetzner-machine-delete machine server))
+          (raise-exception exception)))
+    (lambda ()
+      (let ((server (hetzner-machine-create-server machine)))
+        (hetzner-machine-enable-rescue-system machine server)
+        (hetzner-machine-power-on machine server)
+        (let ((ssh-session (hetzner-machine-wait-for-ssh machine server)))
+          (hetzner-machine-rescue-install-packages machine ssh-session)
+          (hetzner-machine-rescue-partition machine ssh-session)
+          (hetzner-machine-rescue-install-os machine ssh-session server)
+          (hetzner-machine-reboot machine server)
+          (sleep 5)
+          (hetzner-machine-authenticate-host machine server)
+          server)))
+    #:unwind? #t))
+
+(define (machine-not-provisioned machine)
+  (formatted-message
+   (G_ "no server provisioned for machine '~a' on the Hetzner Cloud servic=
e")
+   (machine-display-name machine)))
+
+
+;;;
+;;; Remote evaluation.
+;;;
+
+(define (hetzner-remote-eval machine exp)
+  "Internal implementation of 'machine-remote-eval' for MACHINE instances =
with
+an environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (let ((server (hetzner-machine-server machine)))
+    (unless server (raise (machine-not-provisioned machine)))
+    (machine-remote-eval (hetzner-machine-delegate machine server) exp)))
+
+
+
+;;;
+;;; System deployment.
+;;;
+
+(define (deploy-hetzner machine)
+  "Internal implementation of 'deploy-machine' for 'machine' instances wit=
h an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (unless (hetzner-machine-ssh-key machine)
+    (hetzner-machine-ssh-key-create machine))
+  (let ((server (or (hetzner-machine-server machine)
+                    (hetzner-machine-provision machine))))
+    (deploy-machine (hetzner-machine-delegate machine server))))
+
+
+
+;;;
+;;; Roll-back.
+;;;
+
+(define (roll-back-hetzner machine)
+  "Internal implementation of 'roll-back-machine' for MACHINE instances wi=
th an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (let ((server (hetzner-machine-server machine)))
+    (unless server (raise (machine-not-provisioned machine)))
+    (roll-back-machine (hetzner-machine-delegate machine server))))
+
+
+
+;;;
+;;; Environment type.
+;;;
+
+(define hetzner-environment-type
+  (environment-type
+   (machine-remote-eval hetzner-remote-eval)
+   (deploy-machine deploy-hetzner)
+   (roll-back-machine roll-back-hetzner)
+   (name 'hetzner-environment-type)
+   (description "Provisioning of virtual machine servers on the Hetzner Cl=
oud
+service.")))
diff --git a/gnu/machine/hetzner/http.scm b/gnu/machine/hetzner/http.scm
new file mode 100644
index 0000000000..c4a2d41068
=2D-- /dev/null
+++ b/gnu/machine/hetzner/http.scm
@@ -0,0 +1,636 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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 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-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-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 VCUs, 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))) "=3D"
+                 (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-ipv=
6>
+
+(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") ; bool=
ean
+  (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)
+  (headers hetzner-api-response-headers)
+  (status hetzner-api-response-status))
+
+(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 respons=
e."
+  (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 (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 (formatted-message
+            (G_ "unexpected HTTP status code: ~a, expected: ~a~%~a")
+            (hetzner-api-response-status response)
+            expected
+            (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 (if (unspecified? body) "" (scm->json-string body))))
+    (string->bytevector string "UTF-8")))
+
+(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 2=
04)))
+  "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)))
+
+(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 . options)
+  "Get actions from the Hetzner API."
+  (apply hetzner-api-list api "/actions" "actions" json->hetzner-action op=
tions))
+
+(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 #:params `(("id" . ,id)))))
+        (cond
+         ((zero? (length actions))
+          (raise (formatted-message (G_ "server action '~a' not found") id=
)))
+         ((not (=3D 1 (length actions)))
+          (raise (formatted-message
+                  (G_ "expected one server action, but got '~a'")
+                  (length actions))))
+         ((string=3D 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-locat=
ion 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 op=
tions))
+
+(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))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index ae506df14c..8decfdbab9 100644
=2D-- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port identity
                            host-key
                            (compression %compression)
                            (timeout 3600)
=2D                           (connection-timeout 10))
+                           (connection-timeout 10)
+                           (strict-host-key-check? #t))
   "Open an SSH session for HOST and return it.  IDENTITY specifies the file
 name of a private key to use for authenticating with the host.  When USER,
 PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
@@ -117,6 +118,9 @@ (define* (open-ssh-session host #:key user port identity
 seconds.  Install TIMEOUT as the maximum time in seconds after which a rea=
d or
 write operation on a channel of the returned session is considered as fail=
ing.
=20
+IF STRICT-HOST-KEY-CHECK? is #f, strict host key checking is turned off for
+the new session.
+
 Throw an error on failure."
   (let ((session (make-session #:user user
                                #:identity identity
@@ -137,7 +141,8 @@ (define* (open-ssh-session host #:key user port identity
=20
                                ;; Speed up RPCs by creating sockets with
                                ;; TCP_NODELAY.
=2D                               #:nodelay #t)))
+                               #:nodelay #t
+                               #:stricthostkeycheck strict-host-key-check?=
)))
=20
     ;; Honor ~/.ssh/config.
     (session-parse-config! session)
@@ -149,13 +154,14 @@ (define* (open-ssh-session host #:key user port ident=
ity
            (authenticate-server* session host-key)
=20
            ;; Authenticate against ~/.ssh/known_hosts.
=2D           (match (authenticate-server session)
=2D             ('ok #f)
=2D             (reason
=2D              (raise (formatted-message (G_ "failed to authenticate \
+           (when strict-host-key-check?
+             (match (authenticate-server session)
+               ('ok #f)
+               (reason
+                (raise (formatted-message (G_ "failed to authenticate \
 server at '~a': ~a")
=2D                                        (session-get session 'host)
=2D                                        reason)))))
+                                          (session-get session 'host)
+                                          reason))))))
=20
        ;; Use public key authentication, via the SSH agent if it's availab=
le.
        (match (userauth-public-key/auto! session)
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index e37da506fc..d68fad4e8c 100644
=2D-- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -81,6 +81,8 @@ gnu/installer/steps.scm
 gnu/installer/timezone.scm
 gnu/installer/user.scm
 gnu/installer/utils.scm
+gnu/machine/hetzner.scm
+gnu/machine/hetzner/http.scm
 gnu/machine/ssh.scm
 gnu/packages/bootstrap.scm
 guix/build/utils.scm
diff --git a/tests/machine/hetzner.scm b/tests/machine/hetzner.scm
new file mode 100644
index 0000000000..5c84529c84
=2D-- /dev/null
+++ b/tests/machine/hetzner.scm
@@ -0,0 +1,244 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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 (debugging assert)
+  #: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))
+
+;;; Tests for the (gnu machine hetzner) module.
+
+;; This test requires the GUIX_HETZNER_API_TOKEN environment variable to b=
e set.
+;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
+
+(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
+                   (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
+                   (server-type "cpx51")
+                   (ssh-key %ssh-key-file)))))
+
+(define (cleanup machine)
+  (let* ((config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (for-each (lambda (ssh-key)
+                (hetzner-api-ssh-key-delete api ssh-key))
+              (hetzner-api-ssh-keys
+               (hetzner-configuration-api config)
+               #:params `(("name" . ,%ssh-key-name))))
+    (for-each (lambda (server)
+                (hetzner-api-server-delete api server))
+              (hetzner-api-servers
+               (hetzner-configuration-api config)
+               #:params `(("name" . ,(machine-display-name machine)))))
+    machine))
+
+(define-syntax-rule (with-cleanup-machine (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))))
+
+(test-begin "machine-hetzner")
+
+(test-skip %when-no-token)
+(test-assert "deploy-arm-machine"
+  (with-cleanup-machine (machine %arm-machine)
+    (deploy-hetzner machine)))
+
+(test-skip %when-no-token)
+(test-assert "deploy-x86-machine"
+  (with-cleanup-machine (machine %x86-machine)
+    (deploy-hetzner machine)))
+
+(define (expected-ssh-machine? machine ssh-machine)
+  (let ((config (machine-configuration machine))
+        (ssh-config (machine-configuration ssh-machine)))
+    (assert (equal? (hetzner-configuration-authorize? config)
+                    (machine-ssh-configuration-authorize? ssh-config)))
+    (assert (equal? (hetzner-configuration-allow-downgrades? config)
+                    (machine-ssh-configuration-allow-downgrades? ssh-confi=
g)))
+    (assert (equal? (hetzner-configuration-build-locally? config)
+                    (machine-ssh-configuration-build-locally? ssh-config)))
+    (assert (equal? (hetzner-server-public-ipv4 (mock-server machine))
+                    (machine-ssh-configuration-host-name ssh-config)))))
+
+(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))))
+          (mock ((gnu machine hetzner http) hetzner-api-server-types
+                 (lambda* (api . options)
+                   (list (mock-server-type machine))))
+                (mock ((gnu machine hetzner http) hetzner-api-ssh-keys
+                       (lambda* (api . options)
+                         (list (mock-ssh-key machine))))
+                      (mock ((gnu machine hetzner http) hetzner-api-servers
+                             (lambda* (api . options)
+                               (list (mock-server machine))))
+                            (mock ((gnu machine) deploy-machine
+                                   (lambda* (ssh-machine)
+                                     (assert (expected-ssh-machine? machin=
e 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))))
+          (mock ((gnu machine hetzner http) hetzner-api-server-types
+                 (lambda* (api . options)
+                   (list (mock-server-type machine))))
+                (mock ((gnu machine hetzner http) hetzner-api-ssh-keys
+                       (lambda* (api . options)
+                         (list (mock-ssh-key machine))))
+                      (mock ((gnu machine hetzner http) hetzner-api-servers
+                             (lambda* (api . options)
+                               servers))
+                            (mock ((gnu machine hetzner http) hetzner-api-=
server-create
+                                   (lambda* (api name ssh-keys . options)
+                                     (set! servers (list (mock-server mach=
ine)))
+                                     (car servers)))
+                                  (mock ((gnu machine hetzner http) hetzne=
r-api-server-enable-rescue-system
+                                         (lambda (api server ssh-keys)
+                                           (format #t "MOCK ENABLE RESUCE~=
%")
+                                           (mock-action "enable_rescue")))
+                                        (mock ((gnu machine hetzner http) =
hetzner-api-server-power-on
+                                               (lambda (api server)
+                                                 (format #t "MOCK POWER ON=
~%")
+                                                 (mock-action "start_serve=
r")))
+                                              (mock ((gnu machine hetzner)=
 hetzner-machine-ssh-run-script
+                                                     (lambda (ssh-session =
name content)
+                                                       (format #t "MOCK RU=
NNING SCRIPT: ~a~%" name)
+                                                       #t))
+                                                    (mock ((guix ssh) open=
-ssh-session
+                                                           (lambda* (host =
. options)
+                                                             (format #t "M=
OCK OPEN SSH SESSION~%")
+                                                             (make-session=
 #:host host)))
+                                                          (mock ((gnu mach=
ine hetzner http) hetzner-api-server-reboot
+                                                                 (lambda (=
api server)
+                                                                   (mock-a=
ction "reboot_server")))
+                                                                (mock ((ss=
h session) write-known-host!
+                                                                       (la=
mbda (session)
+                                                                         #=
t))
+                                                                      (moc=
k ((gnu machine) deploy-machine
+                                                                          =
   (lambda* (ssh-machine)
+                                                                          =
     (assert (expected-ssh-machine? machine ssh-machine))))
+                                                                          =
  (deploy-hetzner machine)))))))))))))))
+
+(test-end "machine-hetzner")
+
+;; Local Variables:
+;; eval: (put 'with-cleanup-machine '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..616c5ae67f
=2D-- /dev/null
+++ b/tests/machine/hetzner/http.scm
@@ -0,0 +1,167 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright =C2=A9 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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 (gnu machine hetzner http)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-64)
+  #:use-module (ssh key))
+
+;;; Tests for the (gnu machine hetzner api) module.
+
+;; This test requires the GUIX_HETZNER_API_TOKEN environment variable to b=
e set.
+;; https://docs.hetzner.com/cloud/api/getting-started/generating-api-token
+
+(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* (create-ssh-key api ssh-key #:key (labels '()))
+  (hetzner-api-ssh-key-create
+   api
+   (hetzner-ssh-key-name ssh-key)
+   (hetzner-ssh-key-public-key ssh-key)
+   #:labels labels))
+
+(define (cleanup api)
+  (let ((api (hetzner-api)))
+    (for-each (lambda (ssh-key)
+                (hetzner-api-ssh-key-delete api ssh-key))
+              (hetzner-api-ssh-keys
+               api #:params `(("name" . ,%ssh-key-name))))
+    (for-each (lambda (server)
+                (hetzner-api-server-delete api server))
+              (hetzner-api-servers
+               api #:params `(("name" . ,%server-name))))
+    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")
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-actions"
+  (every hetzner-action? (hetzner-api-actions (hetzner-api))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-locations"
+  (every hetzner-location? (hetzner-api-locations (hetzner-api))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-types"
+  (every hetzner-server-type? (hetzner-api-server-types (hetzner-api))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-create"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key))=
))
+      (hetzner-server? server))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-delete"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key)))
+           (action (hetzner-api-server-delete api server)))
+      (hetzner-action? action))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-enable-rescue-system"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key)))
+           (action (hetzner-api-server-enable-rescue-system api server (li=
st key))))
+      (hetzner-action? action))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-power-on"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key)))
+           (action (hetzner-api-server-power-on api server)))
+      (hetzner-action? action))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-power-off"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key)))
+           (action (hetzner-api-server-power-off api server)))
+      (hetzner-action? action))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-server-reboot"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((key (create-ssh-key api %ssh-key))
+           (server (hetzner-api-server-create api %server-name (list key)))
+           (action (hetzner-api-server-reboot api server)))
+      (hetzner-action? action))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-servers"
+  (every hetzner-server? (hetzner-api-servers (hetzner-api))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-key-create"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((api (cleanup (hetzner-api)))
+           (key (create-ssh-key api %ssh-key)))
+      (hetzner-ssh-key? key))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-key-delete"
+  (with-cleanup-api (api (hetzner-api))
+    (let* ((api (cleanup (hetzner-api)))
+           (key (create-ssh-key
+                 api %ssh-key
+                 #:labels '(("environment" . "development")))))
+      (hetzner-api-ssh-key-delete api key))))
+
+(test-skip %when-no-token)
+(test-assert "hetzner-api-ssh-keys"
+  (every hetzner-ssh-key? (hetzner-api-ssh-keys (hetzner-api))))
+
+(test-end "machine-hetzner-api")
+
+;; Local Variables:
+;; eval: (put 'with-cleanup-api 'scheme-indent-function 1)
+;; End:

base-commit: 7aae0e2c159b1612b405a372b18f25fbb58f9d82
prerequisite-patch-id: ac1f0d4a2d25a1b4d5bc2113465fff75fe16b173
prerequisite-patch-id: eb3f1eb84750594036d67d1415c45ac1b79ddef4
prerequisite-patch-id: 01e878a55309cfb2b19a5616530cc95e305a17df
prerequisite-patch-id: 5a938c41d076ed210df0dd2ea14064581d54d245
prerequisite-patch-id: 1d62fb01e63abea0cdd588a52c1e570a5175eff7
prerequisite-patch-id: e5bdca7bb03c74026330fbaae6bd89efcbf4c2a9
prerequisite-patch-id: 10a22db612648d6a35e93d44afac961b3e5d2e9e
prerequisite-patch-id: 6a052619a2a8a036f658f0de4a2f4e42f6354d19
prerequisite-patch-id: 7a18e5bff86d43b14e6633357c185cd9a1ebf072
prerequisite-patch-id: 0d39c3063a794f1c740021e5d5f43e98c3e74013
prerequisite-patch-id: 8d732b32581c39cd4e61cfd583be9b8fdff4b86d
prerequisite-patch-id: 4233e276f34af03e0e84ce06aec407d13a3c0dab
prerequisite-patch-id: a95d5a44ca76b5e4ee7d7a552fa644e3c07c1ca9
prerequisite-patch-id: 500d513328a3545d08a954e09f1cabcef6c22f8c
prerequisite-patch-id: e3538aa251c819e1e6f100b9f547f64e79535957
prerequisite-patch-id: 8be1562d2e1390bd513303496e2cfe930e83cf98
prerequisite-patch-id: 1384fe5a71920e6f02858ccce39ae9a481d5d170
prerequisite-patch-id: ac21d3b2571c5f51a0e4b338fa4292189928c9d4
prerequisite-patch-id: 11eccf9862f6122ae1d52c13d218eac0064f0b22
prerequisite-patch-id: 86f80755bf52b691ea258121089f394a49a7aca7
prerequisite-patch-id: fa2314d1b06b810ecd2bb69f86b8556204a87e22
prerequisite-patch-id: b41b483173b7790006158179a4f2459af02cc088
prerequisite-patch-id: a4833568bf4308b39b456841e89be021b444b17e
=2D-=20
2.47.1


--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable


Ludovic Court=C3=A8s <ludo@HIDDEN> writes:

> Hello Roman,
>
> Roman Scherer <roman@HIDDEN> skribis:
>
>> * gnu/machine/hetzner.scm: New file.
>> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
>> * guix/ssh.scm (open-ssh-session): Add stricthostkeycheck option.
>> * doc/guix.texi (Invoking guix deploy): Add documentation for
>> 'hetzner-configuration'.
>>
>> Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41
>
> Thumbs up for this big piece of work, one that I think is important for
> the project!  =E2=80=98guix deploy=E2=80=99 is a great idea but it desper=
ately needs
> more backends like this one.
>
> I=E2=80=99m not familiar with Hetzner so I=E2=80=99ll comment on more gen=
eral aspects.
> Chris, perhaps you can provide feedback on Hetzner-specific issues?  I
> think we could put this backend to good use for Guix infra since a few
> services are running at Hetzner.
>
>> +@deftp {Data Type} hetzner-configuration
>> +This is the data type describing the server that should be created for a
>> +machine with an @code{environment} of @code{hetzner-environment-type}.
>
> Could you add a sentence providing more context like:
>
>   It allows you to configure deployment to a @acronym{VPS, virtual
>   private server} hosted by @uref{https://www.hetzner.com, Hetzner}.
>
>> +@item @code{authorize?} (default: @code{#t})
>> +If true, the coordinator's public signing key
>
> =E2=80=9Ccoordinator=E2=80=9D has nothing to do here I guess.
>
>> +@item @code{labels} (default: @code{'()})
>> +A user defined alist of key/value pairs attached to the server. Keys and
>> +values must be strings. For more information, see
>> +@uref{https://docs.hetzner.cloud/#labels, Labels}.
>
> Maybe add a short example?
>
>> +@item @code{location} (default: @code{"fsn1"})
>> +The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
>> +location} to create the server in.
>
> Maybe add: =E2=80=9CFor example, @code{"fsn1"} corresponds to the Hetzner=
 site
> in Falkenstein, Germany, while @code{"sin"} corresponds to its site in
> Singapore.=E2=80=9D
>
>> +@item @code{server-type} (default: @code{"cx42"})
>> +The name of the
>> +@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
>> +server type} this server should be created with.
>
> Likewise, an example would be elcome.
>
>> +@item @code{ssh-key}
>> +The path to the SSH private key to use to authenticate with the remote
>> +host.
>
> s/path to/file name of/
>
>> +The following example shows the definition of 2 machines that are
>
> s/2/two/
>
>> +vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second
>
> s/@code{aarch64}/AArch64/
>
>> +shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.
>
> Drop @code.
>
>> +@lisp
>> +(use-modules (gnu machine)
>> +             (gnu machine hetzner))
>> +
>> +(list (machine
>> +       (operating-system %hetzner-os-arm)
>> +       (environment hetzner-environment-type)
>> +       (configuration (hetzner-configuration
>> +                       (server-type "cax41")
>> +                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
>> +      (machine
>> +       (operating-system %hetzner-os-x86)
>> +       (environment hetzner-environment-type)
>> +       (configuration (hetzner-configuration
>> +                       (server-type "cpx51")
>> +                       (ssh-key "/home/charlie/.ssh/id_rsa")))))
>
> Nice!
>
>> +API key} should provision 2 machines for you.
>
> s/2/two/
>
>> +  #:use-module (ice-9 receive)
>
> The code base preferable uses SRFI-71 for multiple-value returns.
>
>> +      (raise (formatted-message
>> +              (G_ "Expected a list of Hetzner API responses")))))
>
> Messages should start with a lower-case letter (for all the messages in
> this file).
>
> Please add the file to =E2=80=98po/guix/POTFILES.in=E2=80=99 so that it=
=E2=80=99s actually
> subject to translation.
>
>> +(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 (json-string->scm (bytevector->string body "UTF-8")))
>
> Just =E2=80=98string->utf8=E2=80=99 (shorter).
>
> More importantly: instead of =E2=80=98json-string->scm=E2=80=99 (which gi=
ves an alist,
> leading to =E2=80=98assoc-ref=E2=80=99 calls all over the code base along=
 with free-form
> alists, which is very error-prone), could you use =E2=80=98define-json-ma=
pping=E2=80=99?
>
> In essence it=E2=80=99s like =E2=80=98define-record-type=E2=80=99 but it =
additionally define how
> to map a JSON dictionary to a Scheme record.  There are several examples
> in Guix, such as (guix swh).
>
> For clarity, it might be useful to move all the hetzner-api-* bits to a
> separate module, for example (gnu machine hetzner http).  WDYT?
>
>
> The rest of the code looks nice to me (modulo alists :-)) but that=E2=80=
=99s
> about all I can say.  It=E2=80=99s quite a significant body of code.  Wha=
t would
> you suggest to prevent bitrot and support maintenance?  Are there parts
> of it that could be usefully tested automatically, possibly by mocking
> part of the Hetzner API?  Or are there tips on how you tested it that
> could be written down in the file itself?
>
>
> Could you move the (guix ssh) bits to a separate patch?
>
>> +++ b/guix/ssh.scm
>> @@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port iden=
tity
>>                             host-key
>>                             (compression %compression)
>>                             (timeout 3600)
>> -                           (connection-timeout 10))
>> +                           (connection-timeout 10)
>> +                           (stricthostkeycheck #t))
>>    "Open an SSH session for HOST and return it.  IDENTITY specifies the =
file
>>  name of a private key to use for authenticating with the host.  When US=
ER,
>>  PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
>
> Please update the docstring.
>
> Rather =E2=80=98strict-host-key-check?=E2=80=99 to match naming conventio=
ns, even if
> Guile-SSH calls it that way.
>
>> @@ -137,7 +138,8 @@ (define* (open-ssh-session host #:key user port iden=
tity
>>
>>                                 ;; Speed up RPCs by creating sockets with
>>                                 ;; TCP_NODELAY.
>> -                               #:nodelay #t)))
>> +                               #:nodelay #t
>> +                               #:stricthostkeycheck stricthostkeycheck)=
))
>
> Not sure what this does actually.  Looks like the main part is the
> =E2=80=9Cwhen stricthostkeycheck=E2=80=9D condition that comes below, no?
>
> Could you send a second version?
>
> Thank you!
>
> Ludo=E2=80=99.

--=-=-=--

--==-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeNL1oXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZm9dQgAsLRwAkE6KFUS4Z0zCdIy668C
q6MoIUNFzyTIL94UOHVxHMUIbApE1CkuNsoVHx73/4vcmMekxnvYB9pd8ng8QwcV
q3u3iGLzwS0LIIJMiY5FwcVD6OaYgjz1LrO23Wn7qRx4f9u2PqpQAfuaec0GjBQM
F6T6P5KGJ7eefv84nMT/h4PLNUGYTYQd0R+oIoYog30ILv/NQfLaFlgY7iu478nd
/lJZm7WvXwTrysGYCFE2icgD7eIAk5i30DCdYys9eFgQjlKuxpOFr/bqqlz+7yCC
XSnYxw1bQ3D6ApotpBujuStPGap3NuoEd5pzEK10uIF5qjGbr9bK46qT25hJkg==
=CGHe
-----END PGP SIGNATURE-----
--==-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Sat, 25 Jan 2025 13:38:01 +0000
Resent-Message-ID: <handler.75144.B75144.173781225032146 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173781225032146
          (code B ref 75144); Sat, 25 Jan 2025 13:38:01 +0000
Received: (at 75144) by debbugs.gnu.org; 25 Jan 2025 13:37:30 +0000
Received: from localhost ([127.0.0.1]:48954 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tbgLp-0008MP-ES
	for submit <at> debbugs.gnu.org; Sat, 25 Jan 2025 08:37:30 -0500
Received: from mail-ed1-x52b.google.com ([2a00:1450:4864:20::52b]:48195)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tbgLm-0008M0-Ie
 for 75144 <at> debbugs.gnu.org; Sat, 25 Jan 2025 08:37:28 -0500
Received: by mail-ed1-x52b.google.com with SMTP id
 4fb4d7f45d1cf-5d7e3f1fdafso5709840a12.0
 for <75144 <at> debbugs.gnu.org>; Sat, 25 Jan 2025 05:37:26 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1737812240;
 x=1738417040; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=fJdr2MSSvQV4lYarKnpktQZKch8hA0fU4PDjF/88v0s=;
 b=GtHUKPEHFln1t/T7NJQwupfGlwOQsR2uAdkA61PZMfm4K4JnKdQTTVqOPWmFRSnt+i
 9n7K3Mb9FziBGs/JfFUgpSfq3oyPaNy5tt5ehcFlCKXxl8w+60RFl5+SyIMSXTZjJJoc
 DAjFGK1OTO/u+SRvkBHaB3UuKBaPJPS/uGc28+tHUxpTIGNNkMD9ih8CUOpFFqoZR+aF
 M750NEHjjKlucGDahMWCQnVFEawt/2xZqqx2GCPQeDK7q/RVT3zNT5aLqQmS2eeVRydO
 rc9Q605QR1dRLGwGHbj8TacgrPanlJNksOCXCa8OxVSq3Tils7cd//1iOth4x2LL6Nfl
 lGaQ==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1737812240; x=1738417040;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=fJdr2MSSvQV4lYarKnpktQZKch8hA0fU4PDjF/88v0s=;
 b=jycYRwdvMqTfKE5L4fEZMxBg7Nw/icP+q1E4mDulshnXdhTCSWJrRCQ59vGkPZiRCe
 Z/cyPzZdvnZc3MXRgkOZ2bREwvwB693RvqEGxmyWtUZss2w0P9hyUM0lQ8Hiv9UsVZd9
 mWBoNgA6JwzFFQYJ38HojIi+aaldjVROQDOy2h3jECdRiF1zjDxKsMPrukF8jO6yacOT
 hXWaqTfuGFQstQocyWKqU1TRXMaxnB8QPfB6UBAswfjniSKt7KxPu+yQ5Ut0lgOnZb3m
 hpHOtw3vNOxk8WzpFXW0eyhG0uC3PoTeuRLe4O/i640awUeqjYsfxBRSWEFszOKl5uuY
 uZ4w==
X-Forwarded-Encrypted: i=1;
 AJvYcCXruXA9pVlHcZRiPHJWPabM8eQjYgXtRCfOOgViCXYlcdOgg7dxhWeGnUFMD/PPpMrP6CRHNQ==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YxRGKG7qTVbsZmJqC7+xtVJeUPXTiiHQ+nr2wCVdRcN86gPk8xG
 AoedDS7zBo2eP68h8AQX59yj5Pq5NjEUJ8E+rpouxSHqI1WENYM4QaWv5Xml570=
X-Gm-Gg: ASbGncsDq64JIbW+O4wHSo2fR8Tr/yKNECl9VwU1vop5l7C4HuYTaCRj/YtpyJ+domo
 mA+28V4IWKbaK04PbDfs0I8n0mIbocTkzQhd0iwDaaefMBr6VHOloGKmlt/bIVTWd5zRYkgWw4A
 1fQXd2gLjoaao7inUJVR/qUP6OOX6CPIIvtpMPeBhyrHH7XrtnCMKIj9F8bQAOuMnZpV7JmuFaF
 NA53s91NSINsw5n6h5XnDv/j2ysqe9QMzpO4HH4g+NlDv3hQR3+TtTFDz5jshENybf/w5jMgjXs
 CJ2lB2E=
X-Google-Smtp-Source: AGHT+IG+9TbL2dQuxkEMMrCLt0wT4uVtR1EfUBCnc8G0xO/nUBhvlxouoC6luelWaor3m9yLifgc7A==
X-Received: by 2002:a17:906:b7d1:b0:ab6:36fd:942a with SMTP id
 a640c23a62f3a-ab636fd9552mr1772409566b.50.1737812239899; 
 Sat, 25 Jan 2025 05:37:19 -0800 (PST)
Received: from precision ([2a01:599:11f:daca:818d:9c76:9dab:a8e0])
 by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab675e8b01asm282420766b.84.2025.01.25.05.37.18
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Sat, 25 Jan 2025 05:37:18 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <868qr6n3j9.fsf@HIDDEN> (Roman Scherer's message of
 "Sun, 19 Jan 2025 17:59:06 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
User-Agent: mu4e 1.12.7; emacs 29.4
Date: Sat, 25 Jan 2025 14:37:16 +0100
Message-ID: <87ed0rt3oz.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable


I made a `mock*` macro to get around this ugly nesting in the meantime.

https://github.com/r0man/guix/blob/hetzner-machine-v2-mock-star/tests/machi=
ne/hetzner.scm#L165-L248

But I'm still wondering why the `mock` in `deploy-machine-mock-with-unprovi=
sioned-server` is working in the REPL,
but failing when I run the test with make ...

Roman Scherer <roman@HIDDEN> writes:

> Hi Ludo,
>
> thanks for your review. Here is a v2, I hope I addressed your previous
> comments with it, but I need some help.
>
> As you suggested I also added some tests. Some use mocking, and some run
> against the Hetzner API, if the GUIX_HETZNER_API_TOKEN env var is set.
>
> ./pre-inst-env make check TESTS=3D"tests/machine/hetzner/http.scm"
> ./pre-inst-env make check TESTS=3D"tests/machine/hetzner.scm"
>
> All tests pass when I run them in the Geiser REPL, where I developed them.
>
> But I have some trouble with one test that uses mocking. The
> "deploy-machine-mock-with-unprovisioned-server" test in
> tests/machine/hetzner.scm only fails when run in the terminal. :?
>
> I'm using the "mock" function from (guix tests) to mock some HTTP and SSH
> calls. The issue is that I see different behaviour whether I run the test=
s in
> Geiser vs in the Terminal.
>
> In Geiser I see the following output for this test, in it passes:
>
> -------------------------------------------------------------------------=
------
> creating 'cx42' server for 'guix-x86'...
> successfully created 'cx42' x86 server for 'guix-x86'
> enabling rescue system on 'guix-x86'...
> MOCK ENABLE RESUCE
> successfully enabled rescue system on 'guix-x86'
> powering on server for 'guix-x86'...
> MOCK POWER ON
> successfully powered on server for 'guix-x86'
> connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key=
'...
> MOCK OPEN SSH SESSION
> installing rescue system packages on 'guix-x86'...
> MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-install-pack=
ages
> successfully installed rescue system packages on 'guix-x86'
> setting up partitions on 'guix-x86'...
> MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-partition
> successfully setup partitions on 'guix-x86'
> installing guix operating system on 'guix-x86'...
> MOCK RUNNING SCRIPT: /tmp/guix/deploy/hetzner-machine-rescue-install-os
> successfully installed guix operating system on 'guix-x86'
> rebooting server for 'guix-x86'...
> successfully rebooted server for 'guix-x86'
> connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key=
'...
> MOCK OPEN SSH SESSION
> -------------------------------------------------------------------------=
------
>
> You can see that calls to "hetzner-machine-ssh-run-script" are mocked, be=
cause
> "MOCK RUNNING SCRIPT" is printed multiple times.
>
> But in a "guix shell -D" terminal I see the following output for the test=
, and
> it is failing:
>
> -------------------------------------------------------------------------=
------
>
> creating 'cx42' server for 'guix-x86'...
> successfully created 'cx42' x86 server for 'guix-x86'
> enabling rescue system on 'guix-x86'...
> MOCK ENABLE RESUCE
> successfully enabled rescue system on 'guix-x86'
> powering on server for 'guix-x86'...
> MOCK POWER ON
> successfully powered on server for 'guix-x86'
> connecting via SSH to '1.2.3.4' using '/tmp/guix-hetzner-machine-test-key=
'...
> MOCK OPEN SSH SESSION
> installing rescue system packages on 'guix-x86'...
> test-name: deploy-machine-mock-with-unprovisioned-server
> location: /home/roman/workspace/guix/tests/machine/hetzner.scm:189
>
> actual-value: #f
> actual-error:
> + (guile-ssh-error
> +   "%gssh-make-sftp-session"
> +   "Could not create a SFTP session"
> +   #<session #<undefined>@1.2.3.4:22 (disconnected) ffff85596de0>
> +   #f)
> result: FAIL
>
> ;;; [2025/01/19 17:39:16.791023, 0] [GSSH ERROR] Could not create a SFTP =
session: #<session #<undefined>@1.2.3.4:22 (disconnected) ffff85596de0>
>
> -------------------------------------------------------------------------=
------
>
> The tests fails here trying to use a disconnected SSH session object, tha=
t I
> returned in a mocked call. This code should actually never be reached, be=
cause
> I mock the "hetzner-machine-ssh-run-script" call. But for some reason the=
 mock
> is not working here. The "MOCK RUNNING SCRIPT" output is missing.
>
> Do you have any ideas what could be going on here? I suspect this might b=
e due
> to some optimization or env issue, but I'm pretty lost.
>
> I attached a WIP v2 for now. Will send a v3 and a separate patch for the =
ssh
> modification once I fixed this mock test.
>
> Thanks, Roman.
>
> [2. text/x-patch; v2-0001-machine-Implement-hetzner-environment-type.patc=
h]...
>
>
> Ludovic Court=C3=A8s <ludo@HIDDEN> writes:
>
>> Hello Roman,
>>
>> Roman Scherer <roman@HIDDEN> skribis:
>>
>>> * gnu/machine/hetzner.scm: New file.
>>> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
>>> * guix/ssh.scm (open-ssh-session): Add stricthostkeycheck option.
>>> * doc/guix.texi (Invoking guix deploy): Add documentation for
>>> 'hetzner-configuration'.
>>>
>>> Change-Id: Idc17dbc33279ecbf3cbfe2c53d7699140f8b9f41
>>
>> Thumbs up for this big piece of work, one that I think is important for
>> the project!  =E2=80=98guix deploy=E2=80=99 is a great idea but it despe=
rately needs
>> more backends like this one.
>>
>> I=E2=80=99m not familiar with Hetzner so I=E2=80=99ll comment on more ge=
neral aspects.
>> Chris, perhaps you can provide feedback on Hetzner-specific issues?  I
>> think we could put this backend to good use for Guix infra since a few
>> services are running at Hetzner.
>>
>>> +@deftp {Data Type} hetzner-configuration
>>> +This is the data type describing the server that should be created for=
 a
>>> +machine with an @code{environment} of @code{hetzner-environment-type}.
>>
>> Could you add a sentence providing more context like:
>>
>>   It allows you to configure deployment to a @acronym{VPS, virtual
>>   private server} hosted by @uref{https://www.hetzner.com, Hetzner}.
>>
>>> +@item @code{authorize?} (default: @code{#t})
>>> +If true, the coordinator's public signing key
>>
>> =E2=80=9Ccoordinator=E2=80=9D has nothing to do here I guess.
>>
>>> +@item @code{labels} (default: @code{'()})
>>> +A user defined alist of key/value pairs attached to the server. Keys a=
nd
>>> +values must be strings. For more information, see
>>> +@uref{https://docs.hetzner.cloud/#labels, Labels}.
>>
>> Maybe add a short example?
>>
>>> +@item @code{location} (default: @code{"fsn1"})
>>> +The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
>>> +location} to create the server in.
>>
>> Maybe add: =E2=80=9CFor example, @code{"fsn1"} corresponds to the Hetzne=
r site
>> in Falkenstein, Germany, while @code{"sin"} corresponds to its site in
>> Singapore.=E2=80=9D
>>
>>> +@item @code{server-type} (default: @code{"cx42"})
>>> +The name of the
>>> +@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
>>> +server type} this server should be created with.
>>
>> Likewise, an example would be elcome.
>>
>>> +@item @code{ssh-key}
>>> +The path to the SSH private key to use to authenticate with the remote
>>> +host.
>>
>> s/path to/file name of/
>>
>>> +The following example shows the definition of 2 machines that are
>>
>> s/2/two/
>>
>>> +vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second
>>
>> s/@code{aarch64}/AArch64/
>>
>>> +shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.
>>
>> Drop @code.
>>
>>> +@lisp
>>> +(use-modules (gnu machine)
>>> +             (gnu machine hetzner))
>>> +
>>> +(list (machine
>>> +       (operating-system %hetzner-os-arm)
>>> +       (environment hetzner-environment-type)
>>> +       (configuration (hetzner-configuration
>>> +                       (server-type "cax41")
>>> +                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
>>> +      (machine
>>> +       (operating-system %hetzner-os-x86)
>>> +       (environment hetzner-environment-type)
>>> +       (configuration (hetzner-configuration
>>> +                       (server-type "cpx51")
>>> +                       (ssh-key "/home/charlie/.ssh/id_rsa")))))
>>
>> Nice!
>>
>>> +API key} should provision 2 machines for you.
>>
>> s/2/two/
>>
>>> +  #:use-module (ice-9 receive)
>>
>> The code base preferable uses SRFI-71 for multiple-value returns.
>>
>>> +      (raise (formatted-message
>>> +              (G_ "Expected a list of Hetzner API responses")))))
>>
>> Messages should start with a lower-case letter (for all the messages in
>> this file).
>>
>> Please add the file to =E2=80=98po/guix/POTFILES.in=E2=80=99 so that it=
=E2=80=99s actually
>> subject to translation.
>>
>>> +(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 (json-string->scm (bytevector->string body "UTF-8")))
>>
>> Just =E2=80=98string->utf8=E2=80=99 (shorter).
>>
>> More importantly: instead of =E2=80=98json-string->scm=E2=80=99 (which g=
ives an alist,
>> leading to =E2=80=98assoc-ref=E2=80=99 calls all over the code base alon=
g with free-form
>> alists, which is very error-prone), could you use =E2=80=98define-json-m=
apping=E2=80=99?
>>
>> In essence it=E2=80=99s like =E2=80=98define-record-type=E2=80=99 but it=
 additionally define how
>> to map a JSON dictionary to a Scheme record.  There are several examples
>> in Guix, such as (guix swh).
>>
>> For clarity, it might be useful to move all the hetzner-api-* bits to a
>> separate module, for example (gnu machine hetzner http).  WDYT?
>>
>>
>> The rest of the code looks nice to me (modulo alists :-)) but that=E2=80=
=99s
>> about all I can say.  It=E2=80=99s quite a significant body of code.  Wh=
at would
>> you suggest to prevent bitrot and support maintenance?  Are there parts
>> of it that could be usefully tested automatically, possibly by mocking
>> part of the Hetzner API?  Or are there tips on how you tested it that
>> could be written down in the file itself?
>>
>>
>> Could you move the (guix ssh) bits to a separate patch?
>>
>>> +++ b/guix/ssh.scm
>>> @@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port ide=
ntity
>>>                             host-key
>>>                             (compression %compression)
>>>                             (timeout 3600)
>>> -                           (connection-timeout 10))
>>> +                           (connection-timeout 10)
>>> +                           (stricthostkeycheck #t))
>>>    "Open an SSH session for HOST and return it.  IDENTITY specifies the=
 file
>>>  name of a private key to use for authenticating with the host.  When U=
SER,
>>>  PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/confi=
g'
>>
>> Please update the docstring.
>>
>> Rather =E2=80=98strict-host-key-check?=E2=80=99 to match naming conventi=
ons, even if
>> Guile-SSH calls it that way.
>>
>>> @@ -137,7 +138,8 @@ (define* (open-ssh-session host #:key user port ide=
ntity
>>>
>>>                                 ;; Speed up RPCs by creating sockets wi=
th
>>>                                 ;; TCP_NODELAY.
>>> -                               #:nodelay #t)))
>>> +                               #:nodelay #t
>>> +                               #:stricthostkeycheck stricthostkeycheck=
)))
>>
>> Not sure what this does actually.  Looks like the main part is the
>> =E2=80=9Cwhen stricthostkeycheck=E2=80=9D condition that comes below, no?
>>
>> Could you send a second version?
>>
>> Thank you!
>>
>> Ludo=E2=80=99.

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeU6QwXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZkaCgf8D9vItAoQLPOR2dLsR5hL5rYA
O+UuBocypV2COfipG6d0Dt+3CbKUS4sbJWg2hodRVxG2ZHY+nyBn05DwDpUdGT0l
SxWHMQMiVjlyIvxW0VxTOFVwymFCdKWCrY2q2T+UunwmzvPC5ALbm9asUP6SF5UL
IYB+2+nD7fuML3ti7Un7VK9S/QgwbRpZynjFpavfWrZzPUT0lvo6FFhx9VYoLi0C
nHo0vRAm5pUpywmlX5b4+OXQoTlw9hwX4zghukwvvBezkuhh/lTJtAcskd4Qd+Md
lqFgPkMZQyrdWcHv+s85MXO3yHqFetgUuv2ZU9fiSO9dh6TpRm7l1S180B2Tbw==
=TKJR
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Mon, 27 Jan 2025 00:47:02 +0000
Resent-Message-ID: <handler.75144.B75144.173793878216484 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173793878216484
          (code B ref 75144); Mon, 27 Jan 2025 00:47:02 +0000
Received: (at 75144) by debbugs.gnu.org; 27 Jan 2025 00:46:22 +0000
Received: from localhost ([127.0.0.1]:58424 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tcDGf-0004Ho-La
	for submit <at> debbugs.gnu.org; Sun, 26 Jan 2025 19:46:21 -0500
Received: from mail-pj1-x1036.google.com ([2607:f8b0:4864:20::1036]:60711)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <maxim.cournoyer@HIDDEN>)
 id 1tcDGd-0004HV-6N
 for 75144 <at> debbugs.gnu.org; Sun, 26 Jan 2025 19:46:19 -0500
Received: by mail-pj1-x1036.google.com with SMTP id
 98e67ed59e1d1-2ef748105deso5092351a91.1
 for <75144 <at> debbugs.gnu.org>; Sun, 26 Jan 2025 16:46:19 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=gmail.com; s=20230601; t=1737938773; x=1738543573; darn=debbugs.gnu.org;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=I7u5/f+8S68rKTUVwx9jUq+wXApwqAW2IfSHit0OcU4=;
 b=TBzttzS2EAueilg9ElDZEiPay4iP5QVY78jwinWl8NYj2CXh7FIsN2NnPllcUc/0ic
 1SeR5PP2kmzNE1SKDiFBo1W8VLXFdXZGiNxme01WxEwwSf+y5CYrRO8/7QKX5/goKX64
 ZjkR9L5Z9BBk7M5TOYAQLEwB1ZLl8ePWKMhWuQ7OOkPdRuxCGsYjnjmy4p7IC8SnWjS0
 zyBMvCPpbPp8HfkNOrupDQPSesrfVpD6MNLmqpG4kt4psPZre++Mb0jEyiMDjmJIAP1H
 /Otlq/R51lqXi1S/8N6hYa6ZOYS/Wsctb6PDNg2LHHdT7QNX49K3GUbF4B7hsVx1RHyZ
 D5kQ==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1737938773; x=1738543573;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=I7u5/f+8S68rKTUVwx9jUq+wXApwqAW2IfSHit0OcU4=;
 b=DsYKGXrKiXJNiV3xXbzXa2nQA2GeQZ7MKTiDONBLdpzXdBi6A33bA1p65nchLWiA2H
 EYWxR1uuB4XisDFdsvO6ZS+R2OVFv4p93Ek0dFJ7KnALBPXJM4VXvZjKxKhWreiRcKBx
 pc35vM28yqqFQ8NGZyC3+Av5tciuM6mMl4FM8D1ax61j6z8oquIL58MqRAQ6o/28uof8
 6O0LyEhslO5AzT19qIZo/iyJTbdKWmxSlr+KPvXc7x+aKQQjzLKvSk+lkQPZQPHmzf9b
 hCQKODsv+i1Qz/ley8XEw9uV0DVuO4EQOuCpUJxSEYaz2aPa9AgUs4Ubn/nJzdFNXaCU
 SkTQ==
X-Forwarded-Encrypted: i=1;
 AJvYcCX4ubKgn4tWZV+GS0MFwgoA8V5K2B6FL/Vn1nl310aQigj8goTDGp2H+1+YxDfX4MH9zEepVg==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YxjR+DJIHPKaftmwIMz/q59+8OFz+VQO4IX2GlXBTIXFyWcLal8
 yXcLEMf/sXdUhQCaymuyONA6lj0W0lTJUX1i94JoIUCO5/WW8r7J
X-Gm-Gg: ASbGncstgIEJkppf5tqlWSE/sU60J4LHGYjr0et3l6gu3vuBlVm4Me78hsKJTaM0pa8
 4fADfoFjPv4uTl/QZiTT9J4AiL/J9HEZWd4yheiKzk+nALnl+cqGdg97ypqaU0GGH4ycPDhJkWy
 enMvX8NRtPiAY5Bx8d3b7JhVZn5UE3b643Zt1oP/+KiTXIiexg80D/D09B+nCi415By/zolWCis
 DSXPNWL7mWMMQkf5/oQfLHZ/7YxbsRhYQj325iy+DJRIBFo6kpU277vTKLHBFKxXmThDOckoNXb
 ag==
X-Google-Smtp-Source: AGHT+IE3WJG2XGIcAkfh5X6rwDSp6rMsOcpN8gTdQpQ8zdv8dTs6JwXXKiQLh4KFo+InXeCDDVoTWw==
X-Received: by 2002:a05:6a00:bd7:b0:72d:b2ed:8788 with SMTP id
 d2e1a72fcca58-72db2ed89dbmr37822462b3a.10.1737938773042; 
 Sun, 26 Jan 2025 16:46:13 -0800 (PST)
Received: from terra ([2405:6586:be0:0:c8ff:1707:9b9:af89])
 by smtp.gmail.com with ESMTPSA id
 d2e1a72fcca58-72f8a77c560sm6005229b3a.142.2025.01.26.16.46.10
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Sun, 26 Jan 2025 16:46:12 -0800 (PST)
From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
In-Reply-To: <87ed0rt3oz.fsf@HIDDEN> (Roman Scherer's message of
 "Sat, 25 Jan 2025 14:37:16 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
 <87ed0rt3oz.fsf@HIDDEN>
Date: Mon, 27 Jan 2025 09:45:59 +0900
Message-ID: <87o6zt5bjs.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Hi Roman,

Roman Scherer <roman@HIDDEN> writes:

> I made a `mock*` macro to get around this ugly nesting in the meantime.
>
> https://github.com/r0man/guix/blob/hetzner-machine-v2-mock-star/tests/machine/hetzner.scm#L165-L248
>
> But I'm still wondering why the `mock` in
> `deploy-machine-mock-with-unprovisioned-server` is working in the
> REPL,
> but failing when I run the test with make ...

Could it be that you are tricked by the caching of HTTP queries?  I've
been tricked by this before, as if you expect to have to mock each
individual request it may not happen as some will already be cached.

If that's the case, either disabling cache could do, or more easily, use
something like done with mock-http-fetch in the tests/go.scm file.

Hope that helps,

-- 
Thanks,
Maxim

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 28 Jan 2025 09:39:02 +0000
Resent-Message-ID: <handler.75144.B75144.173805709224023 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173805709224023
          (code B ref 75144); Tue, 28 Jan 2025 09:39:02 +0000
Received: (at 75144) by debbugs.gnu.org; 28 Jan 2025 09:38:12 +0000
Received: from localhost ([127.0.0.1]:35563 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tci2u-0006FP-0M
	for submit <at> debbugs.gnu.org; Tue, 28 Jan 2025 04:38:12 -0500
Received: from mail-ed1-x535.google.com ([2a00:1450:4864:20::535]:43335)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tci2r-0006FA-0K
 for 75144 <at> debbugs.gnu.org; Tue, 28 Jan 2025 04:38:10 -0500
Received: by mail-ed1-x535.google.com with SMTP id
 4fb4d7f45d1cf-5d3f57582a2so13461580a12.1
 for <75144 <at> debbugs.gnu.org>; Tue, 28 Jan 2025 01:38:08 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738057082;
 x=1738661882; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=TqAVN1hhjgh1hyd6/xsLOS2zKvOz6QeiksQ85cqyHZo=;
 b=gAkt1MJpFUSN6Gzw0tzYJRYSKxJC6HV6Zi/JdSLXXacm0QrI7M4chX+9WwaUVUrNKh
 NzfzqfGfc6897C3+Hm1hubKPdnz+OORadZnb8vFW6+fZOtfrlQbAmaIuVA9n1T+NJNe3
 aYCE8p/OGYnK41rj9O+UgFkRYDxW5l/fHKLOnlP9+b3fwWD7LlSKp2HERXskRgubkh0c
 ZtFZBobSrfEeFIEimYWjUBdkGjG/0ehAa7tUReEm5BfmN9QZmOKO+g6iAvQJQRnXm84E
 y10EIRJ48CYRmxgJWeBZsfyX6M1fWm+NNZoMYO/sIItVTArXL9caIpH9plLg7aGcszwb
 /z6w==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738057082; x=1738661882;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=TqAVN1hhjgh1hyd6/xsLOS2zKvOz6QeiksQ85cqyHZo=;
 b=YAKCnGFQUA5/OYNrTa9VHWOOuyd11QT2FNQeOZWh9FljMCZrn7YYdth6YJaFbjBPvL
 Sme6r++iWOUTc0dXmEbsLq3CTzZSJskL8caJI9TTXRymJObvqc8W4nXb3CPQ4teXu5mB
 GacvDaE28sB0VGLX6sl884+Cmw9e0Rs63qQ3XXqUf77evk2HKmFr6p+aqn/5kQK8hoEV
 XDypvu5LGx5INU0OfQjawMDXUFSRAC3dNr4J04Dlr2mfOhLU84A/A7hGwEYrGGDRXQVc
 DAlE9D5fRxv40o+mMGSn7RlVXEVfXkAPtIcTKbtZMU6T60aAquzqCAjoEY1LcXGJynik
 hKVA==
X-Forwarded-Encrypted: i=1;
 AJvYcCVWlevptzs6hpXloxCFoyr83zKGt5QmUIreSClVr/jzkmnmafpG/R/4pJM2YF4HaGsRVE6Zcg==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YwhLH4IwG4nWJUtUD8OrX6dBlrf61/KtTIfKQp6GHx0ZNwF6V7g
 3PumNEA1RksU4pOPn52pBDgP8f9Ak8Qkei5PPma6G6l/wp5TyrgS3ngfxMsCQHg=
X-Gm-Gg: ASbGnct4JTsI8alpwknBEl5IA039jrqaqH+bXhgWc/im8O3HvPUjV7bufURydoSaNmt
 N8EuBS+G89k6siF2YYqU+7Jv1gUiEeHL4QQOkk8iKjKJDGkHaBjiQi25v/UKw5N3R9Nsdg+WSaG
 neHE1Jv0i/IWqDsnnsVyAW5Tgo+m9Ehmnln3SSVl6+PMAdj0VzPplwDqnl1Yp9G57dLLIT89U19
 YbUoKx6N9gDdoMIrGObk7OBUHiHxieEJKsTGRvjxzYCtym/vWREIenxg/rnGuTLyVOAt7b5KAJc
 8rfSbqImYAIWPFK6
X-Google-Smtp-Source: AGHT+IFTSCN6zxw2rFacTWty+MFGHLDINOuFyjBMvBh5xjNUrLfXE8oSFhp8BfiHOC/bikSa06HPfg==
X-Received: by 2002:a17:907:c1e:b0:aab:882e:921e with SMTP id
 a640c23a62f3a-ab6bba98021mr336433766b.2.1738057081674; 
 Tue, 28 Jan 2025 01:38:01 -0800 (PST)
Received: from precision ([2a01:599:106:e73a:8668:af15:b5c8:c8b])
 by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab676116951sm734930066b.169.2025.01.28.01.38.00
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 28 Jan 2025 01:38:00 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <87o6zt5bjs.fsf@HIDDEN> (Maxim Cournoyer's message of "Mon, 27
 Jan 2025 09:45:59 +0900")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
 <87ed0rt3oz.fsf@HIDDEN> <87o6zt5bjs.fsf@HIDDEN>
User-Agent: mu4e 1.12.7; emacs 29.4
Date: Tue, 28 Jan 2025 10:37:56 +0100
Message-ID: <87tt9je0sr.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain


Hi Maxim,

thanks for your help and the tip about caching. Unless I'm missing
something, I don't think the caching of HTTP requests is involved
here.

I'm trying to test the (gnu machine hetzner) module and mock the
functions it uses from the (gnu machine hetzner http) module.

When I run the mocked test I expect no code from the (gnu machine
hetzner http) module to be executed, since I mocked all those
functions. This seems to work in the Geiser REPL, but for some reason it
does not work when I run the test with:

./pre-inst-env make check TESTS="tests/machine/hetzner.scm"

To me it looks like the mock function behaves differently in those 2
situations. In the meaintime I also tried setting -O0, but that didn't
make any difference either. :/

Roman

Maxim Cournoyer <maxim.cournoyer@HIDDEN> writes:

> Hi Roman,
>
> Roman Scherer <roman@HIDDEN> writes:
>
>> I made a `mock*` macro to get around this ugly nesting in the meantime.
>>
>> https://github.com/r0man/guix/blob/hetzner-machine-v2-mock-star/tests/machine/hetzner.scm#L165-L248
>>
>> But I'm still wondering why the `mock` in
>> `deploy-machine-mock-with-unprovisioned-server` is working in the
>> REPL,
>> but failing when I run the test with make ...
>
> Could it be that you are tricked by the caching of HTTP queries?  I've
> been tricked by this before, as if you expect to have to mock each
> individual request it may not happen as some will already be cached.
>
> If that's the case, either disabling cache could do, or more easily, use
> something like done with mock-http-fetch in the tests/go.scm file.
>
> Hope that helps,

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeYpXQXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZkabAgAlM8siGqs+Q1WJfIojVyij+ln
SEAhfELYT//itSJXSqep+AFn195XT84uY9jXiN1yD6NDpPVabKlVmglOKwehjbF6
TSHCpl2+rHTp49hvoPQTT00fknzaRHn63J0mKSHdtHK7i1qKwGTCH45VkYaRVTHT
eKpeadMyygdQiFQ8wWO/UnBNFa0x4aDSMdeKM7EEMiBBZkeTqiHAxINfBbtqbBXV
QruGzhtPRe7b0tyQn1ttpBLXaNbIM/As660S/oRk5r5QQ58dw8DD8lvdXylM7r9H
2ou2XdMaoIx04NPiROsQ8Ee1Wy9UX7huye88zx+WceFGxMMdVaVeF3COiiS7nA==
=/ELQ
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 28 Jan 2025 10:52:01 +0000
Resent-Message-ID: <handler.75144.B75144.17380614984232 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.17380614984232
          (code B ref 75144); Tue, 28 Jan 2025 10:52:01 +0000
Received: (at 75144) by debbugs.gnu.org; 28 Jan 2025 10:51:38 +0000
Received: from localhost ([127.0.0.1]:35676 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tcjBy-00016C-02
	for submit <at> debbugs.gnu.org; Tue, 28 Jan 2025 05:51:38 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:50656)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1tcjBw-00015z-7v
 for 75144 <at> debbugs.gnu.org; Tue, 28 Jan 2025 05:51:36 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1tcjBp-0005El-Qv; Tue, 28 Jan 2025 05:51:29 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To:
 From; bh=336+JuqyRDecJMth7mGcaUA/o2DqqJ+1GdX6nDWURIE=; b=IXM7k2rqESsh5JVPaADO
 kCs7uCLO5iu+ELcbYWkPO1Wa/kRsoTBP7XDQzTmooKrf3vHrX+8PvHKzgAaE90D4UJHJbrX+MllJK
 lHnaPsIa3mbu1vYbJ9yLv+ekHfwKzVY3bm7TvkvHqUWiqR4+PWVCh7laxHk0vFog33qaGpR8gWPQ+
 NNTnYIQYJT8lBYJW5YrXfBV0uGUceYth0XmZvhDAkcseFGMyCe1lcmHdY3hRA5gi0okuamY+tZ+Ud
 DzjU7nCSTc4Z9EhlaqviyPrwqFT3RKOAFpl+zVnEBPZVCdzQBXhDrqbRUoNv4gtCT0kFuveeuZRB2
 SJcwMqSQ96ULiA==;
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
In-Reply-To: <87tt9je0sr.fsf@HIDDEN> (Roman Scherer's message of
 "Tue, 28 Jan 2025 10:37:56 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
 <87ed0rt3oz.fsf@HIDDEN> <87o6zt5bjs.fsf@HIDDEN>
 <87tt9je0sr.fsf@HIDDEN>
X-URL: http://www.fdn.fr/~lcourtes/
X-Revolutionary-Date: Nonidi 9 =?UTF-8?Q?Pluvi=C3=B4se?= an 233 de la
 =?UTF-8?Q?R=C3=A9volution,?= jour du Peuplier
X-PGP-Key-ID: 0x090B11993D9AEBB5
X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc
X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4  0CFB 090B 1199 3D9A EBB5
X-OS: x86_64-pc-linux-gnu
Date: Tue, 28 Jan 2025 11:51:16 +0100
Message-ID: <87y0yvdxej.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Hi,

Roman Scherer <roman@HIDDEN> skribis:

> When I run the mocked test I expect no code from the (gnu machine
> hetzner http) module to be executed, since I mocked all those
> functions. This seems to work in the Geiser REPL, but for some reason it
> does not work when I run the test with:
>
> ./pre-inst-env make check TESTS=3D"tests/machine/hetzner.scm"
>
> To me it looks like the mock function behaves differently in those 2
> situations. In the meaintime I also tried setting -O0, but that didn't
> make any difference either. :/

Hmm.  I was going to say that the likely problem is that code from (gnu
machines hetzner http) gets inlined so you cannot really mock it.

To make sure this can be mocked, you can use this trick:

  (set! proc proc)

where =E2=80=98proc=E2=80=99 is the procedure you want to mock (that statem=
ent prevents
the compiler from inlining it).

Ludo=E2=80=99.

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 28 Jan 2025 19:58:02 +0000
Resent-Message-ID: <handler.75144.B75144.173809427324042 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173809427324042
          (code B ref 75144); Tue, 28 Jan 2025 19:58:02 +0000
Received: (at 75144) by debbugs.gnu.org; 28 Jan 2025 19:57:53 +0000
Received: from localhost ([127.0.0.1]:38725 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tcrib-0006Fh-7t
	for submit <at> debbugs.gnu.org; Tue, 28 Jan 2025 14:57:53 -0500
Received: from mail-ed1-x52b.google.com ([2a00:1450:4864:20::52b]:55717)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tcriY-0006FQ-PY
 for 75144 <at> debbugs.gnu.org; Tue, 28 Jan 2025 14:57:51 -0500
Received: by mail-ed1-x52b.google.com with SMTP id
 4fb4d7f45d1cf-5d3d14336f0so10267504a12.3
 for <75144 <at> debbugs.gnu.org>; Tue, 28 Jan 2025 11:57:50 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738094265;
 x=1738699065; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=LKxoMZZQLcSrKkQ/KiofExl8sVQafL0HW0Sv5brVpJo=;
 b=gljbGJCiuX1FQMKfNXyiHmSh06zLlHc4C5tqpLKJroHlDjW0hfXHVyu8uO7w2qgccZ
 G95uKhOch/JxVs32ytdJyB6a0AH8ZLe6gxaG8DJ9OPgFriNi7bLG1tIbATNRDgqdQDBX
 O495Irf/X+YY+n8HYvJy1HboK5YSZ5QZeksqUw2lREFxp7bGpoJlcZBwUevw7+rdsP2y
 fEMQqF7xPjJ+A5wkO4dQpA8yvxI0ztLi4ZrnKlWDIjgkk3LWXQjbTaNbN+QgPj7cppHR
 zHTAYHsmSx5yYim6kEmDtNEk+e50gY36uwfe0SOazMh5Sicrolxexytf71bv2SKbSxv2
 gV7A==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738094265; x=1738699065;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=LKxoMZZQLcSrKkQ/KiofExl8sVQafL0HW0Sv5brVpJo=;
 b=OUrRV12E58ERqZwXUSj23plVqraN/wOw3q633CkuJqlD0joLQJeZS2Bs63zGINNBdz
 KQ91pdUfDWEn/427aEQRKVLCfE3cPwMJR8MSfhU6WMRN/ongbW/0EKOM9chA2JK/KR/w
 SMXwdoUPoNCFeTKJmJajZvEuCcPJxPkzizNHDpWmsbnTji9EyzVOIxDeDz72jDdlgCZ2
 nfB+4/uevkN3u7YxfadUB146/Ul08vSELqnoZitTQKoLbkcooN8N7CBlaqlL0r6udsUR
 6zzXwMjBlqFN2N72BTvEXcrvTqEQTtDBkRupS7hI9iDcPyFF8SZd9kVYY4XSx8NZROXK
 8uSA==
X-Forwarded-Encrypted: i=1;
 AJvYcCUdCqp58VKpuopB/IWbCGT567hXxN4xYS3EbNpParVODOEKFmufPxIb8MictolE+B6rweIEsw==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YyOwCo3hkUy/hhskJ/4zRCIuWEbMv9w/pgzuO7KAQlDCXevv9E4
 ngArgRi09dqWd4Ge9u3f5HegavQBHPo2eItwEZnDekSkXRN7Vx+3dBVeRwVTueM=
X-Gm-Gg: ASbGncuaQH1GhSE+LR76JkwR5ufhQB+pSctPMrPzj4AekqyBEmSRic+okVYOVCl5OEQ
 VV2tN2HYNrwnC0G36x6Ub8pHSF10kMxWZoSrXM7M5kUTD2KrzNQilKXCfaozne62OS8NQ7F5wOl
 3FeYhsWqt9z2XZZEO0wBHG00j/LoHtTT0sgAEqdAgqfPImAvb+aqHpDqNYzWWNsM6+MXWLg7T/l
 dh34kyHQwX3RDNerfrpcC3KSxCd9GslsudvmHx1qIr5J3vpD2ZEhAZQ4TtV3zjZ3X394xZvz9Kx
 VFvt7Xhk
X-Google-Smtp-Source: AGHT+IFDpQIIEW0pG58/s+zFGOprwVEaa2lNYJ9GpoTLl09KAntyZ+njMujYldXBoasgn9YtHrR11Q==
X-Received: by 2002:a05:6402:520e:b0:5d0:aa2d:6eee with SMTP id
 4fb4d7f45d1cf-5dc5efe6376mr220074a12.26.1738094264461; 
 Tue, 28 Jan 2025 11:57:44 -0800 (PST)
Received: from m1 ([2a01:599:106:e73a:cf2d:540d:84c7:1aa5])
 by smtp.gmail.com with ESMTPSA id
 4fb4d7f45d1cf-5dc186b3760sm7475097a12.57.2025.01.28.11.57.43
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 28 Jan 2025 11:57:43 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <87y0yvdxej.fsf@HIDDEN> ("Ludovic =?UTF-8?Q?Court=C3=A8s?="'s message of "Tue, 28 Jan 2025 11:51:16 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
 <87ed0rt3oz.fsf@HIDDEN> <87o6zt5bjs.fsf@HIDDEN>
 <87tt9je0sr.fsf@HIDDEN> <87y0yvdxej.fsf@HIDDEN>
User-Agent: mu4e 1.12.7; emacs 29.4
Date: Tue, 28 Jan 2025 20:57:41 +0100
Message-ID: <867c6e90ei.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable


Hi Ludo,

that's what I was looking for. Now it is working as expected!

I will send an updated patch soon.

Thanks for your help!

Roman

Ludovic Court=C3=A8s <ludo@HIDDEN> writes:

> Hi,
>
> Roman Scherer <roman@HIDDEN> skribis:
>
>> When I run the mocked test I expect no code from the (gnu machine
>> hetzner http) module to be executed, since I mocked all those
>> functions. This seems to work in the Geiser REPL, but for some reason it
>> does not work when I run the test with:
>>
>> ./pre-inst-env make check TESTS=3D"tests/machine/hetzner.scm"
>>
>> To me it looks like the mock function behaves differently in those 2
>> situations. In the meaintime I also tried setting -O0, but that didn't
>> make any difference either. :/
>
> Hmm.  I was going to say that the likely problem is that code from (gnu
> machines hetzner http) gets inlined so you cannot really mock it.
>
> To make sure this can be mocked, you can use this trick:
>
>   (set! proc proc)
>
> where =E2=80=98proc=E2=80=99 is the procedure you want to mock (that stat=
ement prevents
> the compiler from inlining it).
>
> Ludo=E2=80=99.

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeZNrUXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZnvGgf/R1e7zvy3OC/q5GqRjEy1+hEA
BTx1KN1nw29B5TsArmG3PQO4HB6qocUPJtwLdAXy9mg+q6f26bl9ytc+20cqbX1z
7xC3v6vSd/3SZg3jGFPw5t1+iF6YI/ZT7Il/oomCbiP5iSMGSjq3Wc7vVGI2IWSa
Mfj6a9xfXAoQjtk40E4NNWxgsvhmABdbxqHRZzBrpcsDcgHpnX5l4ScEStwdYdwb
JIIGMj56T0FKU/s89s8kimd4Fj4b/Y0fANhJfxh7QzGQSQ1IjqEbXfPqclEWIwCL
j/AbCEwf2h904G4uyAdwAolGurTmiufFrN5Y/81Dd5TT2JUPtGrCTFaYuxxKrA==
=0O6G
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH v3 1/2] guix: ssh: Add strict-host-key-check? option.
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
In-Reply-To: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix@HIDDEN, dev@HIDDEN, ludo@HIDDEN, othacehe@HIDDEN, zimon.toutoune@HIDDEN, me@HIDDEN, guix-patches@HIDDEN
Resent-Date: Tue, 04 Feb 2025 19:02:02 +0000
Resent-Message-ID: <handler.75144.B75144.173869569323028 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75144 <at> debbugs.gnu.org
Cc: Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
X-Debbugs-Original-Xcc: Christopher Baines <guix@HIDDEN>, Josselin Poiret <dev@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173869569323028
          (code B ref 75144); Tue, 04 Feb 2025 19:02:02 +0000
Received: (at 75144) by debbugs.gnu.org; 4 Feb 2025 19:01:33 +0000
Received: from localhost ([127.0.0.1]:46677 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tfOAu-0005zK-PN
	for submit <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:01:33 -0500
Received: from mail-ej1-x631.google.com ([2a00:1450:4864:20::631]:56581)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tfOAs-0005z0-LY
 for 75144 <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:01:31 -0500
Received: by mail-ej1-x631.google.com with SMTP id
 a640c23a62f3a-aaeef97ff02so938478666b.1
 for <75144 <at> debbugs.gnu.org>; Tue, 04 Feb 2025 11:01:30 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738695684;
 x=1739300484; darn=debbugs.gnu.org; 
 h=content-transfer-encoding:mime-version:message-id:date:subject:cc
 :to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=93p0oWV8KKLm9ldp3bPboC1rZeU4hjB7XJJv1/5E8qI=;
 b=De5OwEd+9uCVLz1lf8aF1PsK/tmPevwFoDRDoBu627mbQDVGSjeNQgoAeJvdCSqzFy
 4IUHRzn2T+FROJFSBlzwirC1fm3YdHiYfRVA4Y3ZZ7QJtEeI48ZIQt8YSASNTB9UDcMT
 aEWGTxmpT9VRW/4Kqpp2PnUlMhJniCcFQ05w/qXoiCPnnOlx8iQHA+oelAwoCH2g1PMJ
 hCK2XAzxAOi3JxYgNwdIVQzc2Tp/rLO3GffzFLT3bODoKv9hW1MYhtRuJD0zdy4WdiSH
 Po8yBT+UdhuX4aLBM+8XDBLCFcUxUQjpjvY/Gxf7pU9iBbCjOqAs7h6LgYBG/mS3GhQE
 miWQ==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738695684; x=1739300484;
 h=content-transfer-encoding:mime-version:message-id:date:subject:cc
 :to:from:x-gm-message-state:from:to:cc:subject:date:message-id
 :reply-to;
 bh=93p0oWV8KKLm9ldp3bPboC1rZeU4hjB7XJJv1/5E8qI=;
 b=f5hhGx0ejiabBdHsQ82Se5hWA3mLNJ/lHRBx//9Jlcv26zJyQmNEnDf1CDuF5FQ18T
 TlqbH9kRsjY22eyZ5RjTMF0ti76FOHfOBQzQ5HGWR+Pf/DuWGjv5aQogxlajerfg6xm8
 GBo6cKqRAeM+k+tQlUCvBiUdR6pHdM0EmXlQqUOGfw3v8nbly1yiqOK1GvXaqkKsMliI
 74/lBCwE1SfezWdp6GczbmxFhUO1Or5Hyeje/9omIyZZaMd+sdk+TVKYqiJAgkj7qZdu
 tUvl3T66CtgZs3NitRxv0gGGDikV//vafPQzG75MrPW/N35lxi1uTTKzgT0ZnlQgMJwU
 WxDQ==
X-Gm-Message-State: AOJu0Yw0DijxGkHaeNxMRJrHPF6RVvGmmo+5zdN2ANmXUda2LAqRAP9I
 cYOmzV9UF/EbPQiYwPMZAFnPJ4mak2XD37uqtsrETWzjraUuVNrlvhQwKDpE3aYVZDLgZsu9xi4
 Gpw7Wog==
X-Gm-Gg: ASbGncvOE/YiIYL0ioVI4Y+V1tYHBJQBDWkCzTevgemzOk/6QPFEc3e/pGFOzycpz8Q
 63qxdOlxc731bVBXRmWOcRRlhn8y1i7nlJIYTF8Za1k4ZFqzZp3T1IIVuWgtFLx9+vW0TheLSV1
 eImVXMJt6e6dc2b6TErzD98NnN0dQ7dp50RTly289wsFrw8P3v4UCAaAXtiPSof82QtpdKkhoyz
 m3GBM2fdxOdvHI26fCzRfK/e3miwnN8xAXlsXPCXqm+UTBkLjT4/VIkLuuyHv0NJY5AvLSMgXLt
 z/H3VRPEmHlb7mGTnoWyVQW1WAfArD/YEj8IEc5DZgL5troIStUpY1LVQasv1s/xRU8=
X-Google-Smtp-Source: AGHT+IHSvX+0eqB230QmvyRTZf0Rvj4rHiLO+nl+VPF3q6+M5QDLkWR1c3+ZFnJbZ6Azhg4kE6sU6w==
X-Received: by 2002:a17:907:6d12:b0:ab6:cdc2:bf57 with SMTP id
 a640c23a62f3a-ab6cfcb3389mr2662991366b.1.1738695682789; 
 Tue, 04 Feb 2025 11:01:22 -0800 (PST)
Received: from localhost.localdomain (tmo-086-39.customers.d1-online.com.
 [80.187.86.39]) by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab6e47cf29fsm967666266b.38.2025.02.04.11.01.21
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 04 Feb 2025 11:01:22 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
Date: Tue,  4 Feb 2025 20:01:13 +0100
Message-ID: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
X-Mailer: git-send-email 2.48.1
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

* guix/ssh.scm (open-ssh-session): Add strict-host-key-check? option.

Change-Id: Iae5df5ac8d45033b6b636e9c872f8910d4f6cfe9
---
 guix/ssh.scm | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/guix/ssh.scm b/guix/ssh.scm
index ae506df14c..8decfdbab9 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -103,7 +103,8 @@ (define* (open-ssh-session host #:key user port identity
                            host-key
                            (compression %compression)
                            (timeout 3600)
-                           (connection-timeout 10))
+                           (connection-timeout 10)
+                           (strict-host-key-check? #t))
   "Open an SSH session for HOST and return it.  IDENTITY specifies the file
 name of a private key to use for authenticating with the host.  When USER,
 PORT, or IDENTITY are #f, use default values or whatever '~/.ssh/config'
@@ -117,6 +118,9 @@ (define* (open-ssh-session host #:key user port identity
 seconds.  Install TIMEOUT as the maximum time in seconds after which a read or
 write operation on a channel of the returned session is considered as failing.
 
+IF STRICT-HOST-KEY-CHECK? is #f, strict host key checking is turned off for
+the new session.
+
 Throw an error on failure."
   (let ((session (make-session #:user user
                                #:identity identity
@@ -137,7 +141,8 @@ (define* (open-ssh-session host #:key user port identity
 
                                ;; Speed up RPCs by creating sockets with
                                ;; TCP_NODELAY.
-                               #:nodelay #t)))
+                               #:nodelay #t
+                               #:stricthostkeycheck strict-host-key-check?)))
 
     ;; Honor ~/.ssh/config.
     (session-parse-config! session)
@@ -149,13 +154,14 @@ (define* (open-ssh-session host #:key user port identity
            (authenticate-server* session host-key)
 
            ;; Authenticate against ~/.ssh/known_hosts.
-           (match (authenticate-server session)
-             ('ok #f)
-             (reason
-              (raise (formatted-message (G_ "failed to authenticate \
+           (when strict-host-key-check?
+             (match (authenticate-server session)
+               ('ok #f)
+               (reason
+                (raise (formatted-message (G_ "failed to authenticate \
 server at '~a': ~a")
-                                        (session-get session 'host)
-                                        reason)))))
+                                          (session-get session 'host)
+                                          reason))))))
 
        ;; Use public key authentication, via the SSH agent if it's available.
        (match (userauth-public-key/auto! session)

base-commit: 97fee203a5441f4d3004ccf43ed72fa3b51a7cdc
-- 
2.48.1

Message sent to pelzflorian@HIDDEN, julien@HIDDEN, ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH v3 2/2] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: pelzflorian@HIDDEN, julien@HIDDEN, ludo@HIDDEN, maxim.cournoyer@HIDDEN, guix-patches@HIDDEN
Resent-Date: Tue, 04 Feb 2025 19:02:02 +0000
Resent-Message-ID: <handler.75144.B75144.173869569623045 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75144 <at> debbugs.gnu.org
Cc: Roman Scherer <roman@HIDDEN>, Florian Pelz <pelzflorian@HIDDEN>, Julien Lepiller <julien@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
X-Debbugs-Original-Xcc: Florian Pelz <pelzflorian@HIDDEN>, Julien Lepiller <julien@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173869569623045
          (code B ref 75144); Tue, 04 Feb 2025 19:02:02 +0000
Received: (at 75144) by debbugs.gnu.org; 4 Feb 2025 19:01:36 +0000
Received: from localhost ([127.0.0.1]:46679 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tfOAy-0005zc-3n
	for submit <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:01:36 -0500
Received: from mail-ed1-x536.google.com ([2a00:1450:4864:20::536]:60779)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tfOAv-0005z6-PG
 for 75144 <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:01:34 -0500
Received: by mail-ed1-x536.google.com with SMTP id
 4fb4d7f45d1cf-5d90a5581fcso10864924a12.1
 for <75144 <at> debbugs.gnu.org>; Tue, 04 Feb 2025 11:01:33 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738695687;
 x=1739300487; darn=debbugs.gnu.org; 
 h=content-transfer-encoding:mime-version:references:in-reply-to
 :message-id:date:subject:cc:to:from:from:to:cc:subject:date
 :message-id:reply-to;
 bh=W//CVELOCvmOxtJazm7ygGh9QmVfnX4ntStQjwJ3bmo=;
 b=SkJJEGmW835mViZm2tPIc5wpi+uWUbjWAMOq/KReGZC+LneJfoBku7JT/uoCY/yXk1
 cMntFj9iGfI6lgGg2GaIEF/YHU7jZhAqLRW2mqE3gFNEoxdFVZZ7DvVTY5EtdE/YpdvL
 TqS71RYioxgi6u+qekf1ws/+gs/u2IOovJBxWog5SZbYEyd9TfHI+/VewqX/vmrbLycM
 I2DutTna7b4l/+FmtCHDs6TSlbH0dp5yQ+8KUkAEJRP0+dzkCwpXfArckZz7AZmYV0Jn
 Ju2tIe4x6Vva7bjBufPSXBDcT0uh3zoxsT3ehiFAok10lBu/F1/FGhlBX8V5edNF+V06
 e9NA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738695687; x=1739300487;
 h=content-transfer-encoding:mime-version:references:in-reply-to
 :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc
 :subject:date:message-id:reply-to;
 bh=W//CVELOCvmOxtJazm7ygGh9QmVfnX4ntStQjwJ3bmo=;
 b=QVvjeJI74fTNMATkQnfqeIVuczYuI14+Gt3GahPMjiTK/eEudoLUfsMFsUxq4Ii7Bi
 BJxSxjF5kIDDLaNpw0+wq/6PfXnIpw1h68sEa7jz7TS6KLJt7lLhh+YHYMDzauWWBNNO
 pu6+DAoCCU5bCFU3tMdL5TBFmee1erCbFfT8F2C9zhLznaSccdn2u4nJupi9cpptQokv
 TyIKowUteFMCpFptV6LEckz0DaAMtwA8yszWdO/Llo80j4sHYlUrsaAgCpT/zDKbL5Kq
 LzWObMy1ME4M2ir9YRlr7VRPeeSyH96kpkpc+uQ2zieuFXVd+V06EUvV0s6eIfemwibW
 OO7g==
X-Gm-Message-State: AOJu0Ywv+JltkxVNtGn2fc2jGIrqrwORyULO+1f4gIL47hXMhLka7D4b
 i5d/zlBePvGUKE47UUDZ4X8CBXXkoJ0fFOc6MwfA7WsYgSdOzuuvYU7J75mapdm+qileLA68YZN
 PQjsTYw==
X-Gm-Gg: ASbGnct+ruEmEyD8iYsnzRpF5mks30K35ruXLgCXD6/w30u0I3+TwHUc4AjMdmBmWcI
 neOcjC8mHYvmvllfJXs5xwK/wJAwb/rSgALHViqY9zBkVhhoLfABCd8mI8y1qEGj3dl9Je+XWxp
 YZynLTZ2DIRinXbAmPBclUg2u2W35rFIX3vBB2rrpnu+2em72TV34y+CZ5PoArdqobuAWyUtL6t
 ky1g5tYExhaF3Xv8RdevrUmi53OOJBpQ1nejB24HY8jUFVX5tTmlhEQSylq6rw6H9vyHifv/qIE
 B3biJYpZxA9cponpdDxgja82G6NlBNCBf7RuutDNRoSMAnLILrYO7qNwMYnWOYFkqOQ=
X-Google-Smtp-Source: AGHT+IEDPUf8O9IDzprnDNFaFQFMvgakqAo4xUyrjQyim0fU1Y39fES3Ifz4PvHTaUTQ9Y09WlCrqQ==
X-Received: by 2002:a17:907:2cc5:b0:aa6:9eac:4b8e with SMTP id
 a640c23a62f3a-ab6cfdbf7e2mr3437516766b.41.1738695684344; 
 Tue, 04 Feb 2025 11:01:24 -0800 (PST)
Received: from localhost.localdomain (tmo-086-39.customers.d1-online.com.
 [80.187.86.39]) by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab6e47cf29fsm967666266b.38.2025.02.04.11.01.23
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 04 Feb 2025 11:01:23 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
Date: Tue,  4 Feb 2025 20:01:14 +0100
Message-ID: <7b51e5d7ae56f7f9792252e98b57371b2904a3fe.1738695552.git.roman@HIDDEN>
X-Mailer: git-send-email 2.48.1
In-Reply-To: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
References: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>

* 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
---
 Makefile.am                    |   2 +
 doc/guix.texi                  | 128 ++++++
 gnu/local.mk                   |   2 +
 gnu/machine/hetzner.scm        | 705 +++++++++++++++++++++++++++++++++
 gnu/machine/hetzner/http.scm   | 664 +++++++++++++++++++++++++++++++
 po/guix/POTFILES.in            |   2 +
 tests/machine/hetzner.scm      | 267 +++++++++++++
 tests/machine/hetzner/http.scm | 631 +++++++++++++++++++++++++++++
 8 files changed, 2401 insertions(+)
 create mode 100644 gnu/machine/hetzner.scm
 create mode 100644 gnu/machine/hetzner/http.scm
 create mode 100644 tests/machine/hetzner.scm
 create mode 100644 tests/machine/hetzner/http.scm

diff --git a/Makefile.am b/Makefile.am
index f759803b8b..7bb75aa146 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -562,6 +562,8 @@ SCM_TESTS =					\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
+  tests/machine/hetzner.scm                     \
+  tests/machine/hetzner/http.scm                 \
   tests/minetest.scm				\
   tests/modules.scm				\
   tests/monads.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277f..4226d7ae26 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44783,6 +44783,134 @@ Invoking guix deploy
 @end table
 @end deftp
 
+@deftp {Data Type} hetzner-configuration
+This is the data type describing the server that should be created for a
+machine with an @code{environment} of
+@code{hetzner-environment-type}. It allows you to configure deployment
+to a @acronym{VPS, virtual private server} hosted by
+@uref{https://www.hetzner.com, Hetzner}.
+
+@table @asis
+
+@item @code{allow-downgrades?} (default: @code{#f})
+Whether to allow potential downgrades.
+
+@item @code{authorize?} (default: @code{#t})
+If true, the public signing key @code{"/etc/guix/signing-key.pub"} of
+the machine that invokes @command{guix deploy} will be added to the
+operating system ACL keyring of the target machine.
+
+@item @code{build-locally?} (default: @code{#t})
+If true, system derivations will be built on the machine that invokes
+@command{guix deploy}, otherwise derivations are build on the target
+machine.  Set this to @code{#f} if the machine you are deploying from
+has a different architecture than the target machine and you can't build
+derivations for the target architecture by other means, like offloading
+(@pxref{Daemon Offload Setup}) or emulation
+(@pxref{transparent-emulation-qemu, Transparent Emulation with QEMU}).
+
+@item @code{delete?} (default: @code{#t})
+If true, the server will be deleted when an error happens in the
+provisioning phase. If false, the server will be kept in order to debug
+any issues.
+
+@item @code{labels} (default: @code{'()})
+A user defined alist of key/value pairs attached to the SSH key and the
+server on the Hetzner API.  Keys and values must be strings,
+e.g. @code{'(("environment" . "development"))}.  For more information,
+see @uref{https://docs.hetzner.cloud/#labels, Labels}.
+
+@item @code{location} (default: @code{"fsn1"})
+The name of a @uref{https://docs.hetzner.com/cloud/general/locations,
+location} to create the server in.  For example, @code{"fsn1"}
+corresponds to the Hetzner site in Falkenstein, Germany, while
+@code{"sin"} corresponds to its site in Singapore.
+
+@item @code{server-type} (default: @code{"cx42"})
+The name of the
+@uref{https://docs.hetzner.com/cloud/servers/overview#server-types,
+server type} this virtual server should be created with.  For example,
+@code{"cx42"} corresponds to a x86_64 server that has 8 VCPUs, 16 GB of
+memory and 160 GB of storage, while @code{"cax31"} to the AArch64
+equivalent.  Other server types and their current prices can be found
+@uref{https://www.hetzner.com/cloud/#pricing, here}.
+
+@item @code{ssh-key}
+The file name of the SSH private key to use to authenticate with the
+remote host.
+
+@end table
+
+When deploying a machine for the first time, the following steps are
+taken to provision a server for the machine on the
+@uref{https://www.hetzner.com/cloud, Hetzner Cloud} service:
+
+@itemize
+
+@item
+Create the SSH key of the machine on the Hetzner API.
+
+@item
+Create a server for the machine on the Hetzner API.
+
+@item
+Format the root partition of the disk using the file system of the
+machine's operating system.  Supported file systems are btrfs and ext4.
+
+@item
+Install a minimal Guix operating system on the server using the
+@uref{https://docs.hetzner.com/cloud/servers/getting-started/rescue-system,
+rescue mode}.  This minimal system is used to install the machine's
+operating system, after rebooting.
+
+@item
+Reboot the server and apply the machine's operating system on the
+server.
+
+@end itemize
+
+Once the server has been provisioned and SSH is available, deployment
+continues by delegating it to the @code{managed-host-environment-type}.
+
+Servers on the Hetzner Cloud service can be provisioned on the AArch64
+architecture using UEFI boot mode, or on the x86_64 architecture using
+BIOS boot mode.  The @code{(gnu machine hetzner)} module exports the
+@code{%hetzner-os-arm} and @code{%hetzner-os-x86} operating systems that
+are compatible with those two architectures, and can be used as a base
+for defining your custom operating system.
+
+The following example shows the definition of two machines that are
+deployed on the Hetzner Cloud service.  The first one uses the
+@code{%hetzner-os-arm} operating system to run a server with 16 shared
+vCPUs and 32 GB of RAM on the @code{aarch64} architecture, the second
+one uses the @code{%hetzner-os-x86} operating system on a server with 16
+shared vCPUs and 32 GB of RAM on the @code{x86_64} architecture.
+
+@lisp
+(use-modules (gnu machine)
+             (gnu machine hetzner))
+
+(list (machine
+       (operating-system %hetzner-os-arm)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cax41")
+                       (ssh-key "/home/charlie/.ssh/id_rsa"))))
+      (machine
+       (operating-system %hetzner-os-x86)
+       (environment hetzner-environment-type)
+       (configuration (hetzner-configuration
+                       (server-type "cpx51")
+                       (ssh-key "/home/charlie/.ssh/id_rsa")))))
+@end lisp
+
+Passing this file to @command{guix deploy} with the environment variable
+@env{GUIX_HETZNER_API_TOKEN} set to a valid Hetzner
+@uref{https://docs.hetzner.com/cloud/api/getting-started/generating-api-token,
+API key} should provision two machines for you.
+
+@end deftp
+
 @node Running Guix in a VM
 @section Running Guix in a Virtual Machine
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 83abc86fe2..cc812ad6f3 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -921,6 +921,8 @@ if HAVE_GUILE_SSH
 
 GNU_SYSTEM_MODULES +=         			\
   %D%/machine/digital-ocean.scm			\
+  %D%/machine/hetzner.scm			\
+  %D%/machine/hetzner/http.scm			\
   %D%/machine/ssh.scm
 
 endif HAVE_GUILE_SSH
diff --git a/gnu/machine/hetzner.scm b/gnu/machine/hetzner.scm
new file mode 100644
index 0000000000..5e17bfae21
--- /dev/null
+++ b/gnu/machine/hetzner.scm
@@ -0,0 +1,705 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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)
+  #:use-module (gnu bootloader grub)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu machine hetzner http)
+  #:use-module (gnu machine ssh)
+  #:use-module (gnu machine)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu services base)
+  #:use-module (gnu services networking)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system image)
+  #:use-module (gnu system linux-initrd)
+  #:use-module (gnu system pam)
+  #:use-module (gnu system)
+  #:use-module (guix base32)
+  #:use-module (guix colors)
+  #:use-module (guix derivations)
+  #:use-module (guix diagnostics)
+  #:use-module (guix gexp)
+  #:use-module (guix i18n)
+  #:use-module (guix import json)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix pki)
+  #:use-module (guix records)
+  #:use-module (guix ssh)
+  #:use-module (guix store)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 iconv)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 string-fun)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (json)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-2)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:use-module (ssh channel)
+  #:use-module (ssh key)
+  #:use-module (ssh popen)
+  #:use-module (ssh session)
+  #:use-module (ssh sftp)
+  #:use-module (ssh shell)
+  #:export (%hetzner-os-arm
+            %hetzner-os-x86
+            deploy-hetzner
+            hetzner-configuration
+            hetzner-configuration-allow-downgrades?
+            hetzner-configuration-api
+            hetzner-configuration-authorize?
+            hetzner-configuration-build-locally?
+            hetzner-configuration-delete?
+            hetzner-configuration-labels
+            hetzner-configuration-location
+            hetzner-configuration-server-type
+            hetzner-configuration-ssh-key
+            hetzner-configuration?
+            hetzner-environment-type))
+
+;;; Commentary:
+;;;
+;;; This module implements a high-level interface for provisioning machines on
+;;; the Hetzner Cloud service https://docs.hetzner.cloud.
+;;;
+
+
+;;;
+;;; Hetzner operating systems.
+;;;
+
+;; Operating system for arm servers using UEFI boot mode.
+
+(define %hetzner-os-arm
+  (operating-system
+    (host-name "guix-arm")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-efi-bootloader)
+      (targets (list "/boot/efi"))
+      (terminal-outputs '(console))))
+    (file-systems
+     (cons* (file-system
+              (mount-point "/")
+              (device "/dev/sda1")
+              (type "ext4"))
+            (file-system
+              (mount-point "/boot/efi")
+              (device "/dev/sda15")
+              (type "vfat"))
+            %base-file-systems))
+    (initrd-modules
+     (cons* "sd_mod" "virtio_scsi" %base-initrd-modules))
+    (services
+     (cons* (service dhcp-client-service-type)
+            (service openssh-service-type
+                     (openssh-configuration
+                      (openssh openssh-sans-x)
+                      (permit-root-login 'prohibit-password)))
+            %base-services))))
+
+;; Operating system for x86 servers using BIOS boot mode.
+
+(define %hetzner-os-x86
+  (operating-system
+    (inherit %hetzner-os-arm)
+    (host-name "guix-x86")
+    (bootloader
+     (bootloader-configuration
+      (bootloader grub-bootloader)
+      (targets (list "/dev/sda"))
+      (terminal-outputs '(console))))
+    (initrd-modules
+     (cons "virtio_scsi" %base-initrd-modules))
+    (file-systems
+     (cons (file-system
+             (mount-point "/")
+             (device "/dev/sda1")
+             (type "ext4"))
+           %base-file-systems))))
+
+(define (operating-system-authorize os)
+  "Authorize the OS with the public signing key of the current machine."
+  (if (file-exists? %public-key-file)
+      (operating-system
+        (inherit os)
+        (services
+         (modify-services (operating-system-user-services os)
+           (guix-service-type
+            config => (guix-configuration
+                       (inherit config)
+                       (authorized-keys
+                        (cons*
+                         (local-file %public-key-file)
+                         (guix-configuration-authorized-keys config))))))))
+      (raise-exception
+       (formatted-message (G_ "no signing key '~a'. \
+Have you run 'guix archive --generate-key'?")
+                          %public-key-file))))
+
+(define (operating-system-root-file-system-type os)
+  "Return the root file system type of the operating system OS."
+  (let ((root-fs (find (lambda (file-system)
+                         (equal? "/" (file-system-mount-point file-system)))
+                       (operating-system-file-systems os))))
+    (if (file-system? root-fs)
+        (file-system-type root-fs)
+        (raise-exception
+         (formatted-message
+          (G_ "could not determine root file system type"))))))
+
+
+;;;
+;;; Helper functions.
+;;;
+
+(define (escape-backticks str)
+  "Escape all backticks in STR."
+  (string-replace-substring str "`" "\\`"))
+
+
+
+;;;
+;;; Hetzner configuration.
+;;;
+
+(define-record-type* <hetzner-configuration> hetzner-configuration
+  make-hetzner-configuration hetzner-configuration? this-hetzner-configuration
+  (allow-downgrades? hetzner-configuration-allow-downgrades? ; boolean
+                     (default #f))
+  (api hetzner-configuration-api ; <hetzner-api>
+       (default (hetzner-api)))
+  (authorize? hetzner-configuration-authorize? ; boolean
+              (default #t))
+  (build-locally? hetzner-configuration-build-locally? ; boolean
+                  (default #t))
+  (delete? hetzner-configuration-delete? ; boolean
+           (default #f))
+  (labels hetzner-configuration-labels ; list of strings
+          (default '()))
+  (location hetzner-configuration-location ; #f | string
+            (default "fsn1"))
+  (server-type hetzner-configuration-server-type ; string
+               (default "cx42"))
+  (ssh-key hetzner-configuration-ssh-key)) ; string
+
+(define (hetzner-configuration-ssh-key-fingerprint config)
+  "Return the SSH public key fingerprint of CONFIG as a string."
+  (and-let* ((file-name (hetzner-configuration-ssh-key config))
+             (privkey (private-key-from-file file-name))
+             (pubkey (private-key->public-key privkey))
+             (hash (get-public-key-hash pubkey 'md5)))
+    (bytevector->hex-string hash)))
+
+(define (hetzner-configuration-ssh-key-public config)
+  "Return the SSH public key of CONFIG as a string."
+  (and-let* ((ssh-key (hetzner-configuration-ssh-key config))
+             (public-key (public-key-from-file ssh-key)))
+    (format #f "ssh-~a ~a" (get-key-type public-key)
+            (public-key->string public-key))))
+
+
+;;;
+;;; Hetzner Machine.
+;;;
+
+(define (hetzner-machine-delegate target server)
+  "Return the delagate machine that uses SSH for deployment."
+  (let* ((config (machine-configuration target))
+         ;; Get the operating system WITHOUT the provenance service to avoid a
+         ;; duplicate symlink conflict in the store.
+         (os ((@@ (gnu machine) %machine-operating-system) target)))
+    (machine
+     (inherit target)
+     (operating-system
+       (if (hetzner-configuration-authorize? config)
+           (operating-system-authorize os)
+           os))
+     (environment managed-host-environment-type)
+     (configuration
+      (machine-ssh-configuration
+       (allow-downgrades? (hetzner-configuration-allow-downgrades? config))
+       (authorize? (hetzner-configuration-authorize? config))
+       (build-locally? (hetzner-configuration-build-locally? config))
+       (host-name (hetzner-server-public-ipv4 server))
+       (identity (hetzner-configuration-ssh-key config))
+       (system (hetzner-server-system server)))))))
+
+(define (hetzner-machine-location machine)
+  "Find the location of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-location config)))
+    (find (lambda (location)
+            (equal? expected (hetzner-location-name location)))
+          (hetzner-api-locations
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,expected))))))
+
+(define (hetzner-machine-server-type machine)
+  "Find the server type of MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-server-type config)))
+    (find (lambda (server-type)
+            (equal? expected (hetzner-server-type-name server-type)))
+          (hetzner-api-server-types
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,expected))))))
+
+(define (hetzner-machine-validate-api-token machine)
+  "Validate the Hetzner API authentication token of MACHINE."
+  (let* ((config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (unless (hetzner-api-token api)
+      (raise-exception
+       (formatted-message
+        (G_ "Hetzner Cloud access token was not provided. \
+This may be fixed by setting the environment variable GUIX_HETZNER_API_TOKEN \
+to one procured from \
+https://docs.hetzner.com/cloud/api/getting-started/generating-api-token"))))))
+
+(define (hetzner-machine-validate-configuration-type machine)
+  "Raise an error if MACHINE's configuration is not an instance of
+<hetzner-configuration>."
+  (let ((config (machine-configuration machine))
+        (environment (environment-type-name (machine-environment machine))))
+    (unless (and config (hetzner-configuration? config))
+      (raise-exception
+       (formatted-message (G_ "unsupported machine configuration '~a' \
+for environment of type '~a'")
+                          config
+                          environment)))))
+
+(define (hetzner-machine-validate-server-type machine)
+  "Raise an error if the server type of MACHINE is not supported."
+  (unless (hetzner-machine-server-type machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise-exception
+       (formatted-message
+        (G_ "server type '~a' not supported~%~%\
+Available server types:~%~%~a~%~%For more details and prices, see: ~a")
+        (hetzner-configuration-server-type config)
+        (string-join
+         (map (lambda (type)
+                (format #f " - ~a: ~a, ~a ~a cores, ~a GB mem, ~a GB disk"
+                        (colorize-string
+                         (hetzner-server-type-name type)
+                         (color BOLD))
+                        (hetzner-server-type-architecture type)
+                        (hetzner-server-type-cores type)
+                        (hetzner-server-type-cpu-type type)
+                        (hetzner-server-type-memory type)
+                        (hetzner-server-type-disk type)))
+              (hetzner-api-server-types api))
+         "\n")
+        "https://www.hetzner.com/cloud#pricing")))))
+
+(define (hetzner-machine-validate-location machine)
+  "Raise an error if the location of MACHINE is not supported."
+  (unless (hetzner-machine-location machine)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config)))
+      (raise-exception
+       (formatted-message
+        (G_ "server location '~a' not supported~%~%\
+Available locations:~%~%~a~%~%For more details, see: ~a")
+        (hetzner-configuration-location config)
+        (string-join
+         (map (lambda (location)
+                (format #f " - ~a: ~a, ~a"
+                        (colorize-string
+                         (hetzner-location-name location)
+                         (color BOLD))
+                        (hetzner-location-description location)
+                        (hetzner-location-country location)))
+              (hetzner-api-locations api))
+         "\n")
+        "https://www.hetzner.com/cloud#locations")))))
+
+(define (hetzner-machine-validate machine)
+  "Validate the Hetzner MACHINE."
+  (hetzner-machine-validate-configuration-type machine)
+  (hetzner-machine-validate-api-token machine)
+  (hetzner-machine-validate-location machine)
+  (hetzner-machine-validate-server-type machine))
+
+(define (hetzner-machine-bootstrap-os-form machine server)
+  "Return the form to bootstrap an operating system on SERVER."
+  (let* ((os (machine-operating-system machine))
+         (system (hetzner-server-system server))
+         (arm? (equal? "arm" (hetzner-server-architecture server)))
+         (x86? (equal? "x86" (hetzner-server-architecture server)))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    `(operating-system
+       (host-name ,(operating-system-host-name os))
+       (timezone "Etc/UTC")
+       (bootloader (bootloader-configuration
+                    (bootloader ,(cond (arm? 'grub-efi-bootloader)
+                                       (x86? 'grub-bootloader)))
+                    (targets ,(cond (arm? '(list "/boot/efi"))
+                                    (x86? '(list "/dev/sda"))))
+                    (terminal-outputs '(console))))
+       (initrd-modules (append
+                        ,(cond (arm? '(list "sd_mod" "virtio_scsi"))
+                               (x86? '(list "virtio_scsi")))
+                        %base-initrd-modules))
+       (file-systems ,(cond
+                       (arm? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     (file-system
+                                       (mount-point "/boot/efi")
+                                       (device "/dev/sda15")
+                                       (type "vfat"))
+                                     %base-file-systems))
+                       (x86? `(cons* (file-system
+                                       (mount-point "/")
+                                       (device "/dev/sda1")
+                                       (type ,root-fs-type))
+                                     %base-file-systems))))
+       (services
+        (cons* (service dhcp-client-service-type)
+               (service openssh-service-type
+                        (openssh-configuration
+                         (openssh openssh-sans-x)
+                         (permit-root-login 'prohibit-password)))
+               %base-services)))))
+
+(define (rexec-verbose session cmd)
+  "Execute a command CMD on the remote side and print output.  Return two
+values: list of output lines returned by CMD and its exit code."
+  (let* ((channel (open-remote-input-pipe session cmd))
+         (result  (let loop ((line   (read-line channel))
+                             (result '()))
+                    (if (eof-object? line)
+                        (reverse result)
+                        (begin
+                          (display line)
+                          (newline)
+                          (loop (read-line channel)
+                                (cons line result))))))
+         (exit-status (channel-get-exit-status channel)))
+    (close channel)
+    (values result exit-status)))
+
+(define (hetzner-machine-ssh-key machine)
+  "Find the SSH key for MACHINE on the Hetzner API."
+  (let* ((config (machine-configuration machine))
+         (expected (hetzner-configuration-ssh-key-fingerprint config)))
+    (find (lambda (ssh-key)
+            (equal? expected (hetzner-ssh-key-fingerprint ssh-key)))
+          (hetzner-api-ssh-keys
+           (hetzner-configuration-api config)
+           #:params `(("fingerprint" . ,expected))))))
+
+(define (hetzner-machine-ssh-key-create machine)
+  "Create the SSH key for MACHINE on the Hetzner API."
+  (let ((name (machine-display-name machine)))
+    (format #t "creating ssh key for '~a'...\n" name)
+    (let* ((config (machine-configuration machine))
+           (api (hetzner-configuration-api config))
+           (ssh-key (hetzner-api-ssh-key-create
+                     (hetzner-configuration-api config)
+                     (hetzner-configuration-ssh-key-fingerprint config)
+                     (hetzner-configuration-ssh-key-public config)
+                     #:labels (hetzner-configuration-labels config))))
+      (format #t "successfully created ssh key for '~a'\n" name)
+      ssh-key)))
+
+(define (hetzner-machine-server machine)
+  "Find the Hetzner server for MACHINE."
+  (let ((config (machine-configuration machine)))
+    (find (lambda (server)
+            (equal? (machine-display-name machine)
+                    (hetzner-server-name server)))
+          (hetzner-api-servers
+           (hetzner-configuration-api config)
+           #:params `(("name" . ,(machine-display-name machine)))))))
+
+(define (hetzner-machine-create-server machine)
+  "Create the Hetzner server for MACHINE."
+  (let* ((config (machine-configuration machine))
+         (name (machine-display-name machine))
+         (server-type (hetzner-configuration-server-type config)))
+    (format #t "creating '~a' server for '~a'...\n" server-type name)
+    (let* ((ssh-key (hetzner-machine-ssh-key machine))
+           (api (hetzner-configuration-api config))
+           (server (hetzner-api-server-create
+                    api
+                    (machine-display-name machine)
+                    (list ssh-key)
+                    #:labels (hetzner-configuration-labels config)
+                    #:location (hetzner-configuration-location config)
+                    #:server-type (hetzner-configuration-server-type config)))
+           (architecture (hetzner-server-architecture server)))
+      (format #t "successfully created '~a' ~a server for '~a'\n"
+              server-type architecture name)
+      server)))
+
+(define (wait-for-ssh address ssh-key)
+  "Block until a SSH session can be made as 'root' with SSH-KEY at ADDRESS."
+  (format #t "connecting via SSH to '~a' using '~a'...\n" address ssh-key)
+  (let loop ()
+    (catch #t
+      (lambda ()
+        (open-ssh-session address #:user "root" #:identity ssh-key
+                          #:strict-host-key-check? #f))
+      (lambda args
+        (let ((msg (cadr args)))
+          (if (formatted-message? msg)
+              (format #t "~a\n"
+                      (string-trim-right
+                       (apply format #f
+                              (formatted-message-string msg)
+                              (formatted-message-arguments msg))
+                       #\newline))
+              (format #t "~a" args))
+          (sleep 5)
+          (loop))))))
+
+(define (hetzner-machine-wait-for-ssh machine server)
+  "Wait for SSH connection to be established with the specified machine."
+  (wait-for-ssh (hetzner-server-public-ipv4 server)
+                (hetzner-configuration-ssh-key
+                 (machine-configuration machine))))
+
+(define (hetzner-machine-authenticate-host machine server)
+  "Add the host key of MACHINE to the list of known hosts."
+  (let ((ssh-session (hetzner-machine-wait-for-ssh machine server)))
+    (write-known-host! ssh-session)))
+
+(define (hetzner-machine-enable-rescue-system machine server)
+  "Enable the rescue system on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config))
+         (ssh-keys (list (hetzner-machine-ssh-key machine))))
+    (format #t "enabling rescue system on '~a'...\n" name)
+    (let ((action (hetzner-api-server-enable-rescue-system api server ssh-keys)))
+      (format #t "successfully enabled rescue system on '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-power-on machine server)
+  "Power on the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "powering on server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-power-on api server)))
+      (format #t "successfully powered on server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-ssh-run-script ssh-session name content)
+  (let ((sftp-session (make-sftp-session ssh-session)))
+    (rexec ssh-session (format #f "rm -f ~a" name))
+    (rexec ssh-session (format #f "mkdir -p ~a" (dirname name)))
+    (call-with-remote-output-file
+     sftp-session name
+     (lambda (port)
+       (display content port)))
+    (sftp-chmod sftp-session name 755)
+    (let ((lines exit-code (rexec-verbose ssh-session
+                                          (format #f "~a 2>&1" name))))
+      (if (zero? exit-code)
+          lines
+          (raise-exception
+           (formatted-message
+            (G_ "failed to run script '~a' on machine, exit code: '~a'")
+            name exit-code))))))
+
+;; Prevent compiler from inlining this function, so we can mock it in tests.
+(set! hetzner-machine-ssh-run-script hetzner-machine-ssh-run-script)
+
+(define (hetzner-machine-rescue-install-os machine ssh-session server)
+  (let ((name (machine-display-name machine))
+        (os (hetzner-machine-bootstrap-os-form machine server)))
+    (format #t "installing guix operating system on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-os"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+mount /dev/sda1 /mnt
+mkdir -p /mnt/boot/efi
+mount /dev/sda15 /mnt/boot/efi
+
+mkdir --parents /mnt/root/.ssh
+chmod 700 /mnt/root/.ssh
+cp /root/.ssh/authorized_keys /mnt/root/.ssh/authorized_keys
+chmod 600 /mnt/root/.ssh/authorized_keys
+
+cat > /tmp/guix/deploy/hetzner-os.scm << EOF
+(use-modules (gnu) (guix utils))
+(use-package-modules ssh)
+(use-service-modules base networking ssh)
+(use-system-modules linux-initrd)
+~a
+EOF
+guix system init --verbosity=2 /tmp/guix/deploy/hetzner-os.scm /mnt"
+             (escape-backticks (format #f "~y" os))))
+    (format #t "successfully installed guix operating system on '~a'\n" name)))
+
+(define (hetzner-machine-reboot machine server)
+  "Reboot the Hetzner SERVER for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "rebooting server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-reboot api server)))
+      (format #t "successfully rebooted server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-rescue-partition machine ssh-session)
+  "Setup the partitions of the Hetzner server for MACHINE using SSH-SESSION."
+  (let* ((name (machine-display-name machine))
+         (os (machine-operating-system machine))
+         (root-fs-type (operating-system-root-file-system-type os)))
+    (format #t "setting up partitions on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-partition"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+growpart /dev/sda 1 || true
+~a
+fdisk -l /dev/sda"
+             (cond
+              ((equal? "btrfs" root-fs-type)
+               (format #f "mkfs.btrfs -L ~a -f /dev/sda1" root-label))
+              ((equal? "ext4" root-fs-type)
+               (format #f "mkfs.ext4 -L ~a -F /dev/sda1" root-label))
+              (else (raise-exception
+                     (formatted-message
+                      (G_ "unsupported root file system type '~a'")
+                      root-fs-type))))))
+    (format #t "successfully setup partitions on '~a'\n" name)))
+
+(define (hetzner-machine-rescue-install-packages machine ssh-session)
+  "Install packages on the Hetzner server for MACHINE using SSH-SESSION."
+  (let ((name (machine-display-name machine)))
+    (format #t "installing rescue system packages on '~a'...\n" name)
+    (hetzner-machine-ssh-run-script
+     ssh-session "/tmp/guix/deploy/hetzner-machine-rescue-install-packages"
+     (format #f "#!/usr/bin/env bash
+set -eo pipefail
+apt-get update
+apt-get install guix cloud-initramfs-growroot --assume-yes"))
+    (format #t "successfully installed rescue system packages on '~a'\n" name)))
+
+(define (hetzner-machine-delete machine server)
+  "Delete the Hetzner server for MACHINE."
+  (let* ((name (machine-display-name machine))
+         (config (machine-configuration machine))
+         (api (hetzner-configuration-api config)))
+    (format #t "deleting server for '~a'...\n" name)
+    (let ((action (hetzner-api-server-delete api server)))
+      (format #t "successfully deleted server for '~a'\n" name)
+      action)))
+
+(define (hetzner-machine-provision machine)
+  "Provision a server for MACHINE on the Hetzner Cloud service."
+  (with-exception-handler
+      (lambda (exception)
+        (let ((config (machine-configuration machine))
+              (server (hetzner-machine-server machine)))
+          (when (and server (hetzner-configuration-delete? config))
+            (hetzner-machine-delete machine server))
+          (raise-exception exception)))
+    (lambda ()
+      (let ((server (hetzner-machine-create-server machine)))
+        (hetzner-machine-enable-rescue-system machine server)
+        (hetzner-machine-power-on machine server)
+        (let ((ssh-session (hetzner-machine-wait-for-ssh machine server)))
+          (hetzner-machine-rescue-install-packages machine ssh-session)
+          (hetzner-machine-rescue-partition machine ssh-session)
+          (hetzner-machine-rescue-install-os machine ssh-session server)
+          (hetzner-machine-reboot machine server)
+          (sleep 5)
+          (hetzner-machine-authenticate-host machine server)
+          server)))
+    #:unwind? #t))
+
+(define (machine-not-provisioned machine)
+  (formatted-message
+   (G_ "no server provisioned for machine '~a' on the Hetzner Cloud service")
+   (machine-display-name machine)))
+
+
+;;;
+;;; Remote evaluation.
+;;;
+
+(define (hetzner-remote-eval machine exp)
+  "Internal implementation of 'machine-remote-eval' for MACHINE instances with
+an environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (let ((server (hetzner-machine-server machine)))
+    (unless server (raise-exception (machine-not-provisioned machine)))
+    (machine-remote-eval (hetzner-machine-delegate machine server) exp)))
+
+
+
+;;;
+;;; System deployment.
+;;;
+
+(define (deploy-hetzner machine)
+  "Internal implementation of 'deploy-machine' for 'machine' instances with an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (unless (hetzner-machine-ssh-key machine)
+    (hetzner-machine-ssh-key-create machine))
+  (let ((server (or (hetzner-machine-server machine)
+                    (hetzner-machine-provision machine))))
+    (deploy-machine (hetzner-machine-delegate machine server))))
+
+
+
+;;;
+;;; Roll-back.
+;;;
+
+(define (roll-back-hetzner machine)
+  "Internal implementation of 'roll-back-machine' for MACHINE instances with an
+environment type of 'hetzner-environment-type'."
+  (hetzner-machine-validate machine)
+  (let ((server (hetzner-machine-server machine)))
+    (unless server (raise-exception (machine-not-provisioned machine)))
+    (roll-back-machine (hetzner-machine-delegate machine server))))
+
+
+
+;;;
+;;; Environment type.
+;;;
+
+(define hetzner-environment-type
+  (environment-type
+   (machine-remote-eval hetzner-remote-eval)
+   (deploy-machine deploy-hetzner)
+   (roll-back-machine roll-back-hetzner)
+   (name 'hetzner-environment-type)
+   (description "Provisioning of virtual machine servers on the Hetzner Cloud
+service.")))
diff --git a/gnu/machine/hetzner/http.scm b/gnu/machine/hetzner/http.scm
new file mode 100644
index 0000000000..bfd6555472
--- /dev/null
+++ b/gnu/machine/hetzner/http.scm
@@ -0,0 +1,664 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Roman Scherer <roman@HIDDEN>
+;;;
+;;; 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))
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index e37da506fc..d68fad4e8c 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -81,6 +81,8 @@ gnu/installer/steps.scm
 gnu/installer/timezone.scm
 gnu/installer/user.scm
 gnu/installer/utils.scm
+gnu/machine/hetzner.scm
+gnu/machine/hetzner/http.scm
 gnu/machine/ssh.scm
 gnu/packages/bootstrap.scm
 guix/build/utils.scm
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@HIDDEN>
+;;;
+;;; 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@HIDDEN>
+;;;
+;;; 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@HIDDEN"
+   "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@HIDDEN")
+    ("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:
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 04 Feb 2025 19:12:01 +0000
Resent-Message-ID: <handler.75144.B75144.173869626724830 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173869626724830
          (code B ref 75144); Tue, 04 Feb 2025 19:12:01 +0000
Received: (at 75144) by debbugs.gnu.org; 4 Feb 2025 19:11:07 +0000
Received: from localhost ([127.0.0.1]:46701 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tfOKB-0006SN-7J
	for submit <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:11:07 -0500
Received: from mail-ed1-x533.google.com ([2a00:1450:4864:20::533]:59441)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tfOK7-0006Rp-K7
 for 75144 <at> debbugs.gnu.org; Tue, 04 Feb 2025 14:11:04 -0500
Received: by mail-ed1-x533.google.com with SMTP id
 4fb4d7f45d1cf-5d3bbb0f09dso10551152a12.2
 for <75144 <at> debbugs.gnu.org>; Tue, 04 Feb 2025 11:11:03 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738696257;
 x=1739301057; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:in-reply-to:subject:cc:to:from:from:to
 :cc:subject:date:message-id:reply-to;
 bh=1MfTB97zcOP1ko1WtoM2im+erAO/nfK9MgHNWNdKtFw=;
 b=E58zRZMQudiGfPBM1P+jKMv6cRSwsDLDUgu85fzdEHa2r0Igq1Iyb77X4iME2kEsNa
 rwKGT0RyI3bjfSY9lxfBwcd5oEiGK3gsw2qOUwD0zfMNtxxcZhdYdxN4sLhcurh00Zqd
 0w1t1O47XBI4weTvl4F+JTwreCCePEuequxr4kIY+R98DdUGJieMzyj9mFaQSUJ2puJp
 7CFK+T9a5iXjbxkAQQYTZ+Zsi1PvSPQuBmStwD2RJEjTQ7HKiegkPk6Vm56qwFfPSWT7
 hO10VSurig/r8OSBYH9/uESR3M0La2xw45hKqBZL/Vo2Jq+bZQay1k/1mFNfr0Zv/yVW
 S1Sg==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738696257; x=1739301057;
 h=mime-version:message-id:date:in-reply-to:subject:cc:to:from
 :x-gm-message-state:from:to:cc:subject:date:message-id:reply-to;
 bh=1MfTB97zcOP1ko1WtoM2im+erAO/nfK9MgHNWNdKtFw=;
 b=OYsEqoc2layxMuKR74Al3CabILaTDHEyJ6jI9nRZ2zXv/F6oFKF/n2Wm5GaHngeoOT
 HDe7MrAc3LwHi50ygewNubbwGZpgDVH8FJhqHntaZfYH7vAE4V78Zf0IHaNOqDxzT/ex
 p3DxGUBFCAwVHyvYyAT3LZduXCFjPQykLqV5Cej4j5R3/MM6H6utrr+8I/HKTWeV6rs+
 8tE/pX4ktnRo8CEIlSl9F5a/sZm4yuiOO8PmVH4dwehjQF1J7BM1fq/SyN3AVrzfAsEc
 pFYLOHPV9VnyDdQShiXxZi8hCm60Q3aIxlPG4KTG/U2qV6waZKg1Mz5iDI9efb6N5CyW
 m/sQ==
X-Forwarded-Encrypted: i=1;
 AJvYcCWG/KK4R3NoKdQOMRnN2itwMxGwFElS13FaeNaDKg5+2JsOmu5+U9yq4seQRVoKWrUFEhg5XA==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YyZwIH8mhLuUZ/xSYRXVoVLuy5vZGSQjRLpS2AoQbGerwAUnC7M
 1hoMgzCy/K6cUO5dcQX9ciVoH4ouvXJKa3b/o3YgdDzUMYZ24CdEhG1ti4bjRQ8=
X-Gm-Gg: ASbGncuKWhuJmUnqYobyw4x/6Mob/EtoMr5LvWs7KZNV5M+cLQgwhVkdTgZ5D2VlHoW
 av8o9ghJnz07nI+P2fk3Fbw4ov7mQud75p9K+QDWKOmJmWeZ2JjHU7jqQ7PUCduAHgxUv/giP3c
 TP0fjt0KhYTSGsKFtpONUYr1961ymzX8Yz1/VbcFx44PC8kw8nUpP+7xA7C1oAVNm60pOCbz/PQ
 pLwg5+4LHHpGY/bbmUWmTM+8u8Vn/idBBlSszC6Pj5qTN6PwmdT5xxOrh3Gaa0sHrKF/H9ImEPG
 KLKXGuC4SMkc15Goyo6K16uHZpOvhSiyqsn3oti7qw==
X-Google-Smtp-Source: AGHT+IHzEBtGrhyBerTgs8R+vJZYeypxbarUsnUN2knTQ8XSRAXQ1irHpdokDc7wNendtLyx9ymeyA==
X-Received: by 2002:a05:6402:358e:b0:5d0:cfdd:2ac1 with SMTP id
 4fb4d7f45d1cf-5dcdb6ff652mr237639a12.6.1738696256784; 
 Tue, 04 Feb 2025 11:10:56 -0800 (PST)
Received: from m1 (tmo-086-39.customers.d1-online.com. [80.187.86.39])
 by smtp.gmail.com with ESMTPSA id
 4fb4d7f45d1cf-5dc72405845sm10212332a12.44.2025.02.04.11.10.55
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 04 Feb 2025 11:10:56 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <867c6e90ei.fsf@HIDDEN> (Roman Scherer's message of
 "Tue, 28 Jan 2025 20:57:41 +0100")
Date: Tue, 04 Feb 2025 20:10:53 +0100
Message-ID: <865xlph6f6.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable

References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@=
burningswell.com>
	<8734hi1mdh.fsf@HIDDEN> <868qr6n3j9.fsf@HIDDEN>
	<87ed0rt3oz.fsf@HIDDEN> <87o6zt5bjs.fsf@HIDDEN>
	<87tt9je0sr.fsf@HIDDEN> <87y0yvdxej.fsf@HIDDEN>
	<867c6e90ei.fsf@HIDDEN>
User-Agent: mu4e 1.12.8; emacs 29.4
Hi Ludo,

I just sent v3 of the patch series in which I added test. There are now unit
and integration tests. You can run them with:

./pre-inst-env make check TESTS=3D"tests/machine/hetzner/http.scm"
./pre-inst-env make check TESTS=3D"tests/machine/hetzner.scm"

The integration tests require network access and the GUIX_HETZNER_API_TOKEN
environment variable to be set, otherwise they are skipped.

Can you have another look please?

And Christopher Baines, since Ludo mentioned you have a Hetzner account, wo=
uld
you be interested in trying this out and provide some feedback?

Things to improve another day:

=2D Get Hetzner to add a Guix image to their collectin of supported images.=
 That
would remove the need for using the rescue system to install an initial Gui=
x system.

=2D Installing the initial Guix system via the rescue system is kind of slow
(especially if there are no substituyes), and done in sequence. I'm not sure
how this could be parallelized with how things are invoke by guix deploy.

Roman

Date: Tue, 04 Feb 2025 20:10:53 +0100

Roman Scherer <roman@HIDDEN> writes:

> Hi Ludo,
>
> that's what I was looking for. Now it is working as expected!
>
> I will send an updated patch soon.
>
> Thanks for your help!
>
> Roman
>
> Ludovic Court=C3=A8s <ludo@HIDDEN> writes:
>
>> Hi,
>>
>> Roman Scherer <roman@HIDDEN> skribis:
>>
>>> When I run the mocked test I expect no code from the (gnu machine
>>> hetzner http) module to be executed, since I mocked all those
>>> functions. This seems to work in the Geiser REPL, but for some reason it
>>> does not work when I run the test with:
>>>
>>> ./pre-inst-env make check TESTS=3D"tests/machine/hetzner.scm"
>>>
>>> To me it looks like the mock function behaves differently in those 2
>>> situations. In the meaintime I also tried setting -O0, but that didn't
>>> make any difference either. :/
>>
>> Hmm.  I was going to say that the likely problem is that code from (gnu
>> machines hetzner http) gets inlined so you cannot really mock it.
>>
>> To make sure this can be mocked, you can use this trick:
>>
>>   (set! proc proc)
>>
>> where =E2=80=98proc=E2=80=99 is the procedure you want to mock (that sta=
tement prevents
>> the compiler from inlining it).
>>
>> Ludo=E2=80=99.

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeiZj0XHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZmAPwgAinUdwi4V0EyxDEC/DzYztdlo
mfUA9uPq/pK3eScunl0FJxf7eSXVdGocSlhwpdlc8PI3tSZZDAJO0heZyOYvSz/S
CIbQ1TN1GNip2FchVcr4RuRs2FaNrh7/l+j17HcpXS25siFFSOA3aaR5t0L4mHCT
5NEt40U+igXlXBBIoAuZo0EkF0HGkfwDLp2G0HvcX8WJ2rbm3G97KydyrgV2X+Ms
lNwOABPHC9MR9q3G8nNgZiuJGct0r8qC5L+Z9d6qPYFoLJDsiDxdJqPeMLnSGNvB
1GRCyGw/sKp9l9OwSIH5culqsOXpcmMHBd8docOsHklSHr0hb/V1S6NSx0SqgA==
=yTix
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 07 Feb 2025 12:46:01 +0000
Resent-Message-ID: <handler.75144.B75144.17389323606329 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.17389323606329
          (code B ref 75144); Fri, 07 Feb 2025 12:46:01 +0000
Received: (at 75144) by debbugs.gnu.org; 7 Feb 2025 12:46:00 +0000
Received: from localhost ([127.0.0.1]:33323 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tgNk7-0001e1-TK
	for submit <at> debbugs.gnu.org; Fri, 07 Feb 2025 07:46:00 -0500
Received: from mail-pl1-x629.google.com ([2607:f8b0:4864:20::629]:50324)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <maxim.cournoyer@HIDDEN>)
 id 1tgNk1-0001df-83
 for 75144 <at> debbugs.gnu.org; Fri, 07 Feb 2025 07:45:58 -0500
Received: by mail-pl1-x629.google.com with SMTP id
 d9443c01a7336-21f48ab13d5so25271465ad.0
 for <75144 <at> debbugs.gnu.org>; Fri, 07 Feb 2025 04:45:53 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=gmail.com; s=20230601; t=1738932347; x=1739537147; darn=debbugs.gnu.org;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=fKmhGxS3RvJQ1n4lBCjXRRdqg72aW99Z6xi2WnnfAFU=;
 b=NCwayShleLd9QnQJz1Bt0ubfdGWnCb7yGKd13zMjYWP4kIBAcWTyOsIts1eVMbXJjF
 xT7eesO/1gmnuVvoEgU+n5cnO9vax5vEJg9hZliaHXkQHi7BpkaRYYno0O/kygTmukSz
 4uj5FE8rM4cpBY1CsTTDBN3FPbKf0oZP0kW2/mdoObUPsUHrq3SPy2r51y4Qa9o4W89B
 yK7/7ouE0dXR6Y/h8slwbSgc5mbYLkaC5nJkt/j1m93MKQJFaeZPXDL+Yg6IbxgNh8bm
 MgwtbgYgmbJ1Prq5VCsSnxuHKNeyrPMV8sU2WUCojD16aTGimzcsUsqJO4c7O05UlcXu
 8lrA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738932347; x=1739537147;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=fKmhGxS3RvJQ1n4lBCjXRRdqg72aW99Z6xi2WnnfAFU=;
 b=u0w4G0LRbEQxAWFdAP5A+DvwwmdmWSvZQNMs0etmueX+MfXH13rj99eHxjGW3DNUBr
 2UZ+g9lkvCSzzfxRRiFI392GF4ntYuj6qmzb1pjxqa6VbqZNns5wQonBi0gQAY7Zp10k
 BVCGmSms3M2NLJhe63zCI4ucsPp/rjD/VpfUjDjaFiJUeMNrg+neO3cqZpw+MOQMliGx
 wQqow0xKQLBqM81ZNUzLC6DJUc05uDjHr+ctzUa+bUN9Vv0pQwhM+nNV7gfq8FCkS8lR
 vczZGOYZbZuq8xCudtgAu7e927Gvm151sVzBwuoVfvZzO3/ma7grSjYIp5bqtHDZjkpX
 G71g==
X-Forwarded-Encrypted: i=1;
 AJvYcCUOgxd2kuYHkkk4QiYwj8dI0ibVwdAC/HRGdAK6xDUR8cWFz6dLPj3a9m+b2ugpR5MEAgy2AA==@debbugs.gnu.org
X-Gm-Message-State: AOJu0Yz1MnfOhV17KF7DWhobJKzCvxPUHX9FonCoLOYkgkFbMfG8EkmO
 lVOcRbiWYgcKg4H3GBnXXkXk/9FsycwaMN4/U/+zD9vq5IGLAQLx
X-Gm-Gg: ASbGncugSRozhdWsjNcSghBvQdRzOCQUdmWuTSV5gTP1Ryx9nJi9vKgrnCL2EwcoLtl
 t8HNJNczVtTlOOeBNVw+khMLaLi1YczTixOVXb4PbqePQxIXp2R86KnadKvqBg28WOfUHVgl5nn
 qbRcko7Nznj1xta42SrR6TJ9dXDIW885dG2Fht78uvpasVNluWKsfWVTll+scrCxuRC9oj869Ki
 TNNEMn8Tno+o0bQ4xDpklXJtQJCMdoQ/J1PisjIWmfo7cg7mF8lBLEc8oGkq1ChWkhTvqcluILy
 jvTub2hQKM6p
X-Google-Smtp-Source: AGHT+IEIhO+Aupv7SUx4Djv8NgICUZ1Lbi8R3+GmAagL1sR68d2RWDXiY5eMqQsHZB5gFIUy26+dkQ==
X-Received: by 2002:a17:902:c40f:b0:216:53fa:634f with SMTP id
 d9443c01a7336-21f4e7a1270mr55557835ad.48.1738932347014; 
 Fri, 07 Feb 2025 04:45:47 -0800 (PST)
Received: from terra ([2405:6586:be0:0:c8ff:1707:9b9:af89])
 by smtp.gmail.com with ESMTPSA id
 41be03b00d2f7-ad51aee5ca8sm2555244a12.43.2025.02.07.04.45.44
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Fri, 07 Feb 2025 04:45:46 -0800 (PST)
From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
In-Reply-To: <865xlph6f6.fsf@HIDDEN> (Roman Scherer's message of
 "Tue, 04 Feb 2025 20:10:53 +0100")
References: <865xlph6f6.fsf@HIDDEN>
Date: Fri, 07 Feb 2025 21:45:33 +0900
Message-ID: <87y0yh53f6.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Hi Roman,

Roman Scherer <roman@HIDDEN> writes:

[...]

> Things to improve another day:
>
> - Get Hetzner to add a Guix image to their collectin of supported images. That
> would remove the need for using the rescue system to install an initial Guix system.
>
> - Installing the initial Guix system via the rescue system is kind of slow
> (especially if there are no substituyes), and done in sequence. I'm not sure
> how this could be parallelized with how things are invoke by guix deploy.

Forgive my ignorance, but I thought the idea of a deploy <machine>
environment type was to allow fully provisioning the OS via the service
API?

I haven't reviewed the change yet; perhaps you mean that currently such
provision must happen by going through the rescue system path (but is
still automated by this new environment type?)

-- 
Thanks,
Maxim

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 07 Feb 2025 13:01:02 +0000
Resent-Message-ID: <handler.75144.B75144.17389332549218 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.17389332549218
          (code B ref 75144); Fri, 07 Feb 2025 13:01:02 +0000
Received: (at 75144) by debbugs.gnu.org; 7 Feb 2025 13:00:54 +0000
Received: from localhost ([127.0.0.1]:33378 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tgNyY-0002Oa-1U
	for submit <at> debbugs.gnu.org; Fri, 07 Feb 2025 08:00:54 -0500
Received: from mail-ej1-x633.google.com ([2a00:1450:4864:20::633]:47411)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tgNyS-0002OF-1p
 for 75144 <at> debbugs.gnu.org; Fri, 07 Feb 2025 08:00:52 -0500
Received: by mail-ej1-x633.google.com with SMTP id
 a640c23a62f3a-aaf900cc7fbso362563066b.3
 for <75144 <at> debbugs.gnu.org>; Fri, 07 Feb 2025 05:00:48 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738933242;
 x=1739538042; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=TTgniUYqpL8KHxx5YnhMO+DIX27WaDtLZkFRg0fbIHE=;
 b=bNCN4GQXKgbyIk0EYgvZuUM8+uENw3C3wWKcZoGtFPRrSfeeA1Y8Ld+ErGyM8RwE5Y
 gLEhwLaHt/XVAi1eHigMDAk2uWMdQeWqmlza3Q5YxMGgVaru3k3+NFexivSjgOqGnTUJ
 59HFZzLcjccqmz7aw/RpVI07BmIrLx7JC/O2yZ3yWIj5D24YUGdPJhWXwXPD164WfdVJ
 CdcrPX2sdU0pbS6zWpYqHFXLJMFpiTQ+6KqKzuWw/N60J7JwbKrJXWAzBUO91ttSqxUU
 L2YZv3dc27+r9lbNYGAFJoWsk9RiZZZxF5pRlh5aytPRcQW8al5k1p3QLCYr5KF1XQjV
 blFg==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738933242; x=1739538042;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=TTgniUYqpL8KHxx5YnhMO+DIX27WaDtLZkFRg0fbIHE=;
 b=AMjNKuuR/t/lwzuSHznaYHZG9F7wuyz7KMPcPSMU25BTcwYy8oplLyM8IuU4WVCT7Z
 eqfz4xvvoH42cN1dgHpyl767LOEl5dTKaehTqVZdpyjzwfsRhFVCAGuUb83xNISdxDN6
 huSNKBBfzB+iB3MKWhoENyGSsAMqslzL5hR/Bzb9H7KYrdb/73obhrXVe1dFXLCeOOAJ
 ey9rFdsZ3NSVO1H7CCFzKHKE+8BOh0ofuc6pGHSn8ppaXKA0krTrOhL6xYU/wcT58idE
 yVwH/7W4azmkl643DFfomdqOUd/XoGheg/mPY9CP2WmON1Vm+HVYozgHqep1wyPtnMsB
 n+xQ==
X-Forwarded-Encrypted: i=1;
 AJvYcCWb5+etAabwuhbO6FZzra7KjkvFOFZxQFqFkdr1edJhXUsnRb0Ix+URyCxas8yqe+stJEPGYg==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YwTkxxPrnvXHHeY8HRlcK5D3uskk5uzWmT+/Jx2KTMgCmKfj7TC
 /8wF/QT+i4Iz1Gz+xUGZKt0YZ6niy/3AAb4ZEFsGfB7fYq92xElhZz9UHGIEzjE=
X-Gm-Gg: ASbGncubeT4RGjJOWVnn6X79bFQ18FRdb7TA07TsWTdx54Rh5J4Cb6Tmtr2r58iLt22
 NZSfAHpn5OoAEGkD4EwPB9bxlT0S+HHq7vGdU71jjT7sOzfhuISJUXE5fKy2SeI7hC0YIFGn6z3
 OfsFX+JlG3I0FFd/ewn8mGI5rn8pAp3ttuUarY18o5ZdSUEuMzPp3ucfanBK7Mgvl64cAKja9v1
 YoZ7BYHEdlq9nvi9/H13fMZhusQApCwPO6okpybnhVH/w1ujLQGZj8wirSRYV21tOut+HwJKkUW
 ZKUAXl2X
X-Google-Smtp-Source: AGHT+IGzuU6qfjFQ1ZE/QqzJK688o8j4cYUj79Kg9b73i0+WzRpgQPAaj47Cr2y+mx/nHNTk7bJxhQ==
X-Received: by 2002:a17:907:3fa5:b0:aa5:44a8:9ae7 with SMTP id
 a640c23a62f3a-ab789c2c397mr330329566b.47.1738933240679; 
 Fri, 07 Feb 2025 05:00:40 -0800 (PST)
Received: from m1 ([2a01:599:10d:7ee7:5e17:268a:67a8:fb5e])
 by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab786ece062sm141527866b.123.2025.02.07.05.00.39
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Fri, 07 Feb 2025 05:00:39 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <87y0yh53f6.fsf@HIDDEN> (Maxim Cournoyer's message of "Fri, 07
 Feb 2025 21:45:33 +0900")
References: <865xlph6f6.fsf@HIDDEN> <87y0yh53f6.fsf@HIDDEN>
User-Agent: mu4e 1.12.8; emacs 30.0.92
Date: Fri, 07 Feb 2025 14:00:37 +0100
Message-ID: <86y0yh6hai.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain


Hi Maxim,

yes, it is fully automated. What happens is:

- a server is provisioned through the Hetzner API
- the the server is booted into the rescue system via the API
- partitions are setup in the rescue system (enlarged)
- a minimal Guix system is installed
- then the server re-booted, starting the minimal Guix system
- then the machine-ssh-environment takes over and applies the final system configuration
- this all is done once, when the server is initially provisioned

Previsouly I tried the guix-infect.sh approach that installs a Guix
system on top of a debian/ubuntu image, but I found this was very
brittle (issues with dns when you remove /etc, etc.). From my experience
working with this I found the approach with the rescue system both more
reliable and faster.

Does this mnake sense?

Roman

Maxim Cournoyer <maxim.cournoyer@HIDDEN> writes:

> Hi Roman,
>
> Roman Scherer <roman@HIDDEN> writes:
>
> [...]
>
>> Things to improve another day:
>>
>> - Get Hetzner to add a Guix image to their collectin of supported images. That
>> would remove the need for using the rescue system to install an initial Guix system.
>>
>> - Installing the initial Guix system via the rescue system is kind of slow
>> (especially if there are no substituyes), and done in sequence. I'm not sure
>> how this could be parallelized with how things are invoke by guix deploy.
>
> Forgive my ignorance, but I thought the idea of a deploy <machine>
> environment type was to allow fully provisioning the OS via the service
> API?
>
> I haven't reviewed the change yet; perhaps you mean that currently such
> provision must happen by going through the rescue system path (but is
> still automated by this new environment type?)

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmemA/UXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZnwhggAiGxyuPWgucR2wbEqM7js7hnw
FxcSfVhWhwxo0pfXHOlNnz2EapFTed832Fk3++ivTcfegiFwFoV+mNI7ab6WCXdf
TMTfhvJa7w7mQWtsfK3t+RevYCBbjpWZBm9lXsTRiy/Xm2/7NStOfZACjmjgdxy7
tRwHWrlOt+Dh5TVhxvrCGWaru9dNqDotNNqlkdEkkkbtriV4UI09pLA6DlBzJMCq
sEjeVpkpmDEFtT1olv8mNFva0nHhHCtJVaPzpgBof7/Gx2a0GqodOi5xCz9bd4mq
qKpMaAivVYsqACjrelQirW4OmmsCZKFL/osWBcnlL9Ptz56FIavqxIlxSXn9nQ==
=hJn2
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 07 Feb 2025 14:09:01 +0000
Resent-Message-ID: <handler.75144.B75144.1738937318636 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.1738937318636
          (code B ref 75144); Fri, 07 Feb 2025 14:09:01 +0000
Received: (at 75144) by debbugs.gnu.org; 7 Feb 2025 14:08:38 +0000
Received: from localhost ([127.0.0.1]:33531 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tgP26-0000AB-16
	for submit <at> debbugs.gnu.org; Fri, 07 Feb 2025 09:08:38 -0500
Received: from mail-pl1-x62f.google.com ([2607:f8b0:4864:20::62f]:52332)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <maxim.cournoyer@HIDDEN>)
 id 1tgP20-00009i-9F
 for 75144 <at> debbugs.gnu.org; Fri, 07 Feb 2025 09:08:36 -0500
Received: by mail-pl1-x62f.google.com with SMTP id
 d9443c01a7336-21f49bd087cso20795575ad.0
 for <75144 <at> debbugs.gnu.org>; Fri, 07 Feb 2025 06:08:32 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=gmail.com; s=20230601; t=1738937306; x=1739542106; darn=debbugs.gnu.org;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=dCB04YaP8DaDYx6a6eB79a17GlLPm2i1D8j4zp0/1aw=;
 b=MLJYlY35s4h4BmabHi3MSmXaKqNLfD8+yxwkx33ytG2zC5OnMGgkFdXuTkwklokJgR
 i63QI3T/a8vByMI9uTDHvtYvswlWY0JjZsSSJRlueXYoHoBg63dfbMSaSmFA/2LQd0ZF
 3I1ubPPv7uuf7jEwx1fEyqOzI0bXxQ375Q9dgbgykXZuEt6F3DHpv7kD1w8soZjqbMbx
 kpdP7cakQrh48EtSjOxj7eW4StXzGPDm0xMEzAk5VcB+yo8Em28jwf19+CIK3oW6uWDV
 9Fnwa/+YoaUIEY5rwcWOQnBzV4zsK/1cLvRS+1cz3tMVbHv4/5roww892vBswhU8yr+8
 jVOw==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738937306; x=1739542106;
 h=mime-version:user-agent:message-id:date:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=dCB04YaP8DaDYx6a6eB79a17GlLPm2i1D8j4zp0/1aw=;
 b=VR45bNWNEtu4UM2jQaf/SmzTkNGVSMQz9rhri7gjrbU5bWJHVCNwzkid5nlpftpr72
 aNTEe2aIaUe9TzDbzaPbSh8W7ks9iZlpZNRRNHHPFai+P2PSVhAb3EVoKvrRXT4RxYZz
 vN6TahF4tX09VG4Pp6DGH6Kw5ZUuu82GwSEWme0bI7wJ/fUn1BAKOZPY+a+ulFazOtQb
 Pja9Ocwa5XQ0ogLM4Hvlok/3oNSuIA+1K72GSk8hEeTShvwfcZ+OUpmMqCwrJboVCU1d
 zWLCF902zxccFwQ1ZlyduPH7vqYnIHN3aL5cRcs/ktgZe7Fz5uEglv1Y64BsJY7LFhhT
 Hkvw==
X-Forwarded-Encrypted: i=1;
 AJvYcCVN0Ja3Nw+BIxbBM4C0Msq5RlZf+4x4MPAlVk1rsI97lsSSkK0hQx8Hrm+5N0VTo+1cvLdbKw==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YzEY3PuoujrdSFu6xvrv2CVxJK8Ygbh8iM55Anl+VqAxNGqnSJm
 UH3q7zeY1Gg7VdCkrlcIgVToAYaHD6jodMUIOwq0lDd/M0IyGpYt
X-Gm-Gg: ASbGncuLEYZ7rgE49RX4mPdGJyqXwbsk3diE9oT0X7ww8+3bQUeEEgf67O3NxWYpG0F
 CGM04A/Qb3qmIBkrUCWdxqhIQqLOeMxiQNWCZ10/HJLI3jqp0NKeXNu6W/9OpzqZ/hRqyZllvHB
 xDFHPSgPsQ7zHLrqgXSESsyDm4qTPgW80K3zm+8+c2m6ZV+c85MdpNssz8qzRVsyb11Vbc4Ka5v
 Kfu4fct6YwEb604dXkt5nlud5Y/pv5aHzewxsbRSiZ67jOVeuEtUsUGUY2EqkTqTZiA5ifH+USS
 7cZdnx3Wk4bB
X-Google-Smtp-Source: AGHT+IFYC7EwsC/Rp5FViEY9lq2/KTVD85jPB10BMxihymzxCyasyre6DY30hdlW3S3xs5BojBjH7Q==
X-Received: by 2002:a05:6a20:9c8c:b0:1e1:96d9:a7db with SMTP id
 adf61e73a8af0-1ee03a097c4mr6536987637.4.1738937305785; 
 Fri, 07 Feb 2025 06:08:25 -0800 (PST)
Received: from terra ([2405:6586:be0:0:c8ff:1707:9b9:af89])
 by smtp.gmail.com with ESMTPSA id
 d2e1a72fcca58-73048a9d378sm3020809b3a.26.2025.02.07.06.08.21
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Fri, 07 Feb 2025 06:08:24 -0800 (PST)
From: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
In-Reply-To: <86y0yh6hai.fsf@HIDDEN> (Roman Scherer's message of
 "Fri, 07 Feb 2025 14:00:37 +0100")
References: <865xlph6f6.fsf@HIDDEN> <87y0yh53f6.fsf@HIDDEN>
 <86y0yh6hai.fsf@HIDDEN>
Date: Fri, 07 Feb 2025 23:08:11 +0900
Message-ID: <87frkpalv8.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Hi Roman,

Roman Scherer <roman@HIDDEN> writes:

> Hi Maxim,
>
> yes, it is fully automated. What happens is:
>
> - a server is provisioned through the Hetzner API
> - the the server is booted into the rescue system via the API
> - partitions are setup in the rescue system (enlarged)
> - a minimal Guix system is installed
> - then the server re-booted, starting the minimal Guix system
> - then the machine-ssh-environment takes over and applies the final system configuration
> - this all is done once, when the server is initially provisioned
>
> Previsouly I tried the guix-infect.sh approach that installs a Guix
> system on top of a debian/ubuntu image, but I found this was very
> brittle (issues with dns when you remove /etc, etc.). From my experience
> working with this I found the approach with the rescue system both more
> reliable and faster.
>
> Does this mnake sense?

Thanks for the clear explanation, it makes a lot of sense and it's
awesome that you could automate all that!  It looks a lot like the
manual steps I had to go through to install Guix System on a cheap OVH
VPS [0].  It'd be fun to review if their API would allow automating all
that as what you did here for Hetzner.  The nice thing with OVH is that
they do not place any upper limit on the amount of bandwidth consumed
(no extra billing), and it's quite inexpensive (I currently pay less
than 2 CAD/month, although that's only for the first year -- after it's
similar to Hetzner, about 6 CAD/month IIRC).

[0]  https://lists.gnu.org/archive/html/help-guix/2024-08/msg00125.html

-- 
Thanks,
Maxim

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Fri, 07 Feb 2025 16:59:02 +0000
Resent-Message-ID: <handler.75144.B75144.17389475356239 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Maxim Cournoyer <maxim.cournoyer@HIDDEN>
Cc: Josselin Poiret <dev@HIDDEN>, Simon Tournier <zimon.toutoune@HIDDEN>, Mathieu Othacehe <othacehe@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Tobias Geerinckx-Rice <me@HIDDEN>, Roman Scherer <roman@HIDDEN>, Christopher Baines <guix@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.17389475356239
          (code B ref 75144); Fri, 07 Feb 2025 16:59:02 +0000
Received: (at 75144) by debbugs.gnu.org; 7 Feb 2025 16:58:55 +0000
Received: from localhost ([127.0.0.1]:36229 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tgRgs-0001cS-In
	for submit <at> debbugs.gnu.org; Fri, 07 Feb 2025 11:58:55 -0500
Received: from mail-ej1-x634.google.com ([2a00:1450:4864:20::634]:49226)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tgRgn-0001c3-Up
 for 75144 <at> debbugs.gnu.org; Fri, 07 Feb 2025 11:58:52 -0500
Received: by mail-ej1-x634.google.com with SMTP id
 a640c23a62f3a-aaecf50578eso458266366b.2
 for <75144 <at> debbugs.gnu.org>; Fri, 07 Feb 2025 08:58:49 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1738947524;
 x=1739552324; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=OCteviGrDgYidyxC1cTTKpDb9lVIPnBbDWGyZHgEwa4=;
 b=2FvWkek+7w6XDNtbRvO6//LR35RSy0BbY0MxA66Qa0mVxRZNWiIPxFlBZ28GaD8NcS
 F5P3xAJ2ZwRk46TZCSKWVttTDIIVuSfq1MoPEgUJlAXumzXp567W4oKz2OXlvGfgDF+i
 2ReTy8lxnLb2eebiKFigdqNFYRpO55h0ouHYj73cTI9z8wrxVFgqlzlId8xjCOlfp1I5
 RmW4M4d//nePyrIHG1+WCLcq5AVKnr8cEzEguD/P3OMPUugyvFtYWw+lbmNmeT+vtZcy
 BMMh21JbXuQVO8mNiQKjhW0iNSSecDvwldWdIMqQeBWUYcExBdKDiHnG1Fx3VhBzzJx2
 ABkA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1738947524; x=1739552324;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=OCteviGrDgYidyxC1cTTKpDb9lVIPnBbDWGyZHgEwa4=;
 b=vKTQW6KLnMJovKlznQKzvkUj0yBCZvoGyDLyOKvd9FA/KC2yBQ5T0w/sPCkggl8owD
 5XD/B7LrBw1qHya9vDIgIJ9lVrlBOP6p1DMXy0OIC40AI3fPoLfyki/U5QnxKQ9jRuA1
 GDVJCK9uXFz/QMcVE2/uKNtnVBSmmkLX1nIDMwH7oWzxPDHgbXUrlJ/LlmqRt+18E7TM
 k/6nO9ViawNCLJtqQCKSRGlZkH+hKykZ255PrvoT/w0i3kBa2K74jvIbfp5y+5bWSkAi
 I7B5bQhVM3kr3CqWpWMGWu0crrPPVA6DtAEQ/ZrlopRRxwaywHR+GGhvAjQagwp2uEGI
 7CCw==
X-Forwarded-Encrypted: i=1;
 AJvYcCXnkMA/MEuJA155p5e2QJaIWIh4d0ObmmX9hsoIyFfhV5eJ7BPJOP9bMX8/78BlUSNvKGPWoA==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YwgzLIO1d/KJSurb7CaWqykYf2f/p9I3jnSDV+4hpLHj0kXIovK
 4/B3jG/9pP3OKSfwNxJ9FLlYFLHoj+v12OzHULiPGafoc1zj3Cvm0r9XtOa5ZY0=
X-Gm-Gg: ASbGncuAMWHBeiLU5TrsaTNs72U3FR1/cezDMTwFxLTg6yNMZsfljGgJRueThux5Jbb
 Y2QkbFLjGVVkf+3kF6lbHa3wZcif/OPA37eZSCzFPVCtVBRnnWWIqgk+SWnEHYQ2dImjuXpHndJ
 3FHOtcAxYLpQLyuPWHSYf+BFp6TY//GNbwqOnXm/RRds5s3BMz9hXS0IlW/ieMXycAeZVPwMyL3
 tARi3bC49sIW9BzA3ijdKe0QhWZFLzh0cZI5QGmB9By8pR7YeNIwovD7Xw3nN6ZxwcNBfrLmZCH
 u2n6kQ64
X-Google-Smtp-Source: AGHT+IHY/0U3GIncjbFRd70uAJbqDYTAFn/i9Mucp0/uLXxjvmPc0i30P3kSAqHEi4mCUFcVSrIe/A==
X-Received: by 2002:a17:907:72d5:b0:ab3:4c32:aa6c with SMTP id
 a640c23a62f3a-ab789ade6c1mr402364166b.20.1738947523431; 
 Fri, 07 Feb 2025 08:58:43 -0800 (PST)
Received: from m1 ([2a01:599:10c:b87f:d8f8:533a:afe2:1907])
 by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab772fdb6bcsm297208466b.86.2025.02.07.08.58.42
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Fri, 07 Feb 2025 08:58:42 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <87frkpalv8.fsf@HIDDEN> (Maxim Cournoyer's message of "Fri, 07
 Feb 2025 23:08:11 +0900")
References: <865xlph6f6.fsf@HIDDEN> <87y0yh53f6.fsf@HIDDEN>
 <86y0yh6hai.fsf@HIDDEN> <87frkpalv8.fsf@HIDDEN>
User-Agent: mu4e 1.12.8; emacs 29.4
Date: Fri, 07 Feb 2025 17:58:40 +0100
Message-ID: <86ikpl7ku7.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain


Hi Maxim,

I'm not really familiar with the OVH rescue mode. But a quick search
showed up this:

https://support.us.ovhcloud.com/hc/en-us/articles/20041782509203-Activating-Rescue-Mode-on-a-Public-Cloud-Instance
https://eu.api.ovh.com/console/?section=%2Fcloud&branch=v1#post-/cloud/project/-serviceName-/instance/-instanceId-/rescueMode

So, if it works similar to the Hetzner rescue system, which I think it
does, and you can install guix on it (the package manager is enough) I
don't see why this approach should not work there as well.

Thanks, Roman

Maxim Cournoyer <maxim.cournoyer@HIDDEN> writes:

> Hi Roman,
>
> Roman Scherer <roman@HIDDEN> writes:
>
>> Hi Maxim,
>>
>> yes, it is fully automated. What happens is:
>>
>> - a server is provisioned through the Hetzner API
>> - the the server is booted into the rescue system via the API
>> - partitions are setup in the rescue system (enlarged)
>> - a minimal Guix system is installed
>> - then the server re-booted, starting the minimal Guix system
>> - then the machine-ssh-environment takes over and applies the final system configuration
>> - this all is done once, when the server is initially provisioned
>>
>> Previsouly I tried the guix-infect.sh approach that installs a Guix
>> system on top of a debian/ubuntu image, but I found this was very
>> brittle (issues with dns when you remove /etc, etc.). From my experience
>> working with this I found the approach with the rescue system both more
>> reliable and faster.
>>
>> Does this mnake sense?
>
> Thanks for the clear explanation, it makes a lot of sense and it's
> awesome that you could automate all that!  It looks a lot like the
> manual steps I had to go through to install Guix System on a cheap OVH
> VPS [0].  It'd be fun to review if their API would allow automating all
> that as what you did here for Hetzner.  The nice thing with OVH is that
> they do not place any upper limit on the amount of bandwidth consumed
> (no extra billing), and it's quite inexpensive (I currently pay less
> than 2 CAD/month, although that's only for the first year -- after it's
> similar to Hetzner, about 6 CAD/month IIRC).
>
> [0]  https://lists.gnu.org/archive/html/help-guix/2024-08/msg00125.html

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmemO8AXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZnQUwf+N/iZ4DSmF0FtpJwtWkdwFNNj
qjxs8C0KOpHyd0ohz5zZyztY8eq02HYDmYBEDU3aT3DB+ryh0Kdt4EngsJDpQgoY
J3feBuGDONxHbuE/G7KMam5/nv6bwKjGQTOjzPr8H43z8kPmRPeqnhy1K4LdH9og
F2jbmv1NiVRHhkKxTGOIFIiKK7nwGix/59m+EVb+FCRAUqCZPn0lhO1ASZWzb6Qb
8/PO3hK7Y9GO8PrwM9oMZteiTR40SC9saMSrrxYp/RcZv1z9eS+r2UaeIguUDi8A
NDOLFQ4+AiqNp6zsTxURCtI0eTJSGH2mz2tmLrg2vVBvFPYb+nyJl1aJZWGgsw==
=f9oh
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH v3 2/2] machine: Implement 'hetzner-environment-type'.
Resent-From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Sun, 09 Feb 2025 16:46:01 +0000
Resent-Message-ID: <handler.75144.B75144.173911952028808 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Julien Lepiller <julien@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Florian Pelz <pelzflorian@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173911952028808
          (code B ref 75144); Sun, 09 Feb 2025 16:46:01 +0000
Received: (at 75144) by debbugs.gnu.org; 9 Feb 2025 16:45:20 +0000
Received: from localhost ([127.0.0.1]:46006 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thAQp-0007TO-GX
	for submit <at> debbugs.gnu.org; Sun, 09 Feb 2025 11:45:19 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:38900)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1thAQn-00072h-Dc
 for 75144 <at> debbugs.gnu.org; Sun, 09 Feb 2025 11:45:18 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>)
 id 1thAQh-0005WP-DT; Sun, 09 Feb 2025 11:45:11 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-Version:Date:References:In-Reply-To:Subject:To:
 From; bh=tHE1wzOeDil7f5N9hxeKmL3vu7+5CUb5SO5XYvHWfzo=; b=VWonGeTWKJ+wPdGNEXmq
 THEjfnr+XfsvZBweFEtTt+lYh7lCa0COBTl+8uG6Ak+574Ju4CrNJcN1uZicHQpWPPS3JLLfdUct/
 jBcuc/yt/Nepsw6bv+uHIiLkDywRpprnlS02cnUG5q6EdlVk9k2/gwuNmLGkp0ndPWlzfjlY3Lp8C
 Vu7BGnSTvPj1s1KAFvEfTiafxPxGshZY6QO+E2P0jOPu/p7Lu8DyJFYEp+7MnTjGNUVNl8I7qCCqs
 pN795Zj+odp7VcL7xoNqmVe5Um4LJzv0It1twvEE7o1hRlNxah8PpQRVlIaCANMIrzMeC1tyjdae7
 Ave0fRRT/nOFrg==;
From: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
In-Reply-To: <7b51e5d7ae56f7f9792252e98b57371b2904a3fe.1738695552.git.roman@HIDDEN>
 (Roman Scherer's message of "Tue, 4 Feb 2025 20:01:14 +0100")
References: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
 <7b51e5d7ae56f7f9792252e98b57371b2904a3fe.1738695552.git.roman@HIDDEN>
Date: Sun, 09 Feb 2025 17:45:07 +0100
Message-ID: <87h653qd7w.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Spam-Score: -2.3 (--)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

Hello Roman,

Applied with the one-line change below.

I wasn=E2=80=99t able to run tests that require an API token because I don=
=E2=80=99t
have one (but I may well give that a try eventually); other tests went
well.

Feel free to submit an entry for =E2=80=98etc/news.scm=E2=80=99 (make sure =
to provide
enough context so users can tell whether this is something of interest
to them).  A blog post for guix.gnu.org/blog showing how you use it and
how it=E2=80=99s implemented would also be welcome if you feel so inclined!

Thanks for all the work!

Ludo=E2=80=99.

Message received at control <at> debbugs.gnu.org:

Received: (at control) by debbugs.gnu.org; 9 Feb 2025 16:45:29 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Feb 09 11:45:29 2025
Received: from localhost ([127.0.0.1]:46010 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thAQz-0007rc-2L
	for submit <at> debbugs.gnu.org; Sun, 09 Feb 2025 11:45:29 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10]:59816)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <ludo@HIDDEN>) id 1thAQv-0007VX-Cd
 for control <at> debbugs.gnu.org; Sun, 09 Feb 2025 11:45:25 -0500
Received: from fencepost.gnu.org ([2001:470:142:3::e])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.90_1) (envelope-from <ludo@HIDDEN>) id 1thAQq-0005Ww-4I
 for control <at> debbugs.gnu.org; Sun, 09 Feb 2025 11:45:20 -0500
DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org;
 s=fencepost-gnu-org; h=MIME-version:Subject:From:To:Date:in-reply-to:
 references; bh=+95cWYR5kJqed/668T0Bwcy6De9cIQgFRkkZRBFo5Gg=; b=ZPnzHPW/s5dBL3
 iYqYemJnTZ/0xG3jQTGTnA+jBha2X+sbQWhLDo5hvAeLyPGuf0lnFOdGfRc+Xz29WtOO3wIlAQIho
 LrM+IwborlSly0NUeWO9Thca04LFcPJVu/WK1vyXwq4P3Mdu2Ev12/BYo927OgXm2fV8sYwJDZvv3
 GOqcViMtWc2DUKQgiEIJ/Z4ypQrn5CXXzTuZ3OkfAW44wfMWWlOOU9OFG3eohmbf7F3V9+eTuv6ng
 QF9lDvmzsYpAwBL7Bqezj1tj0rqpXoh++CRsbIjkkrNv4RVgEip+pa26FdnXFWAQATn6dqLpyCkby
 YryALiSGsEu0X2Uks5CQ==;
Date: Sun, 09 Feb 2025 17:45:16 +0100
Message-Id: <87frknqd7n.fsf@HIDDEN>
To: control <at> debbugs.gnu.org
From: =?utf-8?Q?Ludovic_Court=C3=A8s?= <ludo@HIDDEN>
Subject: control message for bug #75144
MIME-version: 1.0
Content-type: text/plain; charset=utf-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -2.3 (--)
X-Debbugs-Envelope-To: control
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -3.3 (---)

close 75144 
quit

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH v3 2/2] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Mon, 10 Feb 2025 20:10:02 +0000
Resent-Message-ID: <handler.75144.B75144.17392181872437 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>
Cc: Julien Lepiller <julien@HIDDEN>, Roman Scherer <roman@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Florian Pelz <pelzflorian@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.17392181872437
          (code B ref 75144); Mon, 10 Feb 2025 20:10:02 +0000
Received: (at 75144) by debbugs.gnu.org; 10 Feb 2025 20:09:47 +0000
Received: from localhost ([127.0.0.1]:52645 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1tha6F-0000dF-2W
	for submit <at> debbugs.gnu.org; Mon, 10 Feb 2025 15:09:47 -0500
Received: from mail-ej1-x62f.google.com ([2a00:1450:4864:20::62f]:44202)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1tha69-0000cw-E1
 for 75144 <at> debbugs.gnu.org; Mon, 10 Feb 2025 15:09:45 -0500
Received: by mail-ej1-x62f.google.com with SMTP id
 a640c23a62f3a-ab7c81b8681so188625966b.0
 for <75144 <at> debbugs.gnu.org>; Mon, 10 Feb 2025 12:09:41 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1739218175;
 x=1739822975; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=tb015cvLzqpj4b7YavhkSHBMHYDZpK3yG9GJgGV4Uig=;
 b=gduxy1GrAi/S9UfHO62pwbFbMRIH+MPyJzQzsK2Y+0FhBsv/ySgKnJhm4HonfBrbsu
 owdxsLoJi1nIAgiYyEQShTeQJYGGPftwf6JOFOfth/mX1SyZOQ7qGcsn21InI+UnYnjD
 M+C4OQq2oiRUuGAXigg1NjiFHM2DQBSlXxBXj8TP6bM+wr1i9Qo9oTN4Wos4dBiJrTrJ
 CZJzzZC6RiIf8iyRlXpTYJFq5FgVs4WnTXXUX0htpc0gcZnNo6Yh0Dq3bHLEHr/uHu0w
 EDOBpQsrqbZb1DdBCTucUDilV6bfWa5kzDiL+o3xzynXHRBFpkn6soj/XY97/cuwYKs1
 3xgg==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1739218175; x=1739822975;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=tb015cvLzqpj4b7YavhkSHBMHYDZpK3yG9GJgGV4Uig=;
 b=rPg3i3VLf0TOtVVPWpJ8onM1lv+ooUaNpiDPO2dW6CvirkXfNKQvrihuvLLrqb+eIw
 TN1nfsCu5jA86uTgMxrKUfq8czSDg9u/SS7iUioWxdfV1D97TKlhHGC0hcVpLq/9e8/D
 NUMeKRhS1xNSEFP/oA27j7bm9TlAohd6iclzJubyt1zjy/edMotn1bQEAi0WVlXxCQCd
 5j25yhzv9Ehzh0nYyTLkRrwrYMTXjREldMJxCEYXKg+lVHos8Yz7zLMxDrnt1/av8b/S
 31xc1t22lpPJQaWYojFwFe/0A7HbuL7zqi3AAtyMQIH+eheydVTorFXbq1G4tajlad+a
 Ia0g==
X-Forwarded-Encrypted: i=1;
 AJvYcCUT3A8RHFR3havO7s6IT3gOwJoI8nrNGt3hv0p49ZYiaZPXJYHZbORa6WRgJyaeS/+DEY8aqA==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YynnyMlHeoDcxaO73AFyMnDqFt9L7n9RTMp3Up09leIeJDc8Y6e
 4h5QWqSAGFOcUMLW6b95F2qIuvVihfdfhKIJnubNIfhMyrliWF4Ik2WeUcXcodc=
X-Gm-Gg: ASbGncuO/kHzTWlrBEPxw1u3u9JPZDuV4gQmta7LiD7AJDylXd7LDKQMP0e79d33mIg
 Tt2IRR3aAG3KSkHJ9HE8GDP+Fuw/y123CU3uEQknWDfLM+tqKYmMtj2d5yGU78uxLhBJDPz0iR8
 yFWsQf5+19nLRaugSnpSD939x+m+6JEl8Q2/uJhdeST7Oi43jsk/rjX8Z073IskzV51FmPbfdTW
 onJFOGw4zxCUhNo2Ubi0o6jOs7GSV/2F/qYBw6OSvymFalo8IUbruW6su+T6YZD0tcDyUPWVb4e
 TiOSQEs=
X-Google-Smtp-Source: AGHT+IFYvG2tJmfkf3b3n09TUVzTvfKZ+4ukR49BOXe26VTHXIIbydra390SR3oJLiYhHPapuW/bjA==
X-Received: by 2002:a17:906:c109:b0:ab7:4262:686b with SMTP id
 a640c23a62f3a-ab7da4be58dmr90471066b.40.1739218174755; 
 Mon, 10 Feb 2025 12:09:34 -0800 (PST)
Received: from m1 ([2a01:599:10b:f79:d63b:6274:c334:5aad])
 by smtp.gmail.com with ESMTPSA id
 a640c23a62f3a-ab79378ee30sm691145766b.160.2025.02.10.12.09.33
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Mon, 10 Feb 2025 12:09:34 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <87h653qd7w.fsf@HIDDEN> ("Ludovic =?UTF-8?Q?Court=C3=A8s?="'s message of "Sun, 09 Feb 2025 17:45:07 +0100")
References: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
 <7b51e5d7ae56f7f9792252e98b57371b2904a3fe.1738695552.git.roman@HIDDEN>
 <87h653qd7w.fsf@HIDDEN>
User-Agent: mu4e 1.12.8; emacs 29.4
Date: Mon, 10 Feb 2025 21:09:32 +0100
Message-ID: <867c5x1s03.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable


Hi Ludo, and everyone still listening,

thanks for merging it and your help on this! I plan to submit a news
entry patch tomorrow.

I don't have the time for a blog post unfortunatly. Too busy with other
things at the moment, sorry. :/ Maybe another time.

Another feedback I wanted to mention. We should really aim to improve on
substitute availability and stability of Guix if we want people to rely
on Guix and `guix deploy`. I think this was also mentioned in the
survey.

While working on this the user experience of guix deploy really
shined/falled, depending on substitute availability and stability. I'm
probably biased and having bad luck with aarch-64 based Guix systems.

For example, using the ARM based servers (which are cheaper than x86)
with Guix on Hetzner can lead to a headache if you or the the servers
you deploy to start building Rust and friends. :/

I think we get there, thanks again, and happy hacking!

Roman

Ludovic Court=C3=A8s <ludo@HIDDEN> writes:

> Hello Roman,
>
> Applied with the one-line change below.
>
> I wasn=E2=80=99t able to run tests that require an API token because I do=
n=E2=80=99t
> have one (but I may well give that a try eventually); other tests went
> well.
>
> Feel free to submit an entry for =E2=80=98etc/news.scm=E2=80=99 (make sur=
e to provide
> enough context so users can tell whether this is something of interest
> to them).  A blog post for guix.gnu.org/blog showing how you use it and
> how it=E2=80=99s implemented would also be welcome if you feel so incline=
d!
>
> Thanks for all the work!
>
> Ludo=E2=80=99.

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmeqXPwXHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZkPdAgAyRHIETVJGhQCq5smY5ZnnUB6
/XwWjJvlYcodcgZUdO0JB3TMGvw8OT2kCcFN+GpZ+CpE21yiba7Iwa3TJcczI8XD
Q+EY+EJXAoCMi9TQzvnICz5CT6ARmjZA4HzoW1I+wJxtGk4RxNpP2bcAr6H5XFHr
NGJPUJU3j6LEcZ42t1e4a/pcae1O3LG0QkvyD/9Y+rUUhejuXd+gD4emQ/MaCV8H
kswTNW9Kg9LcDlW3HDfNziM6LbNW2M0MeaeQifwM5hXqjzfYmvPOIEWj21mLBNdB
c+QiQ+58/t047CPl5O2BUPRG8NA7ej32aJyg6RK60hsodj8VqgdzszH4VdGV1Q==
=SVUp
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to pelzflorian@HIDDEN, julien@HIDDEN, guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] news: Add entry for 'hetzner-environment-type'
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
In-Reply-To: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: pelzflorian@HIDDEN, julien@HIDDEN, guix-patches@HIDDEN
Resent-Date: Tue, 11 Feb 2025 09:24:01 +0000
Resent-Message-ID: <handler.75144.B75144.173926579414087 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: 75144 <at> debbugs.gnu.org
Cc: Roman Scherer <roman@HIDDEN>, Florian Pelz <pelzflorian@HIDDEN>, Julien Lepiller <julien@HIDDEN>
X-Debbugs-Original-Xcc: Florian Pelz <pelzflorian@HIDDEN>, Julien Lepiller <julien@HIDDEN>
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173926579414087
          (code B ref 75144); Tue, 11 Feb 2025 09:24:01 +0000
Received: (at 75144) by debbugs.gnu.org; 11 Feb 2025 09:23:14 +0000
Received: from localhost ([127.0.0.1]:54384 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thmU5-0003f8-TI
	for submit <at> debbugs.gnu.org; Tue, 11 Feb 2025 04:23:14 -0500
Received: from mail-wr1-x436.google.com ([2a00:1450:4864:20::436]:59805)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1thmU1-0003el-BG
 for 75144 <at> debbugs.gnu.org; Tue, 11 Feb 2025 04:23:11 -0500
Received: by mail-wr1-x436.google.com with SMTP id
 ffacd0b85a97d-38dc962f1b9so2306232f8f.3
 for <75144 <at> debbugs.gnu.org>; Tue, 11 Feb 2025 01:23:09 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1739265781;
 x=1739870581; darn=debbugs.gnu.org; 
 h=content-transfer-encoding:mime-version:message-id:date:subject:cc
 :to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=zcyi6ckehfWSXhVYerjHZhb2fhm/Oa8GjnMjaI7ZORg=;
 b=n9s0z9HYzHH23IpOLsVw+dR4yJzzyUsstgYk102aeqbyofVC3nvTrnoc6tfLIcL22+
 ocEjpoicy1h7XdwdXMzLUEywkxFeKUuaQSDzTk9eAbjZ79qY2hKMSQ6s/M1YNorm4TrX
 nzq+oHpmdKTIN4fzaKYlLBQZq7RODQ+WgpuMLtTm1DW3UQXLYRANV/D28NQuWYfOsOjR
 MsGHemJlRVQyO1dTLGGBWEAhxqrTSfSFZJJUfYj7Ayl/ooqkZhCcLhT6b0x+FZYi97kO
 RU8Imi5e1T5JQZF4c/J1uhbHxLSQFlbLNoVXf/zze9uptbNpaUASH7s1rT/F2AXyA0KK
 c/DA==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1739265781; x=1739870581;
 h=content-transfer-encoding:mime-version:message-id:date:subject:cc
 :to:from:x-gm-message-state:from:to:cc:subject:date:message-id
 :reply-to;
 bh=zcyi6ckehfWSXhVYerjHZhb2fhm/Oa8GjnMjaI7ZORg=;
 b=HEEXkiZFzfrkmwFUTlTC4LQmN+nQk+4KuO1K3iCVrPY0C3uGLpIFKhMT5P+JIferfs
 vXtgZqbnBphs9g0XeG7jL493Ybie05AZ/XZzkYs9DIZum1V9huCfY7EZp6Sp1fOUnJFO
 7t4yYU2rIjNX+5F9tXZGIZ43ZJwHHqgG7C0c7zsYp3xc9QefuIxTm78q7OTJ99kM+HOp
 +ixiYcpD0aXNv09T3nM6Wkfg8DANVPTagtAqT33BpagPz/aen2VcjsfLGVWh9sGtua5d
 xsjtWImXhhcpGq1uIgOKeI7e6lYjAE6B/a/OavKb4e1ULZBbx2ssXa0+2PHz5iCMicp0
 PT8w==
X-Gm-Message-State: AOJu0Yy0ZUYQJiPEIM9wDZxl3xEMLC24rk42ZbU9aJEtj7Il/PhpN9MH
 ZzUwlb+cU8SsRURbd7v1gOtFOjRoW09ZM86UUrRIInT9D9XGKyxDq4XE2001APeVszpBiPHJlqA
 rU8Yhu8Lq
X-Gm-Gg: ASbGncsl6EfztOI00i0PKDlgFd4Yx5BS2l8ac94/9NdrO36F+2n6fLACzSbLDU9gC/N
 YwFaEV+NPbO7ai6/04XdGnn8ecii5gNq8mF1xyxBe01wHBwZjO46dJSY9EzPQfIU8e5hVmliH1c
 gXEWzVQIyjru4j8+DRC32NQXyFzijmRZRNB3pUpl2fMCPrgLkWbg9XiwXBrzFm+7nb3O6GfbuPF
 OTtuBypabjI7fTb/OS+v3FOyGNN2MF2TBf76Y1KeasCUYd4wrTuKBJBuy0VLmKakMcy3UzqPMHG
 cJEpr8EJI76fCWS622Vge0wAnS9lJhHS
X-Google-Smtp-Source: AGHT+IF6288bmkUBViVDjt3dXPntm7NzzufVeiE1Va7usUXyNFm1v3+dgi6o47F5OQLXdJSzKxaWWA==
X-Received: by 2002:a05:6000:1445:b0:38d:d387:166 with SMTP id
 ffacd0b85a97d-38dd38707a3mr8131536f8f.34.1739265781362; 
 Tue, 11 Feb 2025 01:23:01 -0800 (PST)
Received: from localhost.localdomain ([2a01:599:10b:f79:d63b:6274:c334:5aad])
 by smtp.gmail.com with ESMTPSA id
 ffacd0b85a97d-38dbde0fd23sm14267767f8f.71.2025.02.11.01.23.00
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 11 Feb 2025 01:23:00 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
Date: Tue, 11 Feb 2025 10:22:55 +0100
Message-ID: <404da01b9d49158bda7764d75e215100afb15fda.1739265567.git.roman@HIDDEN>
X-Mailer: git-send-email 2.48.1
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

* etc/news.scm: Add entry.

Change-Id: I7d2575d8e69855516cbf4c3747a23c344890321a
---
 etc/news.scm | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/etc/news.scm b/etc/news.scm
index dfc64d59cd..147972548c 100644
--- a/etc/news.scm
+++ b/etc/news.scm
@@ -27,6 +27,8 @@
 ;; Copyright © 2024 Zheng Junjie <873216071@HIDDEN>
 ;; Copyright © 2024 Nicolas Graves <ngraves@HIDDEN>
 ;; Copyright © 2024 Sebastian Dümcke <code@HIDDEN>
+;; Copyright © 2024 Roman Scherer <roman@HIDDEN>
+
 ;;
 ;; Copying and distribution of this file, with or without modification, are
 ;; permitted in any medium without royalty provided the copyright notice and
@@ -35,6 +37,22 @@
 (channel-news
  (version 0)
 
+ (entry (commit "0753a17ddf6f4fab98b93c25f1a93b97ff9e46bb")
+        (title
+         (en "The @command{guix deploy} command now supports the Hetzner Cloud
+service"))
+        (body
+         (en "In addition to deploying machines over SSH and on the Digital
+Ocean cloud service, the @command{guix deploy} command now supports deployment
+on the Hetzner Cloud service as well.  When deploying a machine with the new
+@code{hetzner-environment-type}, a @acronym{VPS, virtual private server} will
+be provisioned on the Hetzner Cloud, and the machine configuration's operating
+system will be installed on it.  Provisioning happens through the Hetzner
+Cloud API and you need to set the @code{GUIX_HETZNER_API_TOKEN} environment
+variable to a Hetzner Cloud API token.  Additionally, you can use the
+@code{hetzner-configuration} record to customize the deployment, such as the
+system architecture, type of VPS, etc.")))
+
   (entry (commit "616ae36e0f557cecb4abe58c5b0973b9428d25e0")
         (title
          (en "Kernel persistent storage in UEFI disabled"))

base-commit: d7ca62b15de7ef89c88ef9b1118d29481ca50122
-- 
2.48.1

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH v3 2/2] machine: Implement 'hetzner-environment-type'.
Resent-From: Roman Scherer <roman@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 11 Feb 2025 09:25:02 +0000
Resent-Message-ID: <handler.75144.B75144.173926588514258 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Julien Lepiller <julien@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Florian Pelz <pelzflorian@HIDDEN>, 75144 <at> debbugs.gnu.org
Received: via spool by 75144-submit <at> debbugs.gnu.org id=B75144.173926588514258
          (code B ref 75144); Tue, 11 Feb 2025 09:25:02 +0000
Received: (at 75144) by debbugs.gnu.org; 11 Feb 2025 09:24:45 +0000
Received: from localhost ([127.0.0.1]:54390 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thmVY-0003hu-Sh
	for submit <at> debbugs.gnu.org; Tue, 11 Feb 2025 04:24:45 -0500
Received: from mail-wm1-x32f.google.com ([2a00:1450:4864:20::32f]:55378)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.84_2) (envelope-from <roman@HIDDEN>)
 id 1thmVV-0003hd-AY
 for 75144 <at> debbugs.gnu.org; Tue, 11 Feb 2025 04:24:42 -0500
Received: by mail-wm1-x32f.google.com with SMTP id
 5b1f17b1804b1-4394820123dso10235415e9.2
 for <75144 <at> debbugs.gnu.org>; Tue, 11 Feb 2025 01:24:41 -0800 (PST)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=burningswell-com.20230601.gappssmtp.com; s=20230601; t=1739265875;
 x=1739870675; darn=debbugs.gnu.org; 
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to;
 bh=8j1GVf1CUW3++sWb2J0+m1fVBZWSCnYDTDY6dLq0jXk=;
 b=wJbuIH68sCyilsuQudrSDPXlXx87EWYqcNbSkwrcufVHvfuopGxuRwUJcyJ1WnCb1a
 tOIrDIchIAWj7zV+UJ1BVsxUGZojd2iiaXpNAVCpzaf1owX+5rIklHIcIcb27IqsLj+2
 /QBN+za502mVOU36MkFDbjmu5T3cxvgDvbulZb3wnn9uMZjbcZjGGXsWN3L9QZl34j+v
 4XSfFqGv9DJI1U/1P6gQGsF/GMSlfEXVPMTlgpjOJTfHZ6bIyorcWyxUuYedgu0XjHnj
 GB/KBet1svbE9tybiU5XkoxzTe8y2ctYQlJfk77KDoJxl0feoyLS3YN4bb8ash9Mt/8i
 mLzw==
X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
 d=1e100.net; s=20230601; t=1739265875; x=1739870675;
 h=mime-version:message-id:date:user-agent:references:in-reply-to
 :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date
 :message-id:reply-to;
 bh=8j1GVf1CUW3++sWb2J0+m1fVBZWSCnYDTDY6dLq0jXk=;
 b=rTS5Jj5hE9A5kcEBpc400FoR8ffytOuuXvhpFh7M3AEoXCKjZ1LyCiKqzraSspSnKL
 d3kbFsa3vEQ9LCDxTkAoXvJdgxodl3HdzSJXzm5b7FxdpXNUR/SwZvjRdArh8Xj4MuFN
 IzEd1iT+g8zsgbEQHLshCydStaoysFRESCgMHTaGnUI4CAdNZ9tvnnQ7Cnd1GyfF1jLR
 vm1W4Efzj2LipcJoFdsLITpUXUvgqQkhdTNEnp/1X7kbw0Ox8Z+hLph73SHThwXaGrHc
 03wcQT74g0imzZb5DfLm7kWT3+IvQfkRCq/NjYRfUjNEh82J5Paq9mDRy0Px4YS/04b8
 9NwQ==
X-Forwarded-Encrypted: i=1;
 AJvYcCV0XmFgODohYJ8x5nptWkqnw6yjgMv/o7awXlFUCz9Q4IVP11FD1qUV7htmUNAClFrCjMPsZQ==@debbugs.gnu.org
X-Gm-Message-State: AOJu0YzZRPH4WKz4YXFXbEhxhu1BtCVwH1AcFS/+UH84g7QfVriJBLNd
 27HgmLf17URvYB3AdZ6+FZzgFGN6+Wrs70hLJlSj3dcM98xzBMZG/sSqtH1DaEg=
X-Gm-Gg: ASbGnctvODfp8Ssd9+VcCCnWEU3Tf36DSAgJR2vjN0aqdeV2wZr9hIw0FaYiojfxBlc
 V84ke4OvONXB5Y09V0CremgGkkS0xDIQcH2cdR3NEoWx/FD2FXA/XLmNz78el7/ri+iebCIy+9g
 nWfRrdNrak0e4qi0feqhqJQ0znzmVwUvVMG5KXHZebK86ocQqVIUcShqocCDWjOwsiUr2zVcKRF
 g09ESaT40tamULOtvDPkUHQuBDju6gxk7DugFz4PYE/KIHa/o6Ru9H2zpwQ3BOX+/FCHYfs6m6o
 L7+5/o8=
X-Google-Smtp-Source: AGHT+IE2naXLV1FXhJCryMOTcaua9VM87Rmv4slkY1w49YEB2m6XHOB0sFAdE1zKMSubui58a0JwHg==
X-Received: by 2002:a5d:47c4:0:b0:38d:e61a:bc2 with SMTP id
 ffacd0b85a97d-38de61a0de7mr1120156f8f.20.1739265874798; 
 Tue, 11 Feb 2025 01:24:34 -0800 (PST)
Received: from m1 ([2a01:599:10b:f79:d63b:6274:c334:5aad])
 by smtp.gmail.com with ESMTPSA id
 ffacd0b85a97d-38dc0c5a894sm13983296f8f.95.2025.02.11.01.24.33
 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256);
 Tue, 11 Feb 2025 01:24:34 -0800 (PST)
From: Roman Scherer <roman@HIDDEN>
In-Reply-To: <867c5x1s03.fsf@HIDDEN> (Roman Scherer's message of
 "Mon, 10 Feb 2025 21:09:32 +0100")
References: <53d36027832470a5f3a38d4003ce426fabedb97b.1738695552.git.roman@HIDDEN>
 <7b51e5d7ae56f7f9792252e98b57371b2904a3fe.1738695552.git.roman@HIDDEN>
 <87h653qd7w.fsf@HIDDEN> <867c5x1s03.fsf@HIDDEN>
User-Agent: mu4e 1.12.8; emacs 29.4
Date: Tue, 11 Feb 2025 10:24:31 +0100
Message-ID: <86v7tgzve8.fsf@HIDDEN>
MIME-Version: 1.0
Content-Type: multipart/signed; boundary="=-=-=";
 micalg=pgp-sha256; protocol="application/pgp-signature"
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

--=-=-=
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable


Hello,

I just send another patch for the news entry to this bug number.

Could someone please review it?

Thanks, Roman

Roman Scherer <roman@HIDDEN> writes:

> Hi Ludo, and everyone still listening,
>
> thanks for merging it and your help on this! I plan to submit a news
> entry patch tomorrow.
>
> I don't have the time for a blog post unfortunatly. Too busy with other
> things at the moment, sorry. :/ Maybe another time.
>
> Another feedback I wanted to mention. We should really aim to improve on
> substitute availability and stability of Guix if we want people to rely
> on Guix and `guix deploy`. I think this was also mentioned in the
> survey.
>
> While working on this the user experience of guix deploy really
> shined/falled, depending on substitute availability and stability. I'm
> probably biased and having bad luck with aarch-64 based Guix systems.
>
> For example, using the ARM based servers (which are cheaper than x86)
> with Guix on Hetzner can lead to a headache if you or the the servers
> you deploy to start building Rust and friends. :/
>
> I think we get there, thanks again, and happy hacking!
>
> Roman
>
> Ludovic Court=C3=A8s <ludo@HIDDEN> writes:
>
>> Hello Roman,
>>
>> Applied with the one-line change below.
>>
>> I wasn=E2=80=99t able to run tests that require an API token because I d=
on=E2=80=99t
>> have one (but I may well give that a try eventually); other tests went
>> well.
>>
>> Feel free to submit an entry for =E2=80=98etc/news.scm=E2=80=99 (make su=
re to provide
>> enough context so users can tell whether this is something of interest
>> to them).  A blog post for guix.gnu.org/blog showing how you use it and
>> how it=E2=80=99s implemented would also be welcome if you feel so inclin=
ed!
>>
>> Thanks for all the work!
>>
>> Ludo=E2=80=99.

--=-=-=
Content-Type: application/pgp-signature; name="signature.asc"

-----BEGIN PGP SIGNATURE-----

iQFLBAEBCAA1FiEE0iajOdjfRIFd3gygPdpSUn0qwZkFAmerF08XHHJvbWFuQGJ1
cm5pbmdzd2VsbC5jb20ACgkQPdpSUn0qwZlBBAf+LNVqUBYvFHU6IJdiSFFJZPyk
9pd/0+rg3DY575GuL8ZFE9w7nj9ZnRXHL1zI0j8n5BlZlH4wDgEFh+b9qsbYzkOL
yVpjZPX9IZQ575pMmpfkaAXdysr8nqoyNVkU627FWgHe5cWtCKTnYZTim8D0Ryzm
IDPHsnVutk1DhbtQtRafb01nAYffjAifv3dOolJc1/5dacY80i4N4bOJN4xtk/sI
+jXEEGz/lV4fEWU9q4OK1Hqh7fkG4i935lNbat8mDRnkPVXj2svCNj6Fhk5+ZvRf
fZ24nN2sfwMIhH4wQ/Ilak2s4M9/Cxw+kMaXeo4dUFaZKVaBRHADXkbl48DMwQ==
=XNI+
-----END PGP SIGNATURE-----
--=-=-=--

Message sent to guix-patches@HIDDEN:

X-Loop: help-debbugs@HIDDEN
Subject: [bug#75144] [PATCH] news: Add entry for 'hetzner-environment-type'
Resent-From: "pelzflorian (Florian Pelz)" <pelzflorian@HIDDEN>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
Resent-CC: guix-patches@HIDDEN
Resent-Date: Tue, 11 Feb 2025 14:38:01 +0000
Resent-Message-ID: <handler.75144.D75144.17392846791161 <at> debbugs.gnu.org>
Resent-Sender: help-debbugs@HIDDEN
X-GNU-PR-Message: followup 75144
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: patch
To: Roman Scherer <roman@HIDDEN>
Cc: Julien Lepiller <julien@HIDDEN>, Maxim Cournoyer <maxim.cournoyer@HIDDEN>, Ludovic =?UTF-8?Q?Court=C3=A8s?= <ludo@HIDDEN>, 75144-done <at> debbugs.gnu.org
Received: via spool by 75144-done <at> debbugs.gnu.org id=D75144.17392846791161
          (code D ref 75144); Tue, 11 Feb 2025 14:38:01 +0000
Received: (at 75144-done) by debbugs.gnu.org; 11 Feb 2025 14:37:59 +0000
Received: from localhost ([127.0.0.1]:55396 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1thrOg-0000If-Sp
	for submit <at> debbugs.gnu.org; Tue, 11 Feb 2025 09:37:59 -0500
Received: from relay.yourmailgateway.de ([188.68.63.98]:44543)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from <pelzflorian@HIDDEN>)
 id 1thrOc-0000IT-TE
 for 75144-done <at> debbugs.gnu.org; Tue, 11 Feb 2025 09:37:56 -0500
Received: from mors-relay-2501.netcup.net (localhost [127.0.0.1])
 by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4YskZ85gKZz65yL;
 Tue, 11 Feb 2025 15:37:52 +0100 (CET)
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=pelzflorian.de;
 s=key2; t=1739284672;
 bh=ckqjCkOsVx1ZYsfUIxbCOZcKnVoECPUYKk02JfLvuXc=;
 h=From:To:Cc:Subject:In-Reply-To:References:Date:From;
 b=XMKaU8gGza+Hv78iflHTYU+MXqRvdllJBmGRX9C9vN731VFJS7hBrhjuweu7mQqUx
 V3mpiQ9Dzw68zn5qZVgN7y+a7g+/NOytiXPUoseRMSsuKKGLPP5EDIzbFlY/YSl7HE
 E3q1t5EgoAbnM8CdSDo5hz7rszsdiDPP3Stmmf8dgWgBjM7bI3iBV2YWY5IhxmYZGJ
 c6Jl0P/fgRo9DwGFfflPFZOKKQcGkOapVWuDfD2jcMpq4yZIW9SCaON5eQoeK9PM1X
 v7draA1hvpcpipItWY+O6zDVFDCo93PE4dLpcjAJrNvSXiNhk5YVS9Uye+PY22JJBm
 F7qiiy7RY9L7g==
Received: from policy02-mors.netcup.net (unknown [46.38.225.35])
 by mors-relay-2501.netcup.net (Postfix) with ESMTPS id 4YskZ84xsDz4wg3;
 Tue, 11 Feb 2025 15:37:52 +0100 (CET)
Received: from mxe217.netcup.net (unknown [10.243.12.53])
 (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits))
 (No client certificate requested)
 by policy02-mors.netcup.net (Postfix) with ESMTPS id 4YskZ64Jgrz8sbH;
 Tue, 11 Feb 2025 15:37:50 +0100 (CET)
Received: from florianhp (ipb21a5dbf.dynamic.kabel-deutschland.de
 [178.26.93.191])
 by mxe217.netcup.net (Postfix) with ESMTPSA id 0EF208454E;
 Tue, 11 Feb 2025 15:37:42 +0100 (CET)
From: "pelzflorian (Florian Pelz)" <pelzflorian@HIDDEN>
In-Reply-To: <404da01b9d49158bda7764d75e215100afb15fda.1739265567.git.roman@HIDDEN>
 (Roman Scherer's message of "Tue, 11 Feb 2025 10:22:55 +0100")
References: <6ff52cb81582c81835e39beebc7e6f7f3ecfd81d.1735317980.git.roman@HIDDEN>
 <404da01b9d49158bda7764d75e215100afb15fda.1739265567.git.roman@HIDDEN>
Date: Tue, 11 Feb 2025 15:37:53 +0100
Message-ID: <87frkk1r9a.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: quoted-printable
X-Rspamd-Queue-Id: 0EF208454E
X-Rspamd-Server: rspamd-worker-8404
X-NC-CID: q6BiFjY/fhENAMd4LcvyMCUsvwTN9EsLjM1b2erxSPG0zfF4hFjM+Dl7
X-Spam-Score: 0.0 (/)
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)

Pushed the news as 0bf82b3fd5fcca2baef872ee06b40995cfbba7df
with an added German translation.

I set your copyright year to 2025, though.  I hope the 2024 you wrote
had been a typo.  Also I ended the commit message=E2=80=99s first line with=
 a
period.

Hetzner support is exciting news, though I have no account there and
have not tested.

By the way I just had to build rust=E2=80=99s bootstrap chain, before I cou=
ld
install Guix System on my new ARM machine with which I committed your
patch.  Board info for its RAM is not free software; maybe substitutes
are missing for lack of fast freedom-respecting ARM devices.

Regards,
Florian

Last modified: Tue, 11 Feb 2025 14:45:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.