This commit is contained in:
Nicholas Kariniemi 2014-10-25 16:36:51 +00:00
commit 4883013470
20 changed files with 798 additions and 676 deletions

32
dev/user.clj Normal file
View file

@ -0,0 +1,32 @@
(require '[cljx.repl-middleware :as cljx])
(reset! @#'cljx/cljx-load-rules {:clj cljx.rules/clj-rules})
@@#'cljx/install-cljx-load
(ns user
(:require [grub.core :as system]
[clojure.java.io :as io]
[clojure.string :as str]
[clojure.pprint :refer (pprint)]
[clojure.repl :refer :all]
[clojure.test :as test]
[clojure.tools.namespace.repl :refer (refresh refresh-all)]))
(clojure.tools.namespace.repl/set-refresh-dirs "src/clj" "target/classes")
(def system nil)
(defn start
"Starts the current development system."
[]
(alter-var-root #'system (constantly system/dev-system))
(alter-var-root #'system system/start))
(defn stop
"Shuts down and destroys the current development system."
[]
(alter-var-root #'system
(fn [s] (when s (system/stop s)))))
(defn reset []
(stop)
(refresh :after 'user/start))

View file

@ -8,7 +8,6 @@
[org.clojure/core.async "0.1.346.0-17112a-alpha"]
[om "0.7.3"]
[http-kit "2.1.18"]
[compojure "1.1.8"]
[ring/ring-core "1.3.0" :exclusions [org.clojure/tools.reader]]
[ring/ring-devel "1.3.0" :exclusions [org.clojure/tools.reader]]
[hiccup "1.0.5"]
@ -18,11 +17,13 @@
[clj-webdriver "0.6.1" :exclusions [org.clojure/core.cache]]
[sablono "0.2.17"]
[cljs-uuid "0.0.4"]
[net.polyc0l0r/hasch "0.2.3"]
[com.cognitect/transit-clj "0.8.259"]
[com.cognitect/transit-cljs "0.8.188"]]
:profiles {:uberjar {:aot :all}
:dev {:dependencies [[midje "1.6.3"]]}}
:dev {:source-paths ["dev"]
:dependencies [[midje "1.6.3"]
[org.clojure/tools.namespace "0.2.3"]
[org.clojure/java.classpath "0.2.0"]]}}
:min-lein-version "2.1.2"
:plugins [[lein-cljsbuild "1.0.3"]
[lein-ring "0.8.6"]
@ -44,7 +45,7 @@
{:source-paths ["src/cljx"]
:output-path "target/generated/cljs"
:rules :cljs}]}
:source-paths ["src/clj" "src/test" "target/classes"]
:source-paths ["src/clj" "target/classes"]
:test-paths ["src/test"]
:ring {:handler grub.core/app}
:uberjar-name "grub-standalone.jar"

View file

@ -1,13 +1,11 @@
(ns grub.core
(:require [grub.websocket :as ws]
[grub.db :as db]
[grub.test.integration.core :as integration-test]
[grub.state :as state]
[grub.sync :as sync]
[ring.middleware.file :as file]
[ring.middleware.content-type :as content-type]
[ring.util.response :as resp]
[compojure.core :refer [defroutes GET POST]]
[compojure.handler :as handler]
[compojure.route :as route]
[org.httpkit.server :as httpkit]
[clojure.core.async :as a :refer [<! >! chan go]]
[hiccup
@ -40,49 +38,84 @@
(include-js "/js/grub.js")
[:script {:type "text/javascript"} "goog.require(\"grub.core\")"]]))
(def index-page (atom dev-index-page))
(def prod-system
{:index prod-index-page
:db-name "grub"
:db nil
:db-conn nil
:port 3000
:stop-server nil
:states (atom nil)})
(defn websocket-handler [request]
(when (:websocket? request)
(httpkit/with-channel request ws-channel
(let [to-client (chan)
from-client (chan)]
(ws/add-connected-client! ws-channel to-client from-client)
(state/sync-new-client! to-client from-client)))))
(def dev-system
{:index dev-index-page
:db-name "grub-dev"
:db nil
:db-conn nil
:port 3000
:stop-server nil
:states (atom nil)})
(defroutes routes
(GET "/" [] websocket-handler)
(GET "/" [] @index-page)
(GET "*/src/cljs/grub/:file" [file] (resp/file-response file {:root "src/cljs/grub"}))
(GET "/js/public/js/:file" [file] (resp/redirect (str "/js/" file)))
(route/files "/")
(route/not-found "<p>Page not found.</p>"))
(defn handle-websocket [handler states new-states-pub]
(fn [{:keys [websocket?] :as request}]
(if websocket?
(httpkit/with-channel request ws-channel
(let [to-client (chan)
from-client (chan)
new-states (chan (a/sliding-buffer 1))]
(a/sub new-states-pub :new-state new-states)
(ws/add-connected-client! ws-channel to-client from-client)
(sync/make-server-agent to-client from-client new-states states)))
(handler request))))
(def default-port 3000)
(defn handle-root [handler index]
(fn [{:keys [uri] :as request}]
(if (= uri "/")
(resp/response index)
(handler request))))
(defn start-server [port]
(httpkit/run-server (handler/site routes) {:port port}))
(defn wrap-bounce-favicon [handler]
(fn [req]
(if (= [:get "/favicon.ico"] [(:request-method req) (:uri req)])
{:status 404
:headers {}
:body ""}
(handler req))))
(defn run-integration-test []
(let [stop-server (start-server integration-test/server-port)]
(println "Starting integration test server on localhost:" integration-test/server-port)
(integration-test/run)
(stop-server)))
(defn make-handler [{:keys [index states]} new-states-pub]
(-> (fn [req] "Not found")
(file/wrap-file "public")
(content-type/wrap-content-type)
(handle-root index)
(handle-websocket states new-states-pub)
(wrap-bounce-favicon)))
(defn start-production-server [{:keys [port mongo-url]}]
(reset! index-page prod-index-page)
(let [to-db (chan)]
(db/connect-production-database to-db mongo-url)
(state/init-server to-db (db/get-current-state))
(println "Starting production server on localhost:" port)
(start-server port)))
(defn start [{:keys [port db-name states] :as system}]
(let [{:keys [db conn]} (db/connect db-name)
new-states (chan)
new-states-pub (a/pub new-states (fn [_] :new-state))
db-state (db/get-current-state db)
_ (reset! states (state/new-states (if db-state db-state state/empty-state)))
stop-server (httpkit/run-server (make-handler system new-states-pub) {:port port})]
(add-watch states :db (fn [_ _ old new]
(when-not (= old new)
(let [new-state (state/get-latest new)]
(a/put! new-states new-state)
(db/update-db! db new-state)))))
(println "Started server on localhost:" port)
(assoc system
:db db
:db-conn conn
:stop-server stop-server
:states states)))
(defn start-development-server [{:keys [port]}]
(let [to-db (chan)]
(db/connect-development-database to-db)
(state/init-server to-db (db/get-current-state))
(println "Starting development server on localhost:" port)
(start-server port)))
(defn stop [{:keys [db-conn stop-server states] :as system}]
(remove-watch states :db)
(stop-server)
(db/disconnect db-conn)
(reset! states nil)
system)
(defn usage [options-summary]
(->> ["Usage: grub [options] action"
@ -92,17 +125,14 @@
""
"Actions:"
" dev[elopment] Start development server"
" prod[uction] Start production server"
" integration Run integration tests"]
" prod[uction] Start production server"]
(clojure.string/join \newline)))
(def cli-options
[["-p" "--port PORT" "Port number"
:default default-port
:default 3000
:parse-fn #(Integer/parseInt %)
:validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]
["-m" "--mongo-url URL"
:default (System/getenv "MONGOHQ_URL")]
["-h" "--help"]])
(defn error-msg [errors]
@ -121,9 +151,8 @@
(not= (count arguments) 1) (exit 1 (usage summary))
errors (exit 1 (error-msg errors)))
(case (first arguments)
"development" (start-development-server options)
"dev" (start-development-server options)
"production" (start-production-server options)
"prod" (start-production-server options)
"integration" (run-integration-test)
"development" (start (merge dev-system options))
"dev" (start (merge dev-system options))
"production" (start (merge prod-system options))
"prod" (start (merge prod-system options))
(exit 1 (usage summary)))))

View file

@ -1,49 +1,29 @@
(ns grub.db
(:require [grub.util :as util]
[grub.sync :as sync]
[monger.core :as m]
(:require [monger.core :as m]
[monger.collection :as mc]
[monger.operators :as mo]
[clojure.core.async :as a :refer [<! >! chan go]]))
(def conn (atom nil))
(def db (atom nil))
(def collection "grub-lists")
(def production-db "grub")
(def development-db "grub-dev")
(defn clear-all []
(mc/drop @db collection))
(defn clear-all [db]
(mc/drop db collection))
(defn update-db! [state]
(mc/drop @db collection)
(mc/insert @db collection state))
(defn update-db! [db state]
(mc/drop db collection)
(mc/insert db collection state))
(defn get-current-state []
(let [state (first (mc/find-maps @db collection))]
(if state
(dissoc state :_id)
sync/empty-state)))
(defn get-current-state [db]
(let [state (first (mc/find-maps db collection))]
(when state
(dissoc state :_id))))
(defn connect! [db-name mongo-url]
(if mongo-url
(do (println "Connected to mongo via url:" mongo-url)
(:conn (m/connect-via-uri mongo-url)))
(do (println "Connected to mongo at localhost:" db-name)
(m/connect))))
(defn connect [db-name]
(let [conn (m/connect)
db (m/get-db conn db-name)]
(println "Connected to mongo at localhost:" db-name)
{:conn conn
:db db}))
(defn connect-and-handle-events [to-db db-name & [mongo-url]]
(a/go-loop []
(if-let [state (<! to-db)]
(do (update-db! state)
(recur))
(println "Database disconnected")))
(let [_conn (connect! db-name mongo-url)]
(reset! conn _conn)
(reset! db (m/get-db _conn db-name))))
(defn connect-production-database [to-db mongo-url]
(connect-and-handle-events to-db production-db mongo-url))
(defn connect-development-database [to-db]
(connect-and-handle-events to-db development-db))
(defn disconnect [conn]
(m/disconnect conn))

View file

@ -18,8 +18,9 @@
(defn read-msg [msg]
(let [in (ByteArrayInputStream. (.getBytes msg))
reader (t/reader in :json)]
(t/read reader)))
reader (t/reader in :json)
received (t/read reader)]
received))
(defn add-connected-client! [ws-channel to from]
(println "Client connected:" (.toString ws-channel))

View file

@ -1,17 +1,43 @@
(ns grub.core
(:require [grub.state :as state]
[grub.websocket :as ws]
[grub.sync :as sync]
[grub.websocket :as websocket]
[grub.view.app :as view]
[cljs.core.async :as a :refer [<! >! chan]])
(:require-macros [grub.macros :refer [log logs]]))
(defn init-app []
(let [local-states (chan)
remote-states (chan)
to-remote (chan)
from-remote (chan)]
(view/render-app state/empty-state remote-states local-states)
(ws/connect-client! to-remote from-remote)
(state/init-client from-remote to-remote local-states remote-states)))
(def system
{:pending-msg (atom nil)
:ws (atom nil)
:channels {:local-states (chan)
:remote-states (chan)
:to-remote (chan)
:from-remote (chan)}
:states (atom nil)
:view-state nil})
(init-app)
(defn start [{:keys [states pending-msg] :as system}]
(reset! states sync/empty-state)
(let [new-states (chan)
render-states (chan)
>remote (chan)
events (chan)
view-state (view/render-app state/empty-state render-states new-states)
ws (websocket/connect pending-msg >remote events)
agent-states (sync/sync-client! >remote events new-states states)]
(add-watch states :render (fn [_ _ old new]
(when-not (= old new)
(a/put! render-states (state/get-latest new)))))
(assoc system
:ws ws
:channels {:new-states new-states
:>remote >remote
:events events}
:states states
:view-state view-state)))
(defn stop [{:keys [channels ws]} system]
(doseq [c (vals channels)] (a/close! c))
(websocket/disconnect ws))
(start system)

View file

@ -25,7 +25,7 @@
(dom/on-document-mousedown #(put! >events {:type :body-mousedown :event %}))
(dom/on-window-scroll #(put! >events {:type :body-scroll :event %}))))))
(defn render-app [initial-state <remote >remote]
(defn render-app [initial-state <new-states >new-states]
(let [state (atom initial-state)
>events (chan)
<events (a/pub >events :type)
@ -37,7 +37,9 @@
:<events <events
:add-grubs-ch add-grubs-ch}
:tx-listen (fn [{:keys [new-state tag]} _]
(when (= tag :local) (put! >remote new-state)))})
(go (loop [] (when-let [new-state (<! <remote)]
(reset! state new-state)
(recur))))))
(when (= tag :local) (put! >new-states new-state)))})
(go (loop []
(let [new-state (<! <new-states)]
(reset! state new-state)
(recur))))
state))

