gered/views
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

better testing documentation; adds basic subscription functionality back to base-subscribed-views; beginning of bulk update functionality; moved all database table creation into SQL script

Browse source
This commit is contained in:
Dave Della Costa 2014-06-10 12:12:21 +09:00
parent d63fc95ff1
commit e263ed10c6
15 changed files with 198 additions and 99 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
README.md
View file

@ -12,7 +12,20 @@ TODO
## Testing
You can run all tests in the repl with
You will need to set up the test db to run the tests:
```bash
$ psql -Upostgres < test/views/test_db.sql
CREATE ROLE
CREATE DATABASE
$
```
This will create a role `views_user` and a database owned by that user called `views_test`.
(You can change the database settings if you'd like by editing that file and checking the config in `test/views/fixtures.clj`.)
Then, to run all tests in the repl:
```clojure
user=> (require '[views.all-tests :as at])

4
project.clj
View file

@ -11,7 +11,9 @@
[org.clojure/core.async "0.1.303.0-886421-alpha"]
[org.clojure/java.jdbc "0.3.3"]
[honeysql "0.4.3"]
[org.postgresql/postgresql "9.2-1003-jdbc4"]]
[edl "0.1.0"]
[org.postgresql/postgresql "9.2-1003-jdbc4"]
[clj-logging-config "1.9.10"]]
:profiles {:test {:dependencies [[org.clojure/tools.nrepl "0.2.3"]
[environ "0.4.0"]

91
src/views/base_subscribed_views.clj
View file

@ -1,36 +1,85 @@
(ns views.base-subscribed-views
(:require
[views.db.core :refer [initial-views]]
[views.subscribed-views :refer [SubscribedViews subscriber-key-fn prefix-fn send-message]]
[views.subscriptions :as vs :refer [add-subscriptions!]]
[views.db.load :refer [initial-views]]
[views.subscribed-views :refer [SubscribedViews subscriber-key-fn prefix-fn]]
[views.subscriptions :as vs :refer [add-subscriptions! remove-subscription! subscriptions-for]]
[clojure.tools.logging :refer [debug info warn error]]
[clojure.core.async :refer [put! <! go thread]]))
(defrecord BaseSubscribedViews [db templates delta-broadcast-chan]
(defn view-filter
"Takes a subscription request msg, a collection of view-sigs and
the config templates hash-map for an app. Checks if there is
a global filter-fn in the hash-map metadata and checks against
that if it exists, as well as against any existing filter
functions for individual template config entries. Template
config hash-map entries can specify a filter-fn using the key
:filter-fn, and the global filter-fn is the same, only on
the config meta-data (i.e. (with-meta templates {:filter-fn ...}))
By default throws an exception if no filters are present.
By passing in {:unsafe true} in opts, this can be overridden."
[msg view-sigs templates & opts]
(let [global-filter-fn (:filter-fn (meta templates))]
(filterv
#(let [filter-fn (:filter-fn (get templates (first %)))]
(cond
(and filter-fn global-filter-fn)
(and (global-filter-fn msg %) (filter-fn msg %))
filter-fn
(filter-fn msg %)
global-filter-fn
(global-filter-fn msg %)
:else
(if (-> opts first :unsafe)
(do (warn "YOU ARE RUNNING IN UNSAFE MODE, AND NO FILTERS ARE PRESENT FOR VIEW-SIG: " %)
true)
(throw (Exception. (str "No filter set for view " %))))))
view-sigs)))
(defn send-message
[this address msg]
(warn "IMPLEMENT ME. Got message " msg " sent to address " address))
(deftype BaseSubscribedViews [db templates send-fn broadcast-fn subscribed-views-fn opts]
SubscribedViews
(subscribe-views
[this sub-req]
;; (let [view-sigs (view-filter sub-req (:body sub-req) templates)] ; this is where security comes in.
(let [subscriber-key (subscriber-key-fn this sub-req)
view-sigs (:view-sigs sub-req)]
(info "Subscribing views: " view-sigs)
view-sigs (view-filter sub-req (:views sub-req) templates opts)] ; this is where security comes in.
(info "Subscribing views: " view-sigs " for subscriber " subscriber-key)
(when (seq view-sigs)
(add-subscriptions! subscriber-key view-sigs (prefix-fn this sub-req))
(thread
(->> (initial-views db view-sigs templates @vs/compiled-views)
(send-message this subscriber-key))))))
(let [subbed-views (if-let [prefix (prefix-fn this sub-req)]
(add-subscriptions! subscriber-key view-sigs templates prefix)
(add-subscriptions! subscriber-key view-sigs templates))]
(thread
(->> (initial-views db view-sigs templates subbed-views)
((if send-fn send-fn send-message) this subscriber-key)))))))
(unsubscribe-views [this unsub-req])
(unsubscribe-views
[this unsub-req]
(let [subscriber-key (subscriber-key-fn this unsub-req)
view-sigs (:views unsub-req)]
(info "Unsubscribing views: " view-sigs " for subscriber " subscriber-key)
(if-let [prefix (prefix-fn this unsub-req)]
(doseq [vs view-sigs] (remove-subscription! subscriber-key vs prefix))
(doseq [vs view-sigs] (remove-subscription! subscriber-key vs)))))
(disconnect [this disconnect-req])
(subscribed-views [this] @vs/compiled-views)
(broadcast-deltas [this fdb views-with-deltas])
(send-message [this address msg]
(warn "IMPLEMENT ME. Got message " msg " sent to address " address))
(disconnect [this disconnect-req]
(let [subscriber-key (:subscriber-key disconnect-req)
prefix (prefix-fn this disconnect-req)
view-sigs (if prefix (subscriptions-for subscriber-key prefix) (subscriptions-for subscriber-key))]
(if prefix
(doseq [vs view-sigs] (remove-subscription! subscriber-key vs prefix))
(doseq [vs view-sigs] (remove-subscription! subscriber-key vs)))))
(subscriber-key-fn [this msg] (:subscriber-key msg))
(prefix-fn [this msg] nil))
(prefix-fn [this msg] nil)
;; DB interaction
(subscribed-views [this] @vs/compiled-views)
(broadcast-deltas [this fdb views-with-deltas]))

3
src/views/db/core.clj
View file

@ -72,6 +72,7 @@
(merge {:args (rest view-sig)
:view-sig view-sig
:view compiled-view
:bulk-update? (:bulk-update? (meta view-template))
:tables (set (vh/extract-tables compiled-view))}
(compile-dummy-view view-template (rest view-sig)))))
@ -444,7 +445,7 @@
(broadcast-deltas ~subscribed-views ~(second binding) @deltas#)
result#))))))
(defn vaction!
(defn vexec!
"Used to perform arbitrary insert/update/delete actions on the database,
while ensuring that view deltas are appropriately checked and calculated
for the currently registered views as reported by a type implementing

2
src/views/db/load.clj
View file

@ -23,7 +23,7 @@
(reduce
(fn [results nv]
(->> (get subscribed-views nv)
:view-map
:view
(view-query db)
(into [])
(post-process-result-set nv templates)

34
src/views/filters.clj
View file

@ -1,34 +0,0 @@
(ns views.filters)
(defn view-filter
"Takes a subscription request msg, a collection of view-sigs and
the config templates hash-map for an app. Checks if there is
a global filter-fn in the hash-map metadata and checks against
that if it exists, as well as against any existing filter
functions for individual template config entries. Template
config hash-map entries can specify a filter-fn using the key
:filter-fn, and the global filter-fn is the same, only on
the config meta-data (i.e. (with-meta templates {:filter-fn ...}))
By default throws an exception if no filters are present.
By passing in {:unsafe true} in opts, this can be overridden."
[msg view-sigs templates & opts]
(let [global-filter-fn (:filter-fn (meta templates))]
(filterv
#(let [filter-fn (:filter-fn (get templates (first %)))]
(cond
(and filter-fn global-filter-fn)
(and (global-filter-fn msg %) (filter-fn msg %))
filter-fn
(filter-fn msg %)
global-filter-fn
(global-filter-fn msg %)
:else
(if (-> opts first :unsafe)
(do (warn "YOU ARE RUNNING IN UNSAFE MODE, AND NO FILTERS ARE PRESENT FOR VIEW-SIG: " %)
true)
(throw (Exception. (str "No filter set for view " %))))))
view-sigs)))

1
src/views/subscribed_views.clj
View file

@ -5,7 +5,6 @@
(subscribe-views [this sub-request])
(unsubscribe-views [this unsub-request])
(disconnect [this disconnect-request])
(send-message [this address msg])
(subscriber-key-fn [this msg])
(prefix-fn [this msg])

15
src/views/subscriptions.clj
View file

@ -36,10 +36,17 @@
([subscriber-key view-sigs templates]
(add-subscriptions! subscriber-key view-sigs templates nil))
([subscriber-key view-sigs templates prefix]
(doseq [vs view-sigs]
(if prefix
(add-subscription! subscriber-key vs templates prefix)
(add-subscription! subscriber-key vs templates)))))
(last (mapv
#(if prefix
(add-subscription! subscriber-key % templates prefix)
(add-subscription! subscriber-key % templates))
view-sigs))))
(defn subscriptions-for
([subscriber-key]
(reduce #(if (contains? (second %2) subscriber-key) (conj %1 (first %2)) %1) [] @subscribed-views))
([subscriber-key prefix]
(reduce #(if (contains? (second %2) subscriber-key) (conj %1 (first %2)) %1) [] (get @subscribed-views prefix))))
(defn subscribed-to
([view-sig]

2
test/views/all_tests.clj
View file

@ -2,6 +2,7 @@
(:require
[clojure.test :refer [run-tests]]
[views.subscriptions-test]
[views.base-subscribed-views-test]
[views.db.core-test]
[views.db.honeysql-test]
[views.db.load-test]))
@ -9,6 +10,7 @@
(defn run-all-tests
[]
(run-tests 'views.subscriptions-test
'views.base-subscribed-views-test
'views.db.core-test
'views.db.honeysql-test
'views.db.load-test))

45
test/views/base_subscribed_views_test.clj Normal file
View file

@ -0,0 +1,45 @@
(ns views.base-subscribed-views-test
(:require
[views.base-subscribed-views :as bsv] ; :refer [BaseSubscribedViews]]
[views.subscribed-views :refer [SubscribedViews subscriber-key-fn prefix-fn subscribe-views unsubscribe-views disconnect]]
[views.subscriptions :as vs :refer [subscribed-to?]]
[views.fixtures :as vf]
[clojure.test :refer [use-fixtures deftest is]]
[clojure.java.jdbc :as j]
[clj-logging-config.log4j :refer [set-logger! set-loggers!]])
(:import
[views.base_subscribed_views BaseSubscribedViews]))
(set-loggers! "views.base-subscribed-views" {:level :error})
(defn- subscription-fixtures!
[f]
(reset! vs/subscribed-views {})
(reset! vs/compiled-views {})
(f))
(use-fixtures :each vf/database-fixtures! subscription-fixtures!)
(deftest subscribes-and-dispatches-initial-view-result-set
(let [send-fn #(is (and (= %2 1) (= %3 {[:users] []})))
base-subbed-views (BaseSubscribedViews. vf/db vf/templates send-fn nil nil {:unsafe true})]
(subscribe-views base-subbed-views {:subscriber-key 1 :views [[:users]]})))
(deftest unsubscribes-view
(let [base-subbed-views (BaseSubscribedViews. vf/db vf/templates nil nil nil {:unsafe true})]
(subscribe-views base-subbed-views {:subscriber-key 1 :views [[:users]]})
(unsubscribe-views base-subbed-views {:subscriber-key 1 :views [[:users]]})
(is (not (subscribed-to? 1 [:users])))))
(deftest filters-subscription-requests
(let [templates (assoc-in vf/templates [:users :filter-fn] (fn [msg _] (:authorized? msg)))
base-subbed-views (BaseSubscribedViews. vf/db templates nil nil nil nil)]
(subscribe-views base-subbed-views {:subscriber-key 1 :views [[:users]]})
(is (not (subscribed-to? 1 [:users])))))
(deftest removes-all-subscriptions-on-disconnect
(let [base-subbed-views (BaseSubscribedViews. vf/db vf/templates nil nil nil {:unsafe true})]
(subscribe-views base-subbed-views {:subscriber-key 1 :views [[:users][:user-posts 1]]})
(disconnect base-subbed-views {:subscriber-key 1})
(is (not (subscribed-to? 1 [:user-posts 1])))
(is (not (subscribed-to? 1 [:users])))))

28
test/views/db/core_test.clj
View file

@ -1,9 +1,14 @@
(ns views.db.core-test
(:require
[clojure.test :refer [deftest is run-tests]]
[edl.core :refer [defschema]]
[honeysql.core :as hsql]
[honeysql.helpers :as hh]
[views.db.core :as vdb]))
[views.fixtures :as vf]
[views.db.core :as vdb]
[views.base-subscribed-views :as bsv])
(:import
[views.base_subscribed_views BaseSubscribedViews]))
(defn join-test-template
[id val3]
@ -53,14 +58,6 @@
(is (= (hsql/format check-template)
["SELECT f.id, f.val3 FROM foo f INNER JOIN bar b ON b.id = f.b_id LEFT JOIN baz ba ON ba.id = b.ba_id RIGHT JOIN qux q ON q.id = ba.q_id WHERE (b.id = 123 AND f.val2 = ?)" "constant"]))))
;; ;; Not meaningful at this point perhaps...view-check-template shouldn't
;; ;; get handed an action that doesn't have a related table in the first place...?
;; (deftest removes-non-related-tables
;; (let [update-bar (update-bar-template "foo" [:= :id 123])
;; vm (vdb/view-map no-where-view-template [:no-where])
;; check-template (:view-check (vdb/view-check-template vm update-bar))]
;; (is (nil? check-template))))
(deftest creates-collection-of-views-to-check
(let [views [(vdb/view-map no-where-view-template [:no-where]) ; no :bar
(vdb/view-map no-where-view-template [:no-where]) ; no :bar
@ -75,4 +72,17 @@
;; and 1 for *both* the joint-test-templates.
(is (= (count checked-views) 2))))
;; What is this for?
(def left-join-example (hsql/build :select [:R.a :S.C] :from :R :left-join [:S [:= :R.B :S.B]] :where [:!= :S.C 20]))
(deftest notes-view-map-as-no-delta-calc
(let [tmpl (with-meta vf/users-tmpl {:bulk-update? true})]
(is (:bulk-update? (vdb/view-map tmpl [:users])))))
(defschema schema vf/db "public")
;; (deftest sends-entire-view-on-every-update-with-bulk-update
;; (let [tmpl (with-meta vf/users-tmpl {:bulk-update? true})
;; vm (vdb/view-map tmpl [:users])
;; bsv (BaseSubscribedViews. vf/db

2
test/views/db/load_test.clj
View file

@ -10,7 +10,7 @@
(defn subscribed-views
[]
{[:users] {:view-map ((get-in templates [:users :fn]))}})
{[:users] {:view ((get-in templates [:users :fn]))}})
(deftest initializes-views
(let [users (gen-n-users! 2)]

33
test/views/fixtures.clj
View file

@ -5,9 +5,6 @@
[honeysql.core :as hsql]
[clojure.data.generators :as dg]))
;; CREATE ROLE views_user LOGIN PASSWORD 'password';
;; CREATE DATABASE views_test OWNER views_user;
(defn sql-ts
([ts] (java.sql.Timestamp. ts))
([] (java.sql.Timestamp. (.getTime (java.util.Date.)))))
@ -18,30 +15,15 @@
:user (get :views-test-user e/env "views_user")
:password (get :views-test-ppassword e/env "password")})
(defn users-table-fixture!
[]
(j/execute! db ["CREATE TABLE users (id SERIAL PRIMARY KEY, name TEXT NOT NULL, created_on DATE NOT NULL)"]))
(defn posts-table-fixture!
[]
(j/execute! db ["CREATE TABLE posts (id SERIAL PRIMARY KEY,
title TEXT NOT NULL,
body TEXT NOT NULL,
created_on DATE NOT NULL,
user_id INTEGER NOT NULL,
FOREIGN KEY (user_id) REFERENCES users(id))"]))
(defn drop-tables!
(defn clean-tables!
[tables]
(doseq [t tables]
(j/execute! db [(str "DROP TABLE " (name t))])))
(doseq [t (map name tables)]
(j/execute! db [(str "DELETE FROM " t)])))
(defn database-fixtures!
[f]
(users-table-fixture!)
(posts-table-fixture!)
(f)
(drop-tables! [:posts :users]))
(clean-tables! [:posts :users])
(f))
(defn user-fixture!
[name]
@ -59,9 +41,10 @@
(defn user-posts-tmpl
[user_id]
(hsql/build :select [:u.user_id :u.name :p.title :p.body :p.created_on]
(hsql/build :select [:u.id :u.name :p.title :p.body :p.created_on]
:from {:posts :p}
:join [[:users :u][:= :user_id user_id]]))
:join [[:users :u][:= :u.id :p.user_id]]
:where [:= :p.user_id user_id]))
(def templates
{:users {:fn #'users-tmpl}

10
test/views/subscriptions_test.clj
View file

@ -64,3 +64,13 @@
(vs/add-subscription! key view-sig templates)
(vs/remove-subscription! key view-sig)
(is (nil? (vs/compiled-view-for [:user-posts 1])))))
(deftest retrieves-subscriptions-for-subscriber
(let [key 1, view-sigs [[:users][:user-posts 1]]]
(vs/add-subscriptions! key view-sigs templates)
(is (= (set (vs/subscriptions-for 1)) (set view-sigs)))))
(deftest retrieves-subscriptions-for-subscriber-with-prefix
(let [key 1, view-sigs [[:users][:user-posts 1]] prefix 1]
(vs/add-subscriptions! key view-sigs templates prefix)
(is (= (set (vs/subscriptions-for 1 prefix)) (set view-sigs)))))

12
test/views/test_db.sql Normal file
View file

@ -0,0 +1,12 @@
CREATE ROLE views_user LOGIN PASSWORD 'password';
CREATE DATABASE views_test OWNER views_user;
\c postgresql://localhost/views_test;
CREATE TABLE users (id SERIAL PRIMARY KEY, name TEXT NOT NULL, created_on DATE NOT NULL);
CREATE TABLE posts (id SERIAL PRIMARY KEY,
title TEXT NOT NULL,
body TEXT NOT NULL,
created_on DATE NOT NULL,
user_id INTEGER NOT NULL,
FOREIGN KEY (user_id) REFERENCES users(id));
ALTER TABLE users OWNER TO views_user;
ALTER TABLE posts OWNER TO views_user;