summary refs log tree commit diff
path: root/tests/substitute-binary.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-31 23:47:02 +0200
committerLudovic Courtès <ludo@gnu.org>2014-03-31 23:47:02 +0200
commite4687a5e68fce458685dd33bfa240758c816b3a2 (patch)
treea104d2d3cdbf73f9bc740e21b442cfedcd99d5f3 /tests/substitute-binary.scm
parent81deef270ded7dabcc623d9522ae593ed02160af (diff)
downloadguix-e4687a5e68fce458685dd33bfa240758c816b3a2.tar.gz
Use 'signature-case' in (guix nar) and 'substitute-binary'.
* guix/nar.scm (restore-file-set)[assert-valid-signature]: Rewrite in
  terms of 'signature-case'.
* guix/scripts/substitute-binary.scm (narinfo-signature->canonical-sexp):
  Call 'leave' instead of 'raise' when SIGNATURE is invalid.
  (&nar-signature-error, &nar-invalid-hash-error): Remove.
  (assert-valid-signature): Add 'narinfo' parameter; remove 'port'.
  Rewrite in terms of 'signature-case' and 'leave'.  Mention NARINFO's
  URI in error messages.  Adjust caller.
  (narinfo-sha256): New procedure.
  (assert-valid-narinfo): Use it.
  (valid-narinfo?): Rewrite using 'narinfo-sha256' and
  'signature-case'.
* tests/substitute-binary.scm (assert-valid-signature,
  test-error-condition): Remove.
  ("corrupt signature data", "unauthorized public key", "invalid
  signature"): Remove.
Diffstat (limited to 'tests/substitute-binary.scm')
-rw-r--r--tests/substitute-binary.scm41
1 files changed, 0 insertions, 41 deletions
diff --git a/tests/substitute-binary.scm b/tests/substitute-binary.scm
index 917a0cd55c..8bde7f6aaf 100644
--- a/tests/substitute-binary.scm
+++ b/tests/substitute-binary.scm
@@ -38,13 +38,6 @@
   #:use-module (srfi srfi-35)
   #:use-module ((srfi srfi-64) #:hide (test-error)))
 
-(define assert-valid-signature
-  ;; (guix scripts substitute-binary) does not export this function in order to
-  ;; avoid misuse.
-  (@@ (guix scripts substitute-binary) assert-valid-signature))
-
-;;; XXX: Replace with 'test-error' from SRFI-64 as soon as it allow us to
-;;; catch specific exceptions.
 (define-syntax-rule (test-quit name error-rx exp)
   "Emit a test that passes when EXP throws to 'quit' with value 1, and when
 it writes to GUIX-WARNING-PORT a messages that matches ERROR-RX."
@@ -117,39 +110,6 @@ version identifier.."
 (test-assert "valid narinfo-signature->canonical-sexp"
   (canonical-sexp? (narinfo-signature->canonical-sexp (signature-field "foo"))))
 
-(define-syntax-rule (test-error-condition name pred message-rx exp)
-  (test-assert name
-    (guard (condition ((pred condition)
-                       (and (string-match message-rx
-                                          (condition-message condition))
-                            #t))
-                      (else #f))
-      exp
-      #f)))
-
-(test-error-condition "corrupt signature data"
-    nar-signature-error? "corrupt"
-  (assert-valid-signature (string->canonical-sexp "(foo bar baz)") "irrelevant"
-                          (open-input-string "irrelevant")
-                          (public-keys->acl (list %public-key))))
-
-(test-error-condition "unauthorized public key"
-    nar-signature-error? "unauthorized"
-  (assert-valid-signature (narinfo-signature->canonical-sexp
-                           (signature-field "foo"))
-                          "irrelevant"
-                          (open-input-string "irrelevant")
-                          (public-keys->acl '())))
-
-(test-error-condition "invalid signature"
-    nar-signature-error? "invalid signature"
-  (let ((message "this is the message that we sign"))
-    (assert-valid-signature (narinfo-signature->canonical-sexp
-                             (signature-field message
-                                              #:public-key %wrong-public-key))
-                            (sha256 (string->utf8 message))
-                            (open-input-string "irrelevant")
-                            (public-keys->acl (list %wrong-public-key)))))
 
 
 (define %narinfo
@@ -317,6 +277,5 @@ a file for NARINFO."
 
 ;;; Local Variables:
 ;;; eval: (put 'with-narinfo 'scheme-indent-function 1)
-;;; eval: (put 'test-error-condition 'scheme-indent-function 3)
 ;;; eval: (put 'test-quit 'scheme-indent-function 2)
 ;;; End: