Merge pull request #52 from uosl/feature/more-ws

More webservices and various fixes

README.md

@@ -100,12 +100,14 @@ Most result-fetching functions require that the `:model` key be present in their
 
 **Required dependency:** phantomjs, to run the tests in a headless javascript engine. You'll need a recent version of node installed, perhaps via [nvm](https://github.com/creationix/nvm). Once node is installed, run `npm install -g phantomjs` to install phantomjs. 
 
+**Local biotestmine:** The tests are run against a local biotestmine instance on port 9999 (can be changed in *test/cljs/imcljs/env.cljs*). If you're not familiar with building InterMine instances, we recommend using [intermine_boot](https://github.com/intermine/intermine_boot).
+
 **To run tests in the browser:**
 ```bash
 lein doo
 ```
 
-To run tests in the JVM:
+**To run tests in the JVM:**
 ```bash
 lein test
 ```

src/clj/imcljs/internal/io.clj

@@ -5,7 +5,8 @@
             [imcljs.internal.defaults :refer [url wrap-request-defaults
                                               wrap-post-defaults
                                               wrap-put-defaults
-                                              wrap-auth]]
+                                              wrap-auth
+                                              wrap-get-defaults]]
             [imcljs.internal.utils :refer [assert-args]]))
 
 (def method-map {:get client/get
@@ -59,12 +60,12 @@
 (defn get-body-wrapper-
   [path {:keys [root token model]} options & [xform]]
   (parse-response xform (client/get (url root path)
-                                    (-> options ; Blank request map
+                                    (-> {} ; Blank request map
                                         ;(wrap-accept)
                                         (wrap-request-defaults xform) ; Add defaults such as with-credentials false?
+                                        (wrap-get-defaults options) ; Add query params
                                         ; If we have basic auth options then convert them from the cljs-http to clj-http format
-                                        wrap-basic-auth
-                                        ;(wrap-post-defaults options model) ; Add form params
+                                        (wrap-basic-auth)
                                         (wrap-auth token)
                                         (merge {:as :json})))))
 

src/cljc/imcljs/auth.cljc

@@ -57,3 +57,22 @@
   [service deregistration-token & [options]]
   (let [params {:deregistrationToken deregistration-token}]
     (restful :delete "/user" service (merge params options))))
+
+(defn oauth2authenticator
+  "Commence authentication for logging in using OAuth 2.0 with specified
+  provider.  Will return a URL to redirect to the external login page.
+  Remember to append a `redirect_uri` parameter to the URL before redirecting.
+  This should be an endpoint which will be redirected to after signing in at
+  the third-party, passing parameters required for the `oauth2callback`.
+  Note that the redirect URL might be checked against a whitelist."
+  [service provider & [options]]
+  (let [params {:provider provider}]
+    (restful :get "/oauth2authenticator" service (merge params options) :link)))
+
+(defn oauth2callback
+  "Complete authentication for logging in using OAuth 2.0. Requires parameters
+  state and code, which are received when redirecting back from the external
+  login service in `oauth2authenticator`, in addition to provider which should
+  be identical to the one passed to `oauth2authenticator`."
+  [service & [options]]
+  (restful :get "/oauth2callback" service options))

src/cljc/imcljs/fetch.cljc

@@ -84,6 +84,12 @@
   [service name & [options]]
   (restful :get "/lists" service (merge {:name name} options) (comp first :lists)))
 
+(defn lists-containing
+  "Find lists on the server containing an object.
+  As a minimum, specify either :id or both of :publicId and :type."
+  [service & [options]]
+  (restful :get "/listswithobject" service options :lists))
+
 (defn model
   [service & [options]]
   (restful :get "/model" service options :model))
@@ -152,6 +158,18 @@
   [service]
   (restful :get "/web-properties" service {} :web-properties))
 
+(defn branding
+  "Returns the branding details for a given mine.
+  Used to make things more personal!"
+  [service]
+  (restful :get "/branding" service {} :properties))
+
+(defn bluegenes-properties
+  "Returns the BlueGenes-specific configs for a given mine. These are created
+  and maintained by BlueGenes, similarly to a key-value store."
+  [service & [options]]
+  (restful :get "/bluegenes-properties" service options :bluegenes-properties))
+
 
 ; ID Resolution
 

src/cljc/imcljs/path.cljc

