Commit | Line | Data |
---|---|---|
fa9edf09 JK |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2019 David Thompson <davet@gnu.org> | |
3 | ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org> | |
4 | ;;; | |
5 | ;;; This file is part of GNU Guix. | |
6 | ;;; | |
7 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
8 | ;;; under the terms of the GNU General Public License as published by | |
9 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
10 | ;;; your option) any later version. | |
11 | ;;; | |
12 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
13 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 | ;;; GNU General Public License for more details. | |
16 | ;;; | |
17 | ;;; You should have received a copy of the GNU General Public License | |
18 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
19 | ||
20 | (define-module (gnu machine) | |
21 | #:use-module (gnu system) | |
22 | #:use-module (guix derivations) | |
23 | #:use-module (guix monads) | |
24 | #:use-module (guix records) | |
25 | #:use-module (guix store) | |
26 | #:use-module ((guix utils) #:select (source-properties->location)) | |
9c70c460 | 27 | #:use-module (srfi srfi-35) |
fa9edf09 JK |
28 | #:export (environment-type |
29 | environment-type? | |
30 | environment-type-name | |
31 | environment-type-description | |
32 | environment-type-location | |
33 | ||
34 | machine | |
35 | machine? | |
fa9edf09 | 36 | |
d97ce204 | 37 | machine-operating-system |
fa9edf09 JK |
38 | machine-environment |
39 | machine-configuration | |
40 | machine-display-name | |
41 | ||
42 | deploy-machine | |
9c70c460 JK |
43 | roll-back-machine |
44 | machine-remote-eval | |
45 | ||
46 | &deploy-error | |
47 | deploy-error? | |
48 | deploy-error-should-roll-back | |
49 | deploy-error-captured-args)) | |
fa9edf09 JK |
50 | |
51 | ;;; Commentary: | |
52 | ;;; | |
53 | ;;; This module provides the types used to declare individual machines in a | |
54 | ;;; heterogeneous Guix deployment. The interface allows users of specify system | |
55 | ;;; configurations and the means by which resources should be provisioned on a | |
56 | ;;; per-host basis. | |
57 | ;;; | |
58 | ;;; Code: | |
59 | ||
60 | \f | |
61 | ;;; | |
62 | ;;; Declarations for resources that can be provisioned. | |
63 | ;;; | |
64 | ||
65 | (define-record-type* <environment-type> environment-type | |
66 | make-environment-type | |
67 | environment-type? | |
68 | ||
69 | ;; Interface to the environment type's deployment code. Each procedure | |
70 | ;; should take the same arguments as the top-level procedure of this file | |
71 | ;; that shares the same name. For example, 'machine-remote-eval' should be | |
72 | ;; of the form '(machine-remote-eval machine exp)'. | |
73 | (machine-remote-eval environment-type-machine-remote-eval) ; procedure | |
74 | (deploy-machine environment-type-deploy-machine) ; procedure | |
9c70c460 | 75 | (roll-back-machine environment-type-roll-back-machine) ; procedure |
fa9edf09 JK |
76 | |
77 | ;; Metadata. | |
78 | (name environment-type-name) ; symbol | |
79 | (description environment-type-description ; string | |
80 | (default #f)) | |
81 | (location environment-type-location ; <location> | |
82 | (default (and=> (current-source-location) | |
83 | source-properties->location)) | |
84 | (innate))) | |
85 | ||
86 | \f | |
87 | ;;; | |
88 | ;;; Declarations for machines in a deployment. | |
89 | ;;; | |
90 | ||
a1d79208 | 91 | (define-record-type* <machine> machine make-machine |
fa9edf09 | 92 | machine? |
eaabc5e8 | 93 | (operating-system %machine-operating-system); <operating-system> |
d97ce204 JK |
94 | (environment machine-environment) ; symbol |
95 | (configuration machine-configuration ; configuration object | |
96 | (default #f))) ; specific to environment | |
fa9edf09 | 97 | |
eaabc5e8 LC |
98 | (define (machine-operating-system machine) |
99 | "Return the operating system of MACHINE." | |
100 | (operating-system-with-provenance | |
101 | (%machine-operating-system machine))) | |
102 | ||
fa9edf09 JK |
103 | (define (machine-display-name machine) |
104 | "Return the host-name identifying MACHINE." | |
d97ce204 | 105 | (operating-system-host-name (machine-operating-system machine))) |
fa9edf09 JK |
106 | |
107 | (define (machine-remote-eval machine exp) | |
108 | "Evaluate EXP, a gexp, on MACHINE. Ensure that all the elements EXP refers to | |
109 | are built and deployed to MACHINE beforehand." | |
110 | (let ((environment (machine-environment machine))) | |
111 | ((environment-type-machine-remote-eval environment) machine exp))) | |
112 | ||
113 | (define (deploy-machine machine) | |
114 | "Monadic procedure transferring the new system's OS closure to the remote | |
115 | MACHINE, activating it on MACHINE and switching MACHINE to the new generation." | |
116 | (let ((environment (machine-environment machine))) | |
117 | ((environment-type-deploy-machine environment) machine))) | |
9c70c460 JK |
118 | |
119 | (define (roll-back-machine machine) | |
120 | "Monadic procedure rolling back to the previous system generation on | |
121 | MACHINE. Return the number of the generation that was current before switching | |
122 | and the new generation number." | |
123 | (let ((environment (machine-environment machine))) | |
124 | ((environment-type-roll-back-machine environment) machine))) | |
125 | ||
126 | \f | |
127 | ;;; | |
128 | ;;; Error types. | |
129 | ;;; | |
130 | ||
131 | (define-condition-type &deploy-error &error | |
132 | deploy-error? | |
133 | (should-roll-back deploy-error-should-roll-back) | |
134 | (captured-args deploy-error-captured-args)) |