From: Mathieu Othacehe <m.othacehe@gmail.com>
To: 27876@debbugs.gnu.org
Subject: [bug#27876] [PATCH v2 3/3] cuirass: Add tests for new HTTP API.
Date: Tue, 1 Aug 2017 21:51:24 +0200 [thread overview]
Message-ID: <20170801195124.7030-3-m.othacehe@gmail.com> (raw)
In-Reply-To: <20170801195124.7030-1-m.othacehe@gmail.com>
* tests/http.scm: Add various tests on new HTTP API.
---
tests/http.scm | 219 ++++++++++++++++++++++++++++++++++++++++++++++++++-------
1 file changed, 192 insertions(+), 27 deletions(-)
diff --git a/tests/http.scm b/tests/http.scm
index 4c5214d..99daf23 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -1,6 +1,7 @@
;;; http.scm -- tests for (cuirass http) module
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; This file is part of Cuirass.
;;;
@@ -18,7 +19,14 @@
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(use-modules (cuirass http)
+ (cuirass database)
+ (cuirass utils)
+ (guix utils)
+ (guix build utils)
(json)
+ (web client)
+ (web response)
+ (rnrs bytevectors)
(srfi srfi-1)
(srfi srfi-64))
@@ -42,30 +50,187 @@
#t
t1)))
-(test-begin "http")
-
-(test-assert "spec->json-string"
- ;; Note: We cannot compare the strings directly because field ordering
- ;; depends on the hash algorithm used in Guile's hash tables, and that
- ;; algorithm changed in Guile 2.2.
- (hash-table=?
- (call-with-input-string
- (string-append "{"
- "\"boolean\" : false,"
- "\"string\" : \"guix\","
- "\"alist\" : {\"subset\" : \"hello\"},"
- "\"list\" : [1, \"2\", \"three\"],"
- "\"symbol\" : \"hydra-jobs\","
- "\"number\" : 1"
- "}")
- json->scm)
- (call-with-input-string
- (spec->json-string '((#:number . 1)
- (string . "guix")
- ("symbol" . hydra-jobs)
- (#:alist (subset . "hello"))
- (list 1 "2" #:three)
- ("boolean" . #f)))
- json->scm)))
-
-(test-end)
+(define (http-get-body uri)
+ (call-with-values (lambda () (http-get uri))
+ (lambda (response body) body)))
+
+(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)))))
+
+(define (test-cuirass-uri route)
+ (string-append "http://localhost:6688" route))
+
+(define database-name
+ ;; Use an empty and temporary database for the tests.
+ (string-append (getcwd) "/" (number->string (getpid)) "-tmp.db"))
+
+(define %db
+ ;; Global Slot for a database object.
+ (make-parameter #t))
+
+(define build-query-result
+ '((#:id . 1)
+ (#:project . "guix")
+ (#:jobset . "master")
+ (#:job . "fake-job")
+ (#:timestamp . 1501347493)
+ (#:starttime . 1501347493)
+ (#:stoptime . 1501347493)
+ (#:buildoutputs . ((out ("path" . "/gnu/store/fake-1.0"))))
+ (#:system . "x86_64-linux")
+ (#:nixname . "fake-1.0")
+ (#:buildstatus . 0)
+ (#:busy . 0)
+ (#:priority . 0)
+ (#:finished . 1)
+ (#:buildproducts . #nil)
+ (#:releasename . #nil)
+ (#:buildinputs_builds . #nil)))
+
+(define log-file-name
+ ;; Use a fake temporary log file.
+ (string-append (getcwd) "/" (number->string (getpid)) "-log.txt"))
+
+(call-with-output-file log-file-name
+ ;; Write "build log" string compressed with bzip2 inside LOG-FILE-NAME.
+ (lambda (out)
+ (dump-port
+ (call-with-input-string "build log"
+ (lambda (port)
+ (compressed-port 'bzip2 port)))
+ out)))
+
+(test-group-with-cleanup "http"
+ (test-assert "object->json-string"
+ ;; Note: We cannot compare the strings directly because field ordering
+ ;; depends on the hash algorithm used in Guile's hash tables, and that
+ ;; algorithm changed in Guile 2.2.
+ (hash-table=?
+ (call-with-input-string
+ (string-append "{"
+ "\"boolean\" : false,"
+ "\"string\" : \"guix\","
+ "\"alist\" : {\"subset\" : \"hello\"},"
+ "\"list\" : [1, \"2\", \"three\"],"
+ "\"symbol\" : \"hydra-jobs\","
+ "\"number\" : 1"
+ "}")
+ json->scm)
+ (call-with-input-string
+ (object->json-string '((#:number . 1)
+ (string . "guix")
+ ("symbol" . hydra-jobs)
+ (#:alist (subset . "hello"))
+ (list 1 "2" #:three)
+ ("boolean" . #f)))
+ json->scm)))
+
+ (test-assert "db-init"
+ (%db (db-init database-name)))
+
+ (test-assert "cuirass-run"
+ (call-with-new-thread
+ (lambda ()
+ (run-cuirass-server (%db) #:port 6688))))
+
+ (test-assert "wait-server"
+ (wait-until-ready 6688))
+
+ (test-assert "fill-db"
+ (let ((build
+ `((#:derivation . "/gnu/store/fake.drv")
+ (#:eval-id . 1)
+ (#:log . ,log-file-name)
+ (#:status . 0)
+ (#:outputs . (("out" . "/gnu/store/fake-1.0")))
+ (#:timestamp . 1501347493)
+ (#:starttime . 1501347493)
+ (#:stoptime . 1501347493)))
+ (derivation
+ '((#:derivation . "/gnu/store/fake.drv")
+ (#:job-name . "fake-job")
+ (#:system . "x86_64-linux")
+ (#:nix-name . "fake-1.0")
+ (#:eval-id . 1)))
+ (specification
+ '((#:name . "guix")
+ (#:url . "git://git.savannah.gnu.org/guix.git")
+ (#:load-path . ".")
+ (#:file . "/tmp/gnu-system.scm")
+ (#:proc . hydra-jobs)
+ (#:arguments (subset . "hello"))
+ (#:branch . "master")
+ (#:tag . #f)
+ (#:commit . #f)
+ (#:no-compile? . #f)))
+ (evaluation
+ '((#:specification . "guix")
+ (#:revision . 1))))
+ (db-add-build (%db) build)
+ (db-add-derivation (%db) derivation)
+ (db-add-specification (%db) specification)
+ (db-add-evaluation (%db) evaluation)))
+
+ (test-assert "/build/1"
+ (hash-table=?
+ (call-with-input-string
+ (utf8->string
+ (http-get-body (test-cuirass-uri "/build/1")))
+ json->scm)
+ (call-with-input-string
+ (object->json-string build-query-result)
+ json->scm)))
+
+ (test-equal "/build/1/log/raw"
+ "build log"
+ (http-get-body
+ (test-cuirass-uri "/build/1/log/raw")))
+
+ (test-equal "/build/2"
+ 404
+ (response-code (http-get (test-cuirass-uri "/build/2"))))
+
+ (test-equal "/build/2/log/raw"
+ 404
+ (response-code (http-get (test-cuirass-uri "/build/2/log/raw"))))
+
+ (test-equal "/api/latestbuilds"
+ 500
+ (response-code (http-get (test-cuirass-uri "/api/latestbuilds"))))
+
+ (test-assert "/api/latestbuilds?nr=1&project=guix&jobset=master"
+ (let ((hash-list
+ (call-with-input-string
+ (utf8->string
+ (http-get-body
+ (test-cuirass-uri
+ "/api/latestbuilds?nr=1&project=guix&jobset=master")))
+ json->scm)))
+ (and (= (length hash-list) 1)
+ (hash-table=?
+ (car hash-list)
+ (call-with-input-string
+ (object->json-string build-query-result)
+ json->scm)))))
+
+ (test-assert "/api/latestbuilds?nr=1&project=gnu"
+ ;; The result should be an empty JSON array.
+ (let ((hash-list
+ (call-with-input-string
+ (utf8->string
+ (http-get-body
+ (test-cuirass-uri
+ "/api/latestbuilds?nr=1&project=gnu")))
+ json->scm)))
+ (= (length hash-list) 0)))
+
+ (test-assert "db-close"
+ (db-close (%db)))
+
+ (delete-file database-name)
+ (delete-file log-file-name))
--
2.13.2
next prev parent reply other threads:[~2017-08-01 19:52 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-30 10:07 [bug#27876] [PATCH] cuirass: add Hydra compatible HTTP API Mathieu Othacehe
2017-07-31 14:57 ` Ludovic Courtès
2017-08-01 19:48 ` Mathieu Othacehe
2017-08-02 9:22 ` Ludovic Courtès
2017-08-01 19:51 ` [bug#27876] [PATCH v2 1/3] cuirass: Store new information in database to prepare new HTTP API integration Mathieu Othacehe
2017-08-01 19:51 ` [bug#27876] [PATCH v2 2/3] cuirass: add Hydra compatible HTTP API Mathieu Othacehe
2017-09-08 16:00 ` Ludovic Courtès
2017-08-01 19:51 ` Mathieu Othacehe [this message]
2017-09-08 16:01 ` [bug#27876] [PATCH v2 3/3] cuirass: Add tests for new " Ludovic Courtès
2017-09-08 15:59 ` [bug#27876] [PATCH v2 1/3] cuirass: Store new information in database to prepare new HTTP API integration Ludovic Courtès
2017-09-08 19:13 ` bug#27876: " Mathieu Othacehe
2017-09-08 20:44 ` [bug#27876] " Ludovic Courtès
2017-09-09 7:48 ` Mathieu Othacehe
2017-09-10 13:01 ` Ludovic Courtès
2017-09-10 13:26 ` Mathieu Othacehe
2017-09-10 20:38 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20170801195124.7030-3-m.othacehe@gmail.com \
--to=m.othacehe@gmail.com \
--cc=27876@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.