├── .gitignore ├── README.md ├── core ├── README.md ├── pom.xml ├── project.clj └── src │ └── com │ └── jayway │ └── rps │ ├── core.clj │ ├── facebook.clj │ └── web.clj ├── datomic ├── .lein-env.template ├── README.md ├── project.clj ├── resources │ └── schema.dtm ├── src │ └── com │ │ └── jayway │ │ └── rps │ │ └── datomic │ │ ├── domain.clj │ │ ├── framework.clj │ │ ├── main.clj │ │ └── web.clj └── test │ └── com │ └── jayway │ └── rps │ └── datomic │ └── test │ └── functional.clj └── eventstore ├── .lein-env.template ├── README.md ├── project.clj ├── resources └── projections │ ├── gameStats.js │ ├── games.js │ └── opengames.js └── src └── com └── jayway └── rps ├── atom.clj ├── domain.clj ├── eventstore └── web.clj ├── framework.clj └── main.clj /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | lib 3 | classes 4 | .lein-deps-sum 5 | */bin 6 | .lein-repl-history 7 | .lein-env 8 | .classpath 9 | .nrepl-port 10 | .project 11 | */target 12 | .lein-failures -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # rock-paper-scissors 2 | 3 | Implementation of the game Rock Paper Scissors in clojure using various data stores. To get started: 4 | 5 | * Create a [Facebook application](https://developers.facebook.com/apps/). Needed for user authentication. To disable authentication have a look at [wrap-mock-login in web.clj](https://github.com/jankronquist/rock-paper-scissors-in-clojure/blob/master/core/src/com/jayway/rps/web.clj). 6 | * Install [rock-paper-scissors-core](https://github.com/jankronquist/rock-paper-scissors-in-clojure/tree/master/core) 7 | 8 | Checkout the different implementations: 9 | 10 | * [eventstore](https://github.com/jankronquist/rock-paper-scissors-in-clojure/tree/master/eventstore) 11 | * [datomic](https://github.com/jankronquist/rock-paper-scissors-in-clojure/tree/master/datomic) 12 | 13 | ## License 14 | 15 | Copyright © 2013 Jan Kronquist 16 | 17 | Distributed under the Eclipse Public License, the same as Clojure. 18 | -------------------------------------------------------------------------------- /core/README.md: -------------------------------------------------------------------------------- 1 | To install: 2 | 3 | lein install -------------------------------------------------------------------------------- /core/pom.xml: -------------------------------------------------------------------------------- 1 | 2 | 4.0.0 3 | rock-paper-scissors-core 4 | rock-paper-scissors-core 5 | jar 6 | 1.0.0-SNAPSHOT 7 | rock-paper-scissors-core 8 | The game rock-paper-scissors 9 | 10 | src 11 | test 12 | 13 | 14 | resources 15 | 16 | 17 | 18 | 19 | dev-resources 20 | 21 | 22 | resources 23 | 24 | 25 | target 26 | target/classes 27 | 28 | 29 | 30 | 31 | central 32 | http://repo1.maven.org/maven2/ 33 | 34 | false 35 | 36 | 37 | true 38 | 39 | 40 | 41 | clojars 42 | https://clojars.org/repo/ 43 | 44 | true 45 | 46 | 47 | true 48 | 49 | 50 | 51 | 52 | 53 | org.clojure 54 | clojure 55 | 1.5.0 56 | 57 | 58 | clj-http 59 | clj-http 60 | 0.7.7 61 | 62 | 63 | compojure 64 | compojure 65 | 1.1.6 66 | 67 | 68 | environ 69 | environ 70 | 0.4.0 71 | 72 | 73 | hiccup 74 | hiccup 75 | 1.0.4 76 | 77 | 78 | org.clojure 79 | tools.nrepl 80 | 0.2.3 81 | 82 | 83 | org.clojure 84 | clojure 85 | 86 | 87 | test 88 | 89 | 90 | clojure-complete 91 | clojure-complete 92 | 0.2.3 93 | 94 | 95 | org.clojure 96 | clojure 97 | 98 | 99 | test 100 | 101 | 102 | javax.servlet 103 | servlet-api 104 | 2.5 105 | test 106 | 107 | 108 | ring-mock 109 | ring-mock 110 | 0.1.5 111 | test 112 | 113 | 114 | 115 | 116 | 120 | -------------------------------------------------------------------------------- /core/project.clj: -------------------------------------------------------------------------------- 1 | (defproject rock-paper-scissors-core "1.0.0-SNAPSHOT" 2 | :description "The game rock-paper-scissors" 3 | :dependencies [[org.clojure/clojure "1.5.0"] 4 | [clj-http "0.7.7"] 5 | [compojure "1.1.6"] 6 | [environ "0.4.0"] 7 | [hiccup "1.0.4"]] 8 | :plugins [[lein-ring "0.8.8"]] 9 | :ring {:handler com.jayway.rps.web/app} 10 | :min-lein-version "2.0.0" 11 | :aot :all 12 | :profiles 13 | {:dev {:dependencies [[javax.servlet/servlet-api "2.5"] 14 | [ring-mock "0.1.5"]]}}) -------------------------------------------------------------------------------- /core/src/com/jayway/rps/core.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.core) 2 | 3 | (defprotocol RockPaperScissors 4 | (create-game [this player-name]) 5 | (make-move [this game-id player-name move]) 6 | (load-game [this game-id]) 7 | (load-open-games [this])) 8 | 9 | (defrecord CreateGameCommand [aggregate-id player move]) 10 | (defrecord OnlyCreateGameCommand [aggregate-id player]) 11 | (defrecord DecideMoveCommand [aggregate-id player move]) 12 | -------------------------------------------------------------------------------- /core/src/com/jayway/rps/facebook.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.facebook 2 | (:use [compojure.core] 3 | [environ.core]) 4 | (:require [compojure.route :as route] 5 | [clj-http.client :as client])) 6 | 7 | (def facebook-oauth2 8 | {:authorization-uri "https://www.facebook.com/dialog/oauth" 9 | :access-token-uri "https://graph.facebook.com/oauth/access_token" 10 | :redirect-uri (env :facebook-redirect-uri) 11 | :client-id (env :facebook-client-id) 12 | :client-secret (env :facebook-client-secret) 13 | :access-query-param :access_token 14 | :scope ["email"] 15 | :grant-type "authorization_code"}) 16 | 17 | (defn facebook-redirect [] 18 | (ring.util.response/redirect (str (:authorization-uri facebook-oauth2) 19 | "?client_id=" (:client-id facebook-oauth2) 20 | "&redirect_uri=" (:redirect-uri facebook-oauth2)))) 21 | 22 | (defn parse-token-reply [reply] 23 | (reduce (fn [m arg] (let [spl (.split arg "=")] (assoc m (keyword (nth spl 0)) (nth spl 1)))) {} (.split reply "&"))) 24 | 25 | (defn facebook-get-token [code] 26 | (parse-token-reply (:body (client/get (:access-token-uri facebook-oauth2) 27 | {:query-params {:client_id (:client-id facebook-oauth2) 28 | :redirect_uri (:redirect-uri facebook-oauth2) 29 | :client_secret (:client-secret facebook-oauth2) 30 | :code code}})))) 31 | 32 | (defn facebook-get-me [access_token] 33 | (:body (client/get "https://graph.facebook.com/me" {:as :json 34 | :query-params 35 | {:format "json" 36 | :access_token access_token}}))) 37 | (defn facebook-callback [code request] 38 | (let [access_token (facebook-get-token code)] 39 | (assoc (ring.util.response/redirect "/") 40 | :session {:me (facebook-get-me (:access_token access_token)) 41 | :access_token access_token}))) 42 | 43 | (defroutes callback-handler 44 | (GET "/oauth2-callback" [code :as r] (facebook-callback code r)) 45 | (fn [request] (facebook-redirect))) 46 | 47 | (defn wrap-require-facebook-login [handler] 48 | (fn [request] 49 | (if (get-in request [:session :me]) 50 | (handler request) 51 | (callback-handler request)))) 52 | -------------------------------------------------------------------------------- /core/src/com/jayway/rps/web.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.web 2 | (:use [compojure.core] 3 | [environ.core] 4 | [ring.middleware.session] 5 | [ring.middleware.keyword-params] 6 | [ring.middleware.params] 7 | [hiccup.core] 8 | [com.jayway.rps.facebook]) 9 | (:require [compojure.route :as route] 10 | [com.jayway.rps.core :as c])) 11 | 12 | (defn get-user [request] 13 | (get-in request [:session :me :name])) 14 | 15 | (defn render-move-form 16 | ([] 17 | (render-move-form "/games" "Create game")) 18 | ([game-id] 19 | (render-move-form (str "/games/" game-id) "Make move")) 20 | ([uri button-text] 21 | [:form {:action uri :method "post"} 22 | [:select {:name "move"} 23 | [:option {:value "rock"} "Rock"] 24 | [:option {:value "paper"} "Paper"] 25 | [:option {:value "scissors"} "Scissors"]] 26 | [:input {:type "submit" :value button-text}]])) 27 | 28 | (defn render-create-game-form 29 | [] 30 | [:form {:action "/games" :method "post"} 31 | [:input {:type "submit" :value "Create game"}]]) 32 | 33 | (defn render-open-games 34 | [games] 35 | [:ul 36 | (map 37 | (fn [[game-id creator]] 38 | [:li [:a {:href (str "/games/" game-id)} (str game-id " " creator)]]) 39 | games)]) 40 | 41 | (defn render-moves [moves] 42 | [:ul (map (fn [[player move]] [:li (str (name player) " moved " move)]) moves)]) 43 | 44 | (defn render-game [rps game-id player-name] 45 | (let [game (c/load-game rps game-id)] 46 | (html [:body 47 | [:p (str "Created by " (:creator game))] 48 | (condp = (:state game) 49 | "open" (if-not (get-in game [:moves (keyword player-name)]) 50 | (render-move-form game-id) 51 | [:p "Waiting..."]) 52 | "won" [:div [:p (str "The winner is " (:winner game))] (render-moves (:moves game))] 53 | "tied" [:div [:p "Tie!"] (render-moves (:moves game))] 54 | "???")]))) 55 | 56 | (defn create-handler [rps] 57 | (routes 58 | (GET "/" [] (html [:body (render-create-game-form)])) 59 | (GET "/games" [] (html [:body 60 | (render-create-game-form) 61 | (render-open-games (c/load-open-games rps))])) 62 | (POST "/games" [:as r] 63 | (let [game-id (c/create-game rps (get-user r))] 64 | (ring.util.response/redirect-after-post (str "/games/" game-id)))) 65 | (POST "/games/:game-id" [game-id move :as r] 66 | (c/make-move rps game-id (get-user r) move) 67 | (ring.util.response/redirect-after-post (str "/games/" game-id))) 68 | (GET "/games/:game-id" [game-id :as r] (render-game rps game-id (get-user r))) 69 | (route/not-found "

