From 00832daae019b7c4b3f651426231634dd11ed3b4 Mon Sep 17 00:00:00 2001
From: Pjotr Prins
Date: Thu, 6 Jul 2023 10:26:48 -0500
Subject: guile server: switching to fiber web

---
 gn3-guile/web/.guix-shell   |  2 +-
 gn3-guile/web/webserver.scm | 66 ++++++++++++++++++++++++++++++++++++++-------
 2 files changed, 57 insertions(+), 11 deletions(-)

(limited to 'gn3-guile')

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)))
-- 
cgit v1.2.3