View file

@ -48,7 +48,8 @@
om/IWillReceiveProps
(will-receive-props [this {:keys [text]}]
(om/set-state! owner :grub-text text))
(when-not (= (om/get-state owner :grub-text) text)
(om/set-state! owner :grub-text text)))
om/IRenderState
(render-state [_ {:keys [edit-state] :as state}]

View file

@ -60,9 +60,11 @@
:unmounted false}))
om/IWillReceiveProps
(will-receive-props [this next-recipe]
(om/set-state! owner :name (:name next-recipe))
(om/set-state! owner :grubs (:grubs next-recipe)))
(will-receive-props [this {:keys [name grubs]}]
(when-not (= (om/get-state owner :name) name)
(om/set-state! owner :name name))
(when-not (= (om/get-state owner :grubs) grubs)
(om/set-state! owner :grubs grubs)))
om/IRenderState
(render-state [this {:keys [edit-state name grubs]}]

View file

@ -8,34 +8,38 @@
[grub.macros :refer [log logs]]))
(def server-url (str "ws://" (.-host (.-location js/document))))
(def pending-msg (atom nil))
(def reader (t/reader :json))
(def writer (t/writer :json))
(defn send-pending-msg [websocket]
(defn send-pending-msg [websocket pending-msg]
(when (and (.isOpen websocket)
(not (nil? @pending-msg)))
(.send websocket (t/write writer @pending-msg))
(reset! pending-msg nil)))
(defn on-connected [websocket event]
(defn on-connected [websocket pending-msg event]
(log "Connected:" event)
(send-pending-msg websocket))
(send-pending-msg websocket pending-msg))
(defn read-msg [msg]
(t/read reader (.-message msg)))
(let [received (t/read reader (.-message msg))]
received))
(defn connect-client! [in out]
(let [handler (goog.events.EventHandler.)
websocket (goog.net.WebSocket.)
listen (fn [type fun] (.listen handler websocket type fun false))]
(listen goog.net.WebSocket.EventType.OPENED (partial on-connected websocket))
(defn connect [pending-msg in out]
(let [ws (goog.net.WebSocket.)
handler (goog.events.EventHandler.)
listen (fn [type fun] (.listen handler ws type fun false))]
(listen goog.net.WebSocket.EventType.OPENED (partial on-connected ws pending-msg))
(listen goog.net.WebSocket.EventType.MESSAGE #(a/put! out (read-msg %)))
(listen goog.net.WebSocket.EventType.CLOSED #(log "Closed:" %))
(listen goog.net.WebSocket.EventType.ERROR #(log "Error:" %))
(go (loop []
(when-let [msg (<! in)]
(reset! pending-msg msg)
(send-pending-msg websocket)
(send-pending-msg ws pending-msg)
(recur))))
(.open websocket server-url)))
(.open ws server-url)
ws))
(defn disconnect [ws]
(.close ws))

View file

@ -9,19 +9,28 @@
(second (data/diff a b)))
(defn diff-maps [a b]
{:deleted (deleted a b)
:updated (updated a b)})
(when (and (map? a) (map? b))
{:- (deleted a b)
:+ (updated a b)}))
(defn diff-keys [prev next]
(->> prev
(keys)
(map (fn [k] [k (diff-maps (k prev) (k next))]))
(filter #(not (nil? (second %))))
(into {})))
(defn diff-states [prev next]
(->> prev
(keys)
(map (fn [k] [k (diff-maps (k prev) (k next))]))
(filter #(not (nil? (second %))))
(into {})))
(defn patch-map [state diff]
(-> state
(#(apply dissoc % (into [] (:deleted diff))))
(#(merge-with merge % (:updated diff)))))
(#(apply dissoc % (into [] (:- diff))))
(#(merge-with merge % (:+ diff)))))
(defn patch-state [state diff]
(->> state

View file

@ -1,12 +0,0 @@
(ns grub.message)
(def full-sync-request {:type :full-sync-request})
(defn full-sync [state]
{:type :full-sync
:state state})
(defn diff-msg [diff hash]
{:type :diff
:diff diff
:hash hash})

View file

@ -1,100 +1,30 @@
(ns grub.state
(:require [grub.diff :as diff]
[grub.message :as message]
[grub.sync :as sync]
#+clj [clojure.core.async :as a :refer [<! >! chan go]]
#+cljs [cljs.core.async :as a :refer [<! >! chan]])
#+cljs (:require-macros [grub.macros :refer [log logs]]
[cljs.core.async.macros :refer [go]]))
[grub.util :as util]))
(defmulti handle-event (fn [event] (:type event)))
(def num-history-states 20)
(defmethod handle-event :diff [{:keys [hash diff states shadow client?] :as msg}]
(let [history-shadow (sync/get-history-state states hash)]
(if history-shadow
(let [new-states (sync/apply-diff states diff)
new-shadow (diff/patch-state history-shadow diff)
{new-diff :diff new-hash :hash} (sync/diff-states (sync/get-current-state new-states) new-shadow)]
{:out-event (when-not (sync/empty-diff? diff)
(message/diff-msg new-diff new-hash))
:new-states (if client?
(sync/new-state (sync/get-current-state new-states))
new-states)
:new-shadow new-shadow})
(if client?
{:out-event message/full-sync-request
:new-shadow shadow}
(let [state (sync/get-current-state states)]
{:out-event (message/full-sync state)
:new-shadow state})))))
(def empty-state {:tag 0 :grubs {} :recipes {}})
(defmethod handle-event :full-sync-request [{:keys [states]}]
(let [state (sync/get-current-state states)]
{:new-shadow state
:out-event (message/full-sync state)}))
(defn new-states [state]
[(assoc state :tag 0)])
(defmethod handle-event :full-sync [{:keys [state states]}]
{:new-states (sync/new-state state)
:new-shadow state})
(defn get-latest [states]
(last states))
(defmethod handle-event :new-state [{:keys [client? state states shadow] :as event}]
(let [{:keys [diff hash]} (sync/diff-states state shadow)]
{:new-states (sync/add-history-state states state)
:out-event (when-not (sync/empty-diff? diff) (message/diff-msg diff hash))}))
(defn get-tagged [states tag]
(->> states
(filter #(= (:tag %) tag))
(first)))
(defn make-agent
([client? <remote >remote states*] (make-agent client? <remote >remote states* sync/empty-state))
([client? <remote >remote states* initial-shadow]
(go (loop [shadow initial-shadow]
(when-let [msg (<! <remote)]
(let [states @states*
event (assoc msg :states states :client? client? :shadow shadow)
{:keys [new-states new-shadow out-event]} (handle-event event)]
(when (and new-states (not= states new-states)) (reset! states* new-states))
(when out-event (a/put! >remote out-event))
(recur (if new-shadow new-shadow shadow))))))))
(defn add [states new-state]
(let [last-state (last states)]
(if (= last-state new-state)
states
(let [new-states (conj states (assoc new-state :tag (inc (:tag last-state))))]
(if (>= (count states) num-history-states)
(into [] (rest new-states))
new-states)))))
(defn make-server-agent
([<remote >remote states] (make-agent false <remote >remote states))
([<remote >remote states initial-shadow] (make-agent false <remote >remote states initial-shadow)))
(defn make-client-agent
([<remote >remote states] (make-agent true <remote >remote states))
([<remote >remote states initial-shadow] (make-agent true <remote >remote states initial-shadow)))
(def states (atom []))
(def empty-state sync/empty-state)
#+clj
(defn sync-new-client! [>client <client]
(let [client-id (java.util.UUID/randomUUID)
state-changes (chan)
state-change-events (a/map< (fn [s] {:type :new-state :state s}) state-changes)
client-events (chan)]
(add-watch states client-id (fn [_ _ _ new-states]
(a/put! state-changes (sync/get-current-state new-states))))
(a/go-loop []
(let [[val _] (a/alts! [<client state-change-events])]
(if val
(do (>! client-events val)
(recur))
(do (remove-watch states client-id)
(a/close! <client)
(a/close! state-change-events)))))
(make-server-agent client-events >client states)))
#+clj
(defn init-server [to-db initial-state]
(reset! states (sync/new-state initial-state))
(add-watch states :to-db (fn [_ _ old-states new-states]
(a/put! to-db (sync/get-current-state new-states)))))
#+cljs
(defn init-client [<remote >remote <view >view]
(let [states (atom (sync/initial-state {} {}))]
(add-watch states :render (fn [_ _ _ new-states]
(let [new-state (sync/get-current-state new-states)]
(a/put! >view new-state))))
(a/pipe (a/map< (fn [s] {:type :new-state :state s}) <view) <remote)
(make-client-agent <remote >remote states)
(a/put! >remote message/full-sync-request)))
(defn state= [a b]
(= (dissoc a :tag) (dissoc b :tag)))

View file

@ -1,44 +1,138 @@
(ns grub.sync
(:require [grub.diff :as diff]
[grub.util :as util]
[hasch.core :as hasch]))
[grub.state :as state]
#+clj [clojure.core.async :as a :refer [<! >! chan go]]
#+cljs [cljs.core.async :as a :refer [<! >! chan]])
#+cljs (:require-macros [grub.macros :refer [log logs]]
[cljs.core.async.macros :refer [go]]))
(def num-history-states 20)
(def full-sync-request {:type :full-sync-request})
(def empty-state {:grubs {} :recipes {}})
(defn full-sync [state]
{:type :full-sync
:full-state state})
(defn initial-state [grubs recipes]
(let [state {:grubs (util/map-by-key :id grubs)
:recipes (util/map-by-key :id recipes)}]
[{:state state :hash (hasch/uuid state)}]))
(def empty-state state/empty-state)
(defn new-state [state]
[{:hash (hasch/uuid state)
:state state}])
(defn update-states [states diff]
(let [state (state/get-latest states)
new-state (diff/patch-state state diff)]
(state/add states new-state)))
(defn get-current-state [states]
(:state (last states)))
(defn diff-msg [shadow state]
(let [diff (diff/diff-states shadow state)]
{:type :diff
:diff diff
:tag (:tag state)
:shadow-tag (:tag shadow)}))
(defn get-history-state [states hash]
(:state (first (filter #(= (:hash %) hash) states))))
(defmulti handle-event (fn [event] (:type event)))
(defn add-history-state [states new-state]
(let [last-hash (:hash (last states))
new-hash (hasch/uuid new-state)]
(if (= last-hash new-hash)
states
(let [new-states (conj states {:hash new-hash :state new-state})]
(if (>= (count states) num-history-states)
(into [] (rest new-states))
new-states)))))
(defn apply-diff [states diff shadow new-shadow-tag client?]
(let [new-states (swap! states update-states diff)
new-state (state/get-latest new-states)
new-shadow (assoc (diff/patch-state shadow diff)
:tag new-shadow-tag)]
{:new-shadow new-shadow
;; Workaround to send an "ACK" diff when there are no changes
:out-event (when (and (not client?)
(state/state= new-state new-shadow))
(diff-msg new-shadow new-state))}))
(defn diff-states [state shadow]
{:hash (hasch/uuid shadow)
:diff (diff/diff-states shadow state)})
(defmethod handle-event :diff [{:keys [diff states shadow shadow-tag tag client?]}]
(let [history-shadow (state/get-tagged @states shadow-tag)]
(if history-shadow
(apply-diff states diff history-shadow tag client?)
(if client?
{:out-event full-sync-request
:new-shadow shadow}
(let [state (state/get-latest @states)]
{:out-event (full-sync state)
:new-shadow state})))))
(defn apply-diff [states diff]
(let [new-state (diff/patch-state (get-current-state states) diff)]
(add-history-state states new-state)))
(defmethod handle-event :full-sync-request [{:keys [states]}]
(let [state (state/get-latest @states)]
{:new-shadow state
:out-event (full-sync state)}))
(defn empty-diff? [diff]
(= diff {:recipes {:deleted #{}, :updated nil}, :grubs {:deleted #{}, :updated nil}}))
(defmethod handle-event :full-sync [{:keys [full-state states]}]
(reset! states (state/new-states full-state))
{:new-shadow full-state})
(defmethod handle-event :new-state [{:keys [shadow states new-state client?]}]
(let [new-states (swap! states state/add new-state)
latest-state (state/get-latest new-states)]
{:out-event (when-not (state/state= shadow latest-state)
(diff-msg shadow latest-state))
:new-shadow (when (and (not client?)
(not (state/state= shadow latest-state)))
(assoc latest-state :tag (inc (:tag shadow))))}))
(defmethod handle-event :default [msg]
#+cljs (logs "Unhandled message:" msg)
#+clj (println "Unhandled message:" msg)
{})
(defn make-server-agent
([>remote events new-states states]
(make-server-agent >remote events new-states states state/empty-state))
([>remote events new-states states initial-shadow]
(go (loop [shadow initial-shadow]
(let [[v c] (a/alts! [new-states events] :priority true)]
(cond (nil? v) nil ;; drop out of loop
(= c new-states)
(let [event {:type :new-state
:new-state v
:shadow shadow
:states states
:client? false}
{:keys [out-event new-shadow]} (handle-event event)]
(when out-event (a/put! >remote out-event))
(recur (if new-shadow new-shadow shadow)))
(= c events)
(let [event (assoc v
:states states
:client? false
:shadow shadow)
{:keys [new-shadow out-event]} (handle-event event)]
(when out-event (a/put! >remote out-event))
(recur (if new-shadow new-shadow shadow)))))))))
(defn make-client-agent
([>remote events new-states states]
(make-client-agent >remote events new-states states state/empty-state))
([>remote events new-states states initial-shadow]
(go (loop [shadow initial-shadow
out-event nil]
(when out-event (>! >remote out-event))
(let [timeout (a/timeout 1000)
[v c] (if out-event
(a/alts! [events timeout])
(a/alts! [new-states events] :priority true))]
(cond (= c timeout) (recur shadow out-event)
(nil? v) nil ;; drop out of loop
(= c new-states)
(let [event {:type :new-state
:new-state v
:shadow shadow
:states states
:client? true}
{:keys [out-event]} (handle-event event)]
(recur shadow out-event))
(= c events)
(let [event (assoc v
:states states
:client? true
:shadow shadow)
{:keys [new-shadow out-event]} (handle-event event)]
(recur (if new-shadow new-shadow shadow) out-event))))))))
#+cljs
(defn sync-client! [>remote events new-states states]
(let [new-states* (chan (a/sliding-buffer 1))]
(go (loop []
(let [v (<! new-states)]
(>! new-states* v)
(recur))))
(make-client-agent >remote events new-states* states)
(a/put! >remote full-sync-request)))

View file

@ -1,6 +1,5 @@
(ns grub.util
(:require [grub.diff :as diff]
#+clj [clojure.core.async :as a :refer [<! >! chan go]]
(:require #+clj [clojure.core.async :as a :refer [<! >! chan go]]
#+cljs [cljs.core.async :as a :refer [<! >! chan]])
#+cljs (:require-macros [grub.macros :refer [log logs]]
[cljs.core.async.macros :refer [go]]))

View file

@ -7,83 +7,83 @@
[clj-webdriver.core :as webdriver]
[clojure.test :as test]))
(def server-port 3456)
(def site-url (str "http://localhost:" server-port))
;; (def server-port 3456)
;; (def site-url (str "http://localhost:" server-port))
;; Hard-coded path to chromedriver
(defn set-chromedriver-path! []
(System/setProperty "webdriver.chrome.driver" "bin/chromedriver"))
;; ;; Hard-coded path to chromedriver
;; (defn set-chromedriver-path! []
;; (System/setProperty "webdriver.chrome.driver" "bin/chromedriver"))
(defn get-driver [url]
(webdriver/start {:browser :chrome} url))
;; (defn get-driver [url]
;; (webdriver/start {:browser :chrome} url))
(defn get-rand-grub []
(str "testgrub" (rand-int 10000)))
;; (defn get-rand-grub []
;; (str "testgrub" (rand-int 10000)))
(defn add-grub [driver grub-text]
(taxi/input-text driver "#add-grub-input" grub-text)
(taxi/click driver "#add-grub-btn"))
;; (defn add-grub [driver grub-text]
;; (taxi/input-text driver "#add-grub-input" grub-text)
;; (taxi/click driver "#add-grub-btn"))
(defn test-grubs-saved-to-server [url driver]
(taxi/to driver url)
(let [grubs (repeatedly 4 get-rand-grub)]
(doseq [grub grubs]
(add-grub driver grub))
(Thread/sleep 200)
(taxi/refresh driver)
(Thread/sleep 200)
(doseq [grub grubs]
(test/is (taxi/find-element driver {:value grub})
"Previously added grubs should be loaded on refresh")))
(db/clear-all))
;; (defn test-grubs-saved-to-server [url driver]
;; (taxi/to driver url)
;; (let [grubs (repeatedly 4 get-rand-grub)]
;; (doseq [grub grubs]
;; (add-grub driver grub))
;; (Thread/sleep 200)
;; (taxi/refresh driver)
;; (Thread/sleep 200)
;; (doseq [grub grubs]
;; (test/is (taxi/find-element driver {:value grub})
;; "Previously added grubs should be loaded on refresh")))
;; (db/clear-all))
(defn test-added-grubs-sync [url driver1 driver2]
(taxi/to driver1 url)
(taxi/to driver2 url)
(let [grubs (repeatedly 4 get-rand-grub)]
(doseq [grub grubs]
(add-grub driver1 grub))
(doseq [grub grubs]
(test/is (taxi/find-element driver2 {:value grub})
"Added grubs should appear in other browser"))))
;; (defn test-added-grubs-sync [url driver1 driver2]
;; (taxi/to driver1 url)
;; (taxi/to driver2 url)
;; (let [grubs (repeatedly 4 get-rand-grub)]
;; (doseq [grub grubs]
;; (add-grub driver1 grub))
;; (doseq [grub grubs]
;; (test/is (taxi/find-element driver2 {:value grub})
;; "Added grubs should appear in other browser"))))
(defn get-rand-recipe []
{:name (str "recipe" (rand-int 10000))
:grubs "grubs\nstuff\nmorestuff"})
;; (defn get-rand-recipe []
;; {:name (str "recipe" (rand-int 10000))
;; :grubs "grubs\nstuff\nmorestuff"})
(defn add-recipe [driver {:keys [name grubs]}]
(taxi/click driver "#new-recipe-name")
(taxi/input-text driver "#new-recipe-name" name)
(taxi/input-text driver "#new-recipe-grubs" grubs)
(taxi/click driver "#save-recipe-btn"))
;; (defn add-recipe [driver {:keys [name grubs]}]
;; (taxi/click driver "#new-recipe-name")
;; (taxi/input-text driver "#new-recipe-name" name)
;; (taxi/input-text driver "#new-recipe-grubs" grubs)
;; (taxi/click driver "#save-recipe-btn"))
(defn test-added-recipes-sync [url driver1 driver2]
(taxi/to driver1 url)
(taxi/to driver2 url)
(let [recipes (repeatedly 4 get-rand-recipe )]
(doseq [recipe recipes]
(add-recipe driver1 recipe))
(doseq [{:keys [name]} recipes]
(test/is (taxi/find-element driver2 {:value name})
"Added recipes should appear in other browser"))))
;; (defn test-added-recipes-sync [url driver1 driver2]
;; (taxi/to driver1 url)
;; (taxi/to driver2 url)
;; (let [recipes (repeatedly 4 get-rand-recipe )]
;; (doseq [recipe recipes]
;; (add-recipe driver1 recipe))
;; (doseq [{:keys [name]} recipes]
;; (test/is (taxi/find-element driver2 {:value name})
;; "Added recipes should appear in other browser"))))
(defn run-tests [site-url driver1 driver2]
(test-grubs-saved-to-server site-url driver1)
(test-added-grubs-sync site-url driver1 driver2)
(test-added-recipes-sync site-url driver1 driver2))
;; (defn run-tests [site-url driver1 driver2]
;; (test-grubs-saved-to-server site-url driver1)
;; (test-added-grubs-sync site-url driver1 driver2)
;; (test-added-recipes-sync site-url driver1 driver2))
(defn start-db-and-websocket-server! []
(let [to-db (chan)]
(db/connect-and-handle-events to-db "grub-integration-test")
(state/init-server to-db (db/get-current-state))))
;; (defn start-db-and-websocket-server! []
;; (let [to-db (chan)]
;; (db/connect-and-handle-events to-db "grub-integration-test")
;; (state/init-server to-db (db/get-current-state))))
(defn run []
(println "Starting integration test")
(set-chromedriver-path!)
(start-db-and-websocket-server!)
(let [driver1 (get-driver site-url)
driver2 (get-driver site-url)]
(run-tests site-url driver1 driver2)
(taxi/quit driver1)
(taxi/quit driver2))
(db/clear-all))
;; (defn run []
;; (println "Starting integration test")
;; (set-chromedriver-path!)
;; (start-db-and-websocket-server!)
;; (let [driver1 (get-driver site-url)
;; driver2 (get-driver site-url)]
;; (run-tests site-url driver1 driver2)
;; (taxi/quit driver1)
;; (taxi/quit driver2))
;; (db/clear-all))

View file

@ -1,75 +1,91 @@
(ns grub.test.integration.synchronization
(:require [grub.state :as state]
(:require [grub.sync :as sync]
[grub.state :as state]
[clojure.test :refer :all]
[midje.sweet :refer :all]
[hasch.core :as hasch]
[clojure.core.async :as a :refer [<!! >!! chan go]]))
(defn hashed-states [& states]
(->> states
(map (fn [s] {:hash (hasch/uuid s)
:state s}))
(into [])))
(defn states-atom [& states]
(atom (apply hashed-states states)))
(defn <!!? [c]
(let [[v p] (a/alts!! [c (a/timeout 100)])]
v))
(fact "Client-only changes synced with server"
(let [client-shadow {:grubs {"1" {:text "2 apples" :completed true}} :recipes {}}
client-states (states-atom
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed true}} :recipes {}})
server-shadow {:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
server-states (states-atom server-shadow)
client-in (chan)
client-out (chan)
server-in (chan)
server-out (chan)
client-state-changes (chan 1)
msg {:type :new-state
:state {:grubs {"1" {:text "2 apples" :completed true}} :recipes {}}}]
(a/pipe client-out server-in)
(a/pipe server-out client-in)
(state/make-client-agent client-in client-out client-states server-shadow)
(state/make-server-agent server-in server-out server-states client-shadow)
(add-watch client-states :test (fn [_ _ _ new-states] (a/put! client-state-changes new-states)))
(>!! client-in msg)
(<!!? client-state-changes)
(:state (last @client-states)) => {:grubs {"1" {:completed true, :text "2 apples"}}
:recipes {}}
(:state (last @server-states)) => {:grubs {"1" {:completed true, :text "2 apples"}}
:recipes {}}))
(defn client-server [client-states server-states]
(let [server-shadow (last @server-states)
client-shadow (last @client-states)
new-client-states (chan)
>client (chan)
new-server-states (chan)
>server (chan)]
(sync/make-client-agent >server >client new-client-states client-states server-shadow)
(sync/make-server-agent >client >server new-server-states server-states client-shadow)
{:new-client-states new-client-states
:new-server-states new-server-states}))
(defn states-in-sync? [a b]
(state/state= (last a) (last b)))
(defn last-state [states]
(-> states
(last)
(dissoc :tag)))
(defn short-delay []
(<!! (a/timeout 300)))
(fact "Client-only changes sync with server"
(let [client (atom [{:tag 1
:grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
server (atom [{:tag 44 :grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
{:keys [new-client-states]} (client-server client server)
client-change {:tag 2
:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}]
(swap! client conj client-change)
(>!! new-client-states client-change)
(short-delay)
(states-in-sync? @client @server) => true
(last-state @client) => {:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}))
(fact "Other client changes synced with client"
(let [client (atom [{:tag 1
:grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
server (atom [{:tag 44 :grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
{:keys [new-server-states]} (client-server client server)
server-change {:tag 2
:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}]
(swap! server conj server-change)
(>!! new-server-states server-change)
(short-delay)
(states-in-sync? @client @server) => true
(last-state @client) => {:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}))
(fact "Client changes and simultaneous server changes synced"
(let [client (atom [{:tag 1
:grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
server (atom [{:tag 44 :grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}])
{:keys [new-client-states]} (client-server client server)
client-change {:tag 2
:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}
server-change {:tag 45
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "milk" :completed false}}
:recipes {}}]
(swap! client conj client-change)
(swap! server conj server-change)
(>!! new-client-states client-change)
(short-delay)
(states-in-sync? @client @server) => true
(last-state @client) => {:grubs {"1" {:text "2 apples" :completed true}
"2" {:text "milk" :completed false}}
:recipes {}}))
(fact "Client and server changes synced"
(let [client-shadow {:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
client-states (states-atom
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed true}} :recipes {}})
server-shadow {:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
server-states (states-atom
server-shadow
{:grubs {"1" {:text "4 apples" :completed false}} :recipes {}})
client-in (chan)
client-out (chan)
server-in (chan)
server-out (chan)
msg {:type :new-state
:state {:grubs {"1" {:text "2 apples" :completed true}} :recipes {}}}
client-state-changes (chan 1)]
(a/pipe client-out server-in)
(a/pipe server-out client-in)
(state/make-client-agent client-in client-out client-states server-shadow)
(state/make-server-agent server-in server-out server-states client-shadow)
(add-watch client-states :test (fn [_ _ _ new-states] (a/put! client-state-changes new-states)))
(>!! client-in msg)
(<!!? client-state-changes)
@client-states => (hashed-states
{:grubs {"1" {:completed true, :text "4 apples"}}, :recipes {}})
@server-states => (hashed-states
{:grubs {"1" {:completed false, :text "2 apples"}}, :recipes {}}
{:grubs {"1" {:completed false, :text "4 apples"}}, :recipes {}}
{:grubs {"1" {:completed true, :text "4 apples"}}, :recipes {}})))

View file

@ -1,73 +1,76 @@
(ns grub.test.unit.diff
(:require [grub.diff :as diff]
[clojure.test :refer :all]))
[midje.sweet :refer :all]))
(def empty-diff {:grubs {:deleted #{} :updated nil}
:recipes {:deleted #{} :updated nil}})
(def empty-diff {:grubs {:- #{} :+ nil}
:recipes {:- #{} :+ nil}})
(deftest diff-empty-states
(fact "Diff of empty states is empty diff"
(let [empty-state {:grubs {} :recipes {}}]
(is (= empty-diff
(diff/diff-states empty-state empty-state)))))
(diff/diff-states empty-state empty-state) => empty-diff))
(deftest diff-equal-states
(is (= empty-diff
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf" :completed false}} :recipes {}}))))
(fact "Diff of equal states is empty diff"
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf" :completed false}} :recipes {}})
=> empty-diff)
(deftest diff-added-grub
(is (= {:grubs {:deleted #{}
:updated {"id" {:completed false, :text "asdf"}}}
:recipes {:deleted #{} :updated nil}}
(diff/diff-states {:grubs {} :recipes {}}
{:grubs {"id" {:text "asdf" :completed false}} :recipes {}}))))
(fact "Diff of one added grub has one updated grub"
(diff/diff-states {:grubs {} :recipes {}}
{:grubs {"id" {:text "asdf" :completed false}} :recipes {}})
=> {:grubs {:- #{}
:+ {"id" {:completed false, :text "asdf"}}}
:recipes {:- #{} :+ nil}})
(deftest diff-deleted-grub
(is (= {:grubs {:deleted #{"id"}
:updated nil}
:recipes {:deleted #{} :updated nil}}
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {} :recipes {}}))))
(fact "Diff of one removed grub has one deleted grub"
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {} :recipes {}})
=>
{:grubs {:- #{"id"}
:+ nil}
:recipes {:- #{} :+ nil}})
(deftest diff-edited-grub
(is (= {:grubs {:deleted #{}
:updated {"id" {:text "asdf2"}}}
:recipes {:deleted #{} :updated nil}}
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf2" :completed false}} :recipes {}}))))
(fact "Diff of one changed grub has updated grub"
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf2" :completed false}} :recipes {}})
=>
{:grubs {:- #{}
:+ {"id" {:text "asdf2"}}}
:recipes {:- #{} :+ nil}})
(deftest diff-completed-grub
(is (= {:grubs {:deleted #{}
:updated {"id" {:completed true}}}
:recipes {:deleted #{} :updated nil}}
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf" :completed true}} :recipes {}}))))
(fact "Diff of one completed grub has updated grub"
(diff/diff-states {:grubs {"id" {:text "asdf" :completed false}} :recipes {}}
{:grubs {"id" {:text "asdf" :completed true}} :recipes {}})
=> {:grubs {:- #{}
:+ {"id" {:completed true}}}
:recipes {:- #{} :+ nil}})
(deftest diff-added-recipe
(is (= {:grubs {:deleted #{}
:updated nil}
:recipes {:deleted #{} :updated {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}}
(diff/diff-states {:grubs {} :recipes {}}
{:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}))))
(fact "Diff of one added recipe has updated recipe"
(diff/diff-states {:grubs {} :recipes {}}
{:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}})
=>
{:grubs {:- #{}
:+ nil}
:recipes {:- #{} :+ {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}})
(deftest diff-edited-recipe
(is (= {:grubs {:deleted #{}
:updated nil}
:recipes {:deleted #{} :updated {"id" {:name "Bleu Cheese Soup" }}}}
(diff/diff-states {:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}
{:grubs {} :recipes {"id" {:name "Bleu Cheese Soup"
:grubs "Some grubs"}}}))))
(fact "Diff of one changed recipe has one updated recipe"
(diff/diff-states {:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}
{:grubs {} :recipes {"id" {:name "Bleu Cheese Soup"
:grubs "Some grubs"}}})
=> {:grubs {:- #{}
:+ nil}
:recipes {:- #{} :+ {"id" {:name "Bleu Cheese Soup" }}}})
(deftest diff-deleted-recipe
(is (= {:grubs {:deleted #{} :updated nil}
:recipes {:deleted #{"id"} :updated nil}}
(diff/diff-states {:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}
{:grubs {} :recipes {}}))))
(fact "Diff of one removed recipe has one deleted recipe"
(diff/diff-states {:grubs {} :recipes {"id" {:name "Blue Cheese Soup"
:grubs "Some grubs"}}}
{:grubs {} :recipes {}})
=>
{:grubs {:- #{} :+ nil}
:recipes {:- #{"id"} :+ nil}})
(def before-state
{:grubs
@ -107,8 +110,8 @@
(def expected-diff
{:recipes
{:deleted #{"recipe-deleted"}
:updated
{:- #{"recipe-deleted"}
:+
{"recipe-added"
{:name "Burgers"
:grubs
@ -117,17 +120,16 @@
{:grubs
"300 g lean stew beef (lapa/naudan etuselkä), cut into 1-inch cubes\n2 T. vegetable oil\n5 dl water\n2 lihaliemikuutios\n400 ml burgundy (or another red wine)\n1 garlic clove\n1 bay leaf (laakerinlehti)\n1/2 t. basil\n2 carrots\n1 yellow onion\n4 potatoes\n1 cup celery\n2 tablespoons of cornstarch (maissijauho/maizena)"}}}
:grubs
{:deleted #{"grub-deleted"}
:updated
{:- #{"grub-deleted"}
:+
{"grub-completed" {:completed true}
"grub-updated" {:text "Ketchup"}
"grub-added"
{:completed false :text "Toothpaste"}}}})
(deftest diff-many-changes
(is (= expected-diff (diff/diff-states before-state after-state))))
(fact "Diff of many changes has all changes"
(diff/diff-states before-state after-state) => expected-diff)
(deftest patch-returns-original-state
(is
(let [diff (diff/diff-states before-state after-state)]
(= after-state (diff/patch-state before-state diff)))))
(fact "Diff and patch of many changes returns original state"
(let [diff (diff/diff-states before-state after-state)]
(diff/patch-state before-state diff) => after-state))

View file

@ -1,179 +1,35 @@
(ns grub.test.unit.state
(:require [grub.state :as state]
[grub.sync :as sync]
[midje.sweet :refer :all]
[hasch.core :as hasch]))
(:require [grub.state :as s]
[midje.sweet :refer :all]))
(defn hashed-states [& states]
(->> states
(map (fn [s] {:hash (hasch/uuid s)
:state s}))
(into [])))
(fact "Get current state returns last state"
(let [states [{:tag 1 :a :b}
{:tag 2 :c :d}]]
(s/get-latest states) => {:tag 2 :c :d}))
(fact "Server applies diff and returns empty diff when no server changes"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}})
event {:type :diff
:diff {:grubs {:updated {"1" {:completed true}} :deleted #{}}}
:hash (:hash (first states))
:states states
:shadow (:state (last states))
:client? false}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => (hashed-states
{:grubs {"1" {:completed false, :text "2 apples"}}, :recipes {}}
{:grubs {"1" {:completed true, :text "2 apples"}}, :recipes {}})
new-shadow {:grubs {"1" {:completed true, :text "2 apples"}}, :recipes {}}
out-event => {:type :diff
:diff {:grubs {:deleted #{}, :updated nil}
:recipes {:deleted #{}, :updated nil}}
:hash (:hash (last new-states))}))
(fact "Get history state returns state with given hash"
(let [states [{:tag 1 :a :b}
{:tag 2 :c :d}
{:tag 3 :e :f}]]
(s/get-tagged states 1) => {:tag 1 :a :b}
(s/get-tagged states 2) => {:tag 2 :c :d}
(s/get-tagged states 3) => {:tag 3 :e :f}))
(fact "Client applies diff, clears history, updates shadow, returns empty diff when no client changes"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}})
event {:type :diff
:diff {:grubs {:updated {"1" {:completed true}} :deleted #{}}}
:hash (:hash (first states))
:states states
:shadow (:state (last states))
:client? true}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => (hashed-states
{:grubs {"1" {:completed true, :text "2 apples"}}, :recipes {}})
new-shadow => {:grubs {"1" {:completed true, :text "2 apples"}}, :recipes {}}
out-event => {:type :diff
:diff {:grubs {:deleted #{}, :updated nil}
:recipes {:deleted #{}, :updated nil}}
:hash (:hash (last new-states))}))
(fact "Add history state appends state to the end and increments tag"
(let [states [{:tag 1 :a :b}
{:tag 2 :c :d}]]
(s/add states {:e :f}) => [{:tag 1 :a :b}
{:tag 2 :c :d}
{:tag 3 :e :f}]))
(fact "Server applies diff and returns changes when server has changed"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}})
event {:type :diff
:diff {:grubs {:updated {"1" {:completed true}} :deleted #{}}}
:hash (:hash (first states))
:states states
:shadow sync/empty-state
:client? false}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}
{:grubs {"1" {:text "2 apples" :completed true}
"2" {:text "3 onions" :completed false}}
:recipes {}})
out-event => {:type :diff
:diff {:grubs {:deleted #{}
:updated {"2" {:completed false, :text "3 onions"}}}
:recipes {:deleted #{}, :updated nil}}
:hash (hasch/uuid {:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}})}))
(fact "Add history state appends state to the end and drops first state if full"
(let [states (into [] (for [i (range 20)] {:tag i :i i}))
new-states (s/add states {:i 21})]
(count new-states) => 20
(dissoc (last new-states) :tag) => {:i 21}
(first new-states) => {:tag 1 :i 1}))
(fact "Server forces full sync if client is out of sync"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}})
event {:type :diff
:diff {:grubs {:updated {"0" {:completed true}} :deleted #{}}}
:hash (:hash {:grubs {"0" {:text "milk" :completed false}}
:recipes {}})
:states states
:shadow sync/empty-state
:client? false}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => nil
out-event => {:type :full-sync
:state {:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}}))
(fact "Server sends full sync if client requests it"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}})
event {:type :full-sync-request
:states states}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => nil
out-event => {:type :full-sync
:state {:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}}))
(fact "New state - server passes diff to client, does not update shadow"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}
:recipes {}})
client-state {:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
event {:type :new-state
:state (:state (last states))
:client? false
:states states
:shadow client-state}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}
:recipes {}})
new-shadow => nil
out-event => {:type :diff
:diff {:grubs {:deleted #{}
:updated {"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}}
:recipes {:deleted #{}, :updated nil}}
:hash (hasch/uuid client-state)}))
(fact "New state - client passes diff to server, does not update shadow"
(let [states (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}
:recipes {}})
shadow {:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
event {:type :new-state
:state (:state (last states))
:client? true
:states states
:shadow shadow}
{:keys [new-states new-shadow out-event]} (state/handle-event event)]
new-states => (hashed-states
{:grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}
{:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}
:recipes {}})
new-shadow => nil
out-event => {:type :diff
:diff {:grubs {:deleted #{}
:updated {"2" {:text "3 onions" :completed false}
"3" {:text "milk" :completed false}}}
:recipes {:deleted #{}, :updated nil}}
:hash (hasch/uuid shadow)}))
(fact "Add history state does not add consecutive duplicate states"
(let [states [{:tag 1 :a :b}
{:tag 2 :c :d}]]
(s/add states {:tag 2 :c :d}) => states))

View file

@ -1,45 +1,195 @@
(ns grub.test.unit.sync
(:require [grub.sync :as s]
[midje.sweet :refer :all]
[hasch.core :as hasch]))
(:require [grub.state :as state]
[grub.sync :as sync]
[midje.sweet :refer :all]))
(fact "Sets correct initial state"
(let [grubs [{:id "1" :text "2 bananas" :completed false}
{:id "2" :text "3 onions" :completed false}]
recipes []
expected-state {:grubs {"1" {:id "1" :text "2 bananas" :completed false}
"2" {:id "2" :text "3 onions" :completed false}}
:recipes {}}
expected-hash (hasch/uuid expected-state)]
(s/initial-state grubs recipes) => [{:state expected-state :hash expected-hash}]))
(facts "Server"
(fact "Diff, no server changes - Apply diff, return empty diff"
(let [states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])
{:keys [out-event new-shadow]}
(sync/handle-event
{:type :diff
:tag 4
:shadow-tag 0
:diff {:grubs {:+ {"1" {:completed true}} :- #{}}}
:states states
:shadow {:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
:client? false})]
@states => (just (just {:tag 0
:grubs {"1" {:completed false, :text "2 apples"}}
:recipes {}})
(just {:tag 1
:grubs {"1" {:completed true, :text "2 apples"}}
:recipes {}}))
out-event => (just {:type :diff
:diff {:grubs {:- #{} :+ nil} :recipes {:- #{}, :+ nil}}
:shadow-tag 4
:tag 1})
new-shadow => {:tag 4
:grubs {"1" {:completed true, :text "2 apples"}}
:recipes {}}))
(fact "Get current state returns last state"
(let [states [{:hash "asdf" :state {:a :b}}
{:hash "fdsa" :state {:c :d}}]]
(s/get-current-state states) => {:c :d}))
(fact "Diff, server changes - Apply diff, return changes"
(let [states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 1 :grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}])
{:keys [new-shadow out-event]}
(sync/handle-event
{:type :diff
:shadow-tag 0
:tag 4
:diff {:grubs {:+ {"1" {:completed true}} :- #{}}}
:states states
:shadow state/empty-state
:client? false})]
@states =>
(just {:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 1 :grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}} :recipes {}}
{:tag 2 :grubs {"1" {:text "2 apples" :completed true}
"2" {:text "3 onions" :completed false}} :recipes {}})
out-event =>
(just {:type :diff
:shadow-tag 4
:tag 2
:diff {:grubs {:- #{} :+ {"2" {:completed false, :text "3 onions"}}}
:recipes {:- #{}, :+ nil}}})
new-shadow => {:tag 4
:grubs {"1" {:text "2 apples" :completed true}}
:recipes {}}))
(fact "Diff, client out of sync - Force full sync"
(let [states (atom [{:tag 14 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 15 :grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}])
event {:type :diff
:shadow-tag 3
:tag 12
:diff {:grubs {:updated {"0" {:completed true}} :deleted #{}}}
:states states
:shadow state/empty-state
:client? false}
{:keys [new-shadow out-event]} (sync/handle-event event)]
out-event => {:type :full-sync
:full-state {:tag 15
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}}))
(fact "New state - Update state, send diff, update shadow assuming diff received"
(let [states (atom [{:tag 14 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])
event {:type :new-state
:states states
:shadow {:tag 3 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
:client? false
:new-state {:grubs {"1" {:text "2 apples" :completed true}} :recipes {}}}
{:keys [new-shadow out-event]} (sync/handle-event event)]
@states => [{:tag 14 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 15 :grubs {"1" {:text "2 apples" :completed true}} :recipes {}}]
new-shadow => {:tag 4 :grubs {"1" {:text "2 apples" :completed true}} :recipes {}}
out-event => {:type :diff
:shadow-tag 3
:tag 15
:diff {:grubs {:+ {"1" {:completed true}} :- #{}}
:recipes {:+ nil :- #{}}}}))
(fact "Server sends full sync if client requests it"
(let [result (sync/handle-event
{:type :full-sync-request
:states (atom [{:tag 14 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 15 :grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}])})]
(:new-shadow result) =>
(just {:tag #(not (nil? %))
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}})
(:out-event result) =>
{:type :full-sync
:full-state {:tag 15
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}}))
)
(fact "Get history state returns state with given hash"
(let [states [{:hash "hash1" :state {:a :b}}
{:hash "hash2" :state {:c :d}}
{:hash "hash3" :state {:e :f}}]]
(s/get-history-state states "hash1") => {:a :b}
(s/get-history-state states "hash2") => {:c :d}
(s/get-history-state states "hash3") => {:e :f}))
(fact "Add history state appends state to the end"
(let [states [{:hash "hash1" :state {:a :b}}
{:hash "hash2" :state {:c :d}}]]
(:state (last (s/add-history-state states {:e :f}))) => {:e :f}))
(facts "Client diffs"
(fact "Client applies diff, does not return diff when no client changes"
(let [states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])
event {:type :diff
:shadow-tag 0
:tag 4
:diff {:grubs {:+ {"1" {:completed true}} :- #{}}}
:states states
:shadow {:tag 0 :grubs {"1" {:text "2 apples" :completed false}}
:recipes {}}
:client? true}
{:keys [new-shadow out-event]} (sync/handle-event event)]
@states =>
(just {:tag 0 :grubs {"1" {:completed false, :text "2 apples"}}, :recipes {}}
{:tag 1
:grubs {"1" {:completed true, :text "2 apples"}}
:recipes {}})
new-shadow {:tag 4 :grubs {"1" {:completed true, :text "2 apples"}}, :recipes {}}
out-event => nil))
(fact "Add history state appends state to the end and drops first state if full"
(let [states (into [] (for [i (range 20)] {:hash (str "hash" i) :state {:i i}}))
new-states (s/add-history-state states {:i 21})]
(count new-states) => 20
(:state (last new-states)) => {:i 21}
(:state (first new-states)) => {:i 1}))
(fact "Client state is unchanged on receiving empty diff"
(let [states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])]
(sync/handle-event
{:type :diff
:shadow-tag 0
:tag 4
:diff {:grubs {:+ nil :- #{}}}
:states states
:shadow {:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
:client? true})
@states => [{:tag 0
:grubs {"1" {:completed false, :text "2 apples"}}
:recipes {}}]))
(fact "Client returns no response on empty diff"
(-> (sync/handle-event
{:type :diff
:shadow-tag 0
:tag 4
:diff {:grubs {:+ nil :- #{}}}
:states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])
:shadow {:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
:client? true})
:out-event)
=> nil)
(fact "Add history state does not add consecutive duplicate states"
(let [hash (hasch/uuid {:c :d})
states [{:hash "hash1" :state {:a :b}}
{:hash hash :state {:c :d}}]]
(s/add-history-state states {:c :d}) => states))
(fact "Client updates server shadow on empty diff"
(-> (sync/handle-event
{:type :diff
:shadow-tag 0
:tag 4
:diff {:grubs {:+ nil :- #{}}}
:states (atom [{:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}])
:shadow {:tag 0 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
:client? true})
:new-shadow)
=> {:tag 4 :grubs {"1" {:completed false, :text "2 apples"}} :recipes {}}))
(facts "Full sync"
(fact "Server sends full sync if client requests it"
(let [result (sync/handle-event
{:type :full-sync-request
:states (atom [{:tag 14 :grubs {"1" {:text "2 apples" :completed false}} :recipes {}}
{:tag 15 :grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}])})]
(:new-shadow result) =>
(just {:tag #(not (nil? %))
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}})
(:out-event result) =>
{:type :full-sync
:full-state {:tag 15
:grubs {"1" {:text "2 apples" :completed false}
"2" {:text "3 onions" :completed false}}
:recipes {}}})))