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 . (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"