implement stupid login on server side.

project.clj

@@ -8,7 +8,7 @@
   :resource-paths ["resources"
                    "target/cljsbuild"]
 
-  :dependencies [[org.clojure/clojure "1.9.0"]
+  :dependencies [[org.clojure/clojure "1.10.0-beta3"]
                  [org.clojure/core.async "0.4.474"]
                  [org.clojure/math.combinatorics "0.1.4"]
                  [com.datomic/datomic-free "0.9.5697"]
@@ -16,6 +16,7 @@
 
                  ;; server
                  [aero "1.1.3"]
+                 [com.taoensso/timbre "4.10.0"]
                  [http-kit "2.3.0"]
                  [compojure "1.6.1"]
                  [com.taoensso/nippy "2.14.0"]
@@ -147,6 +148,7 @@
 
 
                    :source-paths ["env/dev/clj"]
+                   :java-source-paths ["src/java"]
                    :plugins [[lein-figwheel "0.5.16"]
                              [deraen/lein-sass4clj "0.3.1"]]
 

resources/config.edn

@@ -37,7 +37,8 @@
  {:port #long #or [#env BROKER_SERVER_PORT 1605]
   :ip "0.0.0.0"
   :max-body 524288 ;; 512kb, small but enough
-  :max-ws 524288}
+  :max-ws 524288
+  :datomic {:transactor-url "datomic:free://localhost:4334/skirmish.broker"}}
 
 
  :wui

src/clj/skirmish/bookkeeper/bookkeeper.clj

@@ -90,7 +90,6 @@
     (go-loop [order (<! new-book-order-channel)]
       (let [order-id (:book.order/id order)
             to-remove (contains? #{:withdrawn :totally-fulfilled} (:book.order/status order))]
-        (println ret)
         (swap! ret (fn [book]
                      (if to-remove
                        (dissoc book order-id)

src/clj/skirmish/bookkeeper/core.clj

@@ -2,6 +2,7 @@
   (:require [org.httpkit.server :refer [run-server]]
             [compojure.handler :refer [api]]
             [skirmish.util :refer [block-thread]]
+            [taoensso.timbre :as timbre]
             [skirmish.middleware.core :refer [create-map-exchange-apis]]
             [skirmish.bookkeeper.bookkeeper :refer [create-routes-for-bookkeeper]]
             [ring.middleware.cors :refer [wrap-cors]]))
@@ -10,8 +11,7 @@
   (let [bookkeeper-config (:api-bookkeeper config)
         exchange-apis (create-map-exchange-apis exchange-apis-mult-chan)
         api-routes (create-routes-for-bookkeeper exchange-apis config)]
-    (println "Running skirmish.bookkeeper.core server with bellow config\n" bookkeeper-config)
-    (println bookkeeper-config)
+    (timbre/info "Running skirmish.bookkeeper.core server with config: " bookkeeper-config)
     (run-server
       (-> api-routes api (wrap-cors :access-control-allow-origin #"http://localhost:3449"
                                     :access-control-allow-methods [:get :put :post :delete]))

src/clj/skirmish/broker/broker.clj

@@ -0,0 +1,41 @@
+(ns skirmish.broker.broker
+  (:require [compojure.core :refer :all]
+            [compojure.route :refer [not-found]]
+            [datomic.api :as d]
+            [slingshot.slingshot :refer [try+ throw+]]
+            [skirmish.rest.util :refer [build-response not-found-resp get-body]]
+            [taoensso.timbre :as timbre]))
+
+
+(defn create-user [conn]
+  (fn [{body :body :as request}]
+    (try+
+       (let [email (-> body get-body :email)]
+         (timbre/info "Creating new user" email)
+         @(d/transact conn [[:skirmish.broker.user/create-user email]])
+         (build-response request {:status 201 :headers {"location" (str "/api/1/users/" email)}}))
+      (catch [:error-type :4XX] e (build-response request e))
+      (catch [:error-type :5XX] e (build-response request e)))))
+
+
+(defn get-user [conn]
+  (fn [{{email :email} :route-params :as request}]
+    (try+
+      (timbre/info "getting user with email" email)
+      (let [db (d/db conn)
+            users (d/q '[:find [(pull ?e [*])]
+                         :in $ ?email
+                         :where [?e :skirmish.broker.user/email ?email]] db email)]
+        (if (nil? users)
+          (build-response request {:status 404 :body {:error (str "cannot find user with email " email)}})
+          (build-response request (first users))))
+      (catch [:error-type :4XX] e (build-response request e))
+      (catch [:error-type :5XX] e (build-response request e)))))
+
+
+(defn create-routes [conn]
+  (routes
+    (context "/api/1" []
+      (POST "/users" [] (create-user conn))
+      (GET "/users/:email" [email] (get-user conn)))
+    not-found-resp))

src/clj/skirmish/broker/core.clj

@@ -2,13 +2,16 @@
   (:require [org.httpkit.server :refer [run-server]]
             [compojure.handler :refer [api]]
             [skirmish.util :refer [block-thread]]
-            [skirmish.exchange-gateway.exchange-gateway :refer [create-routes-for-exchange]]
+            [skirmish.broker.broker :refer [create-routes]]
+            [taoensso.timbre :as timbre]
             [skirmish.middleware.core :refer [create-map-exchange-apis]]
+            [skirmish.broker.db :refer [create-connection]]
             [ring.middleware.cors :refer [wrap-cors]]))
 
 
 (defn -main [config securities-api exchange-apis]
   (let [webserver-config (:api-broker config)
-        api-routes (-> exchange-apis create-map-exchange-apis create-routes-for-exchange)]
-    (println "Running skirmish.exchange-gateway.core server with bellow config\n" webserver-config)
+        conn (create-connection (-> webserver-config :datomic :transactor-url))
+        api-routes (create-routes conn)]
+    (timbre/info "Running skirmish.broker.core server with config: " webserver-config)
     (run-server (api api-routes) webserver-config)))

src/clj/skirmish/broker/db.clj

@@ -0,0 +1,37 @@
+(ns skirmish.broker.db
+  (:require [datomic.api :as d]
+            [slingshot.slingshot :refer [throw+]]))
+
+(def create-user
+  [
+   {:db/ident :skirmish.broker.user/create-user
+    :db/doc   "Create a new user in the system."
+    :db/fn    (d/function {:lang   "clojure"
+                           :requires ['[slingshot.slingshot]]
+                           :params '[db email]
+                           :code   '(let [existing-user (d/pull db '[:db/id] [:skirmish.broker.user/email email])]
+                                      (when (-> existing-user :db/id some?)
+                                        (slingshot.slingshot/throw+ {:error-type :4XX :status 400 :body {:error "A user with this email already exists."}}))
+                                      [#:skirmish.broker.user{:email email}])})}])
+
+
+(def user-schema [
+                  {
+                   :db/ident :skirmish.broker.user/email
+                   :db/unique :db.unique/identity
+                   :db/valueType :db.type/string
+                   :db/cardinality :db.cardinality/one
+                   :db/doc "The email of the user; used as id."}])
+
+
+(def schema (-> []
+                (concat user-schema)
+                (concat create-user)))
+
+(defn create-connection [uri]
+  (let [new-db? (d/create-database uri)
+        conn (d/connect uri)]
+    (when new-db?
+      @(d/transact conn schema))
+    conn))
+

src/clj/skirmish/core.clj

@@ -6,9 +6,11 @@
             [skirmish.bookkeeper.core]
             [skirmish.exchange-gateway.core]
             [skirmish.ledger.core]
+            [taoensso.timbre :as timbre]
+            [skirmish.broker.core]
             [skirmish.middleware.core :refer [create-exchange-apis-for
                                               create-securities-api-for]]
-            [aero.core :refer (read-config)]
+            [aero.core :refer [read-config]]
             [orchestra.spec.test :as st]
             [clojure.core.async :as async])
   (:gen-class))
@@ -19,11 +21,12 @@
    :exchange-core  skirmish.exchange.core/-main ;; should be skirmish.exchange.core/api-main
    :api-bookkeeper skirmish.bookkeeper.core/-main
    :ledger         skirmish.ledger.core/-main
+   :broker         skirmish.broker.core/-main
    :wui            skirmish.wui.server/-main})
 
 (defn run-all-targets-in-separate-threads [target-fns config securities-api exchange-apis]
-  (println "running  multiple targets. This is okay in dev but horrible in production")
-  (println (clojure.string/join "\n" target-fns))
+  (timbre/warn "running  multiple targets. This is okay in dev but horrible in production")
+  (timbre/info (clojure.string/join "\n" target-fns))
   (let [threads (map #(async/thread (% config securities-api exchange-apis)) target-fns)
         finished-threads (async/merge threads)]
     (loop [finished-thread (async/<!! finished-threads)]
@@ -46,7 +49,7 @@
     (if (seq target-fns)
       (run-all-targets target-fns config)
       (do
-        (println argv)
-        (println "target" target-fns "not found")
-        (println "all known targets are...")
-        (println (keys targets))))))
+        (timbre/info argv)
+        (timbre/info "target" target-fns "not found")
+        (timbre/info "all known targets are...")
+        (timbre/info (keys targets))))))

src/clj/skirmish/exchange_gateway/core.clj

@@ -4,13 +4,14 @@
             [skirmish.util :refer [block-thread]]
             [skirmish.exchange-gateway.exchange-gateway :refer [create-routes-for-exchange]]
             [skirmish.middleware.core :refer [create-map-exchange-apis]]
+            [taoensso.timbre :as timbre]
             [ring.middleware.cors :refer [wrap-cors]]))
 
 
 (defn -main [config securities-api exchange-apis]
   (let [webserver-config (:api-server config)
         api-routes (-> exchange-apis create-map-exchange-apis create-routes-for-exchange)]
-    (println "Running skirmish.exchange-gateway.core server with bellow config\n" webserver-config)
+    (timbre/info "Running skirmish.exchange-gateway.core server with config:" webserver-config)
     (run-server (api api-routes) webserver-config)))
 
 

src/clj/skirmish/ledger/core.clj

@@ -8,6 +8,7 @@
             [skirmish.rest.util :refer [build-response get-body]]
             [skirmish.ledger.accounts]
             [datomic.api :as d]
+            [taoensso.timbre :as timbre]
             [compojure.core :refer :all]
             [clojure.spec.alpha :as s]
             [ring.middleware.cors :refer [wrap-cors]]))
@@ -172,5 +173,5 @@
         conn (skirmish.ledger.accounts/create-connection (-> config :datomic :transactor-url))
         api-routes (create-routes-for-ledger (:securities config) conn)]
 
