Working implementation of configurable deploy path

intermine · Nov 9, 2021 · 1255ca5 · 1255ca5
1 parent 5f5c466
commit 1255ca5
Show file tree

Hide file tree

Showing 12 changed files with 129 additions and 82 deletions.
diff --git a/config/defaults/config.edn b/config/defaults/config.edn
@@ -4,6 +4,7 @@
  :logging-level "info"
  :google-analytics nil
  :bluegenes-tool-path "./tools"
+ :bluegenes-deploy-path nil
  :bluegenes-backend-service-root nil
  :bluegenes-default-service-root "https://www.flymine.org/flymine"
  :bluegenes-default-mine-name "FlyMine"
@@ -19,3 +20,4 @@
                               ]
  :hide-registry-mines false
  }
+
diff --git a/project.clj b/project.clj
@@ -4,6 +4,21 @@
       :out
       clojure.string/trim))
 
+(defn ?slurp
+  "Slurp that returns nil if file doesn't exist."
+  [f]
+  (try (slurp f) (catch java.io.FileNotFoundException _)))
+
+(def deploy-path
+  "Reads the :bluegenes-deploy-path key from envvar, config/dev/config.edn or
+  config/defaults/config.edn in order of decending precedence. This is only
+  used for development builds, which is why it doesn't cover all configuration
+  methods of yogthos/config."
+  (or (System/getenv "BLUEGENES_DEPLOY_PATH")
+      (some-> (or (?slurp "config/dev/config.edn")
+                  (?slurp "config/defaults/config.edn"))
+              (clojure.edn/read-string) (:bluegenes-deploy-path))))
+
 (defproject org.intermine/bluegenes "1.2.1"
   :licence "LGPL-2.1-only"
   :description "Bluegenes is a Clojure-powered user interface for InterMine, the biological data warehouse"
@@ -154,7 +169,7 @@
                                         :optimizations :none
                                         :output-to "resources/public/js/compiled/app.js"
                                         :output-dir "resources/public/js/compiled"
-                                        :asset-path "/js/compiled"
+                                        :asset-path ~(str deploy-path "/js/compiled")
                                         :source-map-timestamp true
                                         :pretty-print true
                                         ;:parallel-build true

diff --git a/src/clj/bluegenes/handler.clj b/src/clj/bluegenes/handler.clj
@@ -1,7 +1,5 @@
 (ns bluegenes.handler
   (:require [bluegenes.routes :refer [routes]]
-            [bluegenes-tool-store.core :as tool]
-            [compojure.core :as compojure]
             [ring.middleware.session :refer [wrap-session]]
             [ring.middleware.reload :refer [wrap-reload]]
             [compojure.middleware :refer [wrap-canonical-redirect]]
@@ -20,10 +18,7 @@
         uri))
     uri))
 
-(def combined-routes
-  (compojure/routes tool/routes routes))
-
-(def handler (-> #'combined-routes
+(def handler (-> #'routes
                  ;; Watch changes to the .clj and hot reload them
                  (cond-> (:development env) (wrap-reload {:dirs ["src/clj"]}))
                  ;; Add session functionality

diff --git a/src/clj/bluegenes/index.clj b/src/clj/bluegenes/index.clj
@@ -72,6 +72,13 @@
                (pr-str (.getMessage e)))
         nil))))
 
+(defn use-deployment-path
+  "Takes a URL string to a resource and prefixes the deployment path if defined."
+  [url]
+  (if-let [path (:bluegenes-deploy-path env)]
+    (str path url)
+    url))
+
 (defn head
   ([]
    (head nil {}))
@@ -87,8 +94,8 @@
         [:link {:href rdf-url :rel "alternate" :type "application/rdf+xml" :title "RDF"}]))
     (include-css "https://cdnjs.cloudflare.com/ajax/libs/gridlex/2.2.0/gridlex.min.css")
     (include-css "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css")
-    (include-css bluegenes-css)
-    (include-css im-tables-css)
+    (include-css (use-deployment-path bluegenes-css))
+    (include-css (use-deployment-path im-tables-css))
     (include-css "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css")
     (include-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/9.12.0/styles/github.min.css")
     ; Meta data:
@@ -99,7 +106,7 @@
      (str "var serverVars="
           (let [server-vars (merge (select-keys env [:google-analytics
                                                      :bluegenes-default-service-root :bluegenes-default-mine-name :bluegenes-default-namespace
-                                                     :bluegenes-additional-mines :hide-registry-mines])
+                                                     :bluegenes-additional-mines :hide-registry-mines :bluegenes-deploy-path])
                                    {:version bundle-hash})]
             (str \" (escape-quotes (pr-str server-vars)) \"))
           ";")
@@ -110,7 +117,7 @@
           ";")]
   ; Javascript:
     ;; This favicon is dynamically served; see routes.clj.
