tests/channels.scm

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