diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2012-10-24 17:03:45 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2012-10-24 23:52:15 +0200 |
| commit | 82058eff591866085633679ecfc108020dd99820 (patch) | |
| tree | 270924f4ee4f8e8ca3e980604e205769f96c6fd6 | |
| parent | e6cc3d86543581288239f58db02ca01a0f132562 (diff) | |
| download | gnu-guix-82058eff591866085633679ecfc108020dd99820.tar gnu-guix-82058eff591866085633679ecfc108020dd99820.tar.gz | |
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.
| -rw-r--r-- | guix/store.scm | 18 | ||||
| -rw-r--r-- | 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" |