[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
FileSize: ~a~%"
                  %item
                  (basename %item)
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size info)
                  (basename (first (path-info-references 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))
  (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: ~%\
FileSize: ~a~%"
                  item
                  (uri-encode (basename item))
                  (bytevector->nix-base32-string
                   (path-info-hash info))
                  (path-info-nar-size 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
        #t                                        ;FileSize
        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))

              ;; We should get an explicitly short TTL for 404 in this case
              ;; because it's going to become 200 shortly.
              (match (assq-ref (response-headers response) 'cache-control)
                ((('max-age . ttl))
                 (< ttl 3600)))

              (wait-for-file cached)
              (let* ((body         (http-get-port url))
                     (compressed   (http-get nar-url))
                     (uncompressed (http-get (string-append base "nar/"
                                                            (basename %item))))
                     (narinfo      (recutils->alist body)))
                (list (file-exists? nar)
                      (filter (lambda (item)
                                (match item
                                  (("Compression" . _) #t)
                                  (("StorePath" . _)  #t)
                                  (("URL" . _) #t)
                                  (_ #f)))
                              narinfo)
                      (response-code compressed)
                      (= (response-content-length compressed)
                         (stat:size (stat nar)))
                      (= (string->number
                          (assoc-ref narinfo "FileSize"))
                         (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
dff3189c LC	125	References: ~a
dff3189c LC	126	FileSize: ~a~%"
aff8ce7c DT	127	%item
aff8ce7c DT	128	(basename %item)
9cced526	129	(bytevector->nix-base32-string
aff8ce7c DT	130	(path-info-hash info))
aff8ce7c DT	131	(path-info-nar-size info)
dff3189c LC	132	(basename (first (path-info-references info)))
dff3189c LC	133	(path-info-nar-size info)))
aff8ce7c DT	134	(signature (base64-encode
	135	(string->utf8
	136	(canonical-sexp->string
	137	((@@ (guix scripts publish) signed-string)
	138	unsigned-info))))))
	139	(format #f "~aSignature: 1;~a;~a~%"
	140	unsigned-info (gethostname) signature))
	141	(utf8->string
	142	(http-get-body
	143	(publish-uri
	144	(string-append "/" (store-path-hash-part %item) ".narinfo")))))
	145
93961f02 LC	146	(test-equal "/*.narinfo with properly encoded '+' sign"
	147	;; See <http://bugs.gnu.org/21888>.
	148	(let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
	149	(info (query-path-info %store item))
	150	(unsigned-info
	151	(format #f
	152	"StorePath: ~a
	153	URL: nar/~a
	154	Compression: none
	155	NarHash: sha256:~a
	156	NarSize: ~d
dff3189c LC	157	References: ~%\
dff3189c LC	158	FileSize: ~a~%"
93961f02 LC	159	item
	160	(uri-encode (basename item))
	161	(bytevector->nix-base32-string
	162	(path-info-hash info))
dff3189c	163	(path-info-nar-size info)
93961f02 LC	164	(path-info-nar-size info)))
	165	(signature (base64-encode
	166	(string->utf8
	167	(canonical-sexp->string
	168	((@@ (guix scripts publish) signed-string)
	169	unsigned-info))))))
	170	(format #f "~aSignature: 1;~a;~a~%"
	171	unsigned-info (gethostname) signature))
	172
	173	(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
	174	(utf8->string
	175	(http-get-body
	176	(publish-uri
	177	(string-append "/" (store-path-hash-part item) ".narinfo"))))))
	178
aff8ce7c DT	179	(test-equal "/nar/*"
	180	"bar"
	181	(call-with-temporary-output-file
	182	(lambda (temp port)
	183	(let ((nar (utf8->string
	184	(http-get-body
	185	(publish-uri
	186	(string-append "/nar/" (basename %item)))))))
	187	(call-with-input-string nar (cut restore-file <> temp)))
	188	(call-with-input-file temp read-string))))
	189
4a1fc562 LC	190	(unless (zlib-available?)
	191	(test-skip 1))
	192	(test-equal "/nar/gzip/*"
	193	"bar"
	194	(call-with-temporary-output-file
	195	(lambda (temp port)
	196	(let ((nar (http-get-port
	197	(publish-uri
	198	(string-append "/nar/gzip/" (basename %item))))))
	199	(call-with-gzip-input-port nar
	200	(cut restore-file <> temp)))
	201	(call-with-input-file temp read-string))))
	202
	203	(unless (zlib-available?)
	204	(test-skip 1))
	205	(test-equal "/*.narinfo with compression"
	206	`(("StorePath" . ,%item)
	207	("URL" . ,(string-append "nar/gzip/" (basename %item)))
	208	("Compression" . "gzip"))
a5c37603 LC	209	(let ((thread (with-separate-output-ports
	210	(call-with-new-thread
	211	(lambda ()
	212	(guix-publish "--port=6799" "-C5"))))))
4a1fc562 LC	213	(wait-until-ready 6799)
	214	(let* ((url (string-append "http://localhost:6799/"
	215	(store-path-hash-part %item) ".narinfo"))
	216	(body (http-get-port url)))
	217	(filter (lambda (item)
	218	(match item
	219	(("Compression" . _) #t)
	220	(("StorePath" . _) #t)
	221	(("URL" . _) #t)
	222	(_ #f)))
	223	(recutils->alist body)))))
	224
089b1678 LC	225	(unless (zlib-available?)
	226	(test-skip 1))
	227	(test-equal "/*.narinfo for a compressed file"
	228	'("none" "nar") ;compression-less nar
	229	;; Assume 'guix publish -C' is already running on port 6799.
	230	(let* ((item (add-text-to-store %store "fake.tar.gz"
	231	"This is a fake compressed file."))
	232	(url (string-append "http://localhost:6799/"
	233	(store-path-hash-part item) ".narinfo"))
	234	(body (http-get-port url))
	235	(info (recutils->alist body)))
	236	(list (assoc-ref info "Compression")
	237	(dirname (assoc-ref info "URL")))))
	238
cdd7a7d2 LC	239	(test-equal "custom nar path"
	240	;; Serve nars at /foo/bar/chbouib instead of /nar.
	241	(list `(("StorePath" . ,%item)
	242	("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
	243	("Compression" . "none"))
	244	200
	245	404)
	246	(let ((thread (with-separate-output-ports
	247	(call-with-new-thread
	248	(lambda ()
	249	(guix-publish "--port=6798" "-C0"
	250	"--nar-path=///foo/bar//chbouib/"))))))
	251	(wait-until-ready 6798)
	252	(let* ((base "http://localhost:6798/")
	253	(part (store-path-hash-part %item))
	254	(url (string-append base part ".narinfo"))
	255	(nar-url (string-append base "foo/bar/chbouib/"
	256	(basename %item)))
	257	(body (http-get-port url)))
	258	(list (filter (lambda (item)
	259	(match item
	260	(("Compression" . _) #t)
	261	(("StorePath" . _) #t)
	262	(("URL" . _) #t)
	263	(_ #f)))
	264	(recutils->alist body))
	265	(response-code (http-get nar-url))
	266	(response-code
	267	(http-get (string-append base "nar/" (basename %item))))))))
	268
93961f02 LC	269	(test-equal "/nar/ with properly encoded '+' sign"
	270	"Congrats!"
	271	(let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
	272	(call-with-temporary-output-file
	273	(lambda (temp port)
	274	(let ((nar (utf8->string
	275	(http-get-body
	276	(publish-uri
	277	(string-append "/nar/" (uri-encode (basename item))))))))
	278	(call-with-input-string nar (cut restore-file <> temp)))
	279	(call-with-input-file temp read-string)))))
	280
00435580 LC	281	(test-equal "/nar/invalid"
	282	404
	283	(begin
	284	(call-with-output-file (string-append (%store-prefix) "/invalid")
	285	(lambda (port)
	286	(display "This file is not a valid store item." port)))
	287	(response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
	288
ff6638d1 LC	289	(test-equal "/file/NAME/sha256/HASH"
	290	"Hello, Guix world!"
	291	(let* ((data "Hello, Guix world!")
	292	(hash (call-with-input-string data port-sha256))
	293	(drv (run-with-store %store
	294	(gexp->derivation "the-file.txt"
	295	#~(call-with-output-file #$output
	296	(lambda (port)
	297	(display #$data port)))
	298	#:hash-algo 'sha256
	299	#:hash hash)))
	300	(out (build-derivations %store (list drv))))
	301	(utf8->string
	302	(http-get-body
	303	(publish-uri
	304	(string-append "/file/the-file.txt/sha256/"
	305	(bytevector->nix-base32-string hash)))))))
	306
	307	(test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
	308	404
	309	(let ((uri (publish-uri
	310	"/file/the-file.txt/sha256/not-a-nix-base32-string")))
	311	(response-code (http-get uri))))
	312
	313	(test-equal "/file/NAME/sha256/INVALID-HASH"
	314	404
	315	(let ((uri (publish-uri
	316	(string-append "/file/the-file.txt/sha256/"
	317	(bytevector->nix-base32-string
	318	(call-with-input-string "" port-sha256))))))
	319	(response-code (http-get uri))))
	320
00753f70 LC	321	(unless (zlib-available?)
	322	(test-skip 1))
	323	(test-equal "with cache"
	324	(list #t
	325	`(("StorePath" . ,%item)
	326	("URL" . ,(string-append "nar/gzip/" (basename %item)))
	327	("Compression" . "gzip"))
	328	200 ;nar/gzip/…
	329	#t ;Content-Length
dff3189c	330	#t ;FileSize
00753f70 LC	331	200) ;nar/…
	332	(call-with-temporary-directory
	333	(lambda (cache)
	334	(define (wait-for-file file)
	335	(let loop ((i 20))
	336	(or (file-exists? file)
	337	(begin
	338	(pk 'wait-for-file file)
	339	(sleep 1)
	340	(loop (- i 1))))))
	341
	342	(let ((thread (with-separate-output-ports
	343	(call-with-new-thread
	344	(lambda ()
	345	(guix-publish "--port=6797" "-C2"
	346	(string-append "--cache=" cache)))))))
	347	(wait-until-ready 6797)
	348	(let* ((base "http://localhost:6797/")
	349	(part (store-path-hash-part %item))
	350	(url (string-append base part ".narinfo"))
	351	(nar-url (string-append base "/nar/gzip/" (basename %item)))
	352	(cached (string-append cache "/gzip/" (basename %item)
	353	".narinfo"))
	354	(nar (string-append cache "/gzip/"
	355	(basename %item) ".nar"))
	356	(response (http-get url)))
	357	(and (= 404 (response-code response))
24b21720 LC	358
	359	;; We should get an explicitly short TTL for 404 in this case
	360	;; because it's going to become 200 shortly.
	361	(match (assq-ref (response-headers response) 'cache-control)
	362	((('max-age . ttl))
	363	(< ttl 3600)))
	364
00753f70	365	(wait-for-file cached)
dff3189c LC	366	(let* ((body (http-get-port url))
	367	(compressed (http-get nar-url))
	368	(uncompressed (http-get (string-append base "nar/"
	369	(basename %item))))
	370	(narinfo (recutils->alist body)))
00753f70 LC	371	(list (file-exists? nar)
	372	(filter (lambda (item)
	373	(match item
	374	(("Compression" . _) #t)
	375	(("StorePath" . _) #t)
	376	(("URL" . _) #t)
	377	(_ #f)))
dff3189c	378	narinfo)
00753f70 LC	379	(response-code compressed)
	380	(= (response-content-length compressed)
	381	(stat:size (stat nar)))
dff3189c LC	382	(= (string->number
	383	(assoc-ref narinfo "FileSize"))
	384	(stat:size (stat nar)))
00753f70 LC	385	(response-code uncompressed)))))))))
00753f70 LC	386
aff8ce7c	387	(test-end "publish")