diff options
Diffstat (limited to 'web/webserver.scm')
| -rw-r--r-- | web/webserver.scm | 63 |
1 files changed, 51 insertions, 12 deletions
diff --git a/web/webserver.scm b/web/webserver.scm index 0c0bdd1..4041f50 100644 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -35,11 +35,10 @@ (if dot-pos (substring filename dot-pos) ""))) -(define +current-repo-path+ - (getenv "CURRENT_REPO_PATH")) - -(define +cgit-repo-path+ - (getenv "CGIT_REPO_PATH")) +;; Look into moving this into a config file. +(define +local-repo-checkout-path+ (getenv "CURRENT_REPO_PATH")) +(define +remote-repo-url+ (getenv "CGIT_REPO_PATH")) +(define +working-branch+ (getenv "GN_GUILE_WORKING_BRANCH")) (define +info+ `(("name" . "GeneNetwork REST API") ("version" . ,get-version) @@ -181,7 +180,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 +191,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 +205,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)) @@ -229,14 +250,14 @@ otherwise search for set/group data" (build-json-response 200 ((lambda () (let ((message - (commit-file +current-repo-path+ + (commit-file +local-repo-checkout-path+ file-name content commit-message username email prev-commit))) - (git-invoke +current-repo-path+ "push" +cgit-repo-path+) + (git-invoke +local-repo-checkout-path+ "push" +remote-repo-url+) message)))))) (lambda (key . args) (let ((msg (car args))) @@ -244,6 +265,14 @@ otherwise search for set/group data" `(("error" . ,key) ("msg" . ,msg))))))) +(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) (match-lambda (('GET) @@ -301,9 +330,9 @@ 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 +local-repo-checkout-path+ +working-branch+ request)) (('POST "commit") - (commit-file-handler +current-repo-path+ request body)) + (commit-file-handler +local-repo-checkout-path+ request body)) (('GET id) (let ((names (get-species-shortnames (get-expanded-species)))) (match (string->list id) @@ -327,6 +356,16 @@ 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) |