summaryrefslogtreecommitdiff
path: root/tests
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-20 15:22:15 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-20 15:22:15 +0100
commitce507041f79bd66f54ce406d20b9e33a328a3f3d (patch)
treecf19d2a4e7b5a04c335eadf92503eb7ba1eede7e /tests
parent971cb56dd0c1a1cb265d2adfe41730cd2f8c5c22 (diff)
pk-crypto: Add a few sexp utility procedures.
* guix/pk-crypto.scm (gcry-sexp-car, gcry-sexp-cdr, gcry-sexp-nth, gcry-sexp-nth-data, dereference-size_t, latin1-string->bytevector, hash-data->bytevector): New procedures. * tests/pk-crypto.scm ("gcry-sexp-car + cdr", "gcry-sexp-nth", "gcry-sexp-nth-data", "bytevector->hash-data->bytevector"): New tests.
Diffstat (limited to 'tests')
-rw-r--r--tests/pk-crypto.scm42
1 files changed, 42 insertions, 0 deletions
diff --git a/tests/pk-crypto.scm b/tests/pk-crypto.scm
index 1acce13f0a..7c54e729ad 100644
--- a/tests/pk-crypto.scm
+++ b/tests/pk-crypto.scm
@@ -21,6 +21,8 @@
#:use-module (guix utils)
#:use-module (guix hash)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-64)
#:use-module (rnrs bytevectors)
#:use-module (rnrs io ports)
@@ -75,6 +77,38 @@
(gc)
+(test-equal "gcry-sexp-car + cdr"
+ '("(b \n (c xyz)\n )")
+ (let ((lst (string->gcry-sexp "(a (b (c xyz)))")))
+ (map (lambda (sexp)
+ (and sexp (string-trim-both (gcry-sexp->string sexp))))
+ ;; Note: 'car' returns #f when the first element is an atom.
+ (list (gcry-sexp-car (gcry-sexp-cdr lst))))))
+
+(gc)
+
+(test-equal "gcry-sexp-nth"
+ '(#f "(b pqr)" "(c \"456\")" "(d xyz)" #f #f)
+ (let ((lst (string->gcry-sexp "(a (b 3:pqr) (c 3:456) (d 3:xyz))")))
+ (map (lambda (sexp)
+ (and sexp (string-trim-both (gcry-sexp->string sexp))))
+ (unfold (cut > <> 5)
+ (cut gcry-sexp-nth lst <>)
+ 1+
+ 0))))
+
+(gc)
+
+(test-equal "gcry-sexp-nth-data"
+ '("Name" "Otto" "Meier" #f #f #f)
+ (let ((lst (string->gcry-sexp "(Name Otto Meier (address Burgplatz))")))
+ (unfold (cut > <> 5)
+ (cut gcry-sexp-nth-data lst <>)
+ 1+
+ 0)))
+
+(gc)
+
;; XXX: The test below is typically too long as it needs to gather enough entropy.
;; (test-assert "generate-key"
@@ -85,6 +119,14 @@
;; (find-sexp-token key 'public-key)
;; (find-sexp-token key 'private-key))))
+(test-assert "bytevector->hash-data->bytevector"
+ (let* ((bv (sha256 (string->utf8 "Hello, world.")))
+ (data (bytevector->hash-data bv "sha256")))
+ (and (gcry-sexp? data)
+ (let-values (((value algo) (hash-data->bytevector data)))
+ (and (string=? algo "sha256")
+ (bytevector=? value bv))))))
+
(test-assert "sign + verify"
(let* ((pair (string->gcry-sexp %key-pair))
(secret (find-sexp-token pair 'private-key))