01/07: substitute: Optimize hash-part-to-path conversion on non-200 responses.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 3d3e93b3f9cdf05f3dde07db45147f5919242fa2
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jul 21 14:07:29 2017 +0200

    substitute: Optimize hash-part-to-path conversion on non-200 responses.
    
    Previously this operation was linear in the number of requests and
    involved costly calls to 'string-contains'.
    
    * guix/scripts/substitute.scm (fetch-narinfos)[hash-part->path]: New
    procedure.
    [handle-narinfo-response]: Use it for caching when CODE is not 200.
---
 guix/scripts/substitute.scm | 16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 9348599..c066016 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -47,6 +47,7 @@
   #:use-module (ice-9 format)
   #:use-module (ice-9 ftw)
   #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 vlist)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -609,6 +610,17 @@ if file doesn't exist, and the narinfo otherwise."
                 url (* 100. (/ done (length paths))))
         (set! done (+ 1 done)))))
 
+  (define hash-part->path
+    (let ((mapping (fold (lambda (path result)
+                           (vhash-cons (store-path-hash-part path) path
+                                       result))
+                         vlist-null
+                         paths)))
+      (lambda (hash)
+        (match (vhash-assoc hash mapping)
+          (#f #f)
+          ((_ . path) path)))))
+
   (define (handle-narinfo-response request response port result)
     (let* ((code   (response-code response))
            (len    (response-content-length response))
@@ -627,9 +639,7 @@ if file doesn't exist, and the narinfo otherwise."
             (if len
                 (get-bytevector-n port len)
                 (read-to-eof port))
-            (cache-narinfo! url
-                            (find (cut string-contains <> hash-part) paths)
-                            #f
+            (cache-narinfo! url (hash-part->path hash-part) #f
                             (if (= 404 code)
                                 ttl
                                 %narinfo-transient-error-ttl))