├── .gitignore ├── .travis.yml ├── README.md ├── project.clj ├── src └── ittyon │ ├── client.cljc │ ├── core.cljc │ └── server.cljc └── test └── ittyon ├── client_server_test.cljc ├── core_test.cljc └── test_runner.cljs /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | /codox 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | /.lein-* 10 | /.nrepl-port 11 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: clojure 2 | script: lein test-all 3 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Ittyon 2 | 3 | [![Build Status](https://travis-ci.org/weavejester/ittyon.svg?branch=master)](https://travis-ci.org/weavejester/ittyon) 4 | 5 | Ittyon is a simple library designed to manage state in games, 6 | particularly distributed state in a client/server architecture. It 7 | supports both Clojure and ClojureScript, so is particularly suitable 8 | for web-based games. 9 | 10 | Ittyon draws inspiration from the [entity component][1] model, but 11 | provides a greater separation between code and data. Its data model 12 | has a lot in common with [Datomic][2]. 13 | 14 | Ittyon's network code should be considered **experimental**. 15 | Experimental means that the code is incomplete and subject to change. 16 | 17 | [1]: https://en.wikipedia.org/wiki/Entity_component_system 18 | [2]: http://www.datomic.com/ 19 | 20 | ## Installation 21 | 22 | Add the following to your project dependencies: 23 | 24 | ```clojure 25 | [ittyon "0.11.4"] 26 | ``` 27 | 28 | ## Overview 29 | 30 | Ittyon maintains an immutable database of **facts** to describe a game 31 | state. A fact is a vector of four elements: 32 | 33 | ```clojure 34 | [entity aspect value time] 35 | ``` 36 | 37 | These elements are often abbreviated to `[e a v t]`. 38 | 39 | Facts can be **asserted** or **revoked** to produce a state 40 | **transition**. A state transition can be committed to a state to 41 | produce an updated state. 42 | 43 | Ittyon provides three mechanisms to customize its behavior: 44 | **validation**, **indexing** and **reactions**. 45 | 46 | Validation determines whether or not a transition is valid for a 47 | particular state. If a transition is not valid, the state is not 48 | updated. 49 | 50 | Indexing allows the game state to be efficiently queried. Many indexes 51 | may be defined to allow the data to be accessed in different ways. 52 | 53 | Reactions produce transitions according to changes in state or time. 54 | This is the mechanism Ittyon uses for turning a static world into one 55 | that reacts to events. 56 | 57 | 58 | ## Documentation 59 | 60 | * [Wiki](https://github.com/weavejester/ittyon/wiki) 61 | * [API Docs](https://weavejester.github.io/ittyon) 62 | 63 | 64 | ## License 65 | 66 | Copyright © 2016 James Reeves 67 | 68 | Distributed under the Eclipse Public License either version 1.0 or (at 69 | your option) any later version. 70 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject ittyon "0.11.4" 2 | :description "Manage distributed state for games" 3 | :url "https://github.com/weavejester/ittyon" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.7.0"] 7 | [org.clojure/core.async "0.2.374"] 8 | [medley "0.7.3"] 9 | [intentions "0.2.1"]] 10 | :plugins [[lein-cljsbuild "1.1.2"] 11 | [lein-doo "0.1.6"] 12 | [lein-codox "0.9.4"]] 13 | :codox 14 | {:metadata {:doc/format :markdown} 15 | :source-uri "https://github.com/weavejester/ittyon/blob/{version}/{filepath}#{line}" 16 | :output-path "codox"} 17 | :cljsbuild 18 | {:builds 19 | [{:id "test" 20 | :source-paths ["src" "test"] 21 | :compiler {:output-to "target/test-runner.js" 22 | :output-dir "target" 23 | :optimizations :whitespace 24 | :main ittyon.test-runner}}]} 25 | :aliases 26 | {"test-cljs" ["doo" "phantom" "test" "once"] 27 | "test-all" ["do" ["test"] ["test-cljs"]]} 28 | :profiles 29 | {:provided {:dependencies [[org.clojure/clojurescript "1.7.228"]]} 30 | :dev {:dependencies [[org.clojure/tools.namespace "0.2.11"] 31 | [criterium "0.4.3"]] 32 | :jvm-opts ^:replace {}}}) 33 | -------------------------------------------------------------------------------- /src/ittyon/client.cljc: -------------------------------------------------------------------------------- 1 | (ns ittyon.client 2 | "A client that communicates with a server to mirror its state." 3 | #?(:cljs (:require-macros [cljs.core.async.macros :refer [go go-loop]])) 4 | (:require #?(:clj [clojure.core.async :as a :refer [go go-loop !]] 5 | :cljs [cljs.core.async :as a :refer [!]]) 6 | #?(:clj [intentions.core :refer [defconduct]] 7 | :cljs [intentions.core :refer-macros [defconduct]]) 8 | [ittyon.core :as i] 9 | [medley.core :as m])) 10 | 11 | (derive :ittyon/connected? :ittyon/aspect) 12 | (derive :ittyon/local? :ittyon/aspect) 13 | 14 | (defconduct i/-valid? [:assert :ittyon/connected?] [_ [_ _ _ v _]] 15 | (m/boolean? v)) 16 | 17 | (defconduct i/-valid? [:assert :ittyon/local?] [_ [_ _ _ v _]] 18 | (true? v)) 19 | 20 | (defn ^:no-doc log-exceptions [{:keys [logger]} f] 21 | (try 22 | (f) 23 | (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) ex 24 | (logger (str (m/ex-message ex) ": " (:transition (ex-data ex)))) 25 | nil))) 26 | 27 | (defmulti ^:no-doc receive! 28 | (fn [client event] (first event))) 29 | 30 | (defmethod receive! :default [_ _] nil) 31 | 32 | (defmethod receive! :transact [client [_ transitions]] 33 | (log-exceptions client 34 | #(swap! (:state client) i/transact transitions (remove (comp :impure meta))))) 35 | 36 | (defmethod receive! :reset [client [_ facts]] 37 | (reset! (:state client) (i/state facts))) 38 | 39 | (defmethod receive! :time [client [_ time]] 40 | (reset! (:time-offset client) (- (i/time) time))) 41 | 42 | (defn ^:no-doc send! [client message] 43 | (a/put! (-> client :socket :out) message)) 44 | 45 | (defn- fill-transition-times [transitions offset] 46 | (let [time (i/time)] 47 | (for [tr transitions] 48 | (update tr 4 (fn [t] (+ (or t time) offset)))))) 49 | 50 | (defn transact! 51 | "Atomically update the client with an ordered collection of transitions, then 52 | relay them to the server. Times may be omitted from the transitions, in which 53 | case the current time will be used. Transitions tagged as `:local` will not 54 | be sent to the server. Reaction transitions tagged as `:impure` will not be 55 | applied directly by clients, but will be relayed from the server in order to 56 | get a canonical value. See also: [[core/transact]]." 57 | [client transitions] 58 | (let [trans (fill-transition-times transitions @(:time-offset client))] 59 | (swap! (:state client) i/transact trans (remove (comp :impure meta))) 60 | (send! client [:transact (vec (remove (comp :local meta) trans))]))) 61 | 62 | (defn tick! 63 | "Move the clock forward on the client. This does not send anything to the 64 | server." 65 | [client] 66 | (swap! (:state client) i/tick (+ (i/time) @(:time-offset client)))) 67 | 68 | (defn- make-client 69 | [socket [event-type {:keys [id time reset]}]] 70 | {:pre [(= event-type :init)]} 71 | {:socket socket 72 | :id id 73 | :state (atom (i/state (conj reset [id :ittyon/local? true time]))) 74 | :time-offset (atom (- (i/time) time)) 75 | :logger println}) 76 | 77 | (defn connect! 78 | "Connect to a server via a socket, a map that contains `:in` and `:out` keys 79 | that hold the input and output channels. Returns a channel that promises to 80 | deliver a new client once the connection has been established. Used in 81 | conjuction with [[server/accept!]]." 82 | {:arglists '([socket])} 83 | [{:keys [in] :as socket}] 84 | (let [return (a/promise-chan)] 85 | (go (let [client (make-client socket (! return client) 87 | (a/close! return) 88 | (loop [] 89 | (when-let [event ( state 115 | (update-snapshot transition) 116 | (core/update :log conj transition) 117 | (core/update :count inc) 118 | (index transition))) 119 | 120 | (defn prune 121 | "Reset the log of a state back to an empty list." 122 | [state] 123 | (assoc state :log ())) 124 | 125 | (defn state 126 | "Return a new state, either empty or prepopulated with a collection of facts." 127 | ([] 128 | {:snapshot {}, :log (), :index {}, :count 0}) 129 | ([facts] 130 | (reduce update (state) (for [[e a v t] facts] [:assert e a v t])))) 131 | 132 | (defn facts 133 | "Return an ordered collection of facts held by the supplied state." 134 | [state] 135 | (->> (:snapshot state) 136 | (sort-by (fn [[_ [_ n]]] n)) 137 | (map (fn [[[e a v] [t _]]] [e a v t])))) 138 | 139 | (defintent -valid? 140 | "An intention to determine whether a transition is valid for a particular 141 | state. Dispatches off the transition op and the aspect. Combines results of 142 | inherited keys with logical AND." 143 | {:arglists '([state transition])} 144 | :dispatch transition-key 145 | :combine #(and %1 %2)) 146 | 147 | (defconduct -valid? :default [_ _] false) 148 | 149 | (defconduct -valid? [:assert :ittyon/live?] [_ [o e a v t]] 150 | (and (uuid? e) (integer? t) (true? v))) 151 | 152 | (defconduct -valid? [:assert :ittyon/aspect] [s [o e a v t]] 153 | (and (uuid? e) (some? v) (integer? t) (-> s :index :eavt (get e) :ittyon/live?))) 154 | 155 | (defconduct -valid? [:assert :ittyon/ref] [s [o e a v t]] 156 | (-> s :index :eavt (get v))) 157 | 158 | (defconduct -valid? [:revoke :ittyon/live?] [_ [o e a v t]] 159 | (integer? t)) 160 | 161 | (defconduct -valid? [:revoke :ittyon/aspect] [_ [o e a v t]] 162 | (integer? t)) 163 | 164 | (defintent -react 165 | "An intention that returns an ordered collection of reaction transitions, 166 | given a state and a valid transition that is going to be applied to that 167 | state. Dispatches off the transition op and the aspect. Concatenates the 168 | results of inherited keys." 169 | {:arglists '([state transition])} 170 | :dispatch transition-key 171 | :combine concat) 172 | 173 | (defconduct -react :default [_ _] '()) 174 | 175 | (defn- revoke-aspects [s e t] 176 | (for [[a vt] (-> s :index :eavt (get e)) 177 | [v _] vt 178 | :when (not= a :ittyon/live?)] 179 | [:revoke e a v t])) 180 | 181 | (defn- revoke-refs [s v t] 182 | (for [a (cons :ittyon/ref (descendants :ittyon/ref)) 183 | [e _] (-> s :index :avet (get a) (get v)) 184 | :when e] 185 | [:revoke e a v t])) 186 | 187 | (defconduct -react [:revoke :ittyon/live?] [s [o e a v t]] 188 | (concat (revoke-aspects s e t) 189 | (revoke-refs s e t))) 190 | 191 | (defconduct -react [:revoke :ittyon/aspect] [s [o e a v t]] 192 | (if (nil? v) 193 | (for [v* (-> s :index :eavt (get e) (get a) keys)] 194 | [:revoke e a v* t]))) 195 | 196 | (defconduct -react [:assert :ittyon/singular] [s [o e a v t]] 197 | (for [v* (keys (-> s :index :eavt (get e) (get a))) :when (not= v v*)] 198 | [:revoke e a v* t])) 199 | 200 | (defn transition? 201 | "Return true if x is a transition. A transition is a vector of five values: 202 | operation, entity, aspect, value and time. These are commonly abbreviated to 203 | `[o e a v t]`. The operation, o, is either `:assert` or `:revoke`. The aspect, 204 | a, must be a keyword." 205 | [x] 206 | (and (sequential? x) 207 | (= (count x) 5) 208 | (let [[o e a v t] x] 209 | (and (#{:assert :revoke} o) (keyword? a))))) 210 | 211 | (defn valid? 212 | "Return true if the transition is a valid transition for the given state. 213 | Extend using the [[-valid?]] intention." 214 | [state transition] 215 | (and (transition? transition) (-valid? state transition))) 216 | 217 | (defn react 218 | "Return a seq of reaction transitions, or nil, for a given state and 219 | transition. Extend using the [[-react]] intention." 220 | [state transition] 221 | (seq (-react state transition))) 222 | 223 | (defn commit 224 | "Takes a state and a transition, and if the transition is valid, returns 225 | a new state with the transition and any reactions applied. If the transition 226 | is not valid for the state, an ExceptionInfo is thrown with the failing 227 | transition and state as keys. A transducer for transforming the reactions 228 | of the transition may be supplied as an optional third argument." 229 | ([state transition] 230 | (commit state transition identity)) 231 | ([state transition xform] 232 | (if (valid? state transition) 233 | (transduce xform 234 | (completing #(commit %1 %2 xform)) 235 | (update state transition) 236 | (react state transition)) 237 | (throw (ex-info "Invalid transition for state" 238 | {:state state 239 | :transition transition}))))) 240 | 241 | (defn- tick-aspects [conducts] 242 | (into #{} 243 | (comp (filter vector?) (keep (fn [[o a]] (if (= o :tick) a)))) 244 | (keys conducts))) 245 | 246 | (defn- tick-reactor [state time aspects] 247 | (fn [[[e a _] _]] (if (aspects a) (react state [:tick e a time])))) 248 | 249 | (defn tick 250 | "Update a state by moving the clock forward to a new time. This may generate 251 | reactions that alter the state." 252 | [state time] 253 | (let [aspects (tick-aspects (int/conducts -react)) 254 | xform (mapcat (tick-reactor state time aspects))] 255 | (-> (transduce xform (completing commit) state (:snapshot state)) 256 | (assoc :last-tick time)))) 257 | 258 | (defn transact 259 | "Takes a state and an ordered collection of transitions, and returns a new 260 | state with the transitions committed in order. Also adds a `:last-transact` 261 | key to the resulting state that contains the committed transitions. If any 262 | of the transitions fail, an ExceptionInfo is thrown. A transducer for 263 | transforming the reactions of each transition may be supplied as an optional 264 | third argument." 265 | ([state transitions] 266 | (transact state transitions identity)) 267 | ([state transitions xform] 268 | (-> (reduce #(commit %1 %2 xform) (prune state) transitions) 269 | (assoc :last-transact transitions)))) 270 | -------------------------------------------------------------------------------- /src/ittyon/server.cljc: -------------------------------------------------------------------------------- 1 | (ns ittyon.server 2 | "A server that keeps the state of its clients in sync with one another." 3 | #?(:cljs (:require-macros [cljs.core.async.macros :refer [go go-loop]])) 4 | (:require #?(:clj [clojure.core.async :as a :refer [go go-loop !]] 5 | :cljs [cljs.core.async :as a :refer [!]]) 6 | [ittyon.core :as i] 7 | [ittyon.client :as ic] 8 | [medley.core :refer [deref-reset!]])) 9 | 10 | (defn server 11 | "Create a new server with the supplied initial state." 12 | [init-state] 13 | {:state (atom init-state) 14 | :sockets (atom #{}) 15 | :ping-delay 10000 16 | :logger println}) 17 | 18 | (defn shutdown! 19 | "Shutdown the supplied server and atomically close all open sockets." 20 | [server] 21 | (doseq [sock (deref-reset! (:sockets server) nil)] 22 | (a/close! (:in sock)) 23 | (a/close! (:out sock)))) 24 | 25 | (defn ^:no-doc broadcast! [server socket message] 26 | (doseq [sock @(:sockets server) :when (not= sock socket)] 27 | (a/put! (:out sock) message))) 28 | 29 | (defn- transact! [server transitions] 30 | (ic/log-exceptions server #(swap! (:state server) i/transact transitions))) 31 | 32 | (defmulti ^:no-doc receive! 33 | (fn [server socket event] (first event))) 34 | 35 | (defmethod receive! :default [_ _ _] nil) 36 | 37 | (defmethod receive! :transact [server socket [_ transitions]] 38 | (when-let [state (transact! server transitions)] 39 | (let [impure (filter (comp :impure meta) (reverse (:log state)))] 40 | (when (seq impure) 41 | (a/put! (:out socket) [:transact (vec impure)])) 42 | (when-let [trans (seq (concat transitions impure))] 43 | (broadcast! server socket [:transact (vec trans)]))))) 44 | 45 | (defn tick! 46 | "Move the clock forward on the server. This does not send anything to the 47 | clients." 48 | [server] 49 | (swap! (:state server) i/tick (i/time))) 50 | 51 | (defn- connect-event [client-id] 52 | [:transact [[:assert client-id :ittyon/live? true (i/time)] 53 | [:assert client-id :ittyon/connected? true (i/time)]]]) 54 | 55 | (defn- disconnect-event [client-id] 56 | [:transact [[:revoke client-id :ittyon/live? true (i/time)]]]) 57 | 58 | (defn- handshake-event [client-id init-state] 59 | [:init {:id client-id 60 | :time (i/time) 61 | :reset (i/facts init-state)}]) 62 | 63 | (defn accept! 64 | "Accept a new connection in the form of a socket, a map that contains `:in` 65 | and `:out` keys that hold the input and output channels. Used in conjuction 66 | with [[client/connect!]]." 67 | {:arglists '([server socket])} 68 | [{:keys [sockets state ping-delay] :as server} 69 | {:keys [in out] :as socket}] 70 | (when (swap! sockets #(some-> % (conj socket))) 71 | (let [client-id (i/uuid)] 72 | (go (receive! server socket (connect-event client-id)) 73 | (>! out (handshake-event client-id @state)) 74 | (loop [timer (a/timeout ping-delay)] 75 | (let [[val port] (a/alts! [in timer])] 76 | (if (identical? port in) 77 | (when val 78 | (receive! server socket val) 79 | (recur timer)) 80 | (do 81 | (>! out [:time (i/time)]) 82 | (recur (a/timeout ping-delay)))))) 83 | (receive! server socket (disconnect-event client-id)) 84 | (swap! sockets disj socket) 85 | (a/close! in) 86 | (a/close! out))))) 87 | -------------------------------------------------------------------------------- /test/ittyon/client_server_test.cljc: -------------------------------------------------------------------------------- 1 | (ns ittyon.client-server-test 2 | #?(:cljs (:require-macros [cljs.core.async.macros :refer [go]])) 3 | (:require #?(:clj [clojure.test :refer :all] 4 | :cljs [cljs.test :as t :refer-macros [is deftest testing async]]) 5 | #?(:clj [clojure.core.async :as a :refer [go ! !!]] 6 | :cljs [cljs.core.async :as a :refer [!]]) 7 | #?(:clj [intentions.core :refer [defconduct]] 8 | :cljs [intentions.core :refer-macros [defconduct]]) 9 | [clojure.set :as set] 10 | [ittyon.core :as i] 11 | [ittyon.client :as client] 12 | [ittyon.server :as server])) 13 | 14 | (i/derive ::name :ittyon/aspect :ittyon/singular) 15 | (i/derive ::email :ittyon/aspect :ittyon/singular) 16 | (i/derive ::clock :ittyon/aspect :ittyon/singular) 17 | (i/derive ::selected? :ittyon/aspect :ittyon/singular) 18 | 19 | (def entity (i/uuid)) 20 | 21 | (def init-state 22 | (i/state [[entity :ittyon/live? true (i/time)] 23 | [entity ::name "alice" (i/time)] 24 | [entity ::email "alice@example.com" (i/time)] 25 | [entity ::clock 0 (i/time)]])) 26 | 27 | (defn connect-client! [server] 28 | (let [a-ch (a/chan) 29 | b-ch (a/chan) 30 | client (client/connect! {:in a-ch :out b-ch})] 31 | (server/accept! server {:in b-ch :out a-ch}) 32 | client)) 33 | 34 | (deftest test-async 35 | #?(:clj 36 | (let [server (server/server init-state) 37 | client ( client :state deref :snapshot keys set (disj local-fact)) 45 | (-> server :state deref :snapshot keys set)))) 46 | 47 | (testing "connected client stored in state" 48 | (let [facts (-> server :state deref :snapshot keys set)] 49 | (is (contains? facts [(:id client) :ittyon/live? true])) 50 | (is (contains? facts [(:id client) :ittyon/connected? true])))) 51 | 52 | (testing "client has locality" 53 | (let [facts (-> client :state deref :snapshot keys set)] 54 | (is (contains? facts [(:id client) :ittyon/local? true])))) 55 | 56 | (testing "client events relayed to server" 57 | (client/transact! client [[:assert entity ::name "bob"] 58 | [:assert entity ::email "bob@example.com"]]) 59 | (Thread/sleep 25) 60 | (is (= (-> client :state deref :snapshot keys set (disj local-fact)) 61 | (-> server :state deref :snapshot keys set) 62 | #{[(:id client) :ittyon/live? true] 63 | [(:id client) :ittyon/connected? true] 64 | [entity :ittyon/live? true] 65 | [entity ::name "bob"] 66 | [entity ::email "bob@example.com"] 67 | [entity ::clock 0]}))) 68 | 69 | (testing "local events not relayed to server" 70 | (client/transact! client [^:local [:assert entity ::selected? true]]) 71 | (Thread/sleep 25) 72 | (is (= (set/difference 73 | (-> client :state deref :snapshot keys set (disj local-fact)) 74 | (-> server :state deref :snapshot keys set)) 75 | #{[entity ::selected? true]}))) 76 | 77 | (testing "manual transition times" 78 | (reset! (:time-offset client) 0) 79 | (client/transact! client [[:assert entity ::clock 1 1234567890]]) 80 | (Thread/sleep 25) 81 | (is (= (-> client :state deref :snapshot (get [entity ::clock 1]) first) 82 | 1234567890)))) 83 | 84 | :cljs 85 | (async done 86 | (go (let [server (server/server init-state) 87 | client ( client :state deref :snapshot keys set (disj local-fact)) 95 | (-> server :state deref :snapshot keys set)))) 96 | 97 | (testing "connected client stored in state" 98 | (let [facts (-> server :state deref :snapshot keys set)] 99 | (is (contains? facts [(:id client) :ittyon/live? true])) 100 | (is (contains? facts [(:id client) :ittyon/connected? true])))) 101 | 102 | (testing "client has locality" 103 | (let [facts (-> client :state deref :snapshot keys set)] 104 | (is (contains? facts [(:id client) :ittyon/local? true])))) 105 | 106 | (testing "client events relayed to server" 107 | (client/transact! client [[:assert entity ::name "bob"] 108 | [:assert entity ::email "bob@example.com"]]) 109 | ( client :state deref :snapshot keys set (disj local-fact)) 111 | (-> server :state deref :snapshot keys set) 112 | #{[(:id client) :ittyon/live? true] 113 | [(:id client) :ittyon/connected? true] 114 | [entity :ittyon/live? true] 115 | [entity ::name "bob"] 116 | [entity ::email "bob@example.com"] 117 | [entity ::clock 0]}))) 118 | 119 | (testing "local events not relayed to server" 120 | ;; go loops in cljs.core.async erroneously eat bare metadata. 121 | ;; Until this bug is fixed, we need to use with-meta instead. 122 | (client/transact! client [(with-meta 123 | [:assert entity ::selected? true] 124 | {:local true})]) 125 | ( client :state deref :snapshot keys set (disj local-fact)) 128 | (-> server :state deref :snapshot keys set)) 129 | #{[entity ::selected? true]}))) 130 | 131 | (testing "manual transition times" 132 | (reset! (:time-offset client) 0) 133 | (client/transact! client [[:assert entity ::clock 1 1234567890]]) 134 | ( client :state deref :snapshot (get [entity ::clock 1]) first) 136 | 1234567890))) 137 | 138 | (done)))))) 139 | 140 | (deftest test-ping 141 | #?(:clj 142 | (do (testing "client" 143 | (let [ch (a/chan) 144 | client (client/connect! {:in ch, :out ch})] 145 | (>!! ch [:init {:id (i/uuid) :time (i/time) :reset #{}}]) 146 | (let [time-offset (:time-offset (!! ch [:time (+ (i/time) 1000)]) 150 | (Thread/sleep 25) 151 | (is (<= -1000 @time-offset -975)) 152 | 153 | (>!! ch [:time (- (i/time) 1000)]) 154 | (Thread/sleep 25) 155 | (is (<= 1000 @time-offset 1025))))) 156 | 157 | (testing "server" 158 | (let [server (-> (server/server init-state) 159 | (assoc :ping-delay 25)) 160 | ch (a/chan)] 161 | (server/accept! server {:in ch, :out ch}) 162 | (is (= (first (! ch [:init {:id (i/uuid) :time (i/time) :reset #{}}]) 174 | (let [time-offset (:time-offset (! ch [:time (+ (i/time) 1000)]) 178 | (! ch [:time (- (i/time) 1000)]) 182 | ( (server/server init-state) 187 | (assoc :ping-delay 25)) 188 | ch (a/chan)] 189 | (server/accept! server {:in ch, :out ch}) 190 | (is (= (first ( server :state deref :snapshot keys set)] 213 | (is (not (contains? facts [dead-entity ::name "invalid"]))))))) 214 | 215 | :cljs 216 | (async done 217 | (go 218 | (let [server (server/server init-state) 219 | client ( server :state deref :snapshot keys set)] 233 | (is (not (contains? facts [invalid-entity ::name "invalid"])))))) 234 | 235 | (done)))))) 236 | 237 | (i/derive ::hire :ittyon/aspect :ittyon/singular) 238 | (i/derive ::employee :ittyon/aspect :ittyon/singular :ittyon/ref) 239 | 240 | (defconduct i/-react [:assert ::hire] [s [_ e a v t]] 241 | (let [e' (i/uuid)] 242 | [^:impure [:assert e' :ittyon/live? true t] 243 | ^:impure [:assert e' ::name v t] 244 | ^:impure [:assert e ::employee e' t]])) 245 | 246 | (defn- get-employee [s e] 247 | (let [id (-> s (get-in [:index :eavt e ::employee]) keys first) 248 | name (-> s (get-in [:index :eavt id ::name]) keys first)] 249 | {:id id, :name name})) 250 | 251 | (deftest test-impure 252 | #?(:clj 253 | (let [server (server/server init-state) 254 | client1 ( server :state deref (get-employee entity))] 264 | (is (i/uuid? (:id employee))) 265 | (is (= (:name employee) "bob"))) 266 | 267 | (is (= (-> server :state deref :snapshot keys set) 268 | (-> client1 :state deref :snapshot keys set (disj local-fact1)) 269 | (-> client2 :state deref :snapshot keys set (disj local-fact2)))) 270 | 271 | (is (contains? (-> client1 :state deref :snapshot keys set) local-fact1)) 272 | (is (contains? (-> client2 :state deref :snapshot keys set) local-fact2))) 273 | 274 | :cljs 275 | (async done 276 | (go (let [server (server/server init-state) 277 | client1 ( server :state deref (get-employee entity))] 287 | (is (i/uuid? (:id employee))) 288 | (is (= (:name employee) "bob"))) 289 | 290 | (is (= (-> server :state deref :snapshot keys set) 291 | (-> client1 :state deref :snapshot keys set (disj local-fact1)) 292 | (-> client2 :state deref :snapshot keys set (disj local-fact2)))) 293 | 294 | (is (contains? (-> client1 :state deref :snapshot keys set) local-fact1)) 295 | (is (contains? (-> client2 :state deref :snapshot keys set) local-fact2)) 296 | (done)))))) 297 | -------------------------------------------------------------------------------- /test/ittyon/core_test.cljc: -------------------------------------------------------------------------------- 1 | (ns ittyon.core-test 2 | (:require #?(:clj [clojure.test :refer :all] 3 | :cljs [cljs.test :as t :refer-macros [is deftest testing async]]) 4 | #?(:clj [intentions.core :refer [defconduct]] 5 | :cljs [intentions.core :refer-macros [defconduct]]) 6 | [ittyon.core :as i])) 7 | 8 | (deftest test-time 9 | (is (= (integer? (i/time))))) 10 | 11 | (deftest test-uuid 12 | (is (i/uuid? (i/uuid))) 13 | (is (not= (i/uuid) (i/uuid)))) 14 | 15 | (deftest test-derive 16 | (is (= (i/derive (make-hierarchy) ::a ::b ::c) 17 | (-> (make-hierarchy) 18 | (derive ::a ::b) 19 | (derive ::a ::c))))) 20 | 21 | (deftest test-periodically 22 | #?(:clj 23 | (let [counter (atom 0) 24 | stop (i/periodically 100 #(swap! counter inc))] 25 | (Thread/sleep 30) 26 | (is (>= @counter 2)) 27 | (stop)) 28 | 29 | :cljs 30 | (async done 31 | (let [counter (atom 0) 32 | stop (i/periodically 100 #(swap! counter inc))] 33 | (js/setTimeout (fn [] 34 | (is (>= @counter 2)) 35 | (stop) 36 | (done)) 37 | 30))))) 38 | 39 | (derive ::a :ittyon/aspect) 40 | 41 | (def eavt-state 42 | {:snapshot {[:e ::a :v] [:t 0]} 43 | :log '([:assert :e ::a :v :t]) 44 | :count 1 45 | :index {:eavt {:e {::a {:v :t}}} 46 | :aevt {::a {:e {:v :t}}} 47 | :avet {::a {:v {:e :t}}}}}) 48 | 49 | (deftest test-state 50 | (testing "empty" 51 | (is (= (i/state) {:snapshot {}, :log (), :index {}, :count 0}))) 52 | (testing "not empty" 53 | (is (= (i/state #{[:e ::a :v :t]}) eavt-state)))) 54 | 55 | (deftest test-update 56 | (testing "assert" 57 | (is (= (i/update (i/state) [:assert :e ::a :v :t]) eavt-state))) 58 | (testing "revoke" 59 | (is (= (i/update eavt-state [:revoke :e ::a :v :t]) 60 | {:snapshot {} 61 | :log '([:revoke :e ::a :v :t] [:assert :e ::a :v :t]) 62 | :index {} 63 | :count 2})))) 64 | 65 | (deftest test-facts 66 | (is (= (i/facts eavt-state) 67 | [[:e ::a :v :t]])) 68 | (is (= (i/facts (i/update eavt-state [:assert :f ::a :v :t])) 69 | [[:e ::a :v :t] [:f ::a :v :t]]))) 70 | 71 | (deftest test-transition? 72 | (is (not (i/transition? nil))) 73 | (is (not (i/transition? [:o :e ::a :v :t]))) 74 | (is (not (i/transition? [:assert :e "a" :v :t]))) 75 | (is (not (i/transition? [:assert :e ::a :v]))) 76 | (is (i/transition? [:assert :e ::a :v :t])) 77 | (is (i/transition? [:assert :e ::a :v :t]))) 78 | 79 | (deftest test-valid? 80 | (let [entity (i/uuid) 81 | time (i/time) 82 | state (i/state)] 83 | (i/derive ::name :ittyon/aspect :ittyon/singular) 84 | (is (not (i/valid? state [:assert entity ::name "alice" time]))) 85 | (is (not (i/valid? state [:assert entity :ittyon/live? false time]))) 86 | (is (i/valid? state [:assert entity :ittyon/live? true time])))) 87 | 88 | (i/derive ::toggle :ittyon/aspect :ittyon/singular) 89 | 90 | (defconduct i/-react [:assert ::toggle] [s [_ e a v t]] 91 | (if (get-in s [:index :eavt e a v]) 92 | [[:revoke e a v t]])) 93 | 94 | (deftest test-react 95 | (i/derive ::name :ittyon/aspect :ittyon/singular) 96 | (let [entity (i/uuid) 97 | time (i/time) 98 | state (i/state #{[entity :ittyon/live? true time] 99 | [entity ::name "alice" time]})] 100 | (testing "singular" 101 | (is (= (i/react state [:assert entity ::name "bob" time]) 102 | [[:revoke entity ::name "alice" time]]))) 103 | (testing "live?" 104 | (is (= (i/react state [:revoke entity :ittyon/live? true time]) 105 | [[:revoke entity ::name "alice" time]]))) 106 | (testing "toggle" 107 | (let [transition [:assert entity ::toggle "foo" time]] 108 | (is (empty? (i/react state transition))) 109 | (is (= (i/react (i/update state transition) transition) 110 | [[:revoke entity ::toggle "foo" time]])))))) 111 | 112 | (i/derive ::dice :ittyon/aspect :ittyon/singular) 113 | (i/derive ::roll :ittyon/aspect :ittyon/singular) 114 | 115 | (defconduct i/-react [:assert ::dice] [s [_ e a v t]] 116 | [[:revoke e a v t] 117 | ^:impure [:assert e ::roll (rand-int v) t]]) 118 | 119 | (deftest test-commit 120 | (let [entity (i/uuid) 121 | time (i/time)] 122 | (i/derive ::name :ittyon/aspect :ittyon/singular) 123 | 124 | (testing "valid commit" 125 | (let [state (-> (i/state) 126 | (i/commit [:assert entity :ittyon/live? true time]) 127 | (i/commit [:assert entity ::name "alice" time]) 128 | (i/commit [:assert entity ::name "bob" time]) 129 | (i/commit [:assert entity ::toggle "foo" time]) 130 | (i/commit [:assert entity ::toggle "foo" time]))] 131 | (is (= (:snapshot state) 132 | {[entity :ittyon/live? true] [time 0] 133 | [entity ::name "bob"] [time 2]})) 134 | (is (= (:log state) 135 | (list [:revoke entity ::toggle "foo" time] 136 | [:assert entity ::toggle "foo" time] 137 | [:assert entity ::toggle "foo" time] 138 | [:revoke entity ::name "alice" time] 139 | [:assert entity ::name "bob" time] 140 | [:assert entity ::name "alice" time] 141 | [:assert entity :ittyon/live? true time]))))) 142 | 143 | (testing "invalid commit" 144 | (is (thrown-with-msg? 145 | #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) 146 | #"Invalid transition for state" 147 | (i/commit (i/state) [:assert entity ::name "alice" time])))) 148 | 149 | (testing "commit with reaction transducer" 150 | (let [trans [:assert entity ::dice 1000 time] 151 | state (i/commit (i/state) [:assert entity :ittyon/live? true time])] 152 | (is (not= (:snapshot (i/commit state trans)) (:snapshot state))) 153 | (is (= (:snapshot (i/commit state trans (remove (comp :impure meta)))) 154 | (:snapshot state))))))) 155 | 156 | 157 | (i/derive ::clock :ittyon/aspect :ittyon/singular) 158 | 159 | (defconduct i/-react [:tick ::clock] [s [o e a t]] 160 | [[:assert e a t t]]) 161 | 162 | (deftest test-tick 163 | (testing "reactions" 164 | (let [entity (i/uuid) 165 | t0 (i/time) 166 | t1 (+ t0 1000) 167 | state (-> (i/state) 168 | (i/commit [:assert entity :ittyon/live? true t0]) 169 | (i/commit [:assert entity ::clock 0 t0]) 170 | (i/tick t1))] 171 | (is (= (:snapshot state) 172 | {[entity :ittyon/live? true] [t0 0] 173 | [entity ::clock t1] [t1 2]})))) 174 | 175 | (testing "last tick recorded" 176 | (is (= (-> (i/state) (i/tick 123456789) :last-tick) 177 | 123456789)))) 178 | 179 | (deftest test-refs 180 | (i/derive ::name :ittyon/aspect :ittyon/singular) 181 | (i/derive ::child :ittyon/aspect :ittyon/ref) 182 | (let [parent-id (i/uuid) 183 | child-id (i/uuid) 184 | time (i/time) 185 | state (-> (i/state) 186 | (i/commit [:assert parent-id :ittyon/live? true time]) 187 | (i/commit [:assert parent-id ::name "alice" time]) 188 | (i/commit [:assert child-id :ittyon/live? true time]) 189 | (i/commit [:assert child-id ::name "bob" time]) 190 | (i/commit [:assert parent-id ::child child-id time])) 191 | state* (-> state 192 | (i/commit [:revoke child-id :ittyon/live? true time]))] 193 | (is (get-in state [:snapshot [parent-id ::child child-id]])) 194 | (is (not (get-in state* [:snapshot [parent-id ::child child-id]]))))) 195 | 196 | (deftest test-revoke-aspect 197 | (i/derive ::job :ittyon/aspect) 198 | (let [entity (i/uuid) 199 | time (i/time) 200 | state (-> (i/state) 201 | (i/commit [:assert entity :ittyon/live? true time]) 202 | (i/commit [:assert entity ::job "barber" time]) 203 | (i/commit [:assert entity ::job "surgeon" time])) 204 | state* (-> state 205 | (i/commit [:revoke entity ::job nil time]))] 206 | (is (= (-> state :index :eavt (get entity) ::job keys set) #{"barber" "surgeon"})) 207 | (is (-> state* :index :eavt (get entity) ::job keys empty?)))) 208 | 209 | (deftest test-transact 210 | (i/derive ::name :ittyon/aspect :ittyon/singular) 211 | (let [entity (i/uuid) 212 | time (i/time) 213 | trans [[:assert entity :ittyon/live? true time] 214 | [:assert entity ::name "alice" time]] 215 | state (i/transact (i/state) trans) 216 | state' (i/transact state [[:assert entity ::name "bob" time]])] 217 | (is (= (:snapshot state) 218 | {[entity :ittyon/live? true] [time 0] 219 | [entity ::name "alice"] [time 1]})) 220 | (is (= (:last-transact state) trans)) 221 | (is (= (:log state) (reverse trans))) 222 | (is (= (:last-transact state') [[:assert entity ::name "bob" time]])) 223 | (is (= (:log state') 224 | (list [:revoke entity ::name "alice" time] 225 | [:assert entity ::name "bob" time]))))) 226 | -------------------------------------------------------------------------------- /test/ittyon/test_runner.cljs: -------------------------------------------------------------------------------- 1 | (ns ittyon.test-runner 2 | (:require [doo.runner :refer-macros [doo-tests]] 3 | ittyon.client-server-test 4 | ittyon.core-test)) 5 | 6 | (doo-tests 'ittyon.client-server-test 7 | 'ittyon.core-test) 8 | --------------------------------------------------------------------------------