01/05: store: Add 'add-data-to-store'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 0d268c5d701423b770b05ed208461c47709dafb7
Author: Ludovic Courtès <address@hidden>
Date:   Sun Jan 29 12:55:24 2017 +0100

    store: Add 'add-data-to-store'.
    
    * guix/serialization.scm (write-bytevector): New procedure.
    (write-string): Rewrite in terms of 'write-bytevector'.
    * guix/store.scm (write-arg): Add 'bytevector' case.
    (add-data-to-store): New procedure, from former 'add-text-to-store'.
    (add-text-to-store): Rewrite in terms of 'add-data-to-store'.
    * tests/store.scm ("add-data-to-store"): New test.
---
 guix/serialization.scm |   12 +++++++-----
 guix/store.scm         |   26 ++++++++++++++++++--------
 tests/store.scm        |    5 +++++
 3 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/guix/serialization.scm b/guix/serialization.scm
index 5953b84..4cab591 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès 
<address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,7 +30,7 @@
   #:export (write-int read-int
             write-long-long read-long-long
             write-padding
-            write-string
+            write-bytevector write-string
             read-string read-latin1-string read-maybe-utf8-string
             write-string-list read-string-list
             write-string-pairs
@@ -102,15 +102,17 @@
         (or (zero? m)
             (put-bytevector p zero 0 (- 8 m)))))))
 
-(define (write-string s p)
-  (let* ((s (string->utf8 s))
-         (l (bytevector-length s))
+(define (write-bytevector s p)
+  (let* ((l (bytevector-length s))
          (m (modulo l 8))
          (b (make-bytevector (+ 8 l (if (zero? m) 0 (- 8 m))))))
     (bytevector-u32-set! b 0 l (endianness little))
     (bytevector-copy! s 0 b 8 l)
     (put-bytevector p b)))
 
+(define (write-string s p)
+  (write-bytevector (string->utf8 s) p))
+
 (define (read-byte-string p)
   (let* ((len (read-int p))
          (m   (modulo len 8))
diff --git a/guix/store.scm b/guix/store.scm
index cb3fbed..cce460f 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -67,6 +67,7 @@
             query-path-hash
             hash-part->path
             query-path-info
+            add-data-to-store
             add-text-to-store
             add-to-store
             build-things
@@ -266,12 +267,15 @@
     (path-info deriver hash refs registration-time nar-size)))
 
 (define-syntax write-arg
-  (syntax-rules (integer boolean string string-list string-pairs
+  (syntax-rules (integer boolean bytevector
+                 string string-list string-pairs
                  store-path store-path-list base16)
     ((_ integer arg p)
      (write-int arg p))
     ((_ boolean arg p)
      (write-int (if arg 1 0) p))
+    ((_ bytevector arg p)
+     (write-bytevector arg p))
     ((_ string arg p)
      (write-string arg p))
     ((_ string-list arg p)
@@ -669,25 +673,31 @@ string).  Raise an error if no such path exists."
   "Return the info (hash, references, etc.) for PATH."
   path-info)
 
-(define add-text-to-store
+(define add-data-to-store
   ;; A memoizing version of `add-to-store', to avoid repeated RPCs with
   ;; the very same arguments during a given session.
   (let ((add-text-to-store
-         (operation (add-text-to-store (string name) (string text)
+         (operation (add-text-to-store (string name) (bytevector text)
                                        (string-list references))
                     #f
                     store-path)))
-    (lambda* (server name text #:optional (references '()))
-      "Add TEXT under file NAME in the store, and return its store path.
+    (lambda* (server name bytes #:optional (references '()))
+      "Add BYTES under file NAME in the store, and return its store path.
 REFERENCES is the list of store paths referred to by the resulting store
 path."
-      (let ((args  `(,text ,name ,references))
-            (cache (nix-server-add-text-to-store-cache server)))
+      (let* ((args  `(,bytes ,name ,references))
+             (cache (nix-server-add-text-to-store-cache server)))
         (or (hash-ref cache args)
-            (let ((path (add-text-to-store server name text references)))
+            (let ((path (add-text-to-store server name bytes references)))
               (hash-set! cache args path)
               path))))))
 
+(define* (add-text-to-store store name text #:optional (references '()))
+  "Add TEXT under file NAME in the store, and return its store path.
+REFERENCES is the list of store paths referred to by the resulting store
+path."
+  (add-data-to-store store name (string->utf8 text) references))
+
 (define true
   ;; Define it once and for all since we use it as a default value for
   ;; 'add-to-store' and want to make sure two default values are 'eq?' for the
diff --git a/tests/store.scm b/tests/store.scm
index 983766d..64d3553 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -92,6 +92,11 @@
 
 (test-skip (if %store 0 13))
 
+(test-equal "add-data-to-store"
+  #vu8(1 2 3 4 5)
+  (call-with-input-file (add-data-to-store %store "data" #vu8(1 2 3 4 5))
+    get-bytevector-all))
+
 (test-assert "valid-path? live"
   (let ((p (add-text-to-store %store "hello" "hello, world")))
     (valid-path? %store p)))