checking for unbound vars that get used for operations. Testing restr…

…icted operations in clojurescript
threatgrid · Jan 20, 2021 · 468ba3e · 468ba3e
1 parent acb9009
commit 468ba3e
Show file tree

Hide file tree

Showing 2 changed files with 98 additions and 54 deletions.
diff --git a/src/asami/query.cljc b/src/asami/query.cljc
@@ -176,9 +176,9 @@
              (not (get varmap arg)))
     arg))
 
-(def Fn (s/pred #(or (fn? %) (var? %))))
+(def Fcn (s/pred #(or (fn? %) (var? %))))
 
-(s/defn resolve-op :- (s/maybe Fn)
+(s/defn resolve-op :- (s/maybe Fcn)
   "Resolves a symbol to an associated function. Symbols without a namespace are presumed to be in clojure.core"
   [s :- s/Symbol]
   (when (or *override-restrictions*
@@ -187,7 +187,7 @@
               (sandbox/allowed-fns s)))
     (fn-for s)))
 
-(s/defn retrieve-op :- Fn
+(s/defn retrieve-op :- Fcn
   "Retrieves a function for a provided operation. An op can be a variable, a function, a symbol for a function, or a string"
   [op var-map part]
   (or
@@ -217,10 +217,11 @@
                          (constantly (nth args i))))
                      args)
         filter-fn (if (vartest? op)
-                    (let [op-idx (var-map op)]
+                    (if-let [op-idx (var-map op)]
                       (fn [a]
                         (let [callable-op (retrieve-op (nth a op-idx) var-map part)]
-                          (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes)))))
+                          (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes))))
+                      (throw (ex-info (str "Unknown variable: " op) {:op op})))
                     (let [callable-op (retrieve-op op var-map part)]
                       (fn [a]
                         (apply callable-op (map (fn [f] (if (fn? f) (f) (nth a f))) arg-indexes)))))]
@@ -245,14 +246,15 @@
         arg-indexes (keep-indexed #(when-not (zero? %1) (var-map %2 (- %1))) expr)
         expr (vec expr)
         binding-fn (if (vartest? op)
-                     (let [op-idx (var-map op)]
+                     (if-let [op-idx (var-map op)]
                        (fn [row]
                          (let [o (retrieve-op (nth row op-idx) var-map part)]
                            (concat row
                                    [(apply o
                                            (map
                                             #(if (neg? %) (nth expr (- %)) (nth row %))
-                                            arg-indexes))]))))
+                                            arg-indexes))])))
+                       (throw (ex-info (str "Unknown variable: " op) {:op op})))
                      (let [callable-op (retrieve-op op var-map part)]
                        (fn [row]
                          (concat row

diff --git a/test/asami/test_core_query.cljc b/test/asami/test_core_query.cljc
@@ -391,53 +391,95 @@
                ["Purely Functional Data Structures"]}
              (set r3)))))
 