-    [:link {:href "/favicon.ico" :type "image/x-icon" :rel "shortcut icon"}]
+    [:link {:href (use-deployment-path "/favicon.ico") :type "image/x-icon" :rel "shortcut icon"}]
     [:script {:src "https://cdn.intermine.org/js/intermine/imjs/latest/im.min.js"}]
     [:script {:crossorigin "anonymous"
               :integrity "sha256-cCueBR6CsyA4/9szpPfrX3s49M9vUU5BgtiJj06wt/s="
@@ -159,7 +166,7 @@
      (css-compiler)
      (loader)
      [:div#app]
-     [:script {:src bundle-path}]
+     [:script {:src (use-deployment-path bundle-path)}]
      ;; Call the constructor of the bluegenes client and pass in the user's
      ;; optional identity as an object.
      [:script "bluegenes.core.init();"]])))
diff --git a/src/clj/bluegenes/routes.clj b/src/clj/bluegenes/routes.clj
@@ -10,7 +10,8 @@
             [bluegenes.index :refer [index]]
             [config.core :refer [env]]
             [bluegenes.utils :refer [env->mines get-service-root]]
-            [clj-http.client :as client]))
+            [clj-http.client :as client]
+            [bluegenes-tool-store.core :as tool]))
 
 (defn with-init
   "One of BlueGenes' web service could have added some data we want passed on
@@ -32,51 +33,54 @@
             (get-in [:headers "Content-Type"])
             (= "image/x-icon"))
       (found mine-favicon)
-      (found "/favicon-fallback.ico"))))
+      (found (str (:bluegenes-deploy-path env) "/favicon-fallback.ico")))))
 
 ; Define the top level URL routes for the server
 (def routes
   (compojure/let-routes [mines (env->mines env)
                          favicon* (delay (get-favicon))]
-    ;;serve compiled files, i.e. js, css, from the resources folder
-    (resources "/")
+    (context (:bluegenes-deploy-path env "/") []
+      ;;serve compiled files, i.e. js, css, from the resources folder
+      (resources "/")
 
-    ;; The favicon is chosen from the following order of priority:
-    ;; 1. `public/favicon.ico` being present as a resource (admin will have to add this).
-    ;; 2. `/<mine>/model/images/favicon.ico` being present on the default mine.
-    ;; 3. `public/favicon-fallback.ico` which is always present.
-    ;; Hence it follows that the following route won't be matched if [1] is true.
-    (GET "/favicon.ico" [] @favicon*)
+      ;; The favicon is chosen from the following order of priority:
+      ;; 1. `public/favicon.ico` being present as a resource (admin will have to add this).
+      ;; 2. `/<mine>/model/images/favicon.ico` being present on the default mine.
+      ;; 3. `public/favicon-fallback.ico` which is always present.
+      ;; Hence it follows that the following route won't be matched if [1] is true.
+      (GET "/favicon.ico" [] @favicon*)
 
-    (GET "/version" [] (response {:version "0.1.0"}))
+      (GET "/version" [] (response {:version "0.1.0"}))
 
-    ;; Anything within this context is the API web service.
-    (context "/api" []
-      (context "/auth" [] auth/routes)
-      (context "/ids" [] ids/routes)
-      (context "/rss" [] rss/routes))
+      tool/routes
 
-    ;; Dynamic routes for handling permanent URL resolution on configured mines.
-    (apply compojure/routes
-           (for [{mine-ns :namespace :as mine} mines]
-             (context (str "/" mine-ns) []
-               (GET ["/:lookup" :lookup #"[^:/.]+:[^:/.]+(?:\.rdf)?"] [lookup]
-                 (lookup/ws lookup mine)))))
+      ;; Anything within this context is the API web service.
+      (context "/api" []
+        (context "/auth" [] auth/routes)
+        (context "/ids" [] ids/routes)
+        (context "/rss" [] rss/routes))
 
-    ;; Passes options to index for including semantic markup with HTML.
-    (GET "/" []
-      (partial with-init {:semantic-markup :home
-                          :mine (first mines)}))
-    (apply compojure/routes
-           (for [{mine-ns :namespace :as mine} mines]
-             (compojure/routes
-              (GET (str "/" mine-ns) []
-                (partial with-init {:semantic-markup :home
-                                    :mine mine}))
-              (GET (str "/" mine-ns "/report/:class/:id") [id]
-                (partial with-init {:semantic-markup :report
-                                    :mine mine
-                                    :object-id id})))))
+      ;; Dynamic routes for handling permanent URL resolution on configured mines.
+      (apply compojure/routes
+             (for [{mine-ns :namespace :as mine} mines]
+               (context (str "/" mine-ns) []
+                 (GET ["/:lookup" :lookup #"[^:/.]+:[^:/.]+(?:\.rdf)?"] [lookup]
+                   (lookup/ws lookup mine)))))
 
-    (GET "*" []
-      (partial with-init {}))))
+      ;; Passes options to index for including semantic markup with HTML.
+      (GET "/" []
+        (partial with-init {:semantic-markup :home
+                            :mine (first mines)}))
+      (apply compojure/routes
+             (for [{mine-ns :namespace :as mine} mines]
+               (compojure/routes
+                (GET (str "/" mine-ns) []
+                  (partial with-init {:semantic-markup :home
+                                      :mine mine}))
+                (GET (str "/" mine-ns "/report/:class/:id") [id]
+                  (partial with-init {:semantic-markup :report
+                                      :mine mine
+                                      :object-id id})))))
+
+      (GET "*" []
+        (partial with-init {})))))
diff --git a/src/clj/bluegenes/ws/auth.clj b/src/clj/bluegenes/ws/auth.clj
@@ -33,6 +33,8 @@
 ;; "client manages token" approach chosen by default for historical reasons, as
 ;; each API client has been doing this. At some point we might raise this
 ;; question again...