-    (println "Running skirmish.ledger.core server with bellow config\n" ledger-config)
+    (timbre/info "Running skirmish.ledger.core server with config: " ledger-config)
     (run-server (api api-routes) ledger-config)))

src/clj/skirmish/rest/util.clj

@@ -49,6 +49,9 @@
      :headers (into {"Content-Type" content-type} ret-headers)
      :status (get-status status request)}))
 
+(defn not-found-resp [request]
+  (build-response request {:status 404 :body {:error "not found"}}))
+
 (defn get-body [body]
   (try+
     (-> body clojure.java.io/reader slurp edn/read-string)

src/clj/skirmish/util.clj

@@ -1,12 +1,12 @@
 (ns skirmish.util
   (:require [clojure.core.async :as async])
-  (:import [skirmish.PersistentSortedList]))
+  (:import (skirmish PersistentSortedList)))
 
 (defn sorted-list [& keys]
-  (skirmish.PersistentSortedList/create (seq keys)))
+  (PersistentSortedList/create (seq keys)))
 
 (defn sorted-list-by [comparator & keys]
-  (skirmish.PersistentSortedList/create comparator (seq keys)))
+  (PersistentSortedList/create comparator (seq keys)))
 
 (defn block-thread []
   "Block the current thread until chuck norris gets weaker."

src/cljs/skirmish/wui/components/home_page.cljs

@@ -7,17 +7,27 @@
                   "Gentrify palo santo enamel pin, tumeric jianbing thundercats shaman green juice chambray yr. Kale chips synth meditation chambray thundercats helvetica, cornhole whatever kickstarter ennui pop-up lo-fi godard. Austin unicorn brunch woke hammock. Coloring book kombucha occupy tofu wayfarers."])
 
 