@@ -7,7 +7,7 @@
   "Split a string path into a vector of keywords.
   (split-path `Gene.organism.shortName`)
   => [:Gene :organism :shortName]"
-  [path-str] (map keyword (split path-str #"\.")))
+  [path-str] (mapv keyword (split path-str #"\.")))
 
 (defn join-path
   "Join a vector path of keywords to a string.
@@ -66,46 +66,41 @@
        (filter identity)
        first))
 
-(defn- walk-rec
-  [model [class-kw & [path & remaining]] trail curr-path path->subclass]
-  ;; Notice that this recursive function consumes two elements of the path at a
-  ;; time. The reason for this is that if `path` happens to be an attribute, we
-  ;; need to know its class `class-kw` to be able to find it.
-  (let [;; At any point, a subclass constraint can override the default class.
-        class-kw (get path->subclass curr-path class-kw)
-        class (get-in model [:classes class-kw])
-        _ (assert (map? class) "Path traverses nonexistent class")
-        ;; Search the class for the property `path` to find the next referenced class.
-        {reference :referencedType :as class-value}
-        (get (apply merge (map class [:attributes :references :collections])) path)
-        ;; This is `curr-path` for the next recursion.
-        next-path (conj curr-path path)]
-    (if remaining
-      ;; If we don't have a reference, we can't go on and so return nil.
-      (when reference
-        (recur model
-               ;; We cons the reference so we know the parent class in case the
-               ;; next recursion's `path` happens to be an attribute. In effect
-               ;; we only consume one element of the path at a time.
-               (cons (keyword reference) remaining)
-               (conj trail class)
-               next-path
-               path->subclass))
-      ;; Because we consume two elements of the path at a time, we have to
-      ;; repeat some logic in the termination case (hence we add two elements).
-      (conj trail
-            class
-            ;; The path can end with a subclass, so we check with `next-path`.
-            (if-let [subclass (get path->subclass next-path)]
-              ;; All the extra stuff done above to `class-kw` need not be
-              ;; repeated, as we've now consumed the entire path.
-              (get-in model [:classes subclass])
-              (if reference
-                ;; Usually the next recursion would get the class from reference.
-                (get-in model [:classes (keyword reference)])
-                ;; If there's no reference, this means the last element of the
-                ;; path is an attribute.
-                class-value))))))
+(defn- walk-get-property
+  "Returns the `prop` property of a model `class`. Lenient to nil arguments."
+  [class prop]
+  (when (map? class)
+    (some->> prop
+             (get (apply merge
+                         (map class [:attributes :references :collections]))))))
+
+(defn- walk-current-path
+  "Returns the portion of `path` that has been consumed by `rem-path`."
+  [path rem-path]
+  (subvec path 0 (- (count path)
+                    (count rem-path))))
+
+(defn- walk-loop
+  [model path & {:keys [path->subclass walk-properties?]}]
+  (let [root-class (get-in model [:classes (first path)])]
+    (loop [rem-path (-> path next next) ; First iteration consumes two.
+           property (walk-get-property root-class (second path))
+           walked [root-class]]
+      (let [next-class (when-let [reference (keyword (:referencedType property))]
+                         ;; Use the subclass if defined for next-class.
+                         (let [curr-path (walk-current-path path rem-path)
+                               reference (get path->subclass curr-path reference)]
+                           (get-in model [:classes reference])))
+            walked (conj walked (if walk-properties?
+                                  property ; Always use property if specified.
+                                  (or next-class ; Otherwise use class.
+                                      property)))] ; If the path ends at an attribute.
+        (cond
+          (empty? rem-path) walked
+          (empty? property) nil ; Path is unresolvable.
+          :else (recur (next rem-path)
+                       (walk-get-property next-class (first rem-path))
+                       walked))))))
 
 (defn walk
   "Return a vector representing each part of path.
@@ -119,17 +114,22 @@
       [{:path `Gene.interactions.participant2`, :type `Gene`}]
   for the path to be resolvable.
       (walk im-model-with-type-constraints
-       `Gene.interactions.participant2.proteinAtlasExpression.tissue.name`)"
-  [model path]
-  (let [p (if (string? path) (split-path path) (map keyword path))]
+       `Gene.interactions.participant2.proteinAtlasExpression.tissue.name`)
+  Optional keyword arguments:
+  walk-properties? - If true, each element will be the parent's property,
+  instead of the referencedType.  The first element will still be a class as it
+  has no parent."
+  [model path & {:keys [walk-properties?]}]
+  (let [p (if (string? path) (split-path path) (mapv keyword path))]
     (if (= 1 (count p))
       [(get-in model [:classes (first p)])]
-      (walk-rec model p [] [(first p)]
-                (->> (:type-constraints model)
-                     (filter #(contains? % :type)) ; In case there are other constraints there.
-                     (reduce (fn [m {:keys [path type]}]
-                               (assoc m (split-path path) (keyword type)))
-                             {}))))))
+      (walk-loop model p
+                 :path->subclass (->> (:type-constraints model)
+                                      (filter #(contains? % :type)) ; In case there are other constraints there.
+                                      (reduce (fn [m {:keys [path type]}]
+                                                (assoc m (split-path path) (keyword type)))
+                                              {}))
+                 :walk-properties? walk-properties?))))
 
 (defn data-type
   "Return the java type of a path representing an attribute.
@@ -169,19 +169,13 @@
 
 (defn display-name
   "Returns a vector of friendly names representing the path.
-  ; TODO make this work with subclasses"
-  ([model path]
-   (let [p (if (string? path) (split-path path) path)]
-     (display-name model p [(get-in model [:classes (first p) :displayName])])))
-  ([model [head next & tail] collected]
-   (if next
-     (let [props      (-> model (get-in [:classes head]) (select-keys [:attributes :references :collections]) vals mapify)
-           collected+ (conj collected
-                            (or (get-in props [next :displayName])
-                                (un-camel-case (get-in props [next :name]))))]
-       (if (not-empty tail)
-         (recur model (conj tail (keyword (get-in props [next :referencedType]))) collected+)
-         collected+)))))
+  Make sure to add :type-constraints to the model if the path traverses a subclass
+  (see docstring of `walk` for more information)."
+  [model path]
+  (mapv (fn [prop]
+          (or (:displayName prop)
+              (un-camel-case (:name prop))))
+        (walk model path :walk-properties? true)))
 
 (defn attributes
   "Returns all attributes for a given string path.

src/cljc/imcljs/save.cljc

@@ -97,3 +97,24 @@
   [service title & [options]]
   (let [params (merge {:name title} options)]
     (restful :delete "/user/queries" service params)))
+
+(defn bluegenes-properties
+  "Add a new key to the BlueGenes-specific config for a mine.
+  Requires that you are authenticated as an admin."
+  [service key value & [options]]
+  (let [params (merge {:key key :value value} options)]
+    (restful :post "/bluegenes-properties" service params)))
+
+(defn update-bluegenes-properties
+  "Update an existing key in the BlueGenes-specific config for a mine.
+  Requires that you are authenticated as an admin."
+  [service key value & [options]]
+  (let [params (merge {:key key :value value} options)]
+    (restful :put "/bluegenes-properties" service params)))
+
+(defn delete-bluegenes-properties
+  "Delete an existing key in the BlueGenes-specific config for a mine.
+  Requires that you are authenticated as an admin."
+  [service key & [options]]
+  (let [params (merge {:key key} options)]
+    (restful :delete "/bluegenes-properties" service params)))

src/cljs/imcljs/internal/io.cljs

@@ -29,7 +29,13 @@
             (wrap-auth token)
             ; Stringify the clojure body to a JSON data structure
             ; This should still work when sending plain/text rather than application/json
-            (update :body (comp js/JSON.stringify clj->js)))))
+            (update :body (fn [body]
+                            (if (coll? body)
+                              (-> body clj->js js/JSON.stringify)
+                              ;; If the body is not a collection (usually a map), it is most likely a string.
+                              ;; We have to pass them as they are, or else the "" will get included in the body,
+                              ;; which makes it impossible to pass more than one identifier.
+                              body))))))
 
 (defn post-wrapper-
   "Returns the results of queries as table rows."

test/cljs/imcljs/bgproperties_test.cljs

@@ -0,0 +1,45 @@
+(ns imcljs.bgproperties-test
+  (:require-macros [cljs.core.async.macros :refer [go]])
+  (:require [cljs.test :refer-macros [async deftest testing is]]
+            [cljs.core.async :refer [<!]]
+            [imcljs.fetch :as fetch]
+            [imcljs.save :as save]
+            [imcljs.env :refer [service]]
+            [imcljs.auth :as auth]
+            [clojure.edn :as edn]))
+
+(def bg-key "ole.dole.doffen")
+
+(defn read-prop [value]
+  (edn/read-string value))
+
+(defn write-prop [value]
+  (pr-str value))
+
+(deftest bg-properties
+  (async done
+    (go
+      (let [login-response (<! (auth/login service "test_user@mail_account" "secret"))
+            token (get-in login-response [:output :token])
+            service (assoc service :token token)]
+        (testing "Add new key to bluegenes properties"
+          (let [value {:foo "bar"}
+                _save-value (<! (save/bluegenes-properties service bg-key (write-prop value)))
+                saved (-> (<! (fetch/bluegenes-properties service))
+                          (get (keyword bg-key))
+                          (read-prop))]
+            (is (= value saved))))
+        (testing "Update an existing key in bluegenes properties"
+          (let [value {:foo "baz"}
+                _update-value (<! (save/update-bluegenes-properties service bg-key (write-prop value)))
+                updated (-> (<! (fetch/bluegenes-properties service))
+                            (get (keyword bg-key))
+                            (read-prop))]
+            (is (= value updated))))
+        (testing "Delete an existing kkey in bluegenes properties"
+          (let [_delete-value (<! (save/delete-bluegenes-properties service bg-key))
+                deleted (-> (<! (fetch/bluegenes-properties service))
+                            (get (keyword bg-key))
+                            (read-prop))]
+            (is (nil? deleted))))
+        (done)))))

test/cljs/imcljs/path_test.cljs

@@ -6,17 +6,17 @@
             [imcljs.path :as path]
             [imcljs.fetch :as fetch]))
 
