#!/usr/bin/env guile \ -e main -s !# ;; Minimal web server can be started from command line. Current example routes: ;; ;; localhost:8080/ ;; (use-modules (json) (ice-9 match) (ice-9 format) (ice-9 iconv) (ice-9 receive) ;; (ice-9 debugger) ;; (ice-9 breakpoints) ;; (ice-9 source) (srfi srfi-1) (srfi srfi-26) (web http) (web client) (web request) (web response) (web uri) (fibers web server)) (define get-version "2.0") (define (base-url) "https://genenetwork.org") (define (prefix) "Build the API URL including version" (string-append (base-url) "/api/" get-version)) (define (mk-url postfix) "Add the path to the API URL" (string-append (prefix) "/" postfix)) (define (mk-doc postfix) "Create a pointer to HTML documentation" (string-append (base-url) "/" postfix ".html")) (define (meta url) "Adds /meta to the URL" (string-append url "/meta")) (define info `( ("name" . "GeneNetwork REST API") ("version" . ,get-version) ("comment" . "This is the official REST API for the GeneNetwork service hosted at https://genenetwork.org/") ("license" . (("source code" . "AGPL"))) ("note" . "work in progress (WIP)") ("see also". ,(meta (prefix))))) (define info-meta `( ("doc" . ,(mk-doc "info")) ("API" . ((,(mk-url "species")."Get a list of all species") (,(mk-url "mouse")."Get information on mouse") (,(mk-url "datasets")."Get a list of datasets"))))) (define (sparql-exec query) "Execute raw SPARQL query returning response as a UTF8 string" (bytevector->string (receive (response-status response-body) (http-request (string-append "https://sparql.genenetwork.org/sparql?default-graph-uri=&query=" (uri-encode query) "&format=application%2Fsparql-results%2Bjson")) response-body) "UTF-8")) (define (unpack field response) "Helper to get nested JSON field from SPARQL response" (cdr (assoc field response))) (define (sparql-names response) "Helper to get the names part of a SPARQL query" (unpack "vars" (unpack "head" response))) (define (sparql-results response) "Helper to get the results part of a SPARQL query" (unpack "bindings" (unpack "results" response))) (define (sparql-scm query) "Return dual S-exp 'resultset' of varnames and results" (let ((response (json-string->scm (sparql-exec query)))) (values (sparql-names response) (sparql-results response)))) (define (sparql-species) (sparql-scm " PREFIX gn: PREFIX rdf: SELECT DISTINCT ?species WHERE { ?species rdf:type gn:species . }")) #! (define-values (names res) (sparql-species-meta)) (define table (get-rows names res)) (define recs '()) (define h (compile-species recs table)) (assoc "http://genenetwork.org/species_drosophila_melanogaster" h) (assoc-ref h "http://genenetwork.org/species_drosophila_melanogaster") ;; note switch! (define d (car h)) (assoc-ref (list d) "http://genenetwork.org/species_drosophila_melanogaster") (scm->json #(1 (("2" . 3)))) ;; [1,{"2":3}] (scm->json #("http://genenetwork.org/species_drosophila_melanogaster" (("http://genenetwork.org/menuName" . "Drosophila") ("http://genenetwork.org/binomialName" . "Drosophila melanogaster") ))) ;; ["http://genenetwork.org/species_drosophila_melanogaster",{"http://genenetwork.org/menuName":"Drosophila","http://genenetwork.org/binomialName":"Drosophila melanogaster"}] l ;; (("http://genenetwork.org/menuName" "Drosophila") ("http://genenetwork.org/name" "Drosophila") ("http://genenetwork.org/binomialName" "Drosophila melanogaster")) (scm->json (map (lambda (i) (cons (car i) (car (cdr i)))) l)) ;; {"http://genenetwork.org/menuName":"Drosophila","http://genenetwork.org/name":"Drosophila","http://genenetwork.org/binomialName":"Drosophila melanogaster"} !# (define (sparql-species-meta) (sparql-scm " PREFIX gn: PREFIX gnterm PREFIX rdf: SELECT ?species ?p ?o WHERE { MINUS { ?species rdf:type ?o . } { SELECT DISTINCT ?species ?p ?o WHERE { ?species rdf:type gn:species . ?species ?p ?o . }}}")) (define (get-values names row) "Get values by name from a resultset row" (map (lambda (n) (unpack "value" (unpack n row))) (array->list names))) (define (get-rows names results) "Format results as a list of values ordered by names" (map (lambda (row) (get-values names row)) (array->list results))) ;; from the triples first harvest the species URIs, followed by creating records of information (define (compile-species recs rows) "Compile a matrix of species triples into records" (for-each (lambda (r) (let* ([s (car r)] [v (cdr (cdr r))] [p (car (cdr r))] [nrec '()] [kv (assoc s recs)]) ; find record to fill based on subject (if (not kv) (set! nrec '()) (set! nrec (cdr kv)) ) (set! nrec (assoc-set! nrec p v)) (set! recs (assoc-set! recs s nrec)) )) rows) recs) ;; result should be a vector of list of pair (define (species-digest recs) (map (lambda (r) (let* ([k (car r)] [v (cdr r)]) (cons k (map (lambda (i) (cons (car i) (car (cdr i)))) v)) )) recs ) ) (define (get-species) (receive (names res) (sparql-species-meta) (let* ([table (get-rows names res)] [recs '()] [h (compile-species recs table)]) (species-digest h)) )) (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 (define (not-found2 request) (values (build-response #:code 404) (string-append "Resource X not found: " (uri->string (request-uri request))))) (define (not-found uri) (list (build-response #:code 404) (string-append "Resource not found: " (uri->string uri)))) (define (render-json json) (list '((content-type . (application/json))) (lambda (port) (scm->json json port)))) (define (render-json-string2 json) (list '((content-type . (text/plain))) (lambda (port) ;; (display "ThthxST" port) (format port "~a" "foo") ))) (define (controller request body) (match-lambda (('GET) (render-json info)) (('GET "meh") (render-json-string2 "ITEST")) (('HEAD "meh") (render-json-string2 "ITEST")) (('GET "meta") (render-json info-meta)) (('GET "version") (render-json get-version)) (('GET "species") (render-json (get-species))) (_ (not-found (request-uri request))) )) (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 " server!")) (write args) (newline) (let ((listen (inexact->exact (string->number (car (cdr args)))))) (display `("listening on" ,listen)) ;; (write listen) ;; (run-server hello-world-handler 'http `(#:port ,listen)))) (start-web-server "127.0.0.1" listen)))