Page not found

"))) 70 | 71 | (defn wrap-log [handler level] 72 | (fn [request] 73 | (println "REQUEST " level " : " request) 74 | (let [response (handler request)] 75 | (println "RESPONSE " level " : " response) 76 | response))) 77 | 78 | (defn wrap-mock-login [handler] 79 | (fn [request] 80 | (handler (assoc request :session {:me {:name "Jan"}})))) 81 | 82 | (defn create-app [implementation] 83 | (-> (create-handler implementation) 84 | ; wrap-mock-login 85 | wrap-require-facebook-login 86 | wrap-session 87 | wrap-keyword-params 88 | wrap-params)) 89 | 90 | ;(defn -main [& args] 91 | ; (let [game-id (c/create-game rps "player-1")] 92 | ; (c/make-move rps game-id "player-1" "rock") 93 | ; (c/make-move rps game-id "player-2" "scissors"))) 94 | -------------------------------------------------------------------------------- /datomic/.lein-env.template: -------------------------------------------------------------------------------- 1 | {:facebook-redirect-uri "http://localhost:3000/oauth2-callback" 2 | :facebook-client-id "YOUR FACEBOOK APP ID" 3 | :facebook-client-secret "THE SECRET" 4 | :datomic-url "datomic:mem://rps"} 5 | -------------------------------------------------------------------------------- /datomic/README.md: -------------------------------------------------------------------------------- 1 | An exploration of how to implement rock-paper-scissors using Commands and Aggregates with [Datomic](http://www.datomic.com/). 2 | 3 | # Usage 4 | 5 | * Create a file `.lein-env` based on provided template `.lein-env.template`. 6 | * Install [rock-paper-scissors-core](https://github.com/jankronquist/rock-paper-scissors-in-clojure/tree/master/core) 7 | * Optionally install Datomic Free and Datomic Console to be able to browse the data. 8 | 9 | Run using: 10 | 11 | lein clean 12 | lein ring server 13 | -------------------------------------------------------------------------------- /datomic/project.clj: -------------------------------------------------------------------------------- 1 | (defproject rock-paper-scissors-datomic "0.1.0-SNAPSHOT" 2 | :description "The game rock-paper-scissors implemented using Datomic" 3 | :url "https://github.com/jankronquist/rock-paper-scissors-with-datomic" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.5.1"] 7 | [com.datomic/datomic-free "0.9.4331"] 8 | [rock-paper-scissors-core "1.0.0-SNAPSHOT"]] 9 | :main com.jayway.rps.datomic.main 10 | :plugins [[lein-ring "0.8.8"]] 11 | :ring {:handler com.jayway.rps.datomic.web/app} 12 | :profiles {:dev {:dependencies [[javax.servlet/servlet-api "2.5"] 13 | [ring-mock "0.1.5"]]}}) 14 | -------------------------------------------------------------------------------- /datomic/resources/schema.dtm: -------------------------------------------------------------------------------- 1 | [ 2 | 3 | ;; framework aggregate 4 | 5 | {:db/id #db/id[:db.part/db] 6 | :db/ident :aggregate/version 7 | :db/valueType :db.type/long 8 | :db/cardinality :db.cardinality/one 9 | :db.install/_attribute :db.part/db} 10 | 11 | ;; player 12 | 13 | {:db/id #db/id[:db.part/db] 14 | :db/ident :player/name 15 | :db/valueType :db.type/string 16 | :db/cardinality :db.cardinality/one 17 | :db.install/_attribute :db.part/db} 18 | 19 | ;; move 20 | 21 | {:db/id #db/id[:db.part/db] 22 | :db/ident :move/player 23 | :db/valueType :db.type/ref 24 | :db/cardinality :db.cardinality/one 25 | :db.install/_attribute :db.part/db} 26 | 27 | {:db/id #db/id[:db.part/db] 28 | :db/ident :move/type 29 | :db/valueType :db.type/ref 30 | :db/cardinality :db.cardinality/one 31 | :db.install/_attribute :db.part/db} 32 | 33 | ;; move-type enum values 34 | [:db/add #db/id[:db.part/user] :db/ident :rock] 35 | [:db/add #db/id[:db.part/user] :db/ident :paper] 36 | [:db/add #db/id[:db.part/user] :db/ident :scissors] 37 | 38 | ;; game 39 | 40 | {:db/id #db/id[:db.part/db] 41 | :db/ident :game/state 42 | :db/valueType :db.type/ref 43 | :db/cardinality :db.cardinality/one 44 | :db.install/_attribute :db.part/db} 45 | 46 | {:db/id #db/id[:db.part/db] 47 | :db/ident :game/created-by 48 | :db/valueType :db.type/ref 49 | :db/cardinality :db.cardinality/one 50 | :db.install/_attribute :db.part/db} 51 | 52 | {:db/id #db/id[:db.part/db] 53 | :db/ident :game/player 54 | :db/valueType :db.type/ref 55 | :db/cardinality :db.cardinality/many 56 | :db.install/_attribute :db.part/db} 57 | 58 | {:db/id #db/id[:db.part/db] 59 | :db/ident :game/winner 60 | :db/valueType :db.type/ref 61 | :db/cardinality :db.cardinality/one 62 | :db.install/_attribute :db.part/db} 63 | 64 | {:db/id #db/id[:db.part/db] 65 | :db/ident :game/loser 66 | :db/valueType :db.type/ref 67 | :db/cardinality :db.cardinality/one 68 | :db.install/_attribute :db.part/db} 69 | 70 | {:db/id #db/id[:db.part/db] 71 | :db/ident :game/moves 72 | :db/valueType :db.type/ref 73 | :db/isComponent true 74 | :db/cardinality :db.cardinality/many 75 | :db.install/_attribute :db.part/db} 76 | 77 | ;; game-state enum values 78 | [:db/add #db/id[:db.part/user] :db/ident :game.state/started] 79 | [:db/add #db/id[:db.part/user] :db/ident :game.state/won] 80 | [:db/add #db/id[:db.part/user] :db/ident :game.state/tied] 81 | 82 | ] -------------------------------------------------------------------------------- /datomic/src/com/jayway/rps/datomic/domain.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.datomic.domain 2 | (:require [datomic.api :as datomic] 3 | [com.jayway.rps.datomic.framework :as f])) 4 | 5 | (defrecord SetPlayerNameCommand [aggregate-id name]) 6 | 7 | (defmulti compare-moves vector) 8 | (defmethod compare-moves [:rock :rock] [x y] :tie) 9 | (defmethod compare-moves [:rock :paper] [x y] :loss) 10 | (defmethod compare-moves [:rock :scissors] [x y] :victory) 11 | (defmethod compare-moves [:paper :rock] [x y] :victory) 12 | (defmethod compare-moves [:paper :paper] [x y] :tie) 13 | (defmethod compare-moves [:paper :scissors] [x y] :loss) 14 | (defmethod compare-moves [:scissors :rock] [x y] :loss) 15 | (defmethod compare-moves [:scissors :paper] [x y] :victory) 16 | (defmethod compare-moves [:scissors :scissors] [x y] :tie) 17 | 18 | (extend-protocol f/CommandHandler 19 | 20 | SetPlayerNameCommand 21 | (perform [command state] 22 | [{:db/id (:aggregate-id command) 23 | :player/name (:name command)}]) 24 | 25 | com.jayway.rps.core.CreateGameCommand 26 | (perform [{:keys [player move aggregate-id]} state] 27 | (when (:game/state state) 28 | (throw (ex-info "Already in started" {:state state}))) 29 | (let [move-id (datomic/tempid :db.part/user)] 30 | [{:db/id move-id 31 | :move/player player 32 | :move/type move} 33 | {:db/id aggregate-id 34 | :game/moves move-id 35 | :game/state :game.state/started 36 | :game/created-by player}])) 37 | 38 | com.jayway.rps.core.OnlyCreateGameCommand 39 | (perform [{:keys [player aggregate-id]} state] 40 | (when (:game/state state) 41 | (throw (ex-info "Already in started" {:state state}))) 42 | [{:db/id aggregate-id 43 | :game/state :game.state/started 44 | :game/created-by player}]) 45 | 46 | com.jayway.rps.core.DecideMoveCommand 47 | (perform [{:keys [player move aggregate-id]} state] 48 | (when-not (= (:game/state state) :game.state/started) 49 | (throw (ex-info "Incorrect state: " {:state (:game/state state)}))) 50 | (when (= (:db/id (:move/player (first (:game/moves state)))) player) 51 | (throw (ex-info "Cannot play against yourself" {:player player}))) 52 | (let [other-move (:move/type (first (:game/moves state))) 53 | creator-id (:db/id (:game/created-by state)) 54 | move-id (datomic/tempid :db.part/user) 55 | move-entity {:db/id move-id 56 | :move/player player 57 | :move/type move} 58 | aggregate-entity {:db/id aggregate-id 59 | :game/moves move-id}] 60 | [move-entity 61 | (if-not other-move 62 | aggregate-entity 63 | (merge aggregate-entity 64 | (case (compare-moves move other-move) 65 | :victory {:game/state :game.state/won 66 | :game/winner player 67 | :game/loser creator-id} 68 | :loss {:game/state :game.state/won 69 | :game/winner creator-id 70 | :game/loser player} 71 | :tie {:game/state :game.state/tied})))]))) 72 | -------------------------------------------------------------------------------- /datomic/src/com/jayway/rps/datomic/framework.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.datomic.framework 2 | (:require [datomic.api :as datomic])) 3 | 4 | (defprotocol CommandHandler 5 | (perform [command state])) 6 | 7 | (defn initialize-schema [conn] 8 | (let [schema-tx (read-string (slurp "resources/schema.dtm"))] 9 | @(datomic/transact conn schema-tx))) 10 | 11 | (defn create-entity [conn] 12 | "Returns the id of the new entity." 13 | (let [temp-id (datomic/tempid :db.part/user) 14 | optimistic-concurrency [:db.fn/cas temp-id :aggregate/version nil 0] 15 | tx @(datomic/transact conn [{:db/id temp-id} optimistic-concurrency])] 16 | (datomic/resolve-tempid (datomic/db conn) (:tempids tx) temp-id))) 17 | 18 | (defn handle-command [{:keys [aggregate-id] :as command} conn] 19 | "Apply the command to its target aggregate using optimistic concurrency. Returns the datomic transaction." 20 | (let [state (datomic/entity (datomic/db conn) aggregate-id) 21 | modification (perform command state) 22 | old-version (:aggregate/version state) 23 | next-version ((fnil inc -1) old-version) 24 | optimistic-concurrency [:db.fn/cas aggregate-id :aggregate/version old-version next-version] 25 | tx @(datomic/transact conn (conj modification optimistic-concurrency))] 26 | tx)) 27 | -------------------------------------------------------------------------------- /datomic/src/com/jayway/rps/datomic/main.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.datomic.main 2 | (:require [datomic.api :as datomic] 3 | [com.jayway.rps.datomic.framework :as f] 4 | [com.jayway.rps.core :as c] 5 | [com.jayway.rps.datomic.domain :as domain])) 6 | 7 | (def uri "datomic:mem://game") 8 | (datomic/create-database uri) 9 | (def conn (datomic/connect uri)) 10 | 11 | (defn print-entity [entity-id] 12 | (let [e (datomic/entity (datomic/db conn) entity-id)] 13 | (println "entity: " (datomic/touch e)))) 14 | 15 | (f/initialize-schema conn) 16 | 17 | (def ply1 (f/create-entity conn)) 18 | (def ply2 (f/create-entity conn)) 19 | (def game-id (f/create-entity conn)) 20 | 21 | (defn -main [& args] 22 | (f/handle-command (domain/->SetPlayerNameCommand ply1 "one") conn) 23 | (f/handle-command (domain/->SetPlayerNameCommand ply2 "two") conn) 24 | (f/handle-command (c/->OnlyCreateGameCommand game-id ply1) conn) 25 | (f/handle-command (c/->DecideMoveCommand game-id ply1 :rock) conn) 26 | (f/handle-command (c/->DecideMoveCommand game-id ply2 :scissors) conn) 27 | (print-entity game-id) 28 | (datomic/shutdown true)) 29 | -------------------------------------------------------------------------------- /datomic/src/com/jayway/rps/datomic/web.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.datomic.web 2 | (:use [environ.core]) 3 | (:require [datomic.api :as datomic] 4 | [com.jayway.rps.datomic.framework :as f] 5 | [com.jayway.rps.datomic.domain :as d] 6 | [com.jayway.rps.core :as c] 7 | [com.jayway.rps.web :as w])) 8 | 9 | (datomic/create-database (env :datomic-url)) 10 | (def conn (datomic/connect (env :datomic-url))) 11 | (f/initialize-schema conn) 12 | 13 | (defn to-player-id [name] 14 | (let [result (datomic/q '[:find ?p :in $ ?name :where [?p :player/name ?name]] (datomic/db conn) name)] 15 | (if-let [existing (ffirst result)] 16 | existing 17 | (let [player-id (f/create-entity conn)] 18 | (println "creating player " player-id " with name " name) 19 | (f/handle-command (d/->SetPlayerNameCommand player-id name) conn) 20 | player-id)))) 21 | 22 | (def app 23 | (w/create-app 24 | (reify com.jayway.rps.core.RockPaperScissors 25 | (create-game [this player-name] 26 | (let [game-id (f/create-entity conn) 27 | command (c/->OnlyCreateGameCommand game-id (to-player-id player-name))] 28 | (f/handle-command command conn) 29 | game-id)) 30 | (make-move [this game-id player-name move] 31 | (f/handle-command (c/->DecideMoveCommand (Long/valueOf game-id) (to-player-id player-name) (keyword move)) conn)) 32 | (load-game [this game-id] 33 | (let [e (datomic/entity (datomic/db conn) (Long/valueOf game-id)) 34 | game (datomic/touch e) 35 | result {:creator (:player/name (:game/created-by game)) 36 | :state (condp = (:game/state game) 37 | :game.state/started "open" 38 | :game.state/won "won" 39 | :game.state/tied "tied") 40 | :moves (into {} (map 41 | (fn [m] {(keyword (:player/name (:move/player m))) (:move/type m)}) 42 | (:game/moves game)))}] 43 | (if-not (= "won" (:state result)) 44 | result 45 | (assoc result 46 | :winner (:player/name (:game/winner game)) 47 | :loser (:player/name (:game/loser game)))))) 48 | (load-open-games 49 | [this] 50 | (into {} 51 | (datomic/q '[:find ?game ?name 52 | :where [?game :game/state :game.state/started] 53 | [?game :game/created-by ?player] 54 | [?player :player/name ?name]] 55 | (datomic/db conn))))))) 56 | -------------------------------------------------------------------------------- /datomic/test/com/jayway/rps/datomic/test/functional.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.datomic.test.functional 2 | (:require [clojure.test :refer :all] 3 | [datomic.api :as datomic] 4 | [com.jayway.rps.core :as c] 5 | [com.jayway.rps.datomic.framework :as f] 6 | [com.jayway.rps.datomic.domain :as domain])) 7 | 8 | (def uri "datomic:mem://game") 9 | (datomic/create-database uri) 10 | (def conn (datomic/connect uri)) 11 | 12 | (f/initialize-schema conn) 13 | 14 | (def ply1 (f/create-entity conn)) 15 | (def ply2 (f/create-entity conn)) 16 | (f/handle-command (domain/->SetPlayerNameCommand ply1 "one") conn) 17 | (f/handle-command (domain/->SetPlayerNameCommand ply2 "two") conn) 18 | 19 | (defn get-entity [entity-id] 20 | (datomic/touch (-> conn datomic/db (datomic/entity entity-id)))) 21 | 22 | (deftest functional-test 23 | (testing "rock beats scissors" 24 | (let [game-id (f/create-entity conn)] 25 | (f/handle-command (c/->CreateGameCommand game-id ply1 :rock) conn) 26 | (f/handle-command (c/->DecideMoveCommand game-id ply2 :scissors) conn) 27 | (is (= :game.state/won (:game/state (get-entity game-id)))) 28 | (is (= (get-entity ply1) (:game/winner (get-entity game-id)))))) 29 | (testing "separate create game" 30 | (let [game-id (f/create-entity conn)] 31 | (f/handle-command (c/->OnlyCreateGameCommand game-id ply1) conn) 32 | (f/handle-command (c/->DecideMoveCommand game-id ply1 :rock) conn) 33 | (f/handle-command (c/->DecideMoveCommand game-id ply2 :scissors) conn) 34 | (is (= :game.state/won (:game/state (get-entity game-id)))) 35 | (is (= (get-entity ply1) (:game/winner (get-entity game-id)))))) 36 | (testing "tie" 37 | (let [game-id (f/create-entity conn)] 38 | (f/handle-command (c/->CreateGameCommand game-id ply1 :paper) conn) 39 | (f/handle-command (c/->DecideMoveCommand game-id ply2 :paper) conn) 40 | (is (= :game.state/tied (:game/state (get-entity game-id)))) 41 | (is (= nil (:game/winner (get-entity game-id)))))) 42 | (testing "should not play against self" 43 | (let [game-id (f/create-entity conn)] 44 | (f/handle-command (c/->CreateGameCommand game-id ply1 :paper) conn) 45 | (is (thrown? Exception 46 | (f/handle-command (c/->DecideMoveCommand game-id ply1 :rock) conn))))) 47 | (testing "cannot start twice" 48 | (let [game-id (f/create-entity conn)] 49 | (f/handle-command (c/->CreateGameCommand game-id ply1 :paper) conn) 50 | (is (thrown? Exception 51 | (f/handle-command (c/->CreateGameCommand game-id ply1 :paper) conn)))))) 52 | -------------------------------------------------------------------------------- /eventstore/.lein-env.template: -------------------------------------------------------------------------------- 1 | {:facebook-redirect-uri "http://localhost:3000/oauth2-callback" 2 | :facebook-client-id "YOUR FACEBOOK APP ID" 3 | :facebook-client-secret "THE SECRET" 4 | :event-store-uri "http://event-store-host:2113"} 5 | -------------------------------------------------------------------------------- /eventstore/README.md: -------------------------------------------------------------------------------- 1 | The game rock-paper-scissors implemented using CQRS & Event Sourcing in Clojure with event storage in [EventStore](http://geteventstore.com). 2 | 3 | * Install EventStore. I have used Ubuntu 12.10 with Mono 3.2.3 using [this guide](http://forums.osgrid.org/viewtopic.php?f=14&t=4625). 4 | * Create a file `.lein-env` based on provided template `.lein-env.template`. 5 | * Install [rock-paper-scissors-core](https://github.com/jankronquist/rock-paper-scissors-in-clojure/tree/master/core) 6 | 7 | Run using: 8 | 9 | lein clean 10 | lein ring server 11 | -------------------------------------------------------------------------------- /eventstore/project.clj: -------------------------------------------------------------------------------- 1 | (defproject rock-paper-scissors-eventstore "1.0.0-SNAPSHOT" 2 | :description "The game rock-paper-scissors implemented using CQRS & Event Sourcing in Clojure" 3 | :dependencies [[org.clojure/clojure "1.5.0"] 4 | [rock-paper-scissors-core "1.0.0-SNAPSHOT"]] 5 | :main com.jayway.rps.main 6 | :plugins [[lein-ring "0.8.8"]] 7 | :min-lein-version "2.0.0" 8 | :ring {:handler com.jayway.rps.eventstore.web/app} 9 | :profiles {:dev {:dependencies [[javax.servlet/servlet-api "2.5"] 10 | [ring-mock "0.1.5"]]}}) -------------------------------------------------------------------------------- /eventstore/resources/projections/gameStats.js: -------------------------------------------------------------------------------- 1 | // naive gameStats, does not really work, if there are "incorrect" events, 2 | // for example duplicate GameCreatedEvents 3 | 4 | fromAll() 5 | 6 | .when({ 7 | $init: function () { 8 | return { inProgress: 0, tied: 0, won:0 }; // initial state 9 | }, 10 | 11 | com_jayway_rps_domain_GameCreatedEvent: function(s, e) { 12 | s.inProgress++; 13 | return s; 14 | }, 15 | 16 | com_jayway_rps_domain_GameTiedEvent: function(s, e) { 17 | s.tied++; 18 | s.inProgress--; 19 | return s; 20 | }, 21 | 22 | com_jayway_rps_domain_GameWonEvent: function(s, e) { 23 | s.won++; 24 | s.inProgress--; 25 | return s; 26 | } 27 | }); -------------------------------------------------------------------------------- /eventstore/resources/projections/games.js: -------------------------------------------------------------------------------- 1 | fromAll() 2 | .foreachStream() 3 | 4 | .when({ 5 | $init: function () { 6 | return { moves: {} }; // initial state 7 | }, 8 | 9 | com_jayway_rps_domain_GameCreatedEvent: function(s, e) { 10 | s.creator = e.body.creator; 11 | s.state = "open"; 12 | return s; 13 | }, 14 | 15 | com_jayway_rps_domain_MoveDecidedEvent: function(s, e) { 16 | s.moves[e.body.player] = e.body.move; 17 | return s; 18 | }, 19 | 20 | com_jayway_rps_domain_GameTiedEvent: function(s, e) { 21 | s.state = "tied"; 22 | return s; 23 | }, 24 | 25 | com_jayway_rps_domain_GameWonEvent: function(s, e) { 26 | s.winner = e.body.winner; 27 | s.loser = e.body.loser; 28 | s.state = "won"; 29 | return s; 30 | } 31 | }); 32 | -------------------------------------------------------------------------------- /eventstore/resources/projections/opengames.js: -------------------------------------------------------------------------------- 1 | fromAll() 2 | 3 | .when({ 4 | $init: function () { 5 | return {}; // initial state 6 | }, 7 | 8 | com_jayway_rps_domain_GameCreatedEvent: function(s, e) { 9 | s[e.streamId] = e.body.creator; 10 | return s; 11 | }, 12 | 13 | com_jayway_rps_domain_GameTiedEvent: function(s, e) { 14 | delete s[e.streamId]; 15 | return s; 16 | }, 17 | 18 | com_jayway_rps_domain_GameWonEvent: function(s, e) { 19 | delete s[e.streamId]; 20 | return s; 21 | } 22 | }); 23 | -------------------------------------------------------------------------------- /eventstore/src/com/jayway/rps/atom.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.atom 2 | (:require [com.jayway.rps.core :as c] 3 | [com.jayway.rps.framework :as f] 4 | [clj-http.client :as client] 5 | [cheshire.core :as json])) 6 | 7 | (defn new-uuid [] (.toString (java.util.UUID/randomUUID))) 8 | 9 | (defn to-eventstore-format [event] 10 | {:eventId (new-uuid) 11 | :eventType (.replace (.getName (class event)) \. \_) 12 | :data event}) 13 | 14 | (defn uri-for-relation [relation links] 15 | (:uri (first (filter #(= relation (:relation %)) links)))) 16 | 17 | (defn construct-record [type string] 18 | (when-let [f (resolve (symbol (clojure.string/replace type #"\.(\w+)$" "/map->$1")))] 19 | (f string))) 20 | 21 | (defn load-event [uri] 22 | (let [response (client/get uri {:as :json}) 23 | event-data (get-in response [:body :content :data] {}) 24 | event-type (.replace (get-in response [:body :content :eventType]) \_ \.)] 25 | (if event-type 26 | (construct-record event-type event-data) 27 | event-data))) 28 | 29 | (declare load-events) 30 | 31 | (defn load-events-from-list [response] 32 | (let [body (:body response) 33 | links (:links body) 34 | event-uris (reverse (map :id (:entries body))) 35 | previous-uri (uri-for-relation "previous" links)] 36 | (lazy-cat (map load-event event-uris) 37 | (if previous-uri (lazy-seq (load-events previous-uri)))))) 38 | 39 | (defn load-events [uri] 40 | (load-events-from-list (client/get uri {:as :json}))) 41 | 42 | (def empty-stream {:version (fn [] -1) :events []}) 43 | 44 | ; three cases: 45 | ; 1) stream does not exist 46 | ; 2) stream exists, but has only a single page 47 | ; 3) stream exists and has multiple pages 48 | (defn load-events-from-feed [uri] 49 | (let [response (client/get uri {:as :json :throw-exceptions false})] 50 | (if-not (= 200 (:status response)) 51 | empty-stream ; case 1 52 | (let [body (:body response) 53 | links (:links body) 54 | last-link (uri-for-relation "last" links) 55 | events (if last-link 56 | (load-events last-link) ; case 3 57 | (load-events-from-list response))] ; case 2 58 | {:version (fn [] (dec (count events))) 59 | :events events})))) 60 | 61 | (defn atom-event-store [uri] 62 | (letfn [(stream-uri [aggregate-id] (str uri "/streams/" aggregate-id))] 63 | (reify f/EventStore 64 | (retrieve-event-stream [this aggregate-id] 65 | (load-events-from-feed (stream-uri aggregate-id))) 66 | 67 | (append-events 68 | [this aggregate-id previous-event-stream events] 69 | (client/post (stream-uri aggregate-id) 70 | {:body (json/generate-string (map to-eventstore-format events)) 71 | :content-type :json 72 | :headers {"ES-ExpectedVersion" (str ((:version previous-event-stream)))}}))))) -------------------------------------------------------------------------------- /eventstore/src/com/jayway/rps/domain.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.domain 2 | (:require [com.jayway.rps.core :as c] 3 | [com.jayway.rps.framework :as f])) 4 | 5 | ; MESSAGES 6 | 7 | (defrecord GameCreatedEvent [game-id creator]) 8 | (defrecord MoveDecidedEvent [game-id player move]) 9 | (defrecord GameWonEvent [game-id winner loser]) 10 | (defrecord GameTiedEvent [game-id]) 11 | 12 | ; move rules 13 | 14 | (defmulti compare-moves vector) 15 | (defmethod compare-moves ["rock" "rock"] [x y] :tie) 16 | (defmethod compare-moves ["rock" "paper"] [x y] :loss) 17 | (defmethod compare-moves ["rock" "scissors"] [x y] :victory) 18 | (defmethod compare-moves ["paper" "rock"] [x y] :victory) 19 | (defmethod compare-moves ["paper" "paper"] [x y] :tie) 20 | (defmethod compare-moves ["paper" "scissors"] [x y] :loss) 21 | (defmethod compare-moves ["scissors" "rock"] [x y] :loss) 22 | (defmethod compare-moves ["scissors" "paper"] [x y] :victory) 23 | (defmethod compare-moves ["scissors" "scissors"] [x y] :tie) 24 | 25 | ; game aggregate - event handlers 26 | 27 | (defmethod f/apply-event GameCreatedEvent [state event] 28 | (assoc state 29 | :state :started 30 | :creator (:creator event))) 31 | 32 | (defmethod f/apply-event MoveDecidedEvent [state event] 33 | (assoc state 34 | :move (:move event))) 35 | 36 | (defmethod f/apply-event GameWonEvent [state event] 37 | (assoc state 38 | :state :completed)) 39 | 40 | (defmethod f/apply-event GameTiedEvent [state event] 41 | (assoc state 42 | :state :completed)) 43 | 44 | ; game aggregate command handler 45 | 46 | (extend-protocol f/CommandHandler 47 | com.jayway.rps.core.CreateGameCommand 48 | (perform [command state] 49 | (when (:state state) 50 | (throw (Exception. "Already in started"))) 51 | [(->GameCreatedEvent (:aggregate-id command) (:player command)) 52 | (->MoveDecidedEvent (:aggregate-id command) (:player command) (:move command))]) 53 | 54 | com.jayway.rps.core.OnlyCreateGameCommand 55 | (perform [command state] 56 | (when (:state state) 57 | (throw (Exception. "Already in started"))) 58 | [(->GameCreatedEvent (:aggregate-id command) (:player command))]) 59 | 60 | com.jayway.rps.core.DecideMoveCommand 61 | (perform [command state] 62 | (when-not (= (:state state) :started) 63 | (throw (Exception. "Incorrect state"))) 64 | (let [events [(->MoveDecidedEvent (:aggregate-id command) (:player command) (:move command))]] 65 | (if-not (:move state) 66 | events 67 | (conj events 68 | (case (compare-moves (:move state) (:move command)) 69 | :victory (->GameWonEvent (:aggregate-id command) (:creator state) (:player command)) 70 | :loss (->GameWonEvent (:aggregate-id command) (:player command) (:creator state)) 71 | :tie (->GameTiedEvent (:aggregate-id command)))))))) 72 | -------------------------------------------------------------------------------- /eventstore/src/com/jayway/rps/eventstore/web.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.eventstore.web 2 | (:use [environ.core]) 3 | (:require [com.jayway.rps.atom :as a] 4 | [com.jayway.rps.framework :as f] 5 | [com.jayway.rps.core :as c] 6 | [com.jayway.rps.domain :as d] 7 | [com.jayway.rps.web :as w] 8 | [clj-http.client :as client])) 9 | 10 | 11 | (def app 12 | (let [event-store (a/atom-event-store (env :event-store-uri))] 13 | (w/create-app 14 | (reify com.jayway.rps.core.RockPaperScissors 15 | (create-game [this player-name] 16 | (let [aggregate-id (str "game-" (.toString (java.util.UUID/randomUUID)))] 17 | (f/handle-command (c/->OnlyCreateGameCommand aggregate-id player-name) event-store) 18 | (Thread/sleep 500) 19 | aggregate-id)) 20 | 21 | (make-move [this game-id player-id move] 22 | (f/handle-command (c/->DecideMoveCommand game-id player-id move) event-store) 23 | (Thread/sleep 500)) 24 | 25 | (load-open-games [this] 26 | (let [url (str (env :event-store-uri) "/projection/opengames/state") 27 | reply (client/get url {:as :json-string-keys}) 28 | games (:body reply)] 29 | (println games) 30 | games)) 31 | 32 | (load-game [this game-id] 33 | (let [url (str (env :event-store-uri) "/projection/games/state?partition=" game-id) 34 | reply (client/get url {:as :json}) 35 | game (:body reply)] 36 | (println game) 37 | game)))))) 38 | 39 | -------------------------------------------------------------------------------- /eventstore/src/com/jayway/rps/framework.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.framework 2 | (:import java.util.ConcurrentModificationException 3 | java.util.concurrent.ConcurrentHashMap) 4 | (:require [com.jayway.rps.core :as c])) 5 | 6 | (defmulti apply-event (fn [state event] (class event))) 7 | 8 | (defprotocol EventStore 9 | (retrieve-event-stream [this aggregate-id]) 10 | (append-events [this aggregate-id previous-event-stream events])) 11 | 12 | (defn apply-events [state events] 13 | (reduce apply-event state events)) 14 | 15 | (defprotocol CommandHandler 16 | (perform [command state])) 17 | 18 | (defn handle-command [command event-store] 19 | (let [event-stream (retrieve-event-stream event-store (:aggregate-id command)) 20 | old-events (:events event-stream) 21 | current-state (apply-events {} old-events) 22 | new-events (perform command current-state)] 23 | (append-events event-store (:aggregate-id command) event-stream new-events))) 24 | -------------------------------------------------------------------------------- /eventstore/src/com/jayway/rps/main.clj: -------------------------------------------------------------------------------- 1 | (ns com.jayway.rps.main 2 | (:use [compojure.core] 3 | [environ.core] 4 | [ring.middleware.session] 5 | [ring.middleware.keyword-params] 6 | [ring.middleware.params] 7 | [hiccup.core] 8 | [com.jayway.rps.facebook]) 9 | (:require [compojure.route :as route] 10 | [com.jayway.rps.atom :as a] 11 | [com.jayway.rps.core :as c] 12 | [com.jayway.rps.framework :as f] 13 | [com.jayway.rps.domain :as d] 14 | [clj-http.client :as client])) 15 | 16 | (defn -main [& args] 17 | (let [game-id (c/create-game com.jayway.rps.eventstore.web/rps)] 18 | (c/perform-command rps (c/->CreateGameCommand game-id "player-1" "rock")) 19 | (c/perform-command rps (c/->DecideMoveCommand game-id "player-2" "scissors")) 20 | (Thread/sleep 2000) 21 | (println (c/load-game rps game-id)))) 22 | --------------------------------------------------------------------------------