gtk and wayland update
[jackhill/guix/guix.git] / tests / channels.scm
CommitLineData
af12790b
RW
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
ca87601d 3;;; Copyright © 2019, 2020, 2022 Ludovic Courtès <ludo@gnu.org>
af12790b
RW
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 (test-channels)
21 #:use-module (guix channels)
ed75bdf3 22 #:use-module (guix profiles)
af12790b
RW
23 #:use-module ((guix build syscalls) #:select (mkdtemp!))
24 #:use-module (guix tests)
ed75bdf3 25 #:use-module (guix store)
ed75bdf3 26 #:use-module (guix derivations)
1fafc383 27 #:use-module (guix sets)
ed75bdf3 28 #:use-module (guix gexp)
a5e2fc73 29 #:use-module ((guix diagnostics)
d51bfe24
LC
30 #:select (error-location?
31 error-location location-line
32 formatted-message?
33 formatted-message-string
34 formatted-message-arguments))
8ba7fd3c
LC
35 #:use-module ((guix build utils) #:select (which))
36 #:use-module (git)
37 #:use-module (guix git)
43badf26
LC
38 #:use-module (guix git-authenticate)
39 #:use-module (guix openpgp)
8ba7fd3c 40 #:use-module (guix tests git)
43badf26 41 #:use-module (guix tests gnupg)
af12790b 42 #:use-module (srfi srfi-1)
ed75bdf3 43 #:use-module (srfi srfi-26)
45b90332
LC
44 #:use-module (srfi srfi-34)
45 #:use-module (srfi srfi-35)
af12790b 46 #:use-module (srfi srfi-64)
43badf26
LC
47 #:use-module (rnrs bytevectors)
48 #:use-module (rnrs io ports)
872898f7 49 #:use-module (ice-9 control)
af12790b
RW
50 #:use-module (ice-9 match))
51
43badf26
LC
52(define (gpg+git-available?)
53 (and (which (git-command))
54 (which (gpg-command)) (which (gpgconf-command))))
55
56(define commit-id-string
57 (compose oid->string commit-id))
58
59\f
af12790b
RW
60(test-begin "channels")
61
62(define* (make-instance #:key
63 (name 'fake)
64 (commit "cafebabe")
65 (spec #f))
66 (define instance-dir (mkdtemp! "/tmp/checkout.XXXXXX"))
ce5d9ec8
LC
67 (when spec
68 (call-with-output-file (string-append instance-dir "/.guix-channel")
69 (lambda (port) (write spec port))))
ed75bdf3
LC
70 (checkout->channel-instance instance-dir
71 #:commit commit
72 #:name name))
af12790b
RW
73
74(define instance--boring (make-instance))
45b90332
LC
75(define instance--unsupported-version
76 (make-instance #:spec
77 '(channel (version 42) (dependencies whatever))))
af12790b
RW
78(define instance--no-deps
79 (make-instance #:spec
ce5d9ec8
LC
80 '(channel (version 0))))
81(define instance--sub-directory
82 (make-instance #:spec
83 '(channel (version 0) (directory "modules"))))
af12790b
RW
84(define instance--simple
85 (make-instance #:spec
86 '(channel
87 (version 0)
88 (dependencies
89 (channel
90 (name test-channel)
91 (url "https://example.com/test-channel"))))))
92(define instance--with-dupes
93 (make-instance #:spec
94 '(channel
95 (version 0)
96 (dependencies
97 (channel
98 (name test-channel)
99 (url "https://example.com/test-channel"))
100 (channel
101 (name test-channel)
102 (url "https://example.com/test-channel")
103 (commit "abc1234"))
104 (channel
105 (name test-channel)
106 (url "https://example.com/test-channel-elsewhere"))))))
107
45b90332
LC
108(define channel-instance-metadata
109 (@@ (guix channels) channel-instance-metadata))
ce5d9ec8
LC
110(define channel-metadata-directory
111 (@@ (guix channels) channel-metadata-directory))
112(define channel-metadata-dependencies
113 (@@ (guix channels) channel-metadata-dependencies))
af12790b
RW
114
115\f
ce5d9ec8
LC
116(test-equal "channel-instance-metadata returns default if .guix-channel does not exist"
117 '("/" ())
118 (let ((metadata (channel-instance-metadata instance--boring)))
119 (list (channel-metadata-directory metadata)
120 (channel-metadata-dependencies metadata))))
121
122(test-equal "channel-instance-metadata and default dependencies"
123 '()
124 (channel-metadata-dependencies (channel-instance-metadata instance--no-deps)))
125
126(test-equal "channel-instance-metadata and directory"
127 "/modules"
128 (channel-metadata-directory
129 (channel-instance-metadata instance--sub-directory)))
45b90332
LC
130
131(test-equal "channel-instance-metadata rejects unsupported version"
132 1 ;line number in the generated '.guix-channel'
133 (guard (c ((and (message-condition? c) (error-location? c))
134 (location-line (error-location c))))
135 (channel-instance-metadata instance--unsupported-version)))
af12790b 136
45b90332 137(test-assert "channel-instance-metadata returns <channel-metadata>"
af12790b 138 (every (@@ (guix channels) channel-metadata?)
45b90332 139 (map channel-instance-metadata
af12790b
RW
140 (list instance--no-deps
141 instance--simple
142 instance--with-dupes))))
143
45b90332 144(test-assert "channel-instance-metadata dependencies are channels"
af12790b 145 (let ((deps ((@@ (guix channels) channel-metadata-dependencies)
45b90332 146 (channel-instance-metadata instance--simple))))
af12790b
RW
147 (match deps
148 (((? channel? dep)) #t)
149 (_ #f))))
150
151(test-assert "latest-channel-instances includes channel dependencies"
152 (let* ((channel (channel
153 (name 'test)
154 (url "test")))
155 (test-dir (channel-instance-checkout instance--simple)))
053b10c3 156 (mock ((guix git) update-cached-checkout
8d1d5657 157 (lambda* (url #:key ref starting-commit)
af12790b 158 (match url
8d1d5657 159 ("test" (values test-dir "caf3cabba9e" #f))
053b10c3 160 (_ (values (channel-instance-checkout instance--no-deps)
8d1d5657 161 "abcde1234" #f)))))
053b10c3
LC
162 (with-store store
163 (let ((instances (latest-channel-instances store (list channel))))
164 (and (eq? 2 (length instances))
165 (lset= eq?
166 '(test test-channel)
167 (map (compose channel-name channel-instance-channel)
168 instances))))))))
af12790b
RW
169
170(test-assert "latest-channel-instances excludes duplicate channel dependencies"
171 (let* ((channel (channel
172 (name 'test)
173 (url "test")))
174 (test-dir (channel-instance-checkout instance--with-dupes)))
053b10c3 175 (mock ((guix git) update-cached-checkout
8d1d5657 176 (lambda* (url #:key ref starting-commit)
af12790b 177 (match url
8d1d5657 178 ("test" (values test-dir "caf3cabba9e" #f))
053b10c3 179 (_ (values (channel-instance-checkout instance--no-deps)
8d1d5657 180 "abcde1234" #f)))))
053b10c3
LC
181 (with-store store
182 (let ((instances (latest-channel-instances store (list channel))))
183 (and (= 2 (length instances))
184 (lset= eq?
185 '(test test-channel)
186 (map (compose channel-name channel-instance-channel)
187 instances))
188 ;; only the most specific channel dependency should remain,
189 ;; i.e. the one with a specified commit.
190 (find (lambda (instance)
191 (and (eq? (channel-name
192 (channel-instance-channel instance))
193 'test-channel)
194 (string=? (channel-commit
195 (channel-instance-channel instance))
196 "abc1234")))
197 instances)))))))
af12790b 198
872898f7
LC
199(unless (which (git-command)) (test-skip 1))
200(test-equal "latest-channel-instances #:validate-pull"
201 'descendant
202
203 ;; Make sure the #:validate-pull procedure receives the right values.
204 (let/ec return
205 (with-temporary-git-repository directory
206 '((add "a.txt" "A")
207 (commit "first commit")
208 (add "b.scm" "#t")
209 (commit "second commit"))
210 (with-repository directory repository
211 (let* ((commit1 (find-commit repository "first"))
212 (commit2 (find-commit repository "second"))
213 (spec (channel (url (string-append "file://" directory))
214 (name 'foo)))
215 (new (channel (inherit spec)
216 (commit (oid->string (commit-id commit2)))))
217 (old (channel (inherit spec)
218 (commit (oid->string (commit-id commit1))))))
5bafc70d 219 (define (validate-pull channel current commit relation)
872898f7
LC
220 (return (and (eq? channel old)
221 (string=? (oid->string (commit-id commit2))
222 current)
223 (string=? (oid->string (commit-id commit1))
5bafc70d 224 commit)
872898f7
LC
225 relation)))
226
227 (with-store store
228 ;; Attempt a downgrade from NEW to OLD.
229 (latest-channel-instances store (list old)
230 #:current-channels (list new)
231 #:validate-pull validate-pull)))))))
232
ed75bdf3
LC
233(test-assert "channel-instances->manifest"
234 ;; Compute the manifest for a graph of instances and make sure we get a
235 ;; derivation graph that mirrors the instance graph. This test also ensures
236 ;; we don't try to access Git repositores at all at this stage.
237 (let* ((spec (lambda deps
238 `(channel (version 0)
239 (dependencies
240 ,@(map (lambda (dep)
241 `(channel
242 (name ,dep)
243 (url "http://example.org")))
244 deps)))))
245 (guix (make-instance #:name 'guix))
246 (instance0 (make-instance #:name 'a))
247 (instance1 (make-instance #:name 'b #:spec (spec 'a)))
248 (instance2 (make-instance #:name 'c #:spec (spec 'b)))
249 (instance3 (make-instance #:name 'd #:spec (spec 'c 'a))))
250 (%graft? #f) ;don't try to build stuff
251
252 ;; Create 'build-self.scm' so that GUIX is recognized as the 'guix' channel.
253 (let ((source (channel-instance-checkout guix)))
254 (mkdir (string-append source "/build-aux"))
255 (call-with-output-file (string-append source
256 "/build-aux/build-self.scm")
257 (lambda (port)
258 (write '(begin
259 (use-modules (guix) (gnu packages bootstrap))
260
261 (lambda _
262 (package->derivation %bootstrap-guile)))
263 port))))
264
265 (with-store store
266 (let ()
267 (define manifest
268 (run-with-store store
269 (channel-instances->manifest (list guix
270 instance0 instance1
271 instance2 instance3))))
272
273 (define entries
274 (manifest-entries manifest))
275
276 (define (depends? drv in out)
1fafc383
LC
277 ;; Return true if DRV depends (directly or indirectly) on all of IN
278 ;; and none of OUT.
279 (let ((set (list->set
280 (requisites store
281 (list (derivation-file-name drv)))))
ed75bdf3
LC
282 (in (map derivation-file-name in))
283 (out (map derivation-file-name out)))
1fafc383
LC
284 (and (every (cut set-contains? set <>) in)
285 (not (any (cut set-contains? set <>) out)))))
ed75bdf3
LC
286
287 (define (lookup name)
288 (run-with-store store
289 (lower-object
290 (manifest-entry-item
291 (manifest-lookup manifest
292 (manifest-pattern (name name)))))))
293
294 (let ((drv-guix (lookup "guix"))
295 (drv0 (lookup "a"))
296 (drv1 (lookup "b"))
297 (drv2 (lookup "c"))
298 (drv3 (lookup "d")))
299 (and (depends? drv-guix '() (list drv0 drv1 drv2 drv3))
300 (depends? drv0
301 (list) (list drv1 drv2 drv3))
302 (depends? drv1
303 (list drv0) (list drv2 drv3))
304 (depends? drv2
1fafc383 305 (list drv1) (list drv3))
ed75bdf3 306 (depends? drv3
1fafc383 307 (list drv2 drv0) (list))))))))
ed75bdf3 308
8ba7fd3c
LC
309(unless (which (git-command)) (test-skip 1))
310(test-equal "channel-news, no news"
311 '()
312 (with-temporary-git-repository directory
313 '((add "a.txt" "A")
314 (commit "the commit"))
315 (with-repository directory repository
316 (let ((channel (channel (url (string-append "file://" directory))
317 (name 'foo)))
318 (latest (reference-name->oid repository "HEAD")))
319 (channel-news-for-commit channel (oid->string latest))))))
320
321(unless (which (git-command)) (test-skip 1))
322(test-assert "channel-news, one entry"
323 (with-temporary-git-repository directory
324 `((add ".guix-channel"
325 ,(object->string
326 '(channel (version 0)
327 (news-file "news.scm"))))
328 (commit "first commit")
329 (add "src/a.txt" "A")
330 (commit "second commit")
9719e8d3 331 (tag "tag-for-first-news-entry")
8ba7fd3c
LC
332 (add "news.scm"
333 ,(lambda (repository)
334 (let ((previous
335 (reference-name->oid repository "HEAD")))
336 (object->string
337 `(channel-news
338 (version 0)
339 (entry (commit ,(oid->string previous))
340 (title (en "New file!")
341 (eo "Nova dosiero!"))
342 (body (en "Yeah, a.txt."))))))))
343 (commit "third commit")
344 (add "src/b.txt" "B")
345 (commit "fourth commit")
346 (add "news.scm"
347 ,(lambda (repository)
348 (let ((second
349 (commit-id
350 (find-commit repository "second commit")))
351 (previous
352 (reference-name->oid repository "HEAD")))
353 (object->string
354 `(channel-news
355 (version 0)
356 (entry (commit ,(oid->string previous))
357 (title (en "Another file!"))
358 (body (en "Yeah, b.txt.")))
9719e8d3 359 (entry (tag "tag-for-first-news-entry")
8ba7fd3c
LC
360 (title (en "Old news.")
361 (eo "Malnovaĵoj."))
362 (body (en "For a.txt"))))))))
363 (commit "fifth commit"))
364 (with-repository directory repository
365 (define (find-commit* message)
366 (oid->string (commit-id (find-commit repository message))))
367
368 (let ((channel (channel (url (string-append "file://" directory))
369 (name 'foo)))
370 (commit1 (find-commit* "first commit"))
371 (commit2 (find-commit* "second commit"))
372 (commit3 (find-commit* "third commit"))
373 (commit4 (find-commit* "fourth commit"))
374 (commit5 (find-commit* "fifth commit")))
375 ;; First try fetching all the news up to a given commit.
376 (and (null? (channel-news-for-commit channel commit2))
377 (lset= string=?
378 (map channel-news-entry-commit
379 (channel-news-for-commit channel commit5))
380 (list commit2 commit4))
381 (lset= equal?
382 (map channel-news-entry-title
383 (channel-news-for-commit channel commit5))
384 '((("en" . "Another file!"))
385 (("en" . "Old news.") ("eo" . "Malnovaĵoj."))))
386 (lset= string=?
387 (map channel-news-entry-commit
388 (channel-news-for-commit channel commit3))
389 (list commit2))
390
391 ;; Now fetch news entries that apply to a commit range.
392 (lset= string=?
393 (map channel-news-entry-commit
394 (channel-news-for-commit channel commit3 commit1))
395 (list commit2))
396 (lset= string=?
397 (map channel-news-entry-commit
398 (channel-news-for-commit channel commit5 commit3))
399 (list commit4))
400 (lset= string=?
401 (map channel-news-entry-commit
402 (channel-news-for-commit channel commit5 commit1))
9719e8d3
LC
403 (list commit4 commit2))
404 (lset= equal?
405 (map channel-news-entry-tag
406 (channel-news-for-commit channel commit5 commit1))
407 '(#f "tag-for-first-news-entry")))))))
8ba7fd3c 408
778c1fb4
LC
409(unless (which (git-command)) (test-skip 1))
410(test-assert "channel-news, annotated tag"
411 (with-temporary-git-repository directory
412 `((add ".guix-channel"
413 ,(object->string
414 '(channel (version 0)
415 (news-file "news.scm"))))
416 (add "src/a.txt" "A")
417 (commit "first commit")
418 (tag "tag-for-first-news-entry"
419 "This is an annotated tag.")
420 (add "news.scm"
421 ,(lambda (repository)
422 (let ((previous
423 (reference-name->oid repository "HEAD")))
424 (object->string
425 `(channel-news
426 (version 0)
427 (entry (tag "tag-for-first-news-entry")
428 (title (en "New file!"))
429 (body (en "Yeah, a.txt."))))))))
430 (commit "second commit"))
431 (with-repository directory repository
432 (define (find-commit* message)
433 (oid->string (commit-id (find-commit repository message))))
434
435 (let ((channel (channel (url (string-append "file://" directory))
436 (name 'foo)))
437 (commit1 (find-commit* "first commit"))
438 (commit2 (find-commit* "second commit")))
439 (and (null? (channel-news-for-commit channel commit1))
440 (lset= equal?
441 (map channel-news-entry-title
442 (channel-news-for-commit channel commit2))
443 '((("en" . "New file!"))))
444 (lset= string=?
445 (map channel-news-entry-tag
446 (channel-news-for-commit channel commit2))
447 (list "tag-for-first-news-entry"))
448 ;; This is an annotated tag, but 'channel-news-entry-commit'
449 ;; should give us the commit ID, not the ID of the annotated tag
450 ;; object.
451 (lset= string=?
452 (map channel-news-entry-commit
453 (channel-news-for-commit channel commit2))
454 (list commit1)))))))
455
ead5c461
LC
456(unless (which (git-command)) (test-skip 1))
457(test-assert "latest-channel-instances, missing introduction for 'guix'"
458 (with-temporary-git-repository directory
459 '((add "a.txt" "A")
460 (commit "first commit")
461 (add "b.scm" "#t")
462 (commit "second commit"))
463 (with-repository directory repository
464 (let* ((commit1 (find-commit repository "first"))
465 (commit2 (find-commit repository "second"))
466 (channel (channel (url (string-append "file://" directory))
467 (name 'guix))))
468
d51bfe24
LC
469 (guard (c ((formatted-message? c)
470 (->bool (string-contains (formatted-message-string c)
ead5c461
LC
471 "introduction"))))
472 (with-store store
473 ;; Attempt a downgrade from NEW to OLD.
474 (latest-channel-instances store (list channel))
475 #f))))))
476
43badf26 477(unless (gpg+git-available?) (test-skip 1))
a18d02de
LC
478(test-equal "authenticate-channel, wrong first commit signer"
479 #t
43badf26
LC
480 (with-fresh-gnupg-setup (list %ed25519-public-key-file
481 %ed25519-secret-key-file
9ebc9ca0
AL
482 %ed25519-2-public-key-file
483 %ed25519-2-secret-key-file)
43badf26
LC
484 (with-temporary-git-repository directory
485 `((add ".guix-channel"
486 ,(object->string
487 '(channel (version 0)
488 (keyring-reference "master"))))
489 (add ".guix-authorizations"
490 ,(object->string
491 `(authorizations (version 0)
492 ((,(key-fingerprint
493 %ed25519-public-key-file)
494 (name "Charlie"))))))
495 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
496 get-string-all))
497 (commit "first commit"
a18d02de
LC
498 (signer ,(key-fingerprint %ed25519-public-key-file)))
499 (add "random" ,(random-text))
500 (commit "second commit"
43badf26
LC
501 (signer ,(key-fingerprint %ed25519-public-key-file))))
502 (with-repository directory repository
503 (let* ((commit1 (find-commit repository "first"))
a18d02de 504 (commit2 (find-commit repository "second"))
8b7d982e 505 (intro (make-channel-introduction
43badf26
LC
506 (commit-id-string commit1)
507 (openpgp-public-key-fingerprint
508 (read-openpgp-packet
9ebc9ca0 509 %ed25519-2-public-key-file)))) ;different key
43badf26
LC
510 (channel (channel (name 'example)
511 (url (string-append "file://" directory))
512 (introduction intro))))
d51bfe24
LC
513 (guard (c ((formatted-message? c)
514 (and (string-contains (formatted-message-string c)
515 "initial commit")
516 (equal? (formatted-message-arguments c)
517 (list
518 (oid->string (commit-id commit1))
519 (key-fingerprint %ed25519-public-key-file)
520 (key-fingerprint
9ebc9ca0 521 %ed25519-2-public-key-file))))))
ca87601d
LC
522 (authenticate-channel channel directory
523 (commit-id-string commit2)
524 #:keyring-reference-prefix "")
525 'failed))))))
526
527(unless (gpg+git-available?) (test-skip 1))
528(test-equal "authenticate-channel, not a descendant of introductory commit"
529 #t
530 (with-fresh-gnupg-setup (list %ed25519-public-key-file
531 %ed25519-secret-key-file
532 %ed25519-2-public-key-file
533 %ed25519-2-secret-key-file)
534 (with-temporary-git-repository directory
535 `((add ".guix-channel"
536 ,(object->string
537 '(channel (version 0)
538 (keyring-reference "master"))))
539 (add ".guix-authorizations"
540 ,(object->string
541 `(authorizations (version 0)
542 ((,(key-fingerprint
543 %ed25519-public-key-file)
544 (name "Charlie"))))))
545 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
546 get-string-all))
547 (commit "first commit"
548 (signer ,(key-fingerprint %ed25519-public-key-file)))
549 (branch "alternate-branch")
550 (checkout "alternate-branch")
551 (add "something.txt" ,(random-text))
552 (commit "intro commit"
553 (signer ,(key-fingerprint %ed25519-public-key-file)))
554 (checkout "master")
555 (add "random" ,(random-text))
556 (commit "second commit"
557 (signer ,(key-fingerprint %ed25519-public-key-file))))
558 (with-repository directory repository
559 (let* ((commit1 (find-commit repository "first"))
560 (commit2 (find-commit repository "second"))
561 (commit0 (commit-lookup
562 repository
563 (reference-target
564 (branch-lookup repository "alternate-branch"))))
565 (intro (make-channel-introduction
566 (commit-id-string commit0)
567 (openpgp-public-key-fingerprint
568 (read-openpgp-packet
569 %ed25519-public-key-file))))
570 (channel (channel (name 'example)
571 (url (string-append "file://" directory))
572 (introduction intro))))
573 (guard (c ((formatted-message? c)
574 (and (string-contains (formatted-message-string c)
575 "not a descendant")
576 (equal? (formatted-message-arguments c)
577 (list
578 (oid->string (commit-id commit2))
579 (oid->string (commit-id commit0)))))))
43badf26 580 (authenticate-channel channel directory
a18d02de 581 (commit-id-string commit2)
43badf26
LC
582 #:keyring-reference-prefix "")
583 'failed))))))
584
585(unless (gpg+git-available?) (test-skip 1))
884df776
LC
586(test-equal "authenticate-channel, .guix-authorizations"
587 #t
43badf26
LC
588 (with-fresh-gnupg-setup (list %ed25519-public-key-file
589 %ed25519-secret-key-file
9ebc9ca0
AL
590 %ed25519-2-public-key-file
591 %ed25519-2-secret-key-file)
43badf26
LC
592 (with-temporary-git-repository directory
593 `((add ".guix-channel"
594 ,(object->string
595 '(channel (version 0)
596 (keyring-reference "channel-keyring"))))
597 (add ".guix-authorizations"
598 ,(object->string
599 `(authorizations (version 0)
600 ((,(key-fingerprint
601 %ed25519-public-key-file)
602 (name "Charlie"))))))
603 (commit "zeroth commit")
604 (add "a.txt" "A")
605 (commit "first commit"
606 (signer ,(key-fingerprint %ed25519-public-key-file)))
607 (add "b.txt" "B")
608 (commit "second commit"
609 (signer ,(key-fingerprint %ed25519-public-key-file)))
610 (add "c.txt" "C")
611 (commit "third commit"
9ebc9ca0 612 (signer ,(key-fingerprint %ed25519-2-public-key-file)))
43badf26
LC
613 (branch "channel-keyring")
614 (checkout "channel-keyring")
615 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
616 get-string-all))
9ebc9ca0 617 (add "other.key" ,(call-with-input-file %ed25519-2-public-key-file
43badf26
LC
618 get-string-all))
619 (commit "keyring commit")
620 (checkout "master"))
621 (with-repository directory repository
622 (let* ((commit1 (find-commit repository "first"))
623 (commit2 (find-commit repository "second"))
624 (commit3 (find-commit repository "third"))
8b7d982e 625 (intro (make-channel-introduction
43badf26
LC
626 (commit-id-string commit1)
627 (openpgp-public-key-fingerprint
628 (read-openpgp-packet
8b7d982e 629 %ed25519-public-key-file))))
43badf26
LC
630 (channel (channel (name 'example)
631 (url (string-append "file://" directory))
632 (introduction intro))))
633 ;; COMMIT1 and COMMIT2 are fine.
634 (and (authenticate-channel channel directory
635 (commit-id-string commit2)
636 #:keyring-reference-prefix "")
637
638 ;; COMMIT3 is signed by an unauthorized key according to its
639 ;; parent's '.guix-authorizations' file.
640 (guard (c ((unauthorized-commit-error? c)
641 (and (oid=? (git-authentication-error-commit c)
642 (commit-id commit3))
643 (bytevector=?
644 (openpgp-public-key-fingerprint
645 (unauthorized-commit-error-signing-key c))
646 (openpgp-public-key-fingerprint
647 (read-openpgp-packet
9ebc9ca0 648 %ed25519-2-public-key-file))))))
43badf26
LC
649 (authenticate-channel channel directory
650 (commit-id-string commit3)
651 #:keyring-reference-prefix "")
652 'failed)))))))
653
d774c7b1
LC
654(unless (gpg+git-available?) (test-skip 1))
655(test-equal "latest-channel-instances, authenticate dependency"
656 #t
657 ;; Make sure that a channel dependency that has an introduction is
658 ;; authenticated. This test checks that an authentication error is raised
659 ;; as it should when authenticating the dependency.
660 (with-fresh-gnupg-setup (list %ed25519-public-key-file
661 %ed25519-secret-key-file)
662 (with-temporary-git-repository dependency-directory
663 `((add ".guix-channel"
664 ,(object->string
665 '(channel (version 0)
666 (keyring-reference "master"))))
667 (add ".guix-authorizations"
668 ,(object->string
669 `(authorizations (version 0) ())))
670 (add "signer.key" ,(call-with-input-file %ed25519-public-key-file
671 get-string-all))
672 (commit "zeroth commit"
673 (signer ,(key-fingerprint %ed25519-public-key-file)))
674 (add "foo.txt" "evil")
675 (commit "unsigned commit"))
676 (with-repository dependency-directory dependency
677 (let* ((commit0 (find-commit dependency "zeroth"))
678 (commit1 (find-commit dependency "unsigned"))
679 (intro `(channel-introduction
680 (version 0)
681 (commit ,(commit-id-string commit0))
682 (signer ,(openpgp-format-fingerprint
683 (openpgp-public-key-fingerprint
684 (read-openpgp-packet
685 %ed25519-public-key-file)))))))
686 (with-temporary-git-repository directory
687 `((add ".guix-channel"
688 ,(object->string
689 `(channel (version 0)
690 (dependencies
691 (channel
692 (name test-channel)
693 (url ,dependency-directory)
694 (introduction ,intro))))))
695 (commit "single commit"))
696 (let ((channel (channel (name 'test) (url directory))))
697 (guard (c ((unsigned-commit-error? c)
698 (oid=? (git-authentication-error-commit c)
699 (commit-id commit1))))
700 (with-store store
701 (latest-channel-instances store (list channel))
702 'failed)))))))))
703
af12790b 704(test-end "channels")