01/02: store: Add query-path-info operation.

[David Thompson]

davexunit pushed a commit to branch master
in repository guix.

commit 533d1768f47520ac7010adc550b0dd9783ebb011
Author: David Thompson <address@hidden>
Date:   Tue Mar 17 10:19:36 2015 -0400

    store: Add query-path-info operation.
    
    * guix/store.scm (<path-info>): New record type.
      (read-path-info): New procedure.
      (read-arg): Add 'path-info' syntax.
      (query-path-info): New variable.
    * tests/store.scm ("query-path-info"): New test.
---
 guix/store.scm  |   34 +++++++++++++++++++++++++++++++++-
 tests/store.scm |   10 ++++++++++
 2 files changed, 43 insertions(+), 1 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 3d6b069..10b9062 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -60,6 +60,7 @@
             valid-path?
             query-path-hash
             hash-part->path
+            query-path-info
             add-text-to-store
             add-to-store
             build-things
@@ -79,6 +80,13 @@
             substitutable-paths
             substitutable-path-info
 
+            path-info?
+            path-info-deriver
+            path-info-hash
+            path-info-references
+            path-info-registration-time
+            path-info-nar-size
+
             references
             requisites
             referrers
@@ -212,6 +220,24 @@
                 (cons (substitutable path deriver refs dl-size nar-size)
                       result))))))
 
+;; Information about a store path.
+(define-record-type <path-info>
+  (path-info deriver hash references registration-time nar-size)
+  path-info?
+  (deriver path-info-deriver)
+  (hash path-info-hash)
+  (references path-info-references)
+  (registration-time path-info-registration-time)
+  (nar-size path-info-nar-size))
+
+(define (read-path-info p)
+  (let ((deriver  (read-store-path p))
+        (hash     (base16-string->bytevector (read-string p)))
+        (refs     (read-store-path-list p))
+        (registration-time (read-int p))
+        (nar-size (read-long-long p)))
+    (path-info deriver hash refs registration-time nar-size)))
+
 (define-syntax write-arg
   (syntax-rules (integer boolean file string string-list string-pairs
                  store-path store-path-list base16)
@@ -236,7 +262,7 @@
 
 (define-syntax read-arg
   (syntax-rules (integer boolean string store-path store-path-list
-                 substitutable-path-list base16)
+                 substitutable-path-list path-info base16)
     ((_ integer p)
      (read-int p))
     ((_ boolean p)
@@ -249,6 +275,8 @@
      (read-store-path-list p))
     ((_ substitutable-path-list p)
      (read-substitutable-path-list p))
+    ((_ path-info p)
+     (read-path-info p))
     ((_ base16 p)
      (base16-string->bytevector (read-string p)))))
 
@@ -541,6 +569,10 @@ string).  Raise an error if no such path exists."
      ;; /HASH.narinfo.
      (query-path-from-hash-part server hash-part))))
 
+(define-operation (query-path-info (store-path path))
+  "Return the info (hash, references, etc.) for PATH."
+  path-info)
+
 (define add-text-to-store
   ;; A memoizing version of `add-to-store', to avoid repeated RPCs with
   ;; the very same arguments during a given session.
diff --git a/tests/store.scm b/tests/store.scm
index f778c20..eeceed4 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -606,6 +606,16 @@
          (file (add %store "foo" "Lowered.")))
     (call-with-input-file file get-string-all)))
 
+(test-assert "query-path-info"
+  (let* ((ref (add-text-to-store %store "ref" "foo"))
+         (item (add-text-to-store %store "item" "bar" (list ref)))
+         (info (query-path-info %store item)))
+    (and (equal? (path-info-references info) (list ref))
+         (equal? (path-info-hash info)
+                 (sha256
+                  (string->utf8
+                   (call-with-output-string (cut write-file item <>))))))))
+
 (test-end "store")