diff options
Diffstat (limited to 'web/webserver.scm')
-rw-r--r-- | web/webserver.scm | 90 |
1 files changed, 46 insertions, 44 deletions
diff --git a/web/webserver.scm b/web/webserver.scm index 145f192..c0fb9a1 100644 --- a/web/webserver.scm +++ b/web/webserver.scm @@ -27,8 +27,14 @@ (web view doc) (web view markdown)) +(define +current-repo-path+ + (getenv "CURRENT_REPO_PATH")) + +(define +cgit-repo-path+ + (getenv "CGIT_REPO_PATH")) + (define +info+ - `(("name" . "GeneNetwork REST API") ("version" unquote get-version) + `(("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 (unless otherwise specified)" . "Affero GNU Public License 3.0 (AGPL3)") @@ -38,11 +44,10 @@ ("links" ("species" ,(mk-meta "species"))))) (define +info-meta+ - `(("doc" unquote - (mk-html "info")) - ("API" ((unquote (mk-url "species")) . "Get a list of all species") - ((unquote (mk-url "mouse")) . "Get information on mouse") - ((unquote (mk-url "datasets")) . "Get a list of datasets")))) + `(("doc" ,(mk-html "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 (get-id-data id) "Get data based on identifier id. If it is a taxon return the taxon data, @@ -82,11 +87,9 @@ otherwise search for set/group data" (modified (and stat (make-time time-utc 0 (stat:mtime stat))))) - (list `((content-type unquote - (assoc-ref file-mime-types - (file-extension file-name))) - (last-modified unquote - (time-utc->date modified))) + (list `((content-type ,(assoc-ref file-mime-types + (file-extension file-name))) + (last-modified ,(time-utc->date modified))) (call-with-input-file file-name get-bytevector-all)))) @@ -97,11 +100,9 @@ otherwise search for set/group data" (modified (and stat (make-time time-utc 0 (stat:mtime stat))))) - (list `((content-type unquote - (assoc-ref file-mime-types - (file-extension path))) - (last-modified unquote - (time-utc->date modified))) + (list `((content-type ,(assoc-ref file-mime-types + (file-extension path))) + (last-modified ,(time-utc->date modified))) (call-with-input-file path get-bytevector-all)))) @@ -171,11 +172,8 @@ otherwise search for set/group data" (lambda (key . args) (let ((msg (car args))) (build-json-response 400 - `(("error" unquote key) - ("msg" unquote msg))))))) - -(define +global-repo+ - (getenv "REPO_PATH")) + `(("error" ,key) + ("msg" ,msg))))))) (define (invalid-data? data target) (if (string? (assoc-ref data target)) @@ -190,30 +188,34 @@ otherwise search for set/group data" (define (commit-file-handler repo request body) (catch 'system-error (lambda () - (let* ((post-data (decode-request-json body)) - (_ (for-each (lambda (target) - (invalid-data? post-data target)) - '("filename" "content" "username" "email" - "prev_commit"))) - (file-name (assoc-ref post-data "filename")) - (content (assoc-ref post-data "content")) - (username (assoc-ref post-data "username")) - (email (assoc-ref post-data "email")) - (commit-message (assoc-ref post-data "commit_message")) - (prev-commit (assoc-ref post-data "prev_commit"))) - (build-json-response 200 - (commit-file repo - file-name - content - commit-message - username - email - prev-commit)))) + (let* ((post-data (decode-request-json body)) + (_ (for-each (lambda (target) + (invalid-data? post-data target)) + '("filename" "content" "username" "email" + "prev_commit"))) + (file-name (assoc-ref post-data "filename")) + (content (assoc-ref post-data "content")) + (username (assoc-ref post-data "username")) + (email (assoc-ref post-data "email")) + (commit-message (assoc-ref post-data "commit_message")) + (prev-commit (assoc-ref post-data "prev_commit"))) + (build-json-response 200 + ((lambda () + (let ((message + (commit-file +current-repo-path+ + file-name + content + commit-message + username + email + prev-commit))) + (git-invoke +current-repo-path+ "push" +cgit-repo-path+) + message)))))) (lambda (key . args) (let ((msg (car args))) (build-json-response 400 - `(("error" unquote key) - ("msg" unquote msg))))))) + `(("error" ,key) + ("msg" ,msg))))))) (define (controller request body) (match-lambda @@ -252,9 +254,9 @@ otherwise search for set/group data" (('GET "species") (render-json (get-species-meta))) (('GET "edit") - (edit-file-handler +global-repo+ request)) + (edit-file-handler +current-repo-path+ request)) (('POST "commit") - (commit-file-handler +global-repo+ request body)) + (commit-file-handler +current-repo-path+ request body)) (('GET id) (let ((names (get-species-shortnames (get-expanded-species)))) (match (string->list id) |