diff options
Diffstat (limited to 'gn3-guile')
-rw-r--r-- | gn3-guile/web/.guix-shell | 2 | ||||
-rwxr-xr-x | gn3-guile/web/webserver.scm | 66 |
2 files changed, 57 insertions, 11 deletions
diff --git a/gn3-guile/web/.guix-shell b/gn3-guile/web/.guix-shell index 3834f90..bb14b26 100644 --- a/gn3-guile/web/.guix-shell +++ b/gn3-guile/web/.guix-shell @@ -5,4 +5,4 @@ echo "Note run: running web-server" -guix shell guile guile-json gnutls guile-readline guile-redis openssl nss-certs $* +guix shell guile guile-fibers guile-json gnutls guile-readline guile-redis openssl nss-certs $* diff --git a/gn3-guile/web/webserver.scm b/gn3-guile/web/webserver.scm index 7809661..2624125 100755 --- a/gn3-guile/web/webserver.scm +++ b/gn3-guile/web/webserver.scm @@ -8,15 +8,21 @@ ;; Note that this is a single blocking thread server right now. (use-modules (json) - (web server) + (ice-9 match) + (ice-9 format) + (srfi srfi-1) + (srfi srfi-26) + (web http) (web request) (web response) - (web uri)) + (web uri) + (fibers web server) + ) (define (get-version-str) "2.0") -(define info-list (scm->json-string `( +(define info-list `( ("name" . "GeneNetwork REST API") ("version" . ,(get-version-str)) ("comment" . "This is the official REST API for the GeneNetwork service hosted at https://genenetwork.org/") @@ -27,11 +33,7 @@ "https://genenetwork.org/api/v2/populations/" "https://genenetwork.org/api/v2/datasets/" ) - )))) - -(define (get-gn-info-str) - info-list - ) + ))) (define (get-species-str) (scm->json-string '(("Mus_musculus" . (("id" . "mouse" ) @@ -39,7 +41,9 @@ ("Rattus_norvegicus" . (("id" . "rat") ("api" . "https://genenetwork.org/api/v2/rat/"))) ))) - +(define (get-species-api-str) + (scm->json-string #("https://genenetwork.org/api/v2/mouse/" + "https://genenetwork.org/api/v2/rat/"))) ;; ---- REST API web server handler @@ -54,6 +58,10 @@ (values '((content-type . (application/json))) (get-species-str) )) + ((member path (list "/species/api/")) + (values '((content-type . (application/json))) + (get-species-api-str) + )) ((member path (list "/")) (values '((content-type . (application/json))) (get-gn-info-str) @@ -66,6 +74,43 @@ (string-append "Resource not found: " (uri->string (request-uri request))))) +(define (render-json json) + (list '((content-type . (application/json))) + (lambda (port) + (scm->json json port)))) + +(define (controller request body) + (match-lambda + (('GET) + (render-json info-list)) + (('GET "version") + (render-json (get-version-str))))) + +(define (request-path-components request) + (split-and-decode-uri-path (uri-path (request-uri request)))) + +(define (handler request body) + (format #t "~a ~a\n" + (request-method request) + (uri-path (request-uri request))) + (apply values + ((controller request body) + (cons (request-method request) + (request-path-components request))))) + +(define (start-web-server address port) + (format (current-error-port) + "GN REST API web server listening on http://~a:~a/~%" + address port) + ;; Wrap handler in another function to support live hacking via the + ;; REPL. If handler is passed as is and is then redefined via the + ;; REPL, the web server will still be using the old handler. The + ;; only way to update the handler reference held by the web server + ;; would be to restart the web server. + (run-server (cut handler <> <>) + #:addr (inet-pton AF_INET address) + #:port port)) + (define (main args) (write (string-append "Starting Guile REST API " (get-version-str) " server!")) (write args) @@ -73,4 +118,5 @@ (let ((listen (inexact->exact (string->number (car (cdr args)))))) (display `("listening on" ,listen)) ;; (write listen) - (run-server hello-world-handler 'http `(#:port ,listen)))) + ; (run-server hello-world-handler 'http `(#:port ,listen)))) + (start-web-server "127.0.0.1" listen))) |