diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | .guix/modules/gn-guile.scm | 2 | ||||
| -rw-r--r-- | README.md | 4 | ||||
| -rwxr-xr-x | bin/gn-guile | 38 | ||||
| -rwxr-xr-x | gn-guile.sh | 3 | ||||
| -rw-r--r-- | gn/db/mysql.scm | 7 | ||||
| -rwxr-xr-x[-rw-r--r--] | gn/db/sparql.scm | 82 | ||||
| -rw-r--r-- | manifest.scm | 7 | ||||
| -rw-r--r-- | web/config.scm | 86 | ||||
| -rw-r--r-- | web/webserver.scm | 149 |
10 files changed, 266 insertions, 113 deletions
diff --git a/.gitignore b/.gitignore index 5f81cf8..26235cb 100644 --- a/.gitignore +++ b/.gitignore @@ -3,3 +3,4 @@ pheno.txt GWA.json K.json .aider* +.config/** diff --git a/.guix/modules/gn-guile.scm b/.guix/modules/gn-guile.scm index 03f2b14..87e059e 100644 --- a/.guix/modules/gn-guile.scm +++ b/.guix/modules/gn-guile.scm @@ -8,7 +8,7 @@ ;; (define-module (gn-guile) - #:use-module ((gn packages guile) #:select (gn-guile) #:prefix gn:) + #:use-module ((gn-machines genenetwork) #:select (gn-guile) #:prefix gn:) #:use-module (guix gexp) #:use-module (guix utils) #:use-module (guix packages) diff --git a/README.md b/README.md index 923b64e..2577c00 100644 --- a/README.md +++ b/README.md @@ -34,7 +34,7 @@ git remote add gn git.genenetwork.org:/home/git/public/gn-guile GNU Guile allows you to develop against a live running web server using emacs-geiser on port 1970. To try this fire up the web server from the `web` directory as ```sh -guix shell -L ~/guix-bioinformatics -m manifest.scm --container --network --file=guix.scm -- guile -L . --fresh-auto-compile --listen=1970 -e main web/webserver.scm 8091 +guix shell -L ~/guix-bioinformatics --container --network --development --file=guix.scm -- guile -L . --fresh-auto-compile --listen=1970 -e main bin/gn-guile 8091 ``` By default the root points to the API: @@ -55,7 +55,7 @@ We recommend checking the Guix documentation for manifests, channels and guix.sc To run a standalone server you should run without the listener on port 1970: ``` -guix shell -L ~/guix-bioinformatics -m manifest.scm --container --network --file=guix.scm -- guile -L . --fresh-auto-compile -e main web/webserver.scm 8091 +guix shell -L ~/guix-bioinformatics --container --network --file=guix.scm -- guile -L . --fresh-auto-compile -e main bin/gn-guile 8091 ``` ## Welcome to the world of interactive Lisp programming diff --git a/bin/gn-guile b/bin/gn-guile new file mode 100755 index 0000000..47bd259 --- /dev/null +++ b/bin/gn-guile @@ -0,0 +1,38 @@ +#!/usr/bin/env sh +# -*- mode: scheme; -*- +exec guile --no-auto-compile -e main -s "$0" "$@" +!# + +;;; gn-guile --- GN Guile web service +;;; Copyright © 2026 Frederick M. Muriithi <fredmanglis@gmail.com> +;;; +;;; This file is part of gn-guile +;;; +;;; gn-guile 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. +;;; +;;; gn-guile 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 gn-guile. If not, see <https://www.gnu.org/licenses/>. + +(use-modules (config) + (web config) + (web gn-uri) + (web webserver)) + +(define (main args) + (write (string-append "Starting Guile REST API " get-version " server!")) + (write args) + (newline) + (let* ((options (parse-cli-options args)) + (listen (option-ref options 'port))) + (when (option-ref options 'write) + (options-write options)) + (display `("listening on" ,listen)) + (start-web-server "127.0.0.1" listen (cli-options->gn-guile-config options)))) diff --git a/gn-guile.sh b/gn-guile.sh deleted file mode 100755 index 9341b26..0000000 --- a/gn-guile.sh +++ /dev/null @@ -1,3 +0,0 @@ -#! @SHELL@ - -guile -e main web/webserver.scm "$@" diff --git a/gn/db/mysql.scm b/gn/db/mysql.scm index 623a726..8da7b60 100644 --- a/gn/db/mysql.scm +++ b/gn/db/mysql.scm @@ -37,9 +37,10 @@ ))) (define (call-with-db thunk) - (let [(db (db-open))] - (thunk db) - (dbi-close db))) + (let* [(db (db-open)) + (result (thunk db))] + (dbi-close db) + result)) (define (ensure db msg1) "Use DBI-style handle to report an error. On error the program will stop." diff --git a/gn/db/sparql.scm b/gn/db/sparql.scm index bd7a306..fbcd2cc 100644..100755 --- a/gn/db/sparql.scm +++ b/gn/db/sparql.scm @@ -18,10 +18,11 @@ the case. #:use-module (json) #:use-module (srfi srfi-1) #:use-module (web client) + #:use-module (web http) #:use-module (web gn-uri) #:use-module (web request) + #:use-module (web response) #:use-module (web uri) - #:export (memo-sparql-species memo-sparql-species-meta sparql-species-meta @@ -37,9 +38,11 @@ the case. strip-lang make-table make-pairs - ) -) + sparql-http-get + sparql-by-term)) +(define virtuoso-endpoint + (or (getenv "SPARQL-ENDPOINT") "http://localhost:8890/sparql/")) (define (strip-lang s) "Strip quotes and language tag (@en) from RDF entries" @@ -58,9 +61,9 @@ the case. (define (gn-sparql-prefix query) (string-append " -PREFIX gn: <http://genenetwork.org/id/> -PREFIX gnt: <http://genenetwork.org/term/> -PREFIX gnc: <http://genenetwork.org/category/> +PREFIX gn: <http://rdf.genenetwork.org/v1/id/> +PREFIX gnt: <http://rdf.genenetwork.org/v1/term/> +PREFIX gnc: <http://rdf.genenetwork.org/v1/category/> PREFIX rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> " query)) @@ -108,46 +111,7 @@ Note this procedure works for GN, but does not yet work for wikidata" (define (tsv->scm text) "Split a TSV string into a list of fields. Returns list of names header) and rows" (let ([lst (map (lambda (f) (string-split f #\tab) ) (delete "" (string-split text #\newline)))]) - (values (car lst) (cdr lst)) - )) - -#! -(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/id/Drosophila_melanogaster") -(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"} - - -curl -G https://query.wikidata.org/sparql -H "Accept: application/json; charset=utf-8" --data-urlencode query="SELECT DISTINCT * where { - wd:Q158695 wdt:P225 ?o . -} limit 5" -{ - "head" : { - "vars" : [ "o" ] - }, - "results" : { - "bindings" : [ { - "o" : { - "type" : "literal", - "value" : "Arabidopsis thaliana" - } - } ] - } -} -!# + (values (car lst) (cdr lst)))) (define (sparql-wd-species-info species) "Returns wikidata entry for species, e.g.: @@ -326,3 +290,29 @@ dump-species-metadata.ttl:gn:Axbxa gnt:belongsToSpecies gn:Mus_musculus . " gnid " ?key ?value . # FILTER ( !EXISTS{ " gnid " gnt:hasTissue ?value }) }"))) + + +(define* (sparql-http-get endpoint-url query #:optional (mime-type "text/microdata+html")) + (receive (response-status response-body) + (http-request + (format #f "~a?default-graph-uri=&query=~a&format=~a" + endpoint-url (uri-encode query) (uri-encode mime-type)) + #:method 'GET) + (values + (build-response + #:code (response-code response-status) + #:headers `((content-type . ,(parse-header 'content-type mime-type)))) + response-body))) + +(define (sparql-by-term prefix val) + (let ((url-alist '((gn . "<http://rdf.genenetwork.org/v1/id/>") + (gnc . "<http://rdf.genenetwork.org/v1/category/>") + (gnt . "<http://rdf.genenetwork.org/v1/term/>")))) + (format #f "PREFIX ~a: ~a + +CONSTRUCT { + ~a:~a ?p ?o . +} FROM <http://rdf.genenetwork.org/v1> +WHERE { + ~a:~a ?p ?o . +}" prefix (assoc-ref url-alist prefix) prefix val prefix val))) diff --git a/manifest.scm b/manifest.scm index bc8f699..aa2b3be 100644 --- a/manifest.scm +++ b/manifest.scm @@ -1,4 +1,11 @@ ;; please do not remove +;; ----------------------- +;; Move these dependencies to `propagated-inputs' for the `gn-guile' package in +;; guix-bioinformatics and remove this file. +;; +;; This will help avoid inconsistencies in the list of dependencies when doing +;; development and when deploying. +;; ----------------------- (specifications->manifest '("coreutils" "guile" diff --git a/web/config.scm b/web/config.scm new file mode 100644 index 0000000..9b3b9c2 --- /dev/null +++ b/web/config.scm @@ -0,0 +1,86 @@ +;;; Copyright © 2026 Frederick M Muriithi <fredmanglis@gmail.com> + +(define-module (web config) + #:use-module (srfi srfi-9 gnu) + + #:use-module (config) + #:use-module (config api) + #:use-module (config parser sexp) + + #:export (<gn-guile-config> + gn-guile-config-port + gn-guile-config-gn-docs-remote-url + gn-guile-config-gn-docs-local-checkout + gn-guile-config-gn-docs-working-branch + + parse-cli-options + cli-options->gn-guile-config)) + +(define-immutable-record-type <gn-guile-config> + (gn-guile-config port gn-docs-remote-url gn-docs-local-checkout + gn-docs-working-branch) + gn-guile-config? + (port gn-guile-config-port) + (gn-docs-remote-url gn-guile-config-gn-docs-remote-url) + (gn-docs-local-checkout gn-guile-config-gn-docs-local-checkout) + (gn-docs-working-branch gn-guile-config-gn-docs-working-branch)) + + +(define string->exact (compose inexact->exact string->number)) + + +(define (user-port? parsed) + (and (positive? parsed) (>= parsed 1024) (<= parsed 49151))) + + +(define (parse-cli-options cmd-line) + "Read configuration values from files and command-line options and convert them to appropriate data types." + (let ((config + (configuration (name 'gn-guile) + (synopsis "gn-guile web service: provide services + to main Genenetwork service.") + (description "gn-guile web service is a small +service, written in GNU Guile, that provides some functionality to the main +Genenetwork service in the background. This is not meant for direct user +interaction.") + (keywords + (list (switch (name 'write) + (default #f) + (test boolean?) + (character #f) + (synopsis "Write the settings to configuration file(s)") + (description "When this option is present, the configuration values, provided as command line option, will be written to the file path(s) that has/have been specified.")) + (setting (name 'port) + (default 8091) + (test user-port?) + (handler string->exact) + (character #\p) + (synopsis "Port number that the service will listen on")) + (setting (name 'gn-docs-remote-url) + (default "git@git.genenetwork.org:/home/git/public/gn-docs") + (test string?) + (character #\r) + (synopsis "Remote URI for gn-docs repository")) + (setting (name 'gn-docs-local-checkout) + (default (string-append (dirname (getcwd)) "/gn-guile-files/gn-docs")) + (test file-exists?) + (character #\c) + (synopsis "Path where gn-docs is checked out")) + (setting (name 'gn-docs-working-branch) + (default "non-existent") + (test string?) + (character #\b) + (synopsis "Branch to push/pull from")))) + (parser sexp-parser) + (directory (list (in-home ".config/gn-guile/") + (in-cwd ".config/")))))) + (getopt-config-auto cmd-line config))) + + +(define (cli-options->gn-guile-config cli-options) + "Extract specific values from guile-config's <codex> object into gn-guile's custom configuration object." + (gn-guile-config + (option-ref cli-options 'port) + (option-ref cli-options 'gn-docs-remote-url) + (option-ref cli-options 'gn-docs-local-checkout) + (option-ref cli-options 'gn-docs-working-branch))) diff --git a/web/webserver.scm b/web/webserver.scm index 0c0bdd1..8c909a5 100644 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -1,46 +1,43 @@ -(use-modules (json) - (ice-9 match) - (ice-9 format) - (ice-9 iconv) - (ice-9 receive) - (ice-9 string-fun) - (ice-9 exceptions) - (srfi srfi-1) - (srfi srfi-11) - (srfi srfi-13) - (srfi srfi-19) - (srfi srfi-26) - (rnrs io ports) - (rnrs bytevectors) - (web http) - (web client) - (web request) - (web response) - (web uri) - (web server) - (gn cache memoize) - (web gn-uri) - (gn db sparql) - (gn data dataset) - (gn data species) - (gn data group) - (gn runner gemma) - (web sxml) - (web view view) - (web view doc) - (web view markdown)) +(define-module (web webserver) + #:use-module (json) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (ice-9 iconv) + #:use-module (ice-9 receive) + #:use-module (ice-9 string-fun) + #:use-module (ice-9 exceptions) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-13) + #:use-module (srfi srfi-19) + #:use-module (srfi srfi-26) + #:use-module (rnrs io ports) + #:use-module (rnrs bytevectors) + #:use-module (web http) + #:use-module (web client) + #:use-module (web request) + #:use-module (web response) + #:use-module (web uri) + #:use-module (web server) + #:use-module (gn cache memoize) + #:use-module (web gn-uri) + #:use-module (gn db sparql) + #:use-module (gn data dataset) + #:use-module (gn data species) + #:use-module (gn data group) + #:use-module (gn runner gemma) + #:use-module (web sxml) + #:use-module (web config) + #:use-module (web view view) + #:use-module (web view doc) + #:use-module (web view markdown) + #:export (start-web-server)) (define (get-extension filename) (let ((dot-pos (string-rindex filename #\.))) (if dot-pos (substring filename dot-pos) ""))) -(define +current-repo-path+ - (getenv "CURRENT_REPO_PATH")) - -(define +cgit-repo-path+ - (getenv "CGIT_REPO_PATH")) - (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/") @@ -181,7 +178,7 @@ otherwise search for set/group data" (cons (string->symbol (uri-decode key)) (uri-decode value)))) -(define (edit-file-handler repo request) +(define (edit-file-handler local-repo working-branch request) (catch 'file-error (lambda () (let* ((query (uri-query (request-uri request))) @@ -192,8 +189,12 @@ otherwise search for set/group data" (query-path (assoc-ref params 'file_path))) (if query-path - (build-json-response 200 - (fetch-file repo query-path)) + (begin + (git-invoke local-repo "fetch" "origin" working-branch) + (git-invoke local-repo "reset" "--hard" + (string-append "origin/" working-branch)) + (build-json-response 200 + (fetch-file local-repo query-path))) (throw 'file-error "Please provide a valid file path in the query")))) (lambda (key . args) @@ -202,6 +203,24 @@ otherwise search for set/group data" `(("error" . ,key) ("msg" . ,msg))))))) +(define (render-sparql request prefix val) + (let* ((mime (negotiate-mime request)) + (resp-mime (if (or (string-contains (symbol->string mime) "html") + (string-contains (symbol->string mime) "microdata")) + 'text/html + mime))) + (receive (sparql-header sparql-resp) + (sparql-http-get + (or (getenv "SPARQL-ENDPOINT") "http://localhost:8890/sparql/") + (sparql-by-term prefix val) + (symbol->string mime)) + (list `((content-type ,resp-mime)) + (lambda (port) + (let ((resp (if (string? sparql-resp) + sparql-resp + (utf8->string sparql-resp)))) + (put-string port resp))))))) + (define (invalid-data? data target) (if (string? (assoc-ref data target)) (if (string-null? (assoc-ref data target)) @@ -212,7 +231,7 @@ otherwise search for set/group data" (format #f "The Key *** ~a *** is missing in your Json Data" target)))) -(define (commit-file-handler repo request body) +(define (commit-file-handler repo-checkout remote-url request body) (catch 'system-error (lambda () (let* ((post-data (decode-request-json body)) @@ -229,14 +248,14 @@ otherwise search for set/group data" (build-json-response 200 ((lambda () (let ((message - (commit-file +current-repo-path+ + (commit-file repo-checkout file-name content commit-message username email prev-commit))) - (git-invoke +current-repo-path+ "push" +cgit-repo-path+) + (git-invoke repo-checkout "push" remote-url) message)))))) (lambda (key . args) (let ((msg (car args))) @@ -244,7 +263,15 @@ otherwise search for set/group data" `(("error" . ,key) ("msg" . ,msg))))))) -(define (controller request body) +(define (negotiate-mime request) + (let* ((headers (request-headers request)) + (accept (caar (assoc-ref headers 'accept)))) + (if (or (eq? (string->symbol "*/*") accept) + (eq? (string->symbol "text/html") accept)) + 'application/x-nice-microdata + accept))) + +(define (controller request body config) (match-lambda (('GET) (render-json +info+)) @@ -301,9 +328,13 @@ otherwise search for set/group data" (('GET "species") (render-json (get-species-meta))) (('GET "edit") - (edit-file-handler +current-repo-path+ request)) + (edit-file-handler (gn-guile-config-gn-docs-local-checkout config) + (gn-guile-config-gn-docs-working-branch config) + request)) (('POST "commit") - (commit-file-handler +current-repo-path+ request body)) + (commit-file-handler (gn-guile-config-gn-docs-local-checkout config) + (gn-guile-config-gn-docs-remote-url config) + request body)) (('GET id) (let ((names (get-species-shortnames (get-expanded-species)))) (match (string->list id) @@ -327,21 +358,31 @@ otherwise search for set/group data" #\n) (render-json (get-id-data (list->string name)))) (rest (render-json "NOP"))))) + ;; RDF End-points + (('GET "v1" "id" id) + (render-sparql request 'gn id)) + + (('GET "v1" "category" category) + (render-sparql request 'gnc category)) + + (('GET "v1" "term" term) + (render-sparql request 'gnt term)) + (_ (not-found (request-uri request))))) (define (request-path-components request) (split-and-decode-uri-path (uri-path (request-uri request)))) -(define (handler request body) +(define (handler request body config) (format #t "~a ~a\n" (request-method request) (uri-path (request-uri request))) (apply values - ((controller request body) + ((controller request body config) (cons (request-method request) (request-path-components request))))) -(define (start-web-server address port) +(define (start-web-server address port config) (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 @@ -349,15 +390,7 @@ otherwise search for set/group data" ;; 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 <> <>) + (run-server (cut handler <> <> config) 'http (list #: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)) - (start-web-server "127.0.0.1" listen))) |