From 82058eff591866085633679ecfc108020dd99820 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 24 Oct 2012 17:03:45 +0200
Subject: store: Add `query-path-hash'.

* guix/store.scm (write-arg, read-arg): Add `base16' literal and
  corresponding rule.
  (query-path-hash): New operation.

* tests/derivations.scm ("fixed-output derivation"): Check whether
  `query-path-hash' returns a bytevector.
---
 guix/store.scm        | 18 ++++++++++++++----
 tests/derivations.scm |  5 +++--
 2 files changed, 17 insertions(+), 6 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 9c965af605..34421a11df 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -17,6 +17,7 @@
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix store)
+  #:use-module (guix utils)
   #:use-module (rnrs bytevectors)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
@@ -44,6 +45,7 @@
             close-connection
             set-build-options
             valid-path?
+            query-path-hash
             add-text-to-store
             add-to-store
             build-derivations
@@ -217,7 +219,7 @@
       (write-string ")" p))))
 
 (define-syntax write-arg
-  (syntax-rules (integer boolean file string string-list)
+  (syntax-rules (integer boolean file string string-list base16)
     ((_ integer arg p)
      (write-int arg p))
     ((_ boolean arg p)
@@ -227,10 +229,12 @@
     ((_ string arg p)
      (write-string arg p))
     ((_ string-list arg p)
-     (write-string-list arg p))))
+     (write-string-list arg p))
+    ((_ base16 arg p)
+     (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path)
+  (syntax-rules (integer boolean string store-path base16)
     ((_ integer p)
      (read-int p))
     ((_ boolean p)
@@ -238,7 +242,9 @@
     ((_ string p)
      (read-string p))
     ((_ store-path p)
-     (read-store-path p))))
+     (read-store-path p))
+    ((_ hash p)
+     (base16-string->bytevector (read-string p)))))
 
 
 ;; remote-store.cc
@@ -391,6 +397,10 @@ again until #t is returned or an error is raised."
   "Return #t when PATH is a valid store path."
   boolean)
 
+(define-operation (query-path-hash (string path))
+  "Return the SHA256 hash of PATH as a bytevector."
+  base16)
+
 (define-operation (add-text-to-store (string name) (string text)
                                      (string-list references))
   "Add TEXT under file NAME in the store."
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 95507aa780..a0cca9386b 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -124,8 +124,9 @@
          (succeeded? (build-derivations %store (list drv-path))))
     (and succeeded?
          (let ((p (derivation-path->output-path drv-path)))
-           (equal? (string->utf8 "hello")
-                   (call-with-input-file p get-bytevector-all))))))
+           (and (equal? (string->utf8 "hello")
+                        (call-with-input-file p get-bytevector-all))
+                (bytevector? (query-path-hash %store p)))))))
 
 (test-assert "multiple-output derivation"
   (let* ((builder    (add-text-to-store %store "my-fixed-builder.sh"
-- 
cgit 1.4.1