-(deftest walk-subclass
-  (testing "Should be able to walk a path that with"
+(deftest walk-parent-reference
+  (testing "Should be able to walk a path that references its parent and return parts of the model"
     (async done
       (go
         (let [model (<! (fetch/model service))]
           (let [walked (path/walk model "Gene.proteins.genes")]
             (is (= (map :name walked) '("Gene" "Protein" "Gene")))
             (done)))))))
 
-(deftest walk-subclasses
-  (testing "Should be able to walk a path with multiple subclasses and return parts of the model"
+(deftest walk-parent-references
+  (testing "Should be able to walk a path with multiple parent references and return parts of the model"
     (async done
       (go
         (let [model (<! (fetch/model service))]
@@ -52,6 +52,24 @@
             (is (= (map :name walked) '("Gene")))
             (done)))))))
 
+(deftest walk-properties
+  (testing "Should be able to walk a path and return properties of the classes in the model"
+    (async done
+      (go
+        (let [model (<! (fetch/model service))]
+          (let [walked (path/walk model "Gene.alleles" :walk-properties? true)]
+            (is (= (map :displayName walked) '("Gene" "Alleles")))
+            (done))))))
+  (testing "Should be able to walk a path with multiple subclasses requiring type constraints and return properties of the classes in the model"
+    (async done
+      (go
+        (let [model (assoc (<! (fetch/model service))
+                           :type-constraints [{:path "Gene.childFeatures" :type "MRNA"}
+                                              {:path "Gene.childFeatures.CDSs.transcript" :type "TRNA"}])]
+          (let [walked (path/walk model "Gene.childFeatures.CDSs.transcript.name" :walk-properties? true)]
+            (is (= (map :displayName walked) '("Gene" "Child Features" "CDSs" "Transcript" "Name")))
+            (done)))))))
+
 (deftest path-root
   (testing "Should be able to parse a root that is just a path"
     (async done

test/cljs/imcljs/runner.cljs

@@ -9,6 +9,7 @@
             [imcljs.auth-test]
             [imcljs.utils-test]
             [imcljs.preferences-test]
-            [imcljs.saved-queries-test]))
+            [imcljs.saved-queries-test]
+            [imcljs.bgproperties-test]))
 
-(doo-tests 'imcljs.core-test 'imcljs.path-test 'imcljs.query-test 'imcljs.list-test 'imcljs.assets-test 'imcljs.registry-test 'imcljs.auth-test 'imcljs.utils-test 'imcljs.preferences-test 'imcljs.saved-queries-test)
+(doo-tests 'imcljs.core-test 'imcljs.path-test 'imcljs.query-test 'imcljs.list-test 'imcljs.assets-test 'imcljs.registry-test 'imcljs.auth-test 'imcljs.utils-test 'imcljs.preferences-test 'imcljs.saved-queries-test 'imcljs.bgproperties-test)