From ce507041f79bd66f54ce406d20b9e33a328a3f3d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 20 Dec 2013 15:22:15 +0100
Subject: 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.
---
 tests/pk-crypto.scm | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

(limited to 'tests/pk-crypto.scm')

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))
-- 
cgit v1.2.3