+(defn email? [s]
+  (let [email-pattern #"^([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)$"]
+    (->> s str (re-matches email-pattern) some?)))
+
 (defn login [state]
   (let [login-field (atom (get state :user ""))
         on-change #(reset! login-field (-> % .-target .-value))]
     (fn []
+      (let [disabled? (-> @login-field email? not)
+            href (if (not disabled?) (str "/home/" @login-field) nil)]
         [:div.field
          [:div.control
-        [:label.label "Username"]
+          [:label.label "Email"]
           [:div.field.is-grouped
-         [:input.input.is-success {:type "text" :value @login-field :on-change on-change :style {:margin-right "1em"}}]
+           [:input.input.is-success {:type "email"
+                                     :value @login-field
+                                     :on-change on-change
+                                     :placeholder "boris.johnson@redneck.co.uk"
+                                     :style {:margin-right "1em"}}]
            [:div.control
-          [:a.button.is-link.has-background-primary {:href (str "/home/" @login-field)} "login"]]]]])))
+            [:a.button.is-link.has-background-primary {:href href :disabled disabled?} "login"]]]]]))))
 
 
 (defn page [state]

src/cljs/skirmish/wui/components/todo_page.cljs

@@ -13,9 +13,14 @@
      [:p "the brooker should use the exchange-gateway and ledge as apis.  Nothing else."]
      [:ol
       [:li done "implement basic login in the wui"]
-      [:li on-it "implement basic web server"]
-      [:li "implement stupid login."]
-      [:li "implement account notion.  Use ledger for that."]
+      [:li done "implement basic web server"]
+      [:li done "implement stupid login on server side."]
+      [:li "link the logic of the client-server login logic"]
+      [:li "add the notion of 'accounts' in the server.  An
+            user should have many accounts; one for each security
+            he owns"]
+      [:li "make the " [:a {:href "/portfolio"} "portfolio"] " page representing the use accounts"]
+      [:li "when a new user logs in, he should receive some sort of money"]
       [:li "implement buy/sell securities."]]]
 
     [:li "Implement Ledger"

src/cljs/skirmish/wui/components/topbar.cljs

@@ -40,5 +40,5 @@
      [:a.navbar-item.is-tab {:href "/portfolio" :class (top-bar-class state :view-portfolio)} "View Portfolio"]
      [:a.navbar-item.is-tab {:href "/todo" :class (top-bar-class state :todo)} "Todo"]]
     [:div.navbar-end
-     [:a.navbar-item.is-tab {} "Skirmish Shitty Exchange"]
+     [:a.navbar-item {} "Skirmish Shitty Exchange"]
      [user-placeholder state]]]])