-  (deftest test-sandbox-queries
-    (let [st (-> empty-graph (assert-data data))
-          r1 (binding [*override-restrictions* true]
-               (q '[:find ?title ?cost
-                    :where [?book :title ?title]
-                    [?book :price ?price]
-                    [?book :profit ?profit]
-                    [(read-string "-") ?minus]
-                    [(?minus ?price ?profit) ?cost]]
-                  st))
-          r2 (q '[:find ?title ?cost
-                  :in $ ?rs
-                  :where [?book :title ?title]
-                  [?book :price ?price]
-                  [?book :profit ?profit]
-                  [(?rs "-") ?minus]
-                  [(?minus ?price ?profit) ?cost]]
-                st read-string)
-          r3 (binding [*env* {'rs read-string}]
-               (q '[:find ?title ?cost
-                    :where [?book :title ?title]
-                    [?book :price ?price]
-                    [?book :profit ?profit]
-                    [(rs "-") ?minus]
-                    [(?minus ?price ?profit) ?cost]]
-                  st))]
-      (is (thrown-with-msg?
-           ExceptionInfo #"Unsupported operation: read-string"
-           (q '[:find ?title ?cost
-                  :where [?book :title ?title]
-                  [?book :price ?price]
-                  [?book :profit ?profit]
-                  [(read-string "-") ?minus]
-                  [(?minus ?price ?profit) ?cost]]
-                st)))
-      (is (= #{["The Art of Computer Programming" 35.66]
-               ["Basic Category Theory for Computer Scientists" 26.17]
-               ["Purely Functional Data Structures" 32.77]}
-             (set r1)))
-      (is (= #{["The Art of Computer Programming" 35.66]
-               ["Basic Category Theory for Computer Scientists" 26.17]
-               ["Purely Functional Data Structures" 32.77]}
-             (set r2)))
-      (is (= #{["The Art of Computer Programming" 35.66]
-               ["Basic Category Theory for Computer Scientists" 26.17]
-               ["Purely Functional Data Structures" 32.77]}
-             (set r3))))))
+  #?(:clj
+     (deftest test-sandbox-queries
+       (let [st (-> empty-graph (assert-data data))
+             r1 (binding [*override-restrictions* true]
+                  (q '[:find ?title ?cost
+                       :where [?book :title ?title]
+                       [?book :price ?price]
+                       [?book :profit ?profit]
+                       [(read-string "-") ?minus]
+                       [(?minus ?price ?profit) ?cost]]
+                     st))
+             r2 (q '[:find ?title ?cost
+                     :in $ ?rs
+                     :where [?book :title ?title]
+                     [?book :price ?price]
+                     [?book :profit ?profit]
+                     [(?rs "-") ?minus]
+                     [(?minus ?price ?profit) ?cost]]
+                   st read-string)
+             r3 (binding [*env* {'rs read-string}]
+                  (q '[:find ?title ?cost
+                       :where [?book :title ?title]
+                       [?book :price ?price]
+                       [?book :profit ?profit]
+                       [(rs "-") ?minus]
+                       [(?minus ?price ?profit) ?cost]]
+                     st))]
+         (is (thrown-with-msg?
+              ExceptionInfo #"Unsupported operation: read-string"
+              (q '[:find ?title ?cost
+                   :where [?book :title ?title]
+                   [?book :price ?price]
+                   [?book :profit ?profit]
+                   [(read-string "-") ?minus]
+                   [(?minus ?price ?profit) ?cost]]
+                 st)))
+         (is (= #{["The Art of Computer Programming" 35.66]
+                  ["Basic Category Theory for Computer Scientists" 26.17]
+                  ["Purely Functional Data Structures" 32.77]}
+                (set r1)))
+         (is (= #{["The Art of Computer Programming" 35.66]
+                  ["Basic Category Theory for Computer Scientists" 26.17]
+                  ["Purely Functional Data Structures" 32.77]}
+                (set r2)))
+         (is (= #{["The Art of Computer Programming" 35.66]
+                  ["Basic Category Theory for Computer Scientists" 26.17]
+                  ["Purely Functional Data Structures" 32.77]}
+                (set r3)))))
+
+     ;; ClojureScript is already sandboxed, so this is just testing mechanism
+     :cljs
+     (deftest test-sandbox-queries
+       (let [st (-> empty-graph (assert-data data))
+             r1 (q '[:find ?title ?cost
+                     :in $ ?atom
+                     :where [?book :title ?title]
+                     [?book :price ?price]
+                     [?book :profit ?profit]
+                     [(?atom ?price) ?p]
+                     [(deref ?p) ?p2]
+                     [(- ?p2 ?profit) ?cost]]
+                   st atom)
+             r2 (binding [*env* {'atom atom}]
+                  (q '[:find ?title ?cost
+                       :where [?book :title ?title]
+                       [?book :price ?price]
+                       [?book :profit ?profit]
+                       [(atom ?price) ?p]
+                       [(deref ?p) ?p2]
+                       [(- ?p2 ?profit) ?cost]]
+                     st))]
+         (is (thrown-with-msg?
+              ExceptionInfo #"Unsupported operation: atom"
+              (q '[:find ?title ?cost
+                   :where [?book :title ?title]
+                   [?book :price ?price]
+                   [?book :profit ?profit]
+                   [(atom ?price) ?p]
+                   [(deref ?p) ?p2]
+                   [(- ?p2 ?profit) ?cost]]
+                 st)))
+         (is (= #{["The Art of Computer Programming" 35.66]
+                  ["Basic Category Theory for Computer Scientists" 26.17]
+                  ["Purely Functional Data Structures" 32.77]}
+                (set r1)))
+         (is (= #{["The Art of Computer Programming" 35.66]
+                  ["Basic Category Theory for Computer Scientists" 26.17]
+                  ["Purely Functional Data Structures" 32.77]}
+                (set r2)))))))
 
 (let [pa (nn)
       paa (nn)