+;; ^ not possible right now; JSESSIONID only works for JSP webapp, not WS requests
+;; => Keep it as it is!
 
 (defn use-backend-service
   "Substitute service root for the one the backend is configured to use, if it
@@ -134,7 +136,7 @@
           user+token (assoc user
                             :token token
                             :login-method :oauth2)]
-      (-> (response/found (str "/" mine-id))
+      (-> (response/found (str (:bluegenes-deploy-path env) "/" mine-id))
           (assoc :session ^:recreate {:identity user+token
                                       :init {:identity user+token
                                              :renamedLists renamedLists}})))
@@ -143,7 +145,7 @@
       (let [{:keys [body]} (ex-data e)
             error (or (:error (cheshire/parse-string body true))
                       (ex-message e))]
-        (-> (response/found (str "/" mine-id))
+        (-> (response/found (str (:bluegenes-deploy-path env) "/" mine-id))
             (assoc :session {:init {:events [[:messages/add
                                               {:style "warning"
                                                :markup (str "Failed to login using OAuth 2.0"

diff --git a/src/clj/bluegenes/ws/lookup.clj b/src/clj/bluegenes/ws/lookup.clj
@@ -5,15 +5,16 @@
             [clojure.string :as str]
             [cheshire.core :as cheshire]
             [clj-http.client :refer [with-middleware]]
-            [bluegenes.utils :as utils]))
+            [bluegenes.utils :as utils]
+            [config.core :refer [env]]))
 
 (def extension->content-type
   {"rdf" "application/rdf+xml;charset=UTF-8"})
 
 (defn handle-failed-lookup [lookup-string {:keys [namespace]} error-string]
   (let [msg [:span "Failed to parse permanent URL for " [:em lookup-string] " "
              [:code error-string]]]
-    (-> (response/found (str "/" namespace))
+    (-> (response/found (str (:bluegenes-deploy-path env) "/" namespace))
         (assoc :session {:init {:events [[:messages/add
                                           {:style "warning"
                                            :timeout 0
@@ -30,7 +31,8 @@
                     :value identifier}]}
         res (im-fetch/rows service q)]
     (if-let [object-id (get-in res [:results 0 0])]
-      (response/found (str "/" namespace
+      (response/found (str (:bluegenes-deploy-path env)
+                           "/" namespace
                            "/" "report"
                            "/" object-type
                            "/" object-id))

diff --git a/src/cljs/bluegenes/effects.cljs b/src/cljs/bluegenes/effects.cljs
@@ -9,7 +9,9 @@
             [oops.core :refer [ocall oget oset!]]
             [goog.dom :as gdom]
             [goog.style :as gstyle]
-            [goog.fx.dom :as gfx]))
+            [goog.fx.dom :as gfx]
+            [bluegenes.config :refer [server-vars]]
+            [clojure.string :as str]))
 
 ;; Cofx and fx which you use from event handlers to read/write to localStorage.
 
@@ -183,15 +185,20 @@
                   :delete http/delete
                   :put http/put
                   http/get)]
-    (let [c (http-fn uri (cond-> {}
-                           query-params (assoc :query-params query-params)
-                           json-params (assoc :json-params json-params)
-                           transit-params (assoc :transit-params transit-params)
-                           form-params (assoc :form-params form-params)
-                           multipart-params (assoc :multipart-params multipart-params)
-                           headers (update :headers #(merge % headers))
-                           (and token @token) (update :headers assoc "X-Auth-Token" @token)
-                           progress (assoc :progress progress)))]
+    (let [c (http-fn (if (str/starts-with? uri "/")
+                       ;; Path only = API call to BG backend.
+                       (str (:bluegenes-deploy-path @server-vars) uri)
+                       ;; Full address = API call to external service.
+                       uri)
+                     (cond-> {}
+                       query-params (assoc :query-params query-params)
+                       json-params (assoc :json-params json-params)
+                       transit-params (assoc :transit-params transit-params)
+                       form-params (assoc :form-params form-params)
+                       multipart-params (assoc :multipart-params multipart-params)
+                       headers (update :headers #(merge % headers))
+                       (and token @token) (update :headers assoc "X-Auth-Token" @token)
+                       progress (assoc :progress progress)))]
       (go (let [{:keys [status body] :as response} (<! c)]
             (cond
               (<= 200 status 399) (when on-success (dispatch (conj on-success body)))
@@ -336,7 +343,7 @@
 (reg-fx
  :change-route
  (fn [new-path]
-   (.replaceState js/window.history nil "" (str "/" new-path))))
+   (.replaceState js/window.history nil "" (str (:bluegenes-deploy-path @server-vars) "/" new-path))))
 
 ;; filename - string including extension
 ;; filetype - string to be appended to 'text/' forming a mime type

diff --git a/src/cljs/bluegenes/events/auth.cljs b/src/cljs/bluegenes/events/auth.cljs
@@ -3,7 +3,8 @@
             [bluegenes.effects :as fx]
             [bluegenes.route :as route]
             [imcljs.auth :as im-auth]
-            [bluegenes.interceptors :refer [origin]]))
+            [bluegenes.interceptors :refer [origin]]
+            [bluegenes.config :refer [server-vars]]))
 
 (defn slim-service
   "Constrains a service map to only the keys needed by the backend API."
@@ -210,7 +211,10 @@
  (fn [{db :db origin :origin} [_ provider]]
    (let [current-mine (:current-mine db)
          service (get-in db [:mines current-mine :service])
-         redirect_uri (str origin "/api/auth/oauth2callback?provider=" provider)]
+         redirect_uri (str origin
+                           (str (:bluegenes-deploy-path @server-vars)
+                                "/api/auth/oauth2callback?provider=")
+                           provider)]
      {:db (update-in db [:mines current-mine :auth] assoc
                      :error? false)
       ::fx/http {:uri "/api/auth/oauth2authenticator"

diff --git a/src/cljs/bluegenes/events/boot.cljs b/src/cljs/bluegenes/events/boot.cljs
@@ -153,11 +153,7 @@
    (let [default-ns (read-default-ns)
          ;; We have to set the db current-mine using `window.location` as the
          ;; router won't have dispatched `:set-current-mine` before later on.
-         current-mine (-> (.. js/window -location -pathname)
-                          (str/split #"/")
-                          (second)
-                          (keyword)
-                          (or default-ns))
+         current-mine (or (keyword (utils/mine-from-pathname)) default-ns)
          ;; These could be passed from the Bluegenes backend and result in
          ;; events being dispatched.
          renamedLists (some-> @init-vars :renamedLists not-empty)

diff --git a/src/cljs/bluegenes/route.cljs b/src/cljs/bluegenes/route.cljs
@@ -7,8 +7,9 @@
             [reitit.frontend :as rf]
             [reitit.frontend.controllers :as rfc]
             [reitit.frontend.easy :as rfe]
-            [bluegenes.config :refer [read-default-ns]]
-            [clojure.string :as str]))
+            [bluegenes.config :refer [read-default-ns server-vars]]
+            [clojure.string :as str]
+            [bluegenes.utils :as utils]))
 
 ;; # Quickstart guide:
 ;; (aka. I just want to route something but don't want to read all this code!)
@@ -121,7 +122,7 @@
 ;; for all our routes. Doing this would fix the discrepancy we currently have
 ;; between `:set-active-panel` and the router events.
 (def routes
-  ["/"
+  [(str (:bluegenes-deploy-path @server-vars) "/")
    [":mine"
     {:controllers
      [{:parameters {:path [:mine]}
@@ -292,14 +293,13 @@
     ;; We end up here when there are no matches (empty or invalid path).
     ;; This does not apply when the path references a nonexistent mine.
     (let [paths (str/split (.. js/window -location -pathname) #"/")
-          target-mine (-> paths
-                          (second)
-                          (or (name (read-default-ns))))]
+          deploy-paths (str/split (:bluegenes-deploy-path @server-vars) #"/")
+          target-mine (or (utils/mine-from-pathname) (name (read-default-ns)))]
       (dispatch [::navigate ::home {:mine target-mine}])
-      (when (> (count paths) 2)
+      (when (>= (count paths) (+ 2 (count deploy-paths)))
         (dispatch [:messages/add
                    {:markup [:span "You have been redirected to the home page as the path "
-                             [:em (->> paths (drop 2) (str/join "/"))]
+                             [:em (.. js/window -location -pathname)]
                              " could not be resolved."]
                     :style "warning"
                     :timeout 0}])))))