From 0f3d2504f75595a2db2a2344b624ced2ba307448 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 3 Feb 2013 23:24:25 +0100
Subject: store: Add substitute-related procedures.

* guix/store.scm (has-substitutes?, substitutable-paths,
  read-substitutable-path-list, substitutable-path-info): New
  procedures.
  (<substitutable>): New record type.
  (read-arg): Add `substitutable-path-info'.  Change `hash' pattern
  variable to `base16' literal.
* tests/store.scm ("no substitutes"): New test.
---
 guix/store.scm  | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 tests/store.scm | 15 ++++++++++++++-
 2 files changed, 69 insertions(+), 3 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 0a6285deac..6a3f036a8c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -54,6 +54,16 @@
             add-temp-root
             add-indirect-root
 
+            substitutable?
+            substitutable-path
+            substitutable-deriver
+            substitutable-references
+            substitutable-download-size
+            substitutable-nar-size
+            has-substitutes?
+            substitutable-paths
+            substitutable-path-info
+
             live-paths
             dead-paths
             collect-garbage
@@ -268,6 +278,30 @@
          (error "ENOSYS")))
       (write-string ")" p))))
 
+;; Information about a substitutable store path.
+(define-record-type <substitutable>
+  (substitutable path deriver refs dl-size nar-size)
+  substitutable?
+  (path      substitutable-path)
+  (deriver   substitutable-deriver)
+  (refs      substitutable-references)
+  (dl-size   substitutable-download-size)
+  (nar-size  substitutable-nar-size))
+
+(define (read-substitutable-path-list p)
+  (let loop ((len    (read-int p))
+             (result '()))
+    (if (zero? len)
+        (reverse result)
+        (let ((path     (read-store-path p))
+              (deriver  (read-store-path p))
+              (refs     (read-store-path-list p))
+              (dl-size  (read-long-long p))
+              (nar-size (read-long-long p)))
+          (loop (- len 1)
+                (cons (substitutable path deriver refs dl-size nar-size)
+                      result))))))
+
 (define-syntax write-arg
   (syntax-rules (integer boolean file string string-list
                  store-path store-path-list base16)
@@ -289,7 +323,8 @@
      (write-string (bytevector->base16-string arg) p))))
 
 (define-syntax read-arg
-  (syntax-rules (integer boolean string store-path store-path-list base16)
+  (syntax-rules (integer boolean string store-path store-path-list
+                 substitutable-path-list base16)
     ((_ integer p)
      (read-int p))
     ((_ boolean p)
@@ -300,7 +335,9 @@
      (read-store-path p))
     ((_ store-path-list p)
      (read-store-path-list p))
-    ((_ hash p)
+    ((_ substitutable-path-list p)
+     (read-substitutable-path-list p))
+    ((_ base16 p)
      (base16-string->bytevector (read-string p)))))
 
 
@@ -552,6 +589,22 @@ name--it is the caller's responsibility to ensure that it is an absolute
 file name.  Return #t on success."
   boolean)
 
+(define-operation (has-substitutes? (store-path path))
+  "Return #t if binary substitutes are available for PATH, and #f otherwise."
+  boolean)
+
+(define substitutable-paths
+  (operation (query-substitutable-paths (store-path-list paths))
+             "Return the subset of PATHS that is substitutable."
+             store-path-list))
+
+(define substitutable-path-info
+  (operation (query-substitutable-paths (store-path-list paths))
+             "Return information about the subset of PATHS that is
+substitutable.  For each substitutable path, a `substitutable?' object is
+returned."
+             substitutable-path-list))
+
 (define (run-gc server action to-delete min-freed)
   "Perform the garbage-collector operation ACTION, one of the
 `gc-action' values.  When ACTION is `delete-specific', the TO-DELETE is
diff --git a/tests/store.scm b/tests/store.scm
index 1ff6aa05c2..c90fd3fed9 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +21,8 @@
   #:use-module (guix store)
   #:use-module (guix utils)
   #:use-module (guix base32)
+  #:use-module (guix packages)
+  #:use-module (guix derivations)
   #:use-module (gnu packages bootstrap)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -77,6 +79,17 @@
            (> freed 0)
            (not (file-exists? p))))))
 
+(test-assert "no substitutes"
+  (let* ((s  (open-connection))
+         (d1 (package-derivation s %bootstrap-guile (%current-system)))
+         (d2 (package-derivation s %bootstrap-glibc (%current-system)))
+         (o  (map derivation-path->output-path (list d1 d2))))
+    (set-build-options s #:use-substitutes? #f)
+    (and (not (has-substitutes? s d1))
+         (not (has-substitutes? s d2))
+         (null? (substitutable-paths s o))
+         (null? (substitutable-path-info s o)))))
+
 (test-end "store")
 
 
-- 
cgit 1.4.1