mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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.
This commit is contained in:
parent
4cd27cd60a
commit
533d1768f4
2 changed files with 43 additions and 1 deletions
|
@ -60,6 +60,7 @@ (define-module (guix store)
|
|||
valid-path?
|
||||
query-path-hash
|
||||
hash-part->path
|
||||
query-path-info
|
||||
add-text-to-store
|
||||
add-to-store
|
||||
build-things
|
||||
|
@ -79,6 +80,13 @@ (define-module (guix store)
|
|||
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 @@ (define (read-substitutable-path-list p)
|
|||
(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 write-arg
|
|||
|
||||
(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 @@ (define-syntax read-arg
|
|||
(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 @@ (define hash-part->path
|
|||
;; /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.
|
||||
|
|
|
@ -606,6 +606,16 @@ (define (same? x y)
|
|||
(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")
|
||||
|
||||
|
||||
|
|
Loading…
Reference in a new issue