[jackhill/guix/guix.git] / tests / publish.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

;; Avoid interference.
(unsetenv "http_proxy")

(define-module (test-publish)
  #:use-module (guix scripts publish)
  #:use-module (guix tests)
  #:use-module (guix config)
  #:use-module (guix utils)
  #:use-module (guix hash)
  #:use-module (guix store)
  #:use-module (guix derivations)
  #:use-module (guix gexp)
  #:use-module (guix base32)
  #:use-module (guix base64)
  #:use-module ((guix records) #:select (recutils->alist))
  #:use-module ((guix serialization) #:select (restore-file))
  #:use-module (guix pk-crypto)
  #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
  #:use-module (guix zlib)
  #:use-module (web uri)
  #:use-module (web client)
  #:use-module (web response)
  #:use-module (rnrs bytevectors)
  #:use-module (ice-9 binary-ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim))

(define %store
  (open-connection-for-tests))

(define %reference (add-text-to-store %store "ref" "foo"))

(define %item (add-text-to-store %store "item" "bar" (list %reference)))

(define (http-get-body uri)
  (call-with-values (lambda () (http-get uri))
    (lambda (response body) body)))

(define (http-get-port uri)
  (let ((socket (open-socket-for-uri uri)))
    ;; Make sure to use an unbuffered port so that we can then peek at the
    ;; underlying file descriptor via 'call-with-gzip-input-port'.
    (setvbuf socket _IONBF)
    (call-with-values
        (lambda ()
          (http-get uri #:port socket #:streaming? #t))
      (lambda (response port)
        ;; Don't (setvbuf port _IONBF) because of <http://bugs.gnu.org/19610>
        ;; (PORT might be a custom binary input port).
        port))))

(define (publish-uri route)
  (string-append "http://localhost:6789" route))

(define-syntax-rule (with-separate-output-ports exp ...)
  ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
  ;; error ports to make sure the two threads don't end up stepping on each
  ;; other's toes.
  (with-output-to-port (duplicate-port (current-output-port) "w")
    (lambda ()
      (with-error-to-port (duplicate-port (current-error-port) "w")
        (lambda ()
          exp ...)))))

;; Run a local publishing server in a separate thread.
(with-separate-output-ports
 (call-with-new-thread
  (lambda ()
    (guix-publish "--port=6789" "-C0"))))     ;attempt to avoid port collision

(define (wait-until-ready port)
  ;; Wait until the server is accepting connections.
  (let ((conn (socket PF_INET SOCK_STREAM 0)))
    (let loop ()
      (unless (false-if-exception
               (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
        (loop)))))

;; Wait until the two servers are ready.
(wait-until-ready 6789)

;; Initialize the public/private key SRFI-39 parameters.
(%public-key (read-file-sexp %public-key-file))
(%private-key (read-file-sexp %private-key-file))

\f
(test-begin "publish")

(test-equal "/nix-cache-info"
  (format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
          %store-directory)
  (http-get-body (publish-uri "/nix-cache-info")))

(test-equal "/*.narinfo"
  (let* ((info (query-path-info %store %item))
         (unsigned-info
          (format #f
                  "StorePath: ~a
URL: nar/~a
Compression: none
NarHash: sha256:~a
NarSize: ~d
References: ~a~%"
                  %item
                  (basename %item)
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size info)
                  (basename (first (path-info-references info)))))
         (signature (base64-encode
                     (string->utf8
                      (canonical-sexp->string
                       ((@@ (guix scripts publish) signed-string)
                        unsigned-info))))))
    (format #f "~aSignature: 1;~a;~a~%"
            unsigned-info (gethostname) signature))
  (utf8->string
   (http-get-body
    (publish-uri
     (string-append "/" (store-path-hash-part %item) ".narinfo")))))

(test-equal "/*.narinfo with properly encoded '+' sign"
  ;; See <http://bugs.gnu.org/21888>.
  (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
         (info (query-path-info %store item))
         (unsigned-info
          (format #f
                  "StorePath: ~a
URL: nar/~a
Compression: none
NarHash: sha256:~a
NarSize: ~d
References: ~%"
                  item
                  (uri-encode (basename item))
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size info)))
         (signature (base64-encode
                     (string->utf8
                      (canonical-sexp->string
                       ((@@ (guix scripts publish) signed-string)
                        unsigned-info))))))
    (format #f "~aSignature: 1;~a;~a~%"
            unsigned-info (gethostname) signature))

  (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
    (utf8->string
     (http-get-body
      (publish-uri
       (string-append "/" (store-path-hash-part item) ".narinfo"))))))

(test-equal "/nar/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (utf8->string
                 (http-get-body
                  (publish-uri
                   (string-append "/nar/" (basename %item)))))))
       (call-with-input-string nar (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(unless (zlib-available?)
  (test-skip 1))
(test-equal "/nar/gzip/*"
  "bar"
  (call-with-temporary-output-file
   (lambda (temp port)
     (let ((nar (http-get-port
                 (publish-uri
                  (string-append "/nar/gzip/" (basename %item))))))
       (call-with-gzip-input-port nar
         (cut restore-file <> temp)))
     (call-with-input-file temp read-string))))

(unless (zlib-available?)
  (test-skip 1))
(test-equal "/*.narinfo with compression"
  `(("StorePath" . ,%item)
    ("URL" . ,(string-append "nar/gzip/" (basename %item)))
    ("Compression" . "gzip"))
  (let ((thread (with-separate-output-ports
                 (call-with-new-thread
                  (lambda ()
                    (guix-publish "--port=6799" "-C5"))))))
    (wait-until-ready 6799)
    (let* ((url  (string-append "http://localhost:6799/"
                                (store-path-hash-part %item) ".narinfo"))
           (body (http-get-port url)))
      (filter (lambda (item)
                (match item
                  (("Compression" . _) #t)
                  (("StorePath" . _)  #t)
                  (("URL" . _) #t)
                  (_ #f)))
              (recutils->alist body)))))

(unless (zlib-available?)
  (test-skip 1))
(test-equal "/*.narinfo for a compressed file"
  '("none" "nar")          ;compression-less nar
  ;; Assume 'guix publish -C' is already running on port 6799.
  (let* ((item (add-text-to-store %store "fake.tar.gz"
                                  "This is a fake compressed file."))
         (url  (string-append "http://localhost:6799/"
                              (store-path-hash-part item) ".narinfo"))
         (body (http-get-port url))
         (info (recutils->alist body)))
    (list (assoc-ref info "Compression")
          (dirname (assoc-ref info "URL")))))

(test-equal "custom nar path"
  ;; Serve nars at /foo/bar/chbouib instead of /nar.
  (list `(("StorePath" . ,%item)
          ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
          ("Compression" . "none"))
        200
        404)
  (let ((thread (with-separate-output-ports
                 (call-with-new-thread
                  (lambda ()
                    (guix-publish "--port=6798" "-C0"
                                  "--nar-path=///foo/bar//chbouib/"))))))
    (wait-until-ready 6798)
    (let* ((base    "http://localhost:6798/")
           (part    (store-path-hash-part %item))
           (url     (string-append base part ".narinfo"))
           (nar-url (string-append base "foo/bar/chbouib/"
                                   (basename %item)))
           (body    (http-get-port url)))
      (list (filter (lambda (item)
                      (match item
                        (("Compression" . _) #t)
                        (("StorePath" . _)  #t)
                        (("URL" . _) #t)
                        (_ #f)))
                    (recutils->alist body))
            (response-code (http-get nar-url))
            (response-code
             (http-get (string-append base "nar/" (basename %item))))))))

(test-equal "/nar/ with properly encoded '+' sign"
  "Congrats!"
  (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
    (call-with-temporary-output-file
     (lambda (temp port)
       (let ((nar (utf8->string
                   (http-get-body
                    (publish-uri
                     (string-append "/nar/" (uri-encode (basename item))))))))
         (call-with-input-string nar (cut restore-file <> temp)))
       (call-with-input-file temp read-string)))))

(test-equal "/nar/invalid"
  404
  (begin
    (call-with-output-file (string-append (%store-prefix) "/invalid")
      (lambda (port)
        (display "This file is not a valid store item." port)))
    (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))

(test-equal "/file/NAME/sha256/HASH"
  "Hello, Guix world!"
  (let* ((data "Hello, Guix world!")
         (hash (call-with-input-string data port-sha256))
         (drv  (run-with-store %store
                 (gexp->derivation "the-file.txt"
                                   #~(call-with-output-file #$output
                                       (lambda (port)
                                         (display #$data port)))
                                   #:hash-algo 'sha256
                                   #:hash hash)))
         (out  (build-derivations %store (list drv))))
    (utf8->string
     (http-get-body
      (publish-uri
       (string-append "/file/the-file.txt/sha256/"
                      (bytevector->nix-base32-string hash)))))))

(test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
  404
  (let ((uri (publish-uri
              "/file/the-file.txt/sha256/not-a-nix-base32-string")))
    (response-code (http-get uri))))

(test-equal "/file/NAME/sha256/INVALID-HASH"
  404
  (let ((uri (publish-uri
              (string-append "/file/the-file.txt/sha256/"
                             (bytevector->nix-base32-string
                              (call-with-input-string "" port-sha256))))))
    (response-code (http-get uri))))

(unless (zlib-available?)
  (test-skip 1))
(test-equal "with cache"
  (list #t
        `(("StorePath" . ,%item)
          ("URL" . ,(string-append "nar/gzip/" (basename %item)))
          ("Compression" . "gzip"))
        200                                       ;nar/gzip/…
        #t                                        ;Content-Length
        200)                                      ;nar/…
  (call-with-temporary-directory
   (lambda (cache)
     (define (wait-for-file file)
       (let loop ((i 20))
         (or (file-exists? file)
             (begin
               (pk 'wait-for-file file)
               (sleep 1)
               (loop (- i 1))))))

     (let ((thread (with-separate-output-ports
                    (call-with-new-thread
                     (lambda ()
                       (guix-publish "--port=6797" "-C2"
                                     (string-append "--cache=" cache)))))))
       (wait-until-ready 6797)
       (let* ((base     "http://localhost:6797/")
              (part     (store-path-hash-part %item))
              (url      (string-append base part ".narinfo"))
              (nar-url  (string-append base "/nar/gzip/" (basename %item)))
              (cached   (string-append cache "/gzip/" (basename %item)
                                       ".narinfo"))
              (nar      (string-append cache "/gzip/"
                                       (basename %item) ".nar"))
              (response (http-get url)))
         (and (= 404 (response-code response))
              (wait-for-file cached)
              (let ((body         (http-get-port url))
                    (compressed   (http-get nar-url))
                    (uncompressed (http-get (string-append base "nar/"
                                                           (basename %item)))))
                (list (file-exists? nar)
                      (filter (lambda (item)
                                (match item
                                  (("Compression" . _) #t)
                                  (("StorePath" . _)  #t)
                                  (("URL" . _) #t)
                                  (_ #f)))
                              (recutils->alist body))
                      (response-code compressed)
                      (= (response-content-length compressed)
                         (stat:size (stat nar)))
                      (response-code uncompressed)))))))))

(test-end "publish")
Commit	Line	Data
aff8ce7c DT	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2015 David Thompson <davet@gnu.org>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
c74f0cb2 LC	19	;; Avoid interference.
	20	(unsetenv "http_proxy")
	21
aff8ce7c DT	22	(define-module (test-publish)
	23	#:use-module (guix scripts publish)
	24	#:use-module (guix tests)
	25	#:use-module (guix config)
	26	#:use-module (guix utils)
	27	#:use-module (guix hash)
	28	#:use-module (guix store)
ff6638d1 LC	29	#:use-module (guix derivations)
ff6638d1 LC	30	#:use-module (guix gexp)
aff8ce7c DT	31	#:use-module (guix base32)
aff8ce7c DT	32	#:use-module (guix base64)
4a1fc562	33	#:use-module ((guix records) #:select (recutils->alist))
aff8ce7c DT	34	#:use-module ((guix serialization) #:select (restore-file))
aff8ce7c DT	35	#:use-module (guix pk-crypto)
ab2a74e4	36	#:use-module ((guix pki) #:select (%public-key-file %private-key-file))
4a1fc562	37	#:use-module (guix zlib)
93961f02	38	#:use-module (web uri)
aff8ce7c DT	39	#:use-module (web client)
	40	#:use-module (web response)
	41	#:use-module (rnrs bytevectors)
4a1fc562	42	#:use-module (ice-9 binary-ports)
aff8ce7c DT	43	#:use-module (srfi srfi-1)
	44	#:use-module (srfi srfi-26)
	45	#:use-module (srfi srfi-64)
93961f02	46	#:use-module (ice-9 format)
aff8ce7c DT	47	#:use-module (ice-9 match)
	48	#:use-module (ice-9 rdelim))
	49
	50	(define %store
	51	(open-connection-for-tests))
	52
	53	(define %reference (add-text-to-store %store "ref" "foo"))
	54
	55	(define %item (add-text-to-store %store "item" "bar" (list %reference)))
	56
	57	(define (http-get-body uri)
	58	(call-with-values (lambda () (http-get uri))
	59	(lambda (response body) body)))
	60
4a1fc562	61	(define (http-get-port uri)
37402ecb LC	62	(let ((socket (open-socket-for-uri uri)))
	63	;; Make sure to use an unbuffered port so that we can then peek at the
	64	;; underlying file descriptor via 'call-with-gzip-input-port'.
	65	(setvbuf socket _IONBF)
	66	(call-with-values
	67	(lambda ()
	68	(http-get uri #:port socket #:streaming? #t))
	69	(lambda (response port)
2c7b48c2 LC	70	;; Don't (setvbuf port _IONBF) because of <http://bugs.gnu.org/19610>
2c7b48c2 LC	71	;; (PORT might be a custom binary input port).
37402ecb	72	port))))
4a1fc562	73
aff8ce7c DT	74	(define (publish-uri route)
	75	(string-append "http://localhost:6789" route))
	76
a5c37603 LC	77	(define-syntax-rule (with-separate-output-ports exp ...)
	78	;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
	79	;; error ports to make sure the two threads don't end up stepping on each
	80	;; other's toes.
	81	(with-output-to-port (duplicate-port (current-output-port) "w")
	82	(lambda ()
	83	(with-error-to-port (duplicate-port (current-error-port) "w")
	84	(lambda ()
	85	exp ...)))))
	86
aff8ce7c	87	;; Run a local publishing server in a separate thread.
a5c37603 LC	88	(with-separate-output-ports
	89	(call-with-new-thread
	90	(lambda ()
	91	(guix-publish "--port=6789" "-C0")))) ;attempt to avoid port collision
4a1fc562 LC	92
	93	(define (wait-until-ready port)
	94	;; Wait until the server is accepting connections.
	95	(let ((conn (socket PF_INET SOCK_STREAM 0)))
	96	(let loop ()
	97	(unless (false-if-exception
	98	(connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
	99	(loop)))))
aff8ce7c	100
4a1fc562 LC	101	;; Wait until the two servers are ready.
4a1fc562 LC	102	(wait-until-ready 6789)
aff8ce7c	103
ab2a74e4 LC	104	;; Initialize the public/private key SRFI-39 parameters.
	105	(%public-key (read-file-sexp %public-key-file))
	106	(%private-key (read-file-sexp %private-key-file))
	107
c74f0cb2	108	\f
aff8ce7c DT	109	(test-begin "publish")
	110
	111	(test-equal "/nix-cache-info"
	112	(format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
	113	%store-directory)
	114	(http-get-body (publish-uri "/nix-cache-info")))
	115
	116	(test-equal "/*.narinfo"
	117	(let* ((info (query-path-info %store %item))
	118	(unsigned-info
	119	(format #f
	120	"StorePath: ~a
	121	URL: nar/~a
	122	Compression: none
	123	NarHash: sha256:~a
	124	NarSize: ~d
	125	References: ~a~%"
	126	%item
	127	(basename %item)
9cced526	128	(bytevector->nix-base32-string
aff8ce7c DT	129	(path-info-hash info))
	130	(path-info-nar-size info)
	131	(basename (first (path-info-references info)))))
	132	(signature (base64-encode
	133	(string->utf8
	134	(canonical-sexp->string
	135	((@@ (guix scripts publish) signed-string)
	136	unsigned-info))))))
	137	(format #f "~aSignature: 1;~a;~a~%"
	138	unsigned-info (gethostname) signature))
	139	(utf8->string
	140	(http-get-body
	141	(publish-uri
	142	(string-append "/" (store-path-hash-part %item) ".narinfo")))))
	143
93961f02 LC	144	(test-equal "/*.narinfo with properly encoded '+' sign"
	145	;; See <http://bugs.gnu.org/21888>.
	146	(let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
	147	(info (query-path-info %store item))
	148	(unsigned-info
	149	(format #f
	150	"StorePath: ~a
	151	URL: nar/~a
	152	Compression: none
	153	NarHash: sha256:~a
	154	NarSize: ~d
	155	References: ~%"
	156	item
	157	(uri-encode (basename item))
	158	(bytevector->nix-base32-string
	159	(path-info-hash info))
	160	(path-info-nar-size info)))
	161	(signature (base64-encode
	162	(string->utf8
	163	(canonical-sexp->string
	164	((@@ (guix scripts publish) signed-string)
	165	unsigned-info))))))
	166	(format #f "~aSignature: 1;~a;~a~%"
	167	unsigned-info (gethostname) signature))
	168
	169	(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
	170	(utf8->string
	171	(http-get-body
	172	(publish-uri
	173	(string-append "/" (store-path-hash-part item) ".narinfo"))))))
	174
aff8ce7c DT	175	(test-equal "/nar/*"
	176	"bar"
	177	(call-with-temporary-output-file
	178	(lambda (temp port)
	179	(let ((nar (utf8->string
	180	(http-get-body
	181	(publish-uri
	182	(string-append "/nar/" (basename %item)))))))
	183	(call-with-input-string nar (cut restore-file <> temp)))
	184	(call-with-input-file temp read-string))))
	185
4a1fc562 LC	186	(unless (zlib-available?)
	187	(test-skip 1))
	188	(test-equal "/nar/gzip/*"
	189	"bar"
	190	(call-with-temporary-output-file
	191	(lambda (temp port)
	192	(let ((nar (http-get-port
	193	(publish-uri
	194	(string-append "/nar/gzip/" (basename %item))))))
	195	(call-with-gzip-input-port nar
	196	(cut restore-file <> temp)))
	197	(call-with-input-file temp read-string))))
	198
	199	(unless (zlib-available?)
	200	(test-skip 1))
	201	(test-equal "/*.narinfo with compression"
	202	`(("StorePath" . ,%item)
	203	("URL" . ,(string-append "nar/gzip/" (basename %item)))
	204	("Compression" . "gzip"))
a5c37603 LC	205	(let ((thread (with-separate-output-ports
	206	(call-with-new-thread
	207	(lambda ()
	208	(guix-publish "--port=6799" "-C5"))))))
4a1fc562 LC	209	(wait-until-ready 6799)
	210	(let* ((url (string-append "http://localhost:6799/"
	211	(store-path-hash-part %item) ".narinfo"))
	212	(body (http-get-port url)))
	213	(filter (lambda (item)
	214	(match item
	215	(("Compression" . _) #t)
	216	(("StorePath" . _) #t)
	217	(("URL" . _) #t)
	218	(_ #f)))
	219	(recutils->alist body)))))
	220
089b1678 LC	221	(unless (zlib-available?)
	222	(test-skip 1))
	223	(test-equal "/*.narinfo for a compressed file"
	224	'("none" "nar") ;compression-less nar
	225	;; Assume 'guix publish -C' is already running on port 6799.
	226	(let* ((item (add-text-to-store %store "fake.tar.gz"
	227	"This is a fake compressed file."))
	228	(url (string-append "http://localhost:6799/"
	229	(store-path-hash-part item) ".narinfo"))
	230	(body (http-get-port url))
	231	(info (recutils->alist body)))
	232	(list (assoc-ref info "Compression")
	233	(dirname (assoc-ref info "URL")))))
	234
cdd7a7d2 LC	235	(test-equal "custom nar path"
	236	;; Serve nars at /foo/bar/chbouib instead of /nar.
	237	(list `(("StorePath" . ,%item)
	238	("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
	239	("Compression" . "none"))
	240	200
	241	404)
	242	(let ((thread (with-separate-output-ports
	243	(call-with-new-thread
	244	(lambda ()
	245	(guix-publish "--port=6798" "-C0"
	246	"--nar-path=///foo/bar//chbouib/"))))))
	247	(wait-until-ready 6798)
	248	(let* ((base "http://localhost:6798/")
	249	(part (store-path-hash-part %item))
	250	(url (string-append base part ".narinfo"))
	251	(nar-url (string-append base "foo/bar/chbouib/"
	252	(basename %item)))
	253	(body (http-get-port url)))
	254	(list (filter (lambda (item)
	255	(match item
	256	(("Compression" . _) #t)
	257	(("StorePath" . _) #t)
	258	(("URL" . _) #t)
	259	(_ #f)))
	260	(recutils->alist body))
	261	(response-code (http-get nar-url))
	262	(response-code
	263	(http-get (string-append base "nar/" (basename %item))))))))
	264
93961f02 LC	265	(test-equal "/nar/ with properly encoded '+' sign"
	266	"Congrats!"
	267	(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
	268	(call-with-temporary-output-file
	269	(lambda (temp port)
	270	(let ((nar (utf8->string
	271	(http-get-body
	272	(publish-uri
	273	(string-append "/nar/" (uri-encode (basename item))))))))
	274	(call-with-input-string nar (cut restore-file <> temp)))
	275	(call-with-input-file temp read-string)))))
	276
00435580 LC	277	(test-equal "/nar/invalid"
	278	404
	279	(begin
	280	(call-with-output-file (string-append (%store-prefix) "/invalid")
	281	(lambda (port)
	282	(display "This file is not a valid store item." port)))
	283	(response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
	284
ff6638d1 LC	285	(test-equal "/file/NAME/sha256/HASH"
	286	"Hello, Guix world!"
	287	(let* ((data "Hello, Guix world!")
	288	(hash (call-with-input-string data port-sha256))
	289	(drv (run-with-store %store
	290	(gexp->derivation "the-file.txt"
	291	#~(call-with-output-file #$output
	292	(lambda (port)
	293	(display #$data port)))
	294	#:hash-algo 'sha256
	295	#:hash hash)))
	296	(out (build-derivations %store (list drv))))
	297	(utf8->string
	298	(http-get-body
	299	(publish-uri
	300	(string-append "/file/the-file.txt/sha256/"
	301	(bytevector->nix-base32-string hash)))))))
	302
	303	(test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
	304	404
	305	(let ((uri (publish-uri
	306	"/file/the-file.txt/sha256/not-a-nix-base32-string")))
	307	(response-code (http-get uri))))
	308
	309	(test-equal "/file/NAME/sha256/INVALID-HASH"
	310	404
	311	(let ((uri (publish-uri
	312	(string-append "/file/the-file.txt/sha256/"
	313	(bytevector->nix-base32-string
	314	(call-with-input-string "" port-sha256))))))
	315	(response-code (http-get uri))))
	316
00753f70 LC	317	(unless (zlib-available?)
	318	(test-skip 1))
	319	(test-equal "with cache"
	320	(list #t
	321	`(("StorePath" . ,%item)
	322	("URL" . ,(string-append "nar/gzip/" (basename %item)))
	323	("Compression" . "gzip"))
	324	200 ;nar/gzip/…
	325	#t ;Content-Length
	326	200) ;nar/…
	327	(call-with-temporary-directory
	328	(lambda (cache)
	329	(define (wait-for-file file)
	330	(let loop ((i 20))
	331	(or (file-exists? file)
	332	(begin
	333	(pk 'wait-for-file file)
	334	(sleep 1)
	335	(loop (- i 1))))))
	336
	337	(let ((thread (with-separate-output-ports
	338	(call-with-new-thread
	339	(lambda ()
	340	(guix-publish "--port=6797" "-C2"
	341	(string-append "--cache=" cache)))))))
	342	(wait-until-ready 6797)
	343	(let* ((base "http://localhost:6797/")
	344	(part (store-path-hash-part %item))
	345	(url (string-append base part ".narinfo"))
	346	(nar-url (string-append base "/nar/gzip/" (basename %item)))
	347	(cached (string-append cache "/gzip/" (basename %item)
	348	".narinfo"))
	349	(nar (string-append cache "/gzip/"
	350	(basename %item) ".nar"))
	351	(response (http-get url)))
	352	(and (= 404 (response-code response))
	353	(wait-for-file cached)
	354	(let ((body (http-get-port url))
	355	(compressed (http-get nar-url))
	356	(uncompressed (http-get (string-append base "nar/"
	357	(basename %item)))))
	358	(list (file-exists? nar)
	359	(filter (lambda (item)
	360	(match item
	361	(("Compression" . _) #t)
	362	(("StorePath" . _) #t)
	363	(("URL" . _) #t)
	364	(_ #f)))
	365	(recutils->alist body))
	366	(response-code compressed)
	367	(= (response-content-length compressed)
	368	(stat:size (stat nar)))
	369	(response-code uncompressed)))))))))
	370
aff8ce7c	371	(test-end "publish")