├── .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 |
--------------------------------------------------------------------------------