4 |
5 | Cube Dashboard
6 |
7 |
8 |
9 |
10 |
18 |
19 |
20 |
24 |
30 |
31 |
32 |
--------------------------------------------------------------------------------
/src/cube/system.clj:
--------------------------------------------------------------------------------
1 | (ns cube.system
2 | (:require [com.stuartsierra.component :as c]
3 | [cube.scheduler :as scheduler]
4 | [cube.db :as db]
5 | [cube.web :as web]
6 | [cube.instances :as instances]
7 | [cube.providers.docker :as provider-docker]
8 | [cube.cluster :as cluster]
9 | [cube.monitoring :as monitoring]))
10 |
11 | (defn create-system [config-options]
12 | (let [{http-port :http-port
13 | db-path :db-path} config-options]
14 | (c/system-map :db (db/new db-path)
15 | :scheduler (scheduler/new {:interval 1})
16 | :web (c/using (web/new http-port) [:db :instances :cluster])
17 | :instances (c/using (instances/new) [:db :scheduler :docker])
18 | :docker (provider-docker/new "unix:///var/run/docker.sock")
19 | :cluster (c/using (cluster/new) [:db :scheduler :instances])
20 | :monitoring (c/using (monitoring/new) [:db :scheduler :instances :cluster])
21 | )))
22 |
--------------------------------------------------------------------------------
/src/ui/components/button.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.components.button
2 | (:require [re-frame.core :refer [dispatch]]))
3 |
4 | (defn go-to-subpage [page]
5 | (dispatch [:go-to-subpage page]))
6 |
7 | (defn add-subpage [page]
8 | (dispatch [:add-subpage page]))
9 |
10 | (defn button [params]
11 | [:a.f6.link.dim.ba.ph3.pv2.dib.navy {:disabled (:disabled params)
12 | :href (:subpage params)
13 | :onClick #(do (when (:add-subpage params)
14 | (.preventDefault %)
15 | (add-subpage (:add-subpage params)))
16 | (when (:subpage params)
17 | (.preventDefault %)
18 | (go-to-subpage (:subpage params)))
19 | (when (:onClick params)
20 | ((:onClick params) %)))}
21 | (:text params)])
22 |
--------------------------------------------------------------------------------
/src/shared/host.cljc:
--------------------------------------------------------------------------------
1 | (ns shared.host
2 | (:require [clojure.spec.alpha :as s]
3 | [clojure.spec.gen.alpha :as gen]))
4 |
5 | (s/def ::not-empty-string (s/and string? (complement empty?)))
6 | (s/def ::name ::not-empty-string)
7 | (s/def ::desc ::not-empty-string)
8 | (s/def ::enabled boolean?)
9 | (s/def ::type #{:solo
10 | :aws
11 | :do
12 | :gcloud
13 | :custom})
14 |
15 | (s/def ::host (s/keys :req [::name
16 | ::desc
17 | ::enabled
18 | ::type]))
19 |
20 | ;; (s/valid? :shared.host/host {:shared.host/name "Solo"
21 | ;; :shared.host/type :aws
22 | ;; :shared.host/desc "AWS"
23 | ;; :shared.host/enabled true})
24 | ;; (s/explain :shared.host/host {:shared.host/name "Solo"
25 | ;; :shared.host/type :aws
26 | ;; :shared.host/desc "AWS"
27 | ;; :shared.host/enabled true})
28 | ;; (gen/sample (s/gen ::host))
29 |
--------------------------------------------------------------------------------
/src/cube/dev.clj:
--------------------------------------------------------------------------------
1 | (ns ^:skip-aot cube.dev
2 | (:require
3 | [clojure.tools.namespace.repl :refer [set-refresh-dirs refresh]]
4 | [figwheel-sidecar.repl-api :as fw]
5 | [clojure.spec.alpha :as s]
6 | [clojure.spec.gen.alpha :as gen]
7 | [cube.system :refer [create-system]]
8 | [com.stuartsierra.component :as c]))
9 |
10 | (def running-system (atom nil))
11 |
12 | (defn start-system! [params]
13 | (reset! running-system (c/start (create-system params))))
14 |
15 | (defn stop-system! []
16 | (c/stop @running-system)
17 | (reset! running-system nil))
18 |
19 | (defn start
20 | ([] (start false))
21 | ([figwheel?] (do (when figwheel? (fw/start-figwheel!))
22 | (start-system! {:http-port 3000
23 | :db-path "/tmp/tmp-cube-db.clj"}))))
24 |
25 | (defn stop
26 | ([] (stop false))
27 | ([figwheel?] (do (when figwheel? (fw/stop-figwheel!))
28 | (stop-system!))))
29 |
30 | (set-refresh-dirs "src/cube" "src/shared")
31 |
32 | (defn reset []
33 | (stop-system!)
34 | (refresh :after 'cube.dev/start))
35 |
--------------------------------------------------------------------------------
/docs/components.md:
--------------------------------------------------------------------------------
1 | ## Cube - Components (backend)
2 |
3 | Cube as an application contains many different components for different purposes
4 | in the system.
5 |
6 | - Cluster - Handles communication with the different ipfs-cluster
7 | - DB - Handles the mutable state and persistance
8 | - Instances - Handles communication with different hosting services
9 | - Scheduler - Manages recurring tasks that should be run continously
10 | - Web - Handles web requests to the application, only available locally
11 |
12 | Future but not yet implemented components
13 |
14 | - Auth - Handles local authentication, protecting various endpoints and
15 | making sure the right users have access to the right things.
16 | - Monitoring - Component that helps monitoring the status/health of Cube
17 |
18 | For an overview of the components and how they work together, checkout
19 | the [Overview document](./overview.md)
20 |
21 | ## Other Parts
22 |
23 | - CLI - Runs the Cube system and opens GUI if needed
24 | - Dev - Makes development easier, exposes functions for the repl
25 | - GUI - Responsible for rendering the main application window
26 | - System - Composition of all the other components
27 |
--------------------------------------------------------------------------------
/src/ui/pages/pin.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.pages.pin
2 | (:require [re-frame.core :refer [subscribe dispatch]]
3 | [clojure.contrib.humanize :refer [filesize]]))
4 |
5 | (defn peer-map [p]
6 | [:div.mt3
7 | [:div.f4
8 | [:span.b "PeerID: "]
9 | [:span (:peer-id p)]
10 | ]
11 | [:div.f5.mt1
12 | [:span.b "Status: "]
13 | [:span (:status p)]
14 | ]
15 | (when (:error p)
16 | [:div.mt1
17 | [:div.white.bg-red.w-70.pa1
18 | [:span.b "Error "]
19 | [:span (:error p)]
20 | ]])
21 | [:div.f6.mt1 (str "Last Update: " (:timestamp p))]])
22 |
23 | (defn render [params]
24 | (let [pin @(subscribe [:pin (:cid params)])]
25 | [:div
26 | [:a.aqua {:href "#"
27 | :onClick #(do (.preventDefault %)
28 | (dispatch [:go-to-page "/pins"]))} "Back to all pins"]
29 | [:div.f3.mt2 (str "Details about pin \"" (:name pin) "\"")]
30 | [:div.f6.mt1
31 | [:span.b.monospace "CID: "]
32 | [:span (:cid pin)]]
33 | [:div.f6.mt1
34 | [:span.b.monospace "Pinners: "]
35 | [:span (-> pin :peer-map count)]]
36 | [:div.f6.mt1
37 | [:span.b.monospace "Size: "]
38 | [:span (filesize (:size pin))]]
39 | [:div.f3.mt4.b "Peers"]
40 | (for [p (:peer-map pin)]
41 | (peer-map p))]))
42 |
--------------------------------------------------------------------------------
/src/ui/http.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.http
2 | (:require [re-frame.core :refer [reg-fx dispatch]]
3 | ;; TODO ruins dead code elimination
4 | [day8.re-frame.tracing :refer-macros [fn-traced defn-traced]]
5 | ))
6 |
7 | (defn to-json [obj]
8 | (.stringify js/JSON (clj->js obj)))
9 |
10 | (defn http [url method body headers func]
11 | "Make a HTTP call with url and method, func is called once res has been received"
12 | (let [opts {:method method
13 | :headers (clj->js headers)}
14 | merged-opts (if (nil? body) opts (merge opts {:body (to-json body)}))]
15 | (-> (js/fetch url (clj->js merged-opts))
16 | (.catch #(func %))
17 | (.then #(func %)))))
18 |
19 | (defn http-status [url method func]
20 | "Make a HTTP call with url and method, func is called once res has been received"
21 | (.then (js/fetch url (clj->js {:method method})) #(func (.-status %))))
22 |
23 | (reg-fx
24 | :http
25 | (fn-traced [v]
26 | (http
27 | (:url v)
28 | (:method v)
29 | (:body v)
30 | (:headers v)
31 | (:on-success v))))
32 |
33 | (reg-fx
34 | :http-status
35 | (fn-traced [v]
36 | (http-status (:url v)
37 | (:method v)
38 | #((:on-success v) %))))
39 |
--------------------------------------------------------------------------------
/src/ui/websocket.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.websocket
2 | (:require [re-frame.core :refer [reg-sub dispatch reg-event-db reg-fx reg-event-fx subscribe]]
3 | [day8.re-frame.tracing :refer-macros [fn-traced]]))
4 |
5 | (defn get-ws-url []
6 | (str "ws://" (-> (.-location js/window) .-host) "/api/db/ws"))
7 |
8 | (defn create-ws [url]
9 | (js/WebSocket. url))
10 |
11 | (defn close-ws [socket]
12 | (.close socket))
13 |
14 | (defn handle-ws-msg [msg]
15 | (dispatch [:set-remote-db (js->clj (.parse js/JSON (.-data msg)) :keywordize-keys true)]))
16 |
17 | (reg-event-db
18 | :set-websocket
19 | (fn-traced [db [_ websocket]]
20 | (assoc db :websocket websocket)))
21 |
22 | (reg-sub
23 | :websocket
24 | (fn-traced [db _]
25 | (:websocket db)))
26 |
27 | (reg-fx
28 | :websocket-disconnect
29 | (fn-traced [v]
30 | ((:on-connect v) (close-ws (:socket v)))))
31 |
32 | (reg-fx
33 | :websocket-connect
34 | (fn-traced [v]
35 | ((:on-connect v) (create-ws (:url v)))))
36 |
37 | (reg-event-fx
38 | :ws-disconnect
39 | (fn-traced [_ _]
40 | {:websocket-disconnect {:socket @(subscribe [:websocket])
41 | :on-connect #(do (dispatch [:set-websocket nil])
42 | (dispatch [:set-remote-db {}]))}}))
43 | (reg-event-fx
44 | :ws-connect
45 | (fn-traced [_ _]
46 | {:websocket-connect {:url (get-ws-url)
47 | :on-connect #(do (dispatch [:set-websocket %])
48 | (set! (.-onmessage %) handle-ws-msg))}}))
49 |
--------------------------------------------------------------------------------
/src/ui/components/text_input.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.components.text-input)
2 |
3 | (defn handle-keyup [ev onEnter]
4 | (when (= (.-keyCode ev) 13)
5 | (onEnter (-> ev .-target .-value .trim))))
6 |
7 | (defn fn-or-noop [f]
8 | (if (nil? f)
9 | (fn [])
10 | f))
11 |
12 | (def default-classes "w-90")
13 |
14 | (defn class-or-default [in]
15 | (if (:class in)
16 | (:class in)
17 | default-classes))
18 |
19 | (defn text-input [params]
20 | (let [{id :id
21 | label :label
22 | description :description
23 | input-type :type
24 | onChange :onChange
25 | onEnter :onEnter
26 | defaultValue :default-value
27 | value :value
28 | style :style
29 | onKeyDown :onKeyDown} params]
30 | [:div
31 | [:label.f6.b.db.m2 {:for id} label]
32 | [:input.input-reset.ba.b--black-20.pa2.mb2.db {
33 | :onKeyDown (fn-or-noop onKeyDown)
34 | :onKeyUp #(handle-keyup % (fn-or-noop onEnter))
35 | :onChange (fn-or-noop onChange)
36 | :type input-type
37 | :value value
38 | :default-value defaultValue
39 | :id id
40 | :style style
41 | :class (class-or-default params)}]
42 | [:small.f6.lh-copy.black-60.db.mb2 description]]))
43 |
--------------------------------------------------------------------------------
/src/cube/scheduler.clj:
--------------------------------------------------------------------------------
1 | (ns cube.scheduler
2 | (:require [com.stuartsierra.component :as c]
3 | [tea-time.core :as tt]
4 | [clojure.pprint :refer [pprint]]))
5 |
6 | (defn add-task [scheduler f]
7 | (do (println "[scheduler] Adding a task to the scheduler")
8 | (swap! (:tasks scheduler) conj f)))
9 |
10 | (defn do-interval [tasks]
11 | (doseq [f @tasks]
12 | (f)))
13 |
14 | (defrecord Scheduler [interval]
15 | c/Lifecycle
16 | (start [this]
17 | (println "[scheduler] Starting")
18 | (tt/start!)
19 | (let [tasks (atom [])
20 | tt-tasks (atom [(tt/every! interval (bound-fn []
21 | (try
22 | (do-interval tasks)
23 | (catch Exception ex
24 | ;; TODO
25 | ;; Error in scheduler,
26 | ;; should log it somewhere
27 | (pprint ex)))
28 |
29 | ))])]
30 | (-> this
31 | ;; External tasks
32 | (assoc :tasks tasks)
33 | ;; Internal, interval tea-time tasks
34 | (assoc :tt-tasks tt-tasks))))
35 | (stop [this]
36 | (println "[scheduler] Stopping")
37 | (tt/stop!)
38 | (doseq [task @(:tt-tasks this)]
39 | (do (println "[scheduler] Cancelling a task")
40 | (tt/cancel! task)))
41 | (assoc this :tt-tasks nil)))
42 |
43 | (defn new [options]
44 | ;; :interval => seconds
45 | (map->Scheduler {:interval (:interval options)}))
46 |
--------------------------------------------------------------------------------
/src/ui/pages/login.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.pages.login
2 | (:require [reagent.core :as r]
3 | [re-frame.core :refer [dispatch subscribe]]
4 | [ui.login :as login]
5 | [ui.components.text-input :refer [text-input]]
6 | [ui.components.button :refer [button]]
7 | ))
8 |
9 | (defn get-value [ev]
10 | (-> ev .-target .-value))
11 |
12 | (def username (r/atom ""))
13 | (def password (r/atom ""))
14 |
15 | (defn do-login [username password]
16 | (dispatch [:do-login username password]))
17 |
18 | (defn render []
19 | [:div.tc
20 | [:h3.f3 "Login"]
21 | [:div.mv3 "You need to login before you can use Cube"]
22 | [:form {:on-submit #(do (.preventDefault %)
23 | (do-login @username @password))}
24 | [:div.mv3
25 | (text-input {:id "username"
26 | :label "Username"
27 | :class "w-20"
28 | :style {:margin "0px auto"}
29 | :type "text"
30 | :value @username
31 | :onChange #(reset! username (get-value %))})]
32 | [:div.mv3
33 | (text-input {:id "password"
34 | :label "Password"
35 | :class "w-20"
36 | :style {:margin "0px auto"}
37 | :type "password"
38 | :value @password
39 | :onChange #(reset! password (get-value %))})]
40 | (text-input {:id "login"
41 | :style {:margin "0px auto"}
42 | :class "w-10 bg-aqua white b"
43 | :type "submit"
44 | :value "Login"
45 | :onChange #(do-login @username @password)})
46 | (let [error-msg @(subscribe [:login/error])]
47 | [:div.red (when error-msg error-msg)])]])
48 |
--------------------------------------------------------------------------------
/src/cube/providers/provider.clj:
--------------------------------------------------------------------------------
1 | (ns cube.providers.provider)
2 |
3 | ;; Not really used yet!
4 |
5 | (defprotocol Provider
6 | "Provider manages hosts in some location"
7 | (credentials [token] "Creates a credentials map for authenticating with this provider")
8 | (create [instance-spec] "Creates a instance based on the passed in specification")
9 | (destroy [instance-id] "Destroys a instance based on the instance ID")
10 | (is-ready? [instance-id] "Checks if the instance is currently running"))
11 |
12 | ;; ;; Experimental API
13 | ;; (s/def ::instance-opts {:name
14 | ;; :size
15 | ;; :region
16 | ;; :image_id })
17 | ;;
18 | ;; (defn create "Creates a new instance" [instance-opts] ^instance)
19 | ;; (defn stop "Stops a instance" [instance])
20 | ;; (defn remove "Removes an instance" [instance])
21 | ;;
22 | ;; ;; connection interface cluster <> instances
23 | ;;
24 | ;; ;; The API should look something like this
25 | ;;
26 | ;; ;; creating credentials
27 | ;; (def creds (create-creds "aws" "username" "password"))
28 | ;;
29 | ;; ;; creating ssh-credentials
30 | ;; (def ssh-creds (create-ssh-creds "username"))
31 | ;;
32 | ;; ;; create a new node
33 | ;; (def node (create-node :default-ec2 node-spec))
34 | ;;
35 | ;; ;; make sure we're running one copy of this node
36 | ;; (def change (converge creds node 1))
37 | ;;
38 | ;; ;; explain what changed
39 | ;; (explain change)
40 | ;;
41 | ;; ;; create a new config named "ipfs-cluster" with `config-spec`
42 | ;; (def config (create-config "ipfs-cluster" config-spec))
43 | ;;
44 | ;; ;; do the provisioning
45 | ;; (def provision-change (provision ssh-creds node config))
46 | ;;
47 | ;; ;; explain what changed
48 | ;; (explain provision-change)
49 |
--------------------------------------------------------------------------------
/test/cube/db_test.clj:
--------------------------------------------------------------------------------
1 | (ns cube.db-test
2 | (:require [cube.db :as db])
3 | (:use clojure.test))
4 |
5 | (defn test-db [] {:db-path "/tmp/test-cube-db.clj"
6 | :state (atom {:name "barry"
7 | :numbers [5]
8 | :nested {:name "larry"}
9 | :instances {:running {}}})})
10 |
11 | (deftest access-value
12 | (is (= "barry" (db/access (test-db) :name)))
13 | (is (= [5] (db/access (test-db) :numbers))))
14 |
15 | (deftest access-in-value
16 | (is (= "barry" (db/access-in (test-db) [:name])))
17 | (is (= 5 (db/access-in (test-db) [:numbers 0])))
18 | (is (= {} (db/access-in (test-db) [:instances :running]))))
19 |
20 | (deftest put-value
21 | (let [new-db (test-db)]
22 | (db/put new-db :testing false)
23 | (is (= false (db/access new-db :testing)))))
24 |
25 | (deftest put-in-value
26 | (let [new-db (test-db)]
27 | (db/put-in new-db [:instances :running :test-id] true)
28 | (is (= true (db/access-in new-db [:instances :running :test-id])))))
29 |
30 | (deftest remove-value
31 | (let [new-db (test-db)]
32 | (db/remove new-db :name)
33 | (is (= nil (db/access new-db :name)))))
34 |
35 | (deftest remove-in-value
36 | (testing "Remove one key"
37 | (let [new-db (test-db)]
38 | (db/remove-in new-db [:name])
39 | (is (= nil (db/access-in new-db [:name])))))
40 | (testing "Not remove empty maps when removing nested values"
41 | (let [new-db (test-db)]
42 | (db/remove-in new-db [:nested :name])
43 | (is (= {} (db/access-in new-db [:nested])))
44 | (is (= nil (db/access-in new-db [:nested :name]))))))
45 |
46 | (deftest add-to-value
47 | (let [new-db (test-db)]
48 | (db/add-to new-db [:numbers] 1)
49 | (is (= [5 1] (db/access-in new-db [:numbers])))))
50 |
--------------------------------------------------------------------------------
/src/ui/pages/monitoring.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.pages.monitoring
2 | (:require [re-frame.core :refer [subscribe dispatch]]
3 | [ui.monitoring :as monitoring]
4 | [clojure.contrib.humanize :refer [filesize]]))
5 |
6 | (defn unix->jsdate [unix-timestamp]
7 | (js/Date. (* unix-timestamp 1000)))
8 |
9 | (def colors {:ok "bg-aqua"
10 | :warn "bg-yellow"
11 | :danger "bg-red"})
12 |
13 | (defn diskspace-colors [current-val]
14 | (cond
15 | (= current-val 0) (:danger colors)
16 | ;; Less than 10GB
17 | (< current-val 10000000000) (:warn colors)
18 | ;; More than 10GB
19 | (> current-val 10000000000) (:ok colors)
20 | :else "bg-gray"))
21 |
22 | (defn render []
23 | (let [pinsize @(subscribe [:monitoring/pinsize])
24 | freespace @(subscribe [:monitoring/freespace])]
25 | [:div
26 | [:div.ma1.pa1 (str "Last Update: " (-> pinsize :timestamp unix->jsdate))]
27 | [:div.tc.w-20.bg-aqua.white.pa2.ma1.fl
28 | [:div.f3.b "Space used by Pins"]
29 | [:div.monospace.mt2.f4 (-> pinsize :value filesize)]]
30 | [:div.tc.w-20.white.pa2.ma1.fl {:class (diskspace-colors (-> freespace :value))}
31 | [:div.f3.b "Free Diskspace"]
32 | [:div.monospace.mt2.f4 (-> freespace :value filesize)]]
33 | [:div.tc.w-20.bg-aqua.white.pa2.ma1.fl.o-20
34 | [:div.f3.b "CPU"]
35 | [:div.monospace.mt2.f4 "25%"]]
36 | [:div.tc.w-20.bg-red.white.pa2.ma1.fl.o-20
37 | [:div.f3.b "Memory"]
38 | [:div.monospace.mt2.f4 "64%"]]
39 | [:div.tc.w-20.bg-aqua.white.pa2.ma1.fl.o-20
40 | [:div.f3.b "Network"]
41 | [:div.monospace.mt2.f5 "24Mbps / 12Mbps (▲/▼)"]]
42 | [:div.cf]
43 | [:div.mt3 "Notice: Currently this only actually updates the 'Space used by
44 | Pins' and 'Free Diskspace' values. Other values are mock values
45 | and not real."]]))
46 |
--------------------------------------------------------------------------------
/src/ui/state.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.state (:require
2 | [re-frame.core :refer [reg-event-db reg-sub]]
3 | ;; TODO ruins dead code elimation
4 | [day8.re-frame.tracing :refer-macros [fn-traced]]))
5 |
6 | ;; contains:
7 | ;; - map of the initial state
8 | ;; - spec for validating the state after every change
9 | ;; - helper for validating state
10 |
11 | (def initial-state
12 | {:active-page "/"
13 | :remote-db {}})
14 |
15 | ;; Events for changing values in the db, basically "setters"
16 | (reg-event-db
17 | :initialize
18 | (fn-traced [_ _] initial-state))
19 |
20 | (reg-event-db
21 | :set-remote-db
22 | (fn-traced [db [_ remote-db]]
23 | (assoc db :remote-db remote-db)))
24 |
25 | (reg-event-db
26 | :set-active-page
27 | (fn-traced [db [_ url]]
28 | (assoc db :active-page url)))
29 |
30 | (reg-sub
31 | :active-page
32 | (fn-traced [db _]
33 | (:active-page db)))
34 |
35 | (reg-sub
36 | :instances/running
37 | (fn-traced [db _]
38 | (-> db
39 | :remote-db
40 | :instances
41 | :running)))
42 |
43 | (reg-sub
44 | :instances/wanted
45 | (fn-traced [db _]
46 | (-> db
47 | :remote-db
48 | :instances
49 | :wanted)))
50 |
51 | (reg-sub
52 | :pins
53 | (fn-traced [db _]
54 | (-> db
55 | :remote-db
56 | :pins)))
57 |
58 | ;; returns the first element that matches predicate
59 | (defn find-first
60 | [f coll]
61 | (first (filter f coll)))
62 |
63 | (defn cid-match? [pin cid]
64 | (= (:cid pin) cid))
65 |
66 | (reg-sub
67 | :pin
68 | (fn-traced [db [_ cid]]
69 | (find-first #(cid-match? % cid) (-> db
70 | :remote-db
71 | :pins))))
72 |
--------------------------------------------------------------------------------
/src/ui/main.cljs:
--------------------------------------------------------------------------------
1 | (ns ^:figwheel-always ui.main
2 | ;; core > external > local
3 | (:require [reagent.core :as reagent]
4 | [re-frame.core :refer [subscribe dispatch-sync dispatch]]
5 | [cljs.pprint :refer [pprint]]
6 | [ui.state :as state]
7 | [ui.router :as router]
8 | [ui.http :as http]
9 | [ui.login :as login]
10 | [ui.navigation :as navigation]
11 | [ui.websocket :as websocket]
12 | [ui.devtools :as devtools]))
13 |
14 | (devtools/init!)
15 |
16 | ;; app doing routing
17 | (defn app []
18 | "The default application view"
19 | [:div
20 | [navigation/navbar]
21 | [:div.ma3.gray-box.pa3
22 | (router/matching-page @(subscribe [:active-page]))]
23 | ;; Debug mode, shows the state on every page
24 | ;; [:pre (with-out-str (cljs.pprint/pprint @re-frame.db/app-db.))]
25 | ])
26 |
27 | ;; aaaaaand a render function! Does what it says on the tin
28 | (defn render! []
29 | (reagent/render [app]
30 | (js/document.getElementById "app")))
31 |
32 | ;; This function is called once dom is ready in `resources/public/index.html`
33 | (defn ^:export run
34 | []
35 | ;; All of these dispatches are syncronous as we want to make sure the
36 | ;; handlers of the events gets fully completed before we move on to the
37 | ;; next one and finally render for the first time
38 | ;; set the initial db
39 | (dispatch-sync [:initialize])
40 | ;; navigate to the page we're at according to url
41 | (dispatch-sync [:go-to-page (-> js/window .-location .-pathname)])
42 | ;; check if we're logged in
43 | (dispatch-sync [:check-logged-in])
44 | ;; setup event listeners for updating state when page changes
45 | (router/dispatch-new-pages! js/window)
46 | ;; And render!
47 | (render!))
48 |
49 | ;; This gets called by figwheel when we change a file
50 | (defn on-js-reload []
51 | (println "Rendering again")
52 | (render!))
53 |
--------------------------------------------------------------------------------
/src/cube/db.clj:
--------------------------------------------------------------------------------
1 | (ns cube.db
2 | (:require [com.stuartsierra.component :as c]
3 | [clojure.java.io :refer [make-parents]]
4 | [clojure.spec.alpha :as s]
5 | [shared.db :as shared-db]
6 | [clojure.pprint :refer [pprint]]))
7 |
8 | ;; TODO - DB under test currently overrides locally saved DB...
9 |
10 | (defn load-db [path]
11 | (try
12 | (read-string (slurp path))
13 | (catch java.io.FileNotFoundException _ nil)))
14 |
15 | (def initial-state {})
16 |
17 | (defn new-or-existing-db [path]
18 | (if-let [new-db (load-db path)]
19 | (atom (merge initial-state new-db))
20 | (atom initial-state)))
21 |
22 | (defn validate-new-state [new-state]
23 | (if (s/valid? :cube/db new-state)
24 | true
25 | (do (println "Explanation:")
26 | (s/explain :cube/db new-state)
27 | (println "Tried new state:")
28 | (pprint new-state)
29 | (println "From:")
30 | (pprint (.getStackTrace (Thread/currentThread))))))
31 |
32 | (defrecord DB [path]
33 | c/Lifecycle
34 | (start [this]
35 | (println (str "[db] Starting with db " path))
36 | (let [new-state (new-or-existing-db path)]
37 | (set-validator! new-state validate-new-state)
38 | (-> this
39 | (assoc :db-path path)
40 | (assoc :state new-state))))
41 |
42 | (stop [this]
43 | (println "[db] Stopping")
44 | (assoc this :state nil)))
45 |
46 | (defn persist! [db]
47 | (make-parents (:db-path db))
48 | (spit (:db-path db) (with-out-str (pprint @(:state db)))))
49 |
50 | (defn put [db k v]
51 | (do
52 | (swap! (:state db) assoc k v)
53 | (persist! db)))
54 |
55 | (defn put-in [db ks v]
56 | (do
57 | (swap! (:state db) assoc-in ks v)
58 | (persist! db)))
59 |
60 | (defn dissoc-in
61 | "Dissociates an entry from a nested associative structure returning a new
62 | nested structure. keys is a sequence of keys."
63 | [m [k & ks :as keys]]
64 | (if ks
65 | (if-let [nextmap (get m k)]
66 | (let [newmap (dissoc-in nextmap ks)]
67 | (assoc m k newmap))
68 | m)
69 | (dissoc m k)))
70 |
71 | (defn remove [db ks]
72 | (do
73 | (swap! (:state db) dissoc ks)
74 | (persist! db)))
75 |
76 | (defn remove-in [db ks]
77 | (do
78 | (swap! (:state db) dissoc-in ks)
79 | (persist! db)))
80 |
81 | (defn access [db k]
82 | (k @(:state db)))
83 |
84 | (defn access-in [db k]
85 | (get-in @(:state db) k nil))
86 |
87 | (defn add-to [db k v]
88 | (swap! (:state db) update-in k conj v))
89 |
90 | (defn on-change [db f]
91 | (add-watch (:state db) nil (fn [key atom old new]
92 | (when (not (= old new))
93 | (f new)))))
94 |
95 | (defn new [path]
96 | (map->DB {:path path}))
97 |
--------------------------------------------------------------------------------
/test/cube/cluster_test.clj:
--------------------------------------------------------------------------------
1 | (ns cube.cluster-test
2 | (:require [cube.cluster :as cluster]
3 | [clojure.spec.alpha :as s])
4 | (:use clojure.test))
5 |
6 | (def example-res '({:cid "QmAUeoxg6D9fYnfwXrVmVmkTm4QhTDTjyoE6ZfKtdGFSLm",
7 | :peer_map
8 | {:QmBbwt9jwWg4q7YMLkG7De2B9MaE7iYZjvV1eWJs4byEvK
9 | {:cid "QmAUeoxg6D9fYnfwXrVmVmkTm4QhTDTjyoE6ZfKtdGFSLm",
10 | :peer "QmBbwt9jwWg4q7YMLkG7De2B9MaE7iYZjvV1eWJs4byEvK",
11 | :peername "21bad271db77",
12 | :status "pinned",
13 | :timestamp "2019-01-20T15:21:23Z",
14 | :error ""},
15 | :QmVqRSNLNqFCKRKV1N4g2Wqi3wpdxhrtgiHm8mzsnQa6om
16 | {:cid "QmAUeoxg6D9fYnfwXrVmVmkTm4QhTDTjyoE6ZfKtdGFSLm",
17 | :peer "QmVqRSNLNqFCKRKV1N4g2Wqi3wpdxhrtgiHm8mzsnQa6om",
18 | :peername "b14754ed2375",
19 | :status "pinned",
20 | :timestamp "2019-01-20T15:21:23Z",
21 | :error ""}}}
22 | {:cid "QmS4fTD7Rh8NouNhp9uZbawUdBpgHaUTeL3EnxX8Tiiu7H",
23 | :peer_map
24 | {:QmBbwt9jwWg4q7YMLkG7De2B9MaE7iYZjvV1eWJs4byEvK
25 | {:cid "QmS4fTD7Rh8NouNhp9uZbawUdBpgHaUTeL3EnxX8Tiiu7H",
26 | :peer "QmBbwt9jwWg4q7YMLkG7De2B9MaE7iYZjvV1eWJs4byEvK",
27 | :peername "21bad271db77",
28 | :status "pinned",
29 | :timestamp "2019-01-20T15:20:28Z",
30 | :error ""},
31 | :QmVqRSNLNqFCKRKV1N4g2Wqi3wpdxhrtgiHm8mzsnQa6om
32 | {:cid "QmS4fTD7Rh8NouNhp9uZbawUdBpgHaUTeL3EnxX8Tiiu7H",
33 | :peer "QmVqRSNLNqFCKRKV1N4g2Wqi3wpdxhrtgiHm8mzsnQa6om",
34 | :peername "b14754ed2375",
35 | :status "pinned",
36 | :timestamp "2019-01-20T15:20:28Z",
37 | :error ""}}}))
38 |
39 | (defn format-test [res-to-use]
40 | (let [res (cluster/format-res res-to-use)]
41 | (is (= "QmAUeoxg6D9fYnfwXrVmVmkTm4QhTDTjyoE6ZfKtdGFSLm" (:cid (first res))))
42 | (is (= 2 (count (:peer-map (first res)))))
43 | (is (= "QmBbwt9jwWg4q7YMLkG7De2B9MaE7iYZjvV1eWJs4byEvK" (:peer-id (first (:peer-map (first res))))))
44 | (is (= nil (:error (first (:peer-map (first res))))))
45 | (is (= :pinned (:status (first (:peer-map (first res))))))))
46 |
47 | (deftest format-pins-response
48 | (format-test example-res))
49 |
50 | ;; Makes sure that whatever way the response is from ipfs-cluster, we make it
51 | ;; into the same order
52 | (deftest format-pins-response-sorts-res
53 | (format-test (reverse example-res)))
54 |
--------------------------------------------------------------------------------
/src/ui/navigation.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.navigation
2 | (:require [re-frame.core :refer [subscribe dispatch]]
3 | [ui.router :as router]))
4 |
5 | ;; list of navigation links, :name represents the permission the user needs to
6 | ;; have access to to see the link as active
7 | (def navbar-items [{:url "/home" :title "Home" :name "pins"}
8 | {:url "/upload" :title "Upload" :name "upload"}
9 | {:url "/pins" :title "Pins" :name "pins"}
10 | {:url "/instances" :title "Instances" :name "instances"}
11 | {:url "/users" :title "Users" :name "users"}
12 | {:url "/groups" :title "Groups" :name "groups"}
13 | {:url "/monitoring" :title "Monitoring" :name "monitoring"}
14 | {:url "/preferences" :title "Preferences" :name "preferences"}])
15 |
16 | (defn take-first-elements [items]
17 | (distinct (reduce (fn [acc [curr1 curr2]] (conj acc curr1)) [] items)))
18 |
19 | (defn is-string [item str]
20 | (= item str))
21 |
22 | (defn has-permission [permissions perm]
23 | (boolean (some #(is-string % perm) (take-first-elements permissions))))
24 |
25 | (defn prevent-default-then [ev then]
26 | (do (.preventDefault ev)
27 | (then)))
28 |
29 | (defn href-attr [url enabled?]
30 | {:href (if enabled? url "")
31 | :key url
32 | :onClick #(prevent-default-then % (fn [] (when enabled?
33 | (router/go-to-page url))))})
34 |
35 | (defn create-navbar-item [url title matched? enabled?]
36 | [:a.link.white.f5.dib.mr3
37 | (merge {:class [(when matched? "underline")]
38 | :disabled (not enabled?)}
39 | (href-attr url enabled?))
40 | title])
41 |
42 | (defn profile-control [profile]
43 | (if (nil? profile)
44 | [:div [:a.link.white.f5.dib.mr3 (href-attr "/login" true) "Login"]]
45 | [:div
46 | [:a.link.white.f5.dib.mr3 (href-attr "/profile" true)
47 | [:span.b "User: "]
48 | [:span (:username profile)]]
49 | [:a.link.white.f5.dib.mr3
50 | {:href "#"
51 | :onClick #(prevent-default-then % (fn []
52 | (dispatch [:logout])))} "Logout"]]))
53 |
54 | (defn navbar []
55 | [:nav.bg-navy
56 | [:div.w-80.pa3.fl
57 | [:a.link.dim.white.b.f3.dib.mr3.aqua (href-attr "/home" true) "Cube"]
58 | (let [active-page @(subscribe [:active-page])
59 | permissions @(subscribe [:login/permissions])]
60 | (doall (for [item navbar-items]
61 | (let [url (:url item)
62 | title (:title item)
63 | perm-name (:name item)
64 | matched? (= active-page url)
65 | enabled? (has-permission permissions perm-name)]
66 | (create-navbar-item url title matched? enabled?)))))]
67 | [:div.tr.w-20.fl.pa3 {:style {:height "27px" :line-height "27px"}}
68 | (profile-control @(subscribe [:login/profile]))]
69 | [:div.cf]])
70 |
--------------------------------------------------------------------------------
/docs/auth.md:
--------------------------------------------------------------------------------
1 | # Auth
2 |
3 | Functions prefixed with `auth:` like `db/auth:put` needs to be based to
4 | additional arguments, `user` and `permissions`, to check the authorization of
5 | the function call. Functions that gets called by `auth:` prefixed functions,
6 | should be private to avoid being called without `user` and `permissions`.
7 |
8 | ## Authentication
9 |
10 | Each user is a map with `username`, `password`, `roles` and `permissions` keys.
11 |
12 | Password is using the `bcrypt` password hashing function.
13 |
14 | Roles is currently limited to one `role` but setup that way to make it easier
15 | if needed to have multiple in the future.
16 |
17 | Notice: `roles` VS `groups` naming still undecided.
18 |
19 | ### HTTP
20 |
21 | Authentication for the HTTP endpoints works the same way for all endpoints
22 | except the `/login` handler.
23 |
24 | `/login` handler checks the request body for a username and password, checks
25 | it's correct and if so, signs the user's username with the applications secret.
26 | This JWT token is then used for doing the authentication and authorization.
27 |
28 | The rest of the endpoints protected by authentication, are checking for the
29 | token in the `Authorization` header, following a `Token ` declaration.
30 |
31 | ### WebSockets
32 |
33 | When the client (browser) connects to the WebSocket endpoint, it expects a cookie
34 | named `login-token` with the value of received JWT signed token from the login.
35 |
36 | If the cookie is missing or the JWT is incorrect, the connection will fail.
37 |
38 | If the authentication is correct, then the username signed in the JWT will be
39 | used to do the filtering of the DB so the user only sees the parts of the DB
40 | they are authorized to see.
41 |
42 | All writes to the DB is handled via HTTP so the authentication described above
43 | applies.
44 |
45 | ## Authorization
46 |
47 | Authorization is handled via the abstractions of `users`, `roles` and `permissions`
48 |
49 | Users are described above in the Authentication part.
50 |
51 | ## Groups
52 |
53 | A group is a named list of N permissions. Instead of assigning individual
54 | permissions to a user, owners of a Cube instance assigns permissions to groups,
55 | then assigns users to groups, to make reuse of permissions easier.
56 |
57 | ## Permissions
58 |
59 | A permission is a vector of two keywords, the first one describing what part
60 | of the DB this permission references, the second one is either `:read` or `:write`.
61 |
62 | For example, the permission `[:pins :read]` indicates that this group has read
63 | access to the pins of Cube.
64 |
65 | This permissions are currently being used to protect both the backend<>frontend
66 | synced DB and the HTTP endpoints (except `/login`, anyone can hit that endpoint)
67 |
68 | # TODO
69 | - [ ] Create spec for permissions/groups/users
70 | - [ ] Protect write endpoints
71 | - [ ] Allow to CRUD users
72 | - [ ] Allow to CRUD groups
73 | - [ ] Generate new `admin` password if first time running Cube
74 | - [ ] Enable changing the JWT signing secret via env vars
75 |
--------------------------------------------------------------------------------
/src/cube/instances.clj:
--------------------------------------------------------------------------------
1 | (ns cube.instances
2 | (:require [com.stuartsierra.component :as c]
3 | [cube.scheduler :as scheduler]
4 | [clojure.pprint :refer [pprint]]
5 | [cube.db :as db]
6 | [crypto.random :refer [hex]]
7 | ;; TODO currently hardcoding provider to docker
8 | [cube.providers.docker :as provider-docker]))
9 |
10 | (defn get-difference [a b]
11 | (- a b))
12 |
13 | (defn create-instances [db conn amount]
14 | (doseq [_ (range amount)]
15 | (provider-docker/create conn db)))
16 |
17 | (defn delete-instances [db conn amount]
18 | (doseq [_ (range amount)]
19 | (let [[id m] (first (db/access-in db [:instances :running]))]
20 | (provider-docker/destroy conn m)
21 | (db/remove-in db [:instances :running id])
22 | )))
23 |
24 | ;; Hard-coded to docker atm
25 | (defn check-instances [db docker-conn]
26 | (when-not (nil? (db/access-in db [:instances :wanted :docker]))
27 | (let [wanted (db/access-in db [:instances :wanted :docker])
28 | current (count (db/access-in db [:instances :running]))]
29 |
30 | (cond
31 | (= wanted 0) (doseq [[id m] (db/access-in db [:instances :running])]
32 | (provider-docker/destroy docker-conn m)
33 | (db/remove-in db [:instances :running id]))
34 | (> wanted current) (let [to-create (- wanted current)]
35 | (println (format "Creating %s new instances" to-create))
36 | (create-instances db docker-conn to-create))
37 | (< wanted current) (let [to-remove (- current wanted)]
38 | (println (format "Removing %s instances" to-remove))
39 | (delete-instances db docker-conn to-remove))
40 | (= wanted current) (comment "Balanced")))))
41 |
42 |
43 | (defrecord Instances [db scheduler docker]
44 | c/Lifecycle
45 | (start [this]
46 | (println "[instances] Starting")
47 | ;; Debug function to change state each tick
48 | ;; (scheduler/add-task scheduler #(db/put db :ticks (+ (db/access db :ticks) 1)))
49 | (when (nil? (db/access db :instances))
50 | (db/put db :instances {:wanted {}
51 | :running {}
52 | :cluster-secret (hex 32)}))
53 | (scheduler/add-task scheduler #(check-instances db (:connection docker)))
54 | ;; pull needed images
55 | (assoc this :instances {:db db}))
56 | (stop [this]
57 | (print "[instances] Stopping")
58 | (assoc this :instances nil)))
59 |
60 | (defn new []
61 | (map->Instances {}))
62 |
63 | (defn set-wanted [instances instance-type instance-count]
64 | (db/put-in (:db instances) [:instances :wanted instance-type] instance-count))
65 |
66 | (defn get-wanted [instances]
67 | (db/access-in (:db instances) [:instances :wanted]))
68 |
69 | (defn get-running [instances]
70 | (db/access-in (:db instances) [:instances :running]))
71 |
72 | (defn get-cluster-api-multiaddrs [instances]
73 | (db/access-in (:db instances) [:instances :running]))
74 |
--------------------------------------------------------------------------------
/docs/contributing.md:
--------------------------------------------------------------------------------
1 | # How to contribute to Cube?
2 |
3 | ## CONTRIBUTE WITH COOOOODE
4 | ### Requirements
5 |
6 | - Java version 1.8 (8) or later
7 | - Leingen (https://leiningen.org)
8 | - Only tested on Linux and macOS currently
9 |
10 | ### Development
11 | #### Quickstart
12 |
13 | Open a terminal window and enter the command:
14 |
15 | ```
16 | lein repl
17 | ```
18 |
19 | Once the repl is running, run `(start true)` to start the web server
20 | and figwheel which builds the frontend.
21 |
22 | Now visit `localhost:3000` in your favorite browser
23 |
24 | #### Frontend
25 |
26 | - Use `(figwheel-sidecar.repl-api/start-figwheel!)` to build and watch
27 | all frontend resources. Runs automatically with `(start true)`
28 | - Styles won't build automatically, you can run `lein less auto` to start doing
29 | that in a separate terminal.
30 | - cljs code will automatically build with `(start true)` but you can also run
31 | `lein cljsbuild once` to build it once.
32 |
33 | If you want a browser repl, first run `(start true)` and then in your favorite
34 | repl-enabled editor: `:Piggieback (figwheel-sidecar.repl-api/repl-env)` (example
35 | with vim-fireplace)
36 |
37 | Make sure that after `(start true)` you open `localhost:3000` (or wherever
38 | you have cube running) in your browser, as the repl will hang until a browser
39 | is available for executing commands for you.
40 |
41 | #### Backend
42 |
43 | - Use `lein run` to start the application like a user normally would (opens a GUI,
44 | uses a random port and opens a browser window automatically)
45 | - Use `(start)` in repl to just run the server
46 | - Use `(reset)` after `(start)` to reload all code and restart the system
47 | - Use `PORT=3000 CUBE_GUI=false CUBE_OPEN_BROWSER=false lein run` to run the app
48 | without opening the GUI or a browser window, and always use port 3000.
49 |
50 | ##### Development Practices
51 |
52 | The application is divided in three parts, `cube` which is the backend, `shared`
53 | which is basically specs and helper functions for data passed between the backend
54 | and frontend, and `ui` that is the frontend.
55 |
56 | `cube` is made out of components, that are then put together into a system. The
57 | repl or the CLI runs this full system with some configuration parameters. Some
58 | components call functions from other components.
59 |
60 | The piece that is pretty much present everywhere is the `DB` component. It's
61 | the shared, mutable state. Reads and writes to this is protected by a auth
62 | layer.
63 |
64 | ##### Tests
65 |
66 | You can run the tests with `lein test` or even `lein auto test` for self-running
67 | tests. That's magic!
68 |
69 | #### Release
70 |
71 | - Make sure you're on Java version 1.8 (8) with `java -version`
72 | - `lein less once`
73 | - `lein cljs once`
74 | - `lein uberjar`
75 |
76 | Now the released jar is the one in `target/cube-$version-standalone.jar`
77 |
78 | #### Directory Structure
79 |
80 | Basically, all the backend code lives at `src/cube`, frontend lives at `src/ui`
81 | and the shared code between the two lives in `src/shared`.
82 |
83 | ## Issues
84 |
85 | Please don't be afraid to open a issue if you have a question/problems about the code/product.
86 |
87 | Also, please do open a issue discussing a feature before trying to implement it,
88 | otherwise we might have to reject your eventual PR :(
89 |
--------------------------------------------------------------------------------
/src/ui/pages/instances.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.pages.instances
2 | (:require [re-frame.core :refer [reg-event-fx dispatch subscribe]]
3 | [reagent.core :as r]
4 | [cljs.pprint :refer [pprint]]
5 | [ui.components.text-input :refer [text-input]]
6 | [ui.components.button :refer [button]]
7 | [day8.re-frame.tracing :refer-macros [fn-traced]]
8 | ))
9 |
10 | (reg-event-fx
11 | :set-wanted-instances
12 | (fn-traced [cofx [_ n]]
13 | {:http {:method "POST"
14 | :url (str "/api/instances/wanted/docker/" n)
15 | :body ""
16 | :headers {}
17 | :on-success (fn [])}}))
18 |
19 | (defn submit-wanted-instances [n]
20 | (do
21 | (println (str "Setting " n " as # of wanted instances"))
22 | (dispatch [:set-wanted-instances n])))
23 |
24 | (defn instance-row [id instance onClick selected-id]
25 | [:div.monospace.dim {:key id
26 | :onClick onClick
27 | :class [(when (= id selected-id) "blue")]}
28 | (str "OK - " id " - " (:type instance))])
29 |
30 | (defn stats [wanted running]
31 | [:div.monospace (str "Wanted: " wanted " Running: " running)])
32 |
33 | (defn label [title text]
34 | [:div
35 | [:label.f6.b.db.m2 title]
36 | [:small.f6.lh-copy.black-60.db.mb2 text]])
37 |
38 | (defn selected-view [id instance]
39 | [:div
40 | (label "go-ipfs container" (-> instance :metadata :go-ipfs-id))
41 | (label "ipfs-cluster container" (-> instance :metadata :ipfs-cluster-id))
42 | (label "instance type" (:type instance))
43 | (label "ipfs-cluster api multiaddr" (:cluster-api instance))])
44 |
45 | (def value (r/atom 0))
46 | (def selected (r/atom nil))
47 |
48 | (defn count-wanted [m]
49 | (reduce + (vals m)))
50 |
51 | (defn render []
52 | (let [wanted (count-wanted @(subscribe [:instances/wanted]))
53 | running (count @(subscribe [:instances/running]))]
54 | [:div
55 | [:div.w-100.fl
56 | [:div.w-30.fl.pa3
57 | [:h3.f3 "Your Instances"]
58 | [:p "Here you can manage your instances, like creating new or delete
59 | the existing ones."]]
60 | [:div.w-30.fl.pa3
61 | [:h3.f3 "How many instances to run"]
62 | [:div.mt3 (stats wanted running)]
63 | [:div.mt3
64 | (text-input {:id "wanted"
65 | :label "Wanted Instances"
66 | :description "This number decides how many instances Cube will try to run"
67 | :type "number"
68 | :value (if (= 0 @value) running @value)
69 | :onEnter #(submit-wanted-instances @value)
70 | :onChange #(reset! value (-> % .-target .-value))})]
71 | (button {:text "Set"
72 | :onClick #(submit-wanted-instances @value)})]
73 | [:div.w-30.fl.pa3
74 | (if @selected
75 | [:div
76 | [:h3.f3 (str "Details about " @selected)]
77 | [:div.mt3 (selected-view @selected (@selected @(subscribe [:instances/running])))]]
78 | [:div
79 | [:h3.f3 "Details"]
80 | [:p "Details about a instance will show here when you select one"]])]
81 | [:div.w-100.fl
82 | [:div.pa4]
83 | [:div.mt3
84 | [:div.f3 "Running Instances"]
85 | [:div.mt1 (for [[id i] @(subscribe [:instances/running])]
86 | (instance-row id i #(reset! selected id) @selected))]]]]
87 | [:div.cf]]))
88 |
--------------------------------------------------------------------------------
/src/cube/cluster.clj:
--------------------------------------------------------------------------------
1 | (ns cube.cluster (:require [com.stuartsierra.component :as c]
2 | [cube.scheduler :as scheduler]
3 | [cube.instances :as instances]
4 | [cube.db :as db]
5 | [clojure.pprint :refer [pprint]]
6 | [clj-http.client :as http]))
7 |
8 | (defn format-peer-info [peer]
9 | (-> (if (empty? (:error peer)) (dissoc peer :error) peer)
10 | (dissoc :peername)
11 | (assoc :peer-id (:peer peer))
12 | (dissoc :peer)
13 | (assoc :status (keyword (:status peer)))
14 | (dissoc :cid)))
15 |
16 | (defn format-res [res]
17 | (sort-by :cid (vec (map (fn [p] {:cid (:cid p)
18 | :peer-map (vec (map format-peer-info (vals (:peer_map p))))}) res))))
19 |
20 | (defn get-api-addr [instances]
21 | (:cluster-api (second (first (instances/get-running instances)))))
22 |
23 | (defn get-proxy-addr [instances]
24 | (:ipfs-proxy (second (first (instances/get-running instances)))))
25 |
26 | (defn get-name-for-pin [api-addr pin]
27 | (-> (http/get (format "%s/allocations/%s" api-addr (:cid pin)) {:as :json})
28 | :body
29 | :name))
30 |
31 | (defn get-size-for-pin [proxy-addr pin]
32 | (-> (http/get (format "%s/api/v0/object/stat/%s" proxy-addr (:cid pin)) {:as :json})
33 | :body
34 | :CumulativeSize))
35 |
36 | (defn set-name [api-addr pin]
37 | (if (nil? (:name pin))
38 | (assoc pin :name (get-name-for-pin api-addr pin))
39 | pin))
40 |
41 | (defn set-size [proxy-addr pin]
42 | (if (nil? (:size pin))
43 | (assoc pin :size (get-size-for-pin proxy-addr pin))))
44 |
45 | (defn set-for-pins [func addr pins]
46 | (map #(func addr %) pins))
47 |
48 | (defn update-pins [db instances]
49 | (let [inst (second (first (instances/get-running instances)))
50 | api-addr (:cluster-api inst)
51 | proxy-addr (:ipfs-proxy inst)]
52 | (when api-addr
53 | (let [pins (format-res (:body (http/get (format "%s/pins" api-addr) {:as :json})))]
54 | (->> pins
55 | (set-for-pins set-name api-addr)
56 | (set-for-pins set-size proxy-addr)
57 | (db/put db :pins))))))
58 |
59 | (defn add-new-pin [instances cid cid-name]
60 | (http/post
61 | (format "%s/pins/%s?name=%s" (get-api-addr instances) cid cid-name)
62 | {:as :json}))
63 |
64 | (defn get-freespace-metrics [cluster]
65 | (:body (http/get
66 | (format "%s/monitor/metrics/freespace" (get-api-addr (:instances cluster)))
67 | {:as :json})))
68 |
69 | (defrecord Cluster [db scheduler instances]
70 | c/Lifecycle
71 | (start [this]
72 | (println "[cluster] Starting...")
73 | (scheduler/add-task scheduler #(update-pins db instances))
74 | (-> this
75 | (assoc :db db)
76 | (assoc :instances instances)))
77 | (stop [this]
78 | (println "[cluster] Stopping...")
79 | this))
80 |
81 | (defn new []
82 | (map->Cluster {}))
83 |
84 | (defn pin [cluster cid cid-name]
85 | (add-new-pin (:instances cluster) cid cid-name))
86 |
87 | (defn remove-pin [cluster cid]
88 | (http/delete
89 | (format "%s/pins/%s" (get-api-addr (:instances cluster)) cid)
90 | {:as :json}))
91 |
92 | (defn get-pins [cluster]
93 | (db/access (:db cluster) :pins))
94 |
95 | (defn status [cluster cid]
96 | (:body
97 | (http/get
98 | (format "%s/pins/%s" (get-api-addr (:instances cluster)) cid)
99 | {:as :json})))
100 |
101 | (defn status-all [cluster]
102 | (:body
103 | (http/get
104 | (format "%s/pins" (get-api-addr (:instances cluster)))
105 | {:as :json})))
106 |
--------------------------------------------------------------------------------
/src/cube/gui.clj:
--------------------------------------------------------------------------------
1 | (ns cube.gui
2 | (:gen-class)
3 | (:require [clojure.pprint :refer [pprint]]
4 | [clojure.java.browse :refer [browse-url]]
5 | [com.stuartsierra.component :as c])
6 | (:use seesaw.core))
7 |
8 | (def cube-status-str {:starting "Starting..."
9 | :running "Running!"
10 | :error "Error!"})
11 |
12 | (def setup-password (atom ""))
13 | (def http-port (atom 0))
14 |
15 | (defn get-status [k] (str "Status: " (k cube-status-str)))
16 | (defn get-url [] (str "URL: " (str "http://localhost:" @http-port)))
17 | (defn get-password [] @setup-password)
18 |
19 | (def status-label (label :text (get-status :starting)))
20 | (def port-label (label :text "URL: N/A"))
21 | (def password-label (label :text "Setup Password:"))
22 | (def password-output (let [out (text :text (get-password)
23 | :editable? false
24 | :columns 1)]
25 | (.setBackground out nil)
26 | (.setBorder out nil)
27 | out))
28 |
29 | (defn cube-url [port]
30 | (str "http://localhost:" port))
31 |
32 | (defn setup-url [port password]
33 | (str (cube-url port) "/setup/" password "/welcome"))
34 |
35 | (defn open-dashboard [port]
36 | (browse-url (cube-url port)))
37 |
38 | (defn open-setup [port password]
39 | (browse-url (setup-url port password)))
40 |
41 | (def shutdown-button (action
42 | :handler (fn [e] (System/exit 0))
43 | :enabled? false
44 | :name "Shutdown and exit"))
45 |
46 | (def open-setup-page-button (action
47 | :handler (fn [e]
48 | (future (open-setup @http-port @setup-password)))
49 | :enabled? false
50 | :name "Open Setup Page"))
51 |
52 | (def open-dashboard-button (action
53 | :handler (fn [e]
54 | (future (open-dashboard @http-port)))
55 | :enabled? false
56 | :name "Open Cube Dashboard"))
57 |
58 | (def panel (vertical-panel
59 | :items [
60 | (label :text "Cube Control Panel" :font "ARIAL-BOLD-21")
61 | status-label
62 | port-label
63 | "---"
64 | password-label
65 | password-output
66 | "---"
67 | open-dashboard-button
68 | open-setup-page-button
69 | shutdown-button]))
70 |
71 | (defn server-started! [] (do
72 | (config! shutdown-button :enabled? true)
73 | (config! open-setup-page-button :enabled? true)
74 | (config! open-dashboard-button :enabled? true)
75 | (config! status-label :text (get-status :running))
76 | (config! port-label :text (get-url))
77 | (config! password-output :text (get-password))))
78 |
79 | (defn set-port! [port]
80 | (reset! http-port port))
81 |
82 | (defn set-password! [password]
83 | (reset! setup-password password))
84 |
85 | (defn start-gui []
86 | (let [myframe (frame :title "Cube",
87 | :content panel
88 | :width 350
89 | :height 220
90 | :resizable? false
91 | :on-close :exit)]
92 | (invoke-later
93 | (show! myframe))))
94 |
--------------------------------------------------------------------------------
/src/cube/monitoring.clj:
--------------------------------------------------------------------------------
1 | (ns cube.monitoring
2 | (:require [clojure.spec.alpha :as s]
3 | [clojure.spec.test.alpha :as stest]
4 | [com.stuartsierra.component :as c]
5 | [cube.cluster :as cluster]
6 | [cube.instances :as instances]
7 | [cube.db :as db]
8 | [cube.scheduler :as scheduler]))
9 |
10 | (s/def ::timestamp string?)
11 |
12 | (s/def ::value int?)
13 |
14 | (s/def ::entry (s/keys :req-un [::timestamp
15 | ::value]))
16 |
17 | (s/def ::history (s/coll-of ::entry))
18 |
19 | (s/def ::current ::entry)
20 |
21 | (s/def ::pinsize (s/keys :req-un [::current
22 | ::history]))
23 |
24 | (s/def ::freespace (s/keys :req-un [::current
25 | ::history]))
26 |
27 | (s/def ::state (s/keys :req-un [::pinsize
28 | ::freespace]))
29 |
30 | (def state (atom {:freespace {:current nil :history []}
31 | :pinsize {:current nil :history []}}))
32 |
33 |
34 | (s/fdef get-current-time
35 | :ret int?)
36 |
37 | (defn get-current-time [] (quot (System/currentTimeMillis) 1000))
38 |
39 | (s/fdef add-to-state
40 | :args (s/cat :entry ::entry)
41 | :ret nil?)
42 |
43 | (defn add-to-state! [entry t]
44 | (do
45 | (swap! state assoc-in [t :current] entry)
46 | (swap! state update-in [t :history] conj entry)))
47 |
48 | (s/fdef calculate-total-pin-size
49 | :args (s/cat :pins :cube/pins)
50 | :ret (s/and int? pos?))
51 |
52 | (defn calculate-total-pin-size [pins]
53 | (reduce (fn [acc curr] (+ acc (:size curr))) 0 pins))
54 |
55 | (s/def :freespace/name string?)
56 | (s/def :freespace/peer string?)
57 | (s/def :freespace/value string?)
58 | (s/def ::freespace-from-cluster (s/keys :req-un [:freespace/name
59 | :freespace/peer
60 | :freespace/value]))
61 |
62 | (s/fdef calculate-total-freespace
63 | :args (s/cat :freespaces ::freespace-from-cluster)
64 | :ret (s/and int?))
65 |
66 | (defn calculate-total-freespace [freespaces]
67 | (reduce (fn [acc curr] (+ acc (Long/parseLong (:value curr)))) 0 freespaces))
68 |
69 | (s/fdef create-entry
70 | :args (s/cat :value ::value)
71 | :ret ::entry)
72 |
73 | (defn create-entry [size]
74 | {:value size
75 | :timestamp (get-current-time)})
76 |
77 | (defn check-pin-total-size [cluster]
78 | (-> cluster
79 | (cluster/get-pins)
80 | (calculate-total-pin-size)
81 | (create-entry)
82 | (add-to-state! :pinsize)))
83 |
84 | (defn check-cluster-freespace [cluster]
85 | (-> cluster
86 | (cluster/get-freespace-metrics)
87 | (calculate-total-freespace)
88 | (create-entry)
89 | (add-to-state! :freespace)))
90 |
91 | (defn check-metrics [instances cluster]
92 | (when (> (count (instances/get-running instances)) 0)
93 | (do (check-pin-total-size cluster)
94 | (check-cluster-freespace cluster))))
95 |
96 | (defn set-db-current-value [db]
97 | (db/put-in db [:monitoring :pinsize] (-> @state :pinsize :current))
98 | (db/put-in db [:monitoring :freespace] (-> @state :freespace :current)))
99 |
100 | (defrecord Monitoring [db scheduler instances cluster]
101 | c/Lifecycle
102 | (start [this]
103 | (println "[monitoring] Starting")
104 | (scheduler/add-task scheduler #(check-metrics instances cluster))
105 | (scheduler/add-task scheduler #(set-db-current-value db))
106 | (-> (create-entry 0) (add-to-state! :freespace))
107 | (-> (create-entry 0) (add-to-state! :pinsize))
108 | this)
109 | (stop [this]
110 | (println "[monitoring] Stopping")
111 | this))
112 |
113 | (defn new []
114 | (map->Monitoring {}))
115 |
--------------------------------------------------------------------------------
/src/cube/cli.clj:
--------------------------------------------------------------------------------
1 | (ns cube.cli
2 | (:require [com.stuartsierra.component :as c]
3 | [cube.system :refer [create-system]]
4 | [cube.gui :as gui]
5 | [clojure.tools.trace :as trace])
6 | (:gen-class))
7 |
8 | (def running-system (atom nil))
9 |
10 | (defn get-port
11 | "Returns the value of the env var PORT or defaults to port 0"
12 | []
13 | (let [port (System/getenv "PORT")]
14 | (if (nil? port)
15 | 0
16 | (Integer/parseInt port))))
17 |
18 | (defn get-db-path
19 | "Returns the value of the env var CUBE_PATH or defaults to ~/.cube/db.clj"
20 | []
21 | (let [path (System/getenv "CUBE_PATH")]
22 | (if (nil? path)
23 | (str (System/getProperty "user.home") "/.cube/db.clj")
24 | path)))
25 |
26 | (defn gui?
27 | "Returns true if CUBE_GUI not set or set to 'true', otherwise returns false"
28 | []
29 | (let [cube-gui (System/getenv "CUBE_GUI")]
30 | (if (nil? cube-gui)
31 | true
32 | (Boolean/parseBoolean cube-gui))))
33 |
34 | (defn open-browser?
35 | "Returns true if CUBE_OPEN_BROWSER not set or set to 'true', otherwise false"
36 | []
37 | (let [cube-browser (System/getenv "CUBE_OPEN_BROWSER")]
38 | (if (nil? cube-browser)
39 | true
40 | (Boolean/parseBoolean cube-browser))))
41 |
42 | (defn tracing-enabled?
43 | "Returns true if CUBE_TRACING set to `true`, otherwise `false`"
44 | []
45 | (let [tracing? (System/getenv "CUBE_TRACING")]
46 | (if (nil? tracing?)
47 | false
48 | (Boolean/parseBoolean tracing?))))
49 |
50 | (defn start-system! [params]
51 | (reset! running-system (c/start (create-system params))))
52 |
53 | (defn stop-system! []
54 | (c/stop @running-system)
55 | (reset! running-system nil))
56 |
57 | (defn get-port-from-system [live-system]
58 | (-> @live-system
59 | :web
60 | :server
61 | (meta)
62 | :local-port))
63 |
64 | (defn get-setup-password-from-system [live-system]
65 | ;; (setup/get-password (:db @live-system))
66 | "random-password"
67 | )
68 |
69 | (defn setup-complete? [live-system]
70 | ;; (setup/completed? (:db @live-system))
71 | true
72 | )
73 |
74 | (defn get-cube-namespaces []
75 | (->> (all-ns)
76 | (filter #(clojure.string/starts-with? % "cube"))))
77 |
78 | ;; Trying to be clever and get all namespaces dynamically but trace-ns is
79 | ;; trying to trace the symbol as the actual namespace, instead of the value
80 | ;; of the symbol (which is the namespace to trace)
81 | ;; (defn trace-cube-namespaces []
82 | ;; (doseq [n (get-cube-namespaces)]
83 | ;; (trace/trace-ns n)))
84 | ;;
85 | ;; Easy solution for now is to just manually list the namespaces
86 | (defn trace-cube-namespaces []
87 | (do (trace/trace-ns 'cube.cli)
88 | (trace/trace-ns 'cube.cluster)
89 | (trace/trace-ns 'cube.db)
90 | (trace/trace-ns 'cube.gui)
91 | (trace/trace-ns 'cube.instances)
92 | (trace/trace-ns 'cube.scheduler)
93 | (trace/trace-ns 'cube.system)
94 | (trace/trace-ns 'cube.web)
95 | ))
96 |
97 | (defn -main [& args]
98 | (when (tracing-enabled?)
99 | (trace-cube-namespaces))
100 | (when (gui?)
101 | (gui/start-gui))
102 | (start-system! {:http-port (get-port)
103 | :db-path (get-db-path)})
104 | (let [port (get-port-from-system running-system)
105 | password (get-setup-password-from-system running-system)]
106 | (when (gui?)
107 | (do
108 | (gui/set-port! port)
109 | (gui/set-password! password)
110 | (gui/server-started!)))
111 | (when (open-browser?)
112 | (if (setup-complete? running-system)
113 | (gui/open-dashboard port)
114 | (gui/open-setup port password)))
115 | (println "======")
116 | (println (str "Server running on http://localhost:" port))
117 | (println (str "Setup Password: " password))))
118 |
--------------------------------------------------------------------------------
/src/ui/router.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.router
2 | (:require [clojure.string :as string]
3 | [cljs.pprint :refer [pprint]]
4 |
5 | [re-frame.core :refer [dispatch reg-event-fx subscribe]]
6 | [bidi.bidi :as bidi]
7 |
8 | ;; TODO find a way of dynamically load these instead
9 | [ui.pages.home :as home]
10 | [ui.pages.upload :as upload]
11 | [ui.pages.pins :as pins]
12 | [ui.pages.pin :as pin]
13 | [ui.pages.instances :as instances]
14 | [ui.pages.users :as users]
15 | [ui.pages.groups :as groups]
16 | [ui.pages.monitoring :as monitoring]
17 | [ui.pages.preferences :as preferences]
18 | [ui.pages.login :as login]
19 | ;; TODO ruins dead code elimation
20 | [day8.re-frame.tracing :refer-macros [fn-traced]]))
21 |
22 | (defn go-to-page [url]
23 | (dispatch [:go-to-page url]))
24 |
25 | (defn go-to-subpage [subpage]
26 | (dispatch [:go-to-subpage subpage]))
27 |
28 | (defn redirect-subpage [subpage]
29 | (dispatch [:go-to-subpage subpage]))
30 |
31 | (defn handle-popstate [ev]
32 | (when (not (nil? (.-state ev)))
33 | (dispatch [:set-active-page (-> ev .-state .-url)])))
34 |
35 | (defn dispatch-new-pages! [ctx]
36 | "Listens to popstate events on 'ctx' and dispatches :set-active-page with the new url"
37 | (.addEventListener ctx "popstate" handle-popstate))
38 |
39 | (def url-map ["/" {"" home/render
40 | "home" home/render
41 | "upload" upload/render
42 | "pins" pins/render
43 | ["pins/" :cid] pin/render
44 | "instances" instances/render
45 | "users" users/render
46 | "groups" groups/render
47 | "monitoring" monitoring/render
48 | "preferences" preferences/render
49 | "login" login/render}])
50 |
51 | (defn not-found [urls active-page]
52 | [:div
53 | [:p (str "Could not find a page for `" active-page "` in list of urls")]
54 | [:pre (with-out-str (pprint urls))]])
55 |
56 | (defn matching-page [active-page]
57 | (if-let [route (bidi/match-route url-map active-page)]
58 | ((:handler route) (:route-params route))
59 | (not-found url-map active-page)))
60 |
61 | (reg-event-fx
62 | :go-to-page
63 | (fn-traced [cofx [_ url]]
64 | {:db (assoc (:db cofx) :active-page url)
65 | :dispatch [:push-state url]}))
66 |
67 | (defn replace-last-url-part
68 | [full part]
69 | "Replaces last component of a full URL with part"
70 | (string/join
71 | "/"
72 | (let [splitted (string/split full "/")]
73 | (concat (butlast splitted) (list part)))))
74 |
75 | ;; Does the same as :go-to-page, but only changes the last part of the URL
76 | ;; Example: on page `/setup/pw/welcome` and dispatch `[:go-to-subpage "users"]`
77 | ;; will send user to page `/setup/pw/users`
78 | (reg-event-fx
79 | :go-to-subpage
80 | (fn-traced [cofx [_ new-sub-page]]
81 | ;; TODO should not subscribe! Pass active page in event
82 | (let [active-page @(subscribe [:active-page])
83 | new-url (replace-last-url-part active-page new-sub-page)]
84 | {:db (assoc (:db cofx) :active-page new-url)
85 | :dispatch [:push-state new-url]})))
86 |
87 | (reg-event-fx
88 | :add-subpage
89 | (fn-traced [cofx [_ new-sub-page]]
90 | ;; TODO should not subscribe! Pass active page in event
91 | (let [active-page @(subscribe [:active-page])
92 | new-url (str active-page "/" new-sub-page)]
93 | {:db (assoc (:db cofx) :active-page new-url)
94 | :dispatch [:push-state new-url]})))
95 |
96 | (reg-event-fx
97 | :push-state
98 | (fn-traced [_ [_ url]]
99 | (.pushState window.history (clj->js {:url url}) "" url)))
100 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject cube "0.2.0-SNAPSHOT"
2 | :description "IPFS Cube will help people deploy and manage their own IPFS pinning services on top of existing cheap hardware, or cloud storage."
3 | :url "https://github.com/ipfs-shipyard/cube"
4 | :jvm-opts ["-Dclojure.compiler.direct-linking=true"]
5 | :license {:name "MIT"
6 | :url "https://opensource.org/licenses/MIT"}
7 | :plugins [[lein-ring "0.12.4"]
8 | [lein-cljsbuild "1.1.7"]
9 | [lein-figwheel "0.5.18"]
10 | [lein-auto "0.1.3"]
11 | [lein-less "1.7.5"]
12 | [lein-shell "0.5.0"]
13 | [io.taylorwood/lein-native-image "0.3.0"]
14 | [lein-cloverage "1.0.13"]]
15 | :native-image {:name "cube"
16 | :graal-bin "graalvm-ce-1.0.0-rc11/"
17 | :opts ["--verbose"
18 | "--enable-url-protocols=http,https"
19 | "-Dclojure.compiler.direct-linking=true"
20 | "--report-unsupported-elements-at-runtime"
21 | "--allow-incomplete-classpath"]}
22 | :dependencies [[javax.xml.bind/jaxb-api "2.3.0"]
23 | [org.clojure/clojure "1.10.0"]
24 | [http-kit "2.3.0"]
25 | [ring "1.7.1"]
26 | [ring/ring-core "1.7.1"]
27 | [ring/ring-json "0.4.0"]
28 | [clj-http "3.9.1"]
29 | [com.stuartsierra/component "0.4.0"]
30 | [compojure "1.6.1"]
31 | [crypto-random "1.2.0"]
32 | [seesaw "1.5.0"]
33 | [korma "0.4.3"]
34 | [ragtime "0.7.2"]
35 | [digitalocean "1.2" :exclusions [midje]]
36 | [javax.servlet/servlet-api "2.5"]
37 | [tea-time "1.0.1"]
38 | [clj-ssh "0.5.14"]
39 | [ring-json-response "0.2.0"]
40 | [aleph "0.4.6"]
41 | [lispyclouds/clj-docker-client "0.1.12"]
42 | [com.fasterxml.jackson.core/jackson-core "2.9.8"]
43 | [org.clojure/tools.trace "0.7.10"]
44 | [buddy/buddy-auth "2.1.0"]
45 | [crypto-password "0.2.0"]
46 | [org.clojure/clojurescript "1.10.238"]
47 | [day8.re-frame/re-frame-10x "0.3.6-react16"]
48 | [reagent "0.8.1"]
49 | [reagent-utils "0.3.2"]
50 | [hiccup "1.0.5"]
51 | [re-frame "0.10.6"]
52 | [bidi "2.1.5"]
53 | [day8.re-frame/tracing "0.5.1"]
54 | [org.clojure/test.check "0.10.0-alpha3"]
55 | [figwheel-sidecar "0.5.18"]
56 | [cider/piggieback "0.3.10"]
57 | [binaryage/devtools "0.9.10"]
58 | [clojure-humanize "0.2.2"]]
59 | :profiles {:uberjar {:hooks [leiningen.cljsbuild leiningen.less]}}
60 | :repl-options {:nrepl-middleware [cider.piggieback/wrap-cljs-repl]
61 | :init-ns cube.dev}
62 | :less {:source-paths ["src/ui/less"]
63 | :target-path "resources/public/css"}
64 | :figwheel { :css-dirs ["resources/public/css"]}
65 | :cljsbuild {:builds [{
66 | :id "main"
67 | :source-paths ["src/ui"]
68 | :figwheel {:on-jsload "ui.main/on-js-reload"}
69 | :compiler {
70 | :output-dir "./resources/public/js"
71 | :output-to "./resources/public/js/cljs-file.js"
72 | :source-map true
73 | ;; TODO enable production builds without devtools
74 | ;; :optimizations :advanced
75 | :optimizations :none
76 | :preloads [day8.re-frame-10x.preload figwheel.preload]
77 | :pretty-print true
78 | }}]}
79 | :main cube.cli
80 | ;; TODO aot disabled for now as corrupts refresh of namespaces in repl
81 | ;; :aot [cube.cli]
82 | )
83 |
--------------------------------------------------------------------------------
/src/shared/db.cljc:
--------------------------------------------------------------------------------
1 | (ns shared.db
2 | (:require [clojure.spec.alpha :as s]
3 | [clojure.spec.gen.alpha :as gen]
4 | [clojure.pprint :refer [pprint]]))
5 |
6 | ;; This file contains bunch of clojure specs for all values that goes into the
7 | ;; DB. If changes are being made that doesn't fit these specs, the change will
8 | ;; fail and be rolled back.
9 |
10 | ;; See more: https://clojure.org/about/spec
11 |
12 | ;; Utils
13 | (s/def :cube.util/not-empty-string (s/and string? (complement empty?)))
14 |
15 | ;; Instances
16 | (s/def :cube.instances.docker/go-ipfs-id :cube.util/not-empty-string)
17 | (s/def :cube.instances.docker/ipfs-cluster-id :cube.util/not-empty-string)
18 |
19 | (s/def :cube.instances.docker/metadata (s/keys :req-un [:cube.instances.docker/go-ipfs-id
20 | :cube.instances.docker/ipfs-cluster-id]))
21 |
22 | (s/def :cube.instances.do/ssh-key :cube.util/not-empty-string)
23 | (s/def :cube.instances.do/ipv4 :cube.util/not-empty-string)
24 |
25 | (s/def :cube.instances.do/metadata (s/keys :req-un [:cube.instances.do/ssh-key
26 | :cube.instances.do/ipv4]))
27 |
28 | (s/def :cube.instances/type #{:docker :do})
29 | (s/def :cube.instances/count (s/and int? (s/or :positive pos? :zero zero?)))
30 |
31 | (s/def :cube.instances/cluster-api :cube.util/not-empty-string)
32 |
33 | (s/def :cube.instances/metadata (s/or :docker :cube.instances.docker/metadata
34 | :do :cube.instances.do/metadata))
35 |
36 | (s/def :cube.instances/instance (s/keys :req-un [:cube.instances/type
37 | :cube.instances/cluster-api
38 | :cube.instances/metadata]))
39 |
40 |
41 | (s/def :cube.instances/wanted (s/map-of :cube.instances/type :cube.instances/count))
42 |
43 | (s/def :cube.instances/cluster-secret :cube.util/not-empty-string)
44 |
45 | (s/def :cube.instances/running (s/map-of keyword? :cube.instances/instance))
46 |
47 | (s/def :cube/instances (s/keys :req-un [:cube.instances/cluster-secret
48 | :cube.instances/wanted
49 | :cube.instances/running]))
50 |
51 | ;; Pins
52 | ;; TODO needs to have all pinning statuses from ipfs-cluster
53 |
54 | (s/def :cube.pin.peer/status #{:pinned
55 | :pinning
56 | :pin_error
57 | :unpin_error})
58 |
59 | (s/def :cube.pin.peer/peer-id :cube.util/not-empty-string)
60 | (s/def :cube.pin.peer/timestamp :cube.util/not-empty-string)
61 |
62 | (s/def :cube.pin/peer (s/keys :req-un [:cube.pin.peer/peer-id
63 | :cube.pin.peer/status
64 | :cube.pin.peer/timestamp]))
65 |
66 | (s/def :cube.pin/peer-map (s/coll-of :cube.pin/peer))
67 |
68 | ;; TODO Currently only validates it starts with `Qm` and at least 10 characters
69 | ;; Should be implemented as specs in multiformats/clj-multihash instead
70 | (defn multihash? [cid]
71 | (let [chs (take 2 cid)
72 | [f s] chs]
73 | (if (= f \Q)
74 | (if (= s \m)
75 | (if (> (count cid) 10)
76 | true
77 | false)
78 | false)
79 | false)))
80 |
81 | (s/def :cube/multihash (s/and :cube.util/not-empty-string multihash?))
82 |
83 | (s/def :cube.pin/cid (s/with-gen
84 | :cube/multihash
85 | #(gen/fmap (fn [s] (str "Qm" s)) (gen/string-alphanumeric))))
86 |
87 | (s/def :cube.pin/name :cube.util/not-empty-string)
88 |
89 | (s/def :cube.pin/size (s/and int? pos?))
90 |
91 | (s/def :cube.pins/pin (s/keys :req-un [:cube.pin/cid
92 | :cube.pin/name
93 | :cube.pin/size
94 | :cube.pin/peer-map]))
95 |
96 | (s/def :cube/pins (s/coll-of :cube.pins/pin))
97 |
98 | (s/def :cube/db (s/keys :opt-un [:cube/instances
99 | :cube/pins]))
100 |
--------------------------------------------------------------------------------
/src/cube/providers/do.clj:
--------------------------------------------------------------------------------
1 | (ns cube.providers.do
2 | (:require [digitalocean.v2.core :as do]
3 | [clojure.spec.alpha :as s]
4 | [clojure.pprint :refer [pprint]]
5 | [cube.providers.provider :as provider]))
6 |
7 | ;; This is not used at all currently, as the provider is not ready
8 |
9 | ;; TODO bunch of data straight from the DO API, should be verified with spec
10 | (def sizes [{:vcpus 1,
11 | :disk 20,
12 | :slug "512mb",
13 | :price_monthly 5.0,
14 | :transfer 1.0,
15 | :price_hourly 0.007439999841153622,
16 | :regions ["ams2"
17 | "ams3"
18 | "blr1"
19 | "fra1"
20 | "lon1"
21 | "nyc1"
22 | "nyc2"
23 | "nyc3"
24 | "sfo1"
25 | "sfo2"
26 | "sgp1"
27 | "tor1"],
28 | :memory 512,
29 | :available true}
30 | {:vcpus 1,
31 | :disk 25,
32 | :slug "s-1vcpu-1gb",
33 | :price_monthly 5.0,
34 | :transfer 1.0,
35 | :price_hourly 0.007439999841153622,
36 | :regions ["ams2"
37 | "ams3"
38 | "blr1"
39 | "fra1"
40 | "lon1"
41 | "nyc1"
42 | "nyc2"
43 | "nyc3"
44 | "sfo1"
45 | "sfo2"
46 | "sgp1"
47 | "tor1"],
48 | :memory 1024,
49 | :available true}
50 | {:vcpus 1,
51 | :disk 30,
52 | :slug "1gb",
53 | :price_monthly 10.0,
54 | :transfer 2.0,
55 | :price_hourly 0.01487999968230724,
56 | :regions ["ams2"
57 | "ams3"
58 | "blr1"
59 | "fra1"
60 | "lon1"
61 | "nyc1"
62 | "nyc2"
63 | "nyc3"
64 | "sfo1"
65 | "sfo2"
66 | "sgp1"
67 | "tor1"],
68 | :memory 1024,
69 | :available true}
70 | {:vcpus 1,
71 | :disk 50,
72 | :slug "s-1vcpu-2gb",
73 | :price_monthly 10.0,
74 | :transfer 2.0,
75 | :price_hourly 0.01487999968230724,
76 | :regions ["ams2"
77 | "ams3"
78 | "blr1"
79 | "fra1"
80 | "lon1"
81 | "nyc1"
82 | "nyc2"
83 | "nyc3"
84 | "sfo1"
85 | "sfo2"
86 | "sgp1"
87 | "tor1"],
88 | :memory 2048,
89 | :available true}])
90 |
91 | (s/def ::not-empty-string (s/and string? (complement empty?)))
92 | (s/def ::tag-name ::not-empty-string)
93 | (s/def ::tag-name ::not-empty-string)
94 |
95 | (def default-tag-name "cube")
96 | (def default-image-id "ubuntu-18-10-x64")
97 | (def default-size "s-2vcpu-2gb")
98 | ;; (def default-size "s-2vcpu-2gb") ;; for running ipfs + ipfs-cluster
99 | (def default-region "region")
100 |
101 | (defn filter-by-tag [droplets tag]
102 | (vec (filter #(.contains (:tags %) tag) droplets)))
103 |
104 | (defn credentials [token] {:token token})
105 | (defn ls [creds]
106 | (filter-by-tag (:droplets (do/droplets (:token creds)))
107 | default-tag-name ))
108 | (defn create [])
109 | (defn destroy [])
110 | (defn pause [])
111 | (defn start [])
112 | (defn stop [])
113 | (defn exists? [])
114 |
115 | (defrecord DigitalOcean []
116 | provider/Provider)
117 |
118 | ;; docs
119 | (defn ls-images [creds]
120 | (do/images (:token creds)))
121 |
122 | (defn ls-sizes [creds]
123 | (do/sizes (:token creds)))
124 |
125 | (defn ls-keys [creds]
126 | (do/ssh-keys (:token creds)))
127 |
--------------------------------------------------------------------------------
/src/cube/auth.clj:
--------------------------------------------------------------------------------
1 | (ns cube.auth
2 | (:require [cube.db :as db]
3 | [clojure.pprint :refer [pprint]]
4 | [crypto.password.bcrypt :as bcrypt]))
5 |
6 | ;; This namespace should maybe be two parts. Authentication and Authorization
7 |
8 | ;; Format for a permission: vector of vectors. Each vector has the keys being
9 | ;; the namespaces, and the last one deciding the access-type
10 | ;; [:person :name :read] would say that (get-in [:person :name]) is allowed.
11 | ;; [:name :write] would say that (assoc-in [:name] value) is allowed.
12 | ;; TODO hardcoded users, roles and permissions for now
13 | (def permissions {:viewer [[:name :read]]
14 | :pinner [[:name :read] [:name :write]]
15 | :guest []})
16 |
17 | ;; Currently only takes the first role, as one user currently can only have
18 | ;; one role. In the future this might change.
19 | (defn roles->permissions [permissions roles]
20 | (let [role (first roles)]
21 | (if (nil? role)
22 | []
23 | (role permissions))))
24 |
25 | (def access-type-error-msg
26 | "'%s' is not a valid access-type. You need either :read or :write")
27 |
28 | ;; Checks a list of permissions against k and access-type
29 | (defn allowed? [permissions k access-type]
30 | (if (not (or (= access-type :read) (= access-type :write))) ;; wrong access-type
31 | (throw (Exception. (format access-type-error-msg access-type)))
32 | (let [permission (first permissions)]
33 | (if (nil? permission) ;; no permissions left to check
34 | false
35 | (let [[role-k role-a] permission]
36 | (if (and (= role-k k) (= role-a access-type))
37 | true ;; had the right permission
38 | (recur (rest permissions) k access-type))))))) ;; not here, continue
39 |
40 | ;; Calls `allowed?` but easier to use as we can just pass the user directly
41 | (defn authorized? [permissions user k access-type]
42 | (let [permissions (roles->permissions permissions (:roles user))]
43 | (allowed? permissions k access-type)))
44 |
45 | (def unauthorized-error-msg
46 | "User '%s' with roles '%s' did not have access to '%s' in the '%s' namespace")
47 |
48 | (defn unauthorized-error [user k access-type]
49 | (throw (Exception. (format unauthorized-error-msg (:username user) (:roles user) access-type k))))
50 |
51 | ;; Interface functions between a user and a DB to protected the DB against
52 | ;; unallowed reads and writes
53 | (defn- protected-read [permissions user db k func-name]
54 | (if (authorized? permissions user k :read)
55 | ((ns-resolve 'cube.db (symbol func-name)) db k)
56 | (unauthorized-error user k :read)))
57 |
58 | (defn- protected-write [permissions user db k v func-name]
59 | (if (authorized? permissions user k :write)
60 | ((ns-resolve 'cube.db (symbol func-name)) db k v)
61 | (unauthorized-error user k :write)))
62 |
63 | (defn protected-access [permissions user db k]
64 | (protected-read permissions user db k "access"))
65 |
66 | (defn protected-put [permissions user db k v]
67 | (protected-write permissions user db k v "put"))
68 |
69 | (defn permission-keys [permissions]
70 | (reduce (fn [acc [p _]] (conj acc p)) #{} permissions))
71 |
72 | (defn filter-keys-from-state [included-ks state]
73 | (let [new-state (atom {})]
74 | (doseq [k included-ks]
75 | (swap! new-state assoc k (k state)))
76 | new-state))
77 |
78 | ;; Function that returns a new DB, but with it's fields only being the
79 | ;; ones the user supposedly have :read access to.
80 | ;; TODO currently has internal knowledge of DB structure...
81 | (defn filter-db [permissions user db]
82 | (let [old-state @(:state db)
83 | ks (permission-keys (roles->permissions permissions (:roles user)))]
84 | (assoc db :state (filter-keys-from-state ks old-state))))
85 |
86 | (defn split-auth [auth-string]
87 | (if auth-string
88 | (let [[username password] (clojure.string/split auth-string #":")]
89 | (if (or (empty? username) (empty? password))
90 | {:username "" :password ""}
91 | {:username username
92 | :password password}))
93 | {:username ""
94 | :password ""}))
95 |
96 | (defn authenticated? [users user]
97 | (let [wanted-user (get-in users [(:username user)])]
98 | (if (nil? wanted-user)
99 | false ;; didnt find user
100 | (bcrypt/check (:password user) (:password wanted-user)))))
101 |
--------------------------------------------------------------------------------
/src/ui/login.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.login
2 | (:require [re-frame.core :refer [dispatch reg-fx reg-event-fx reg-event-db subscribe reg-sub]]
3 | [reagent.cookies :as cookies]
4 | [day8.re-frame.tracing :refer-macros [fn-traced]]))
5 |
6 | (def cookie-name "login-token")
7 |
8 | (reg-sub
9 | :login/error
10 | (fn-traced [db _]
11 | (-> db
12 | :login
13 | :error)))
14 |
15 | (reg-sub
16 | :login/token
17 | (fn-traced [db _]
18 | (-> db
19 | :login
20 | :token)))
21 |
22 | (reg-sub
23 | :login/profile
24 | (fn-traced [db _]
25 | (-> db
26 | :login
27 | :profile)))
28 |
29 | (reg-sub
30 | :login/permissions
31 | (fn-traced [db _]
32 | (-> db
33 | :login
34 | :profile
35 | :permissions)))
36 |
37 | (reg-event-db
38 | :set-login-error
39 | (fn-traced [db [_ msg]]
40 | (assoc-in db [:login :error] msg)))
41 |
42 | (reg-event-db
43 | :set-profile
44 | (fn-traced [db [_ profile]]
45 | (assoc-in db [:login :profile] profile)))
46 |
47 | (reg-fx
48 | :get-cookie
49 | (fn-traced [v]
50 | (let [f (:callback v)]
51 | (f (cookies/get (:name v))))))
52 |
53 | (reg-fx
54 | :delete-cookie
55 | (fn-traced [v] (cookies/remove! (:name v))))
56 |
57 |
58 | (reg-event-fx
59 | :logout
60 | (fn-traced [cofx _]
61 | {:db (dissoc (:db cofx) :login)
62 | :delete-cookie {:name cookie-name}
63 | :dispatch-n [ ;; disconnect ws when logout happen
64 | ;; make sure it's connected again on login
65 | [:ws-disconnect]
66 | [:go-to-page "/login"]]}))
67 |
68 | (reg-fx
69 | :set-cookie
70 | (fn-traced [v] (cookies/set! (:name v) (:value v))))
71 |
72 | (reg-event-fx
73 | :set-login-token
74 | (fn-traced [cofx [_ token]]
75 | (do (cljs.pprint/pprint token)
76 | {:db (assoc-in (:db cofx) [:login :token] token)
77 | :set-cookie {:name cookie-name
78 | :value token}})))
79 |
80 | (reg-event-fx
81 | :check-logged-in
82 | (fn-traced [_ _]
83 | {:get-cookie {:name cookie-name
84 | :callback #(if (nil? %)
85 | (dispatch [:go-to-page "/login"])
86 | (do (dispatch [:set-login-token %])
87 | (dispatch [:get-profile-data])
88 | (dispatch [:ws-connect]))
89 | )}}))
90 | (defn take-token-from-res [res]
91 | (.then (.json res) #(do (println "received res")
92 | (dispatch [:set-login-token (get (js->clj %) "token")])
93 | (dispatch [:get-profile-data])
94 | (dispatch [:go-to-page "/home"])
95 | (dispatch [:ws-connect]))))
96 |
97 | (defn res->set-profile [res]
98 | (.then (.json res) #(do (println "my profile:")
99 | (dispatch [:set-profile (js->clj % :keywordize-keys true)]))))
100 |
101 | (reg-event-fx
102 | :get-profile-data
103 | (fn-traced [cofx _]
104 | {:http {:method "GET"
105 | :url "/api/profile"
106 | :headers {:Content-Type "application/json"
107 | :Authorization (str "Token " @(subscribe [:login/token]))}
108 | :on-success #(res->set-profile %)}}))
109 |
110 | (reg-event-fx
111 | :do-login
112 | (fn-traced [cofx [_ username password]]
113 | {:http {:method "POST"
114 | :url "/api/login"
115 | :body {:username username
116 | :password password}
117 | :headers {:Content-Type "application/json"}
118 | :on-success #(if (= 401 (.-status %))
119 | (dispatch [:set-login-error "Wrong username/password"])
120 | (take-token-from-res %))}
121 | :dispatch [:set-login-error nil]
122 | :dispatch-later [{:ms 2000 :dispatch [:set-login-error nil]}]}))
123 |
--------------------------------------------------------------------------------
/src/cube/providers/docker.clj:
--------------------------------------------------------------------------------
1 | (ns cube.providers.docker
2 | (:require [com.stuartsierra.component :as c]
3 | [clj-docker-client.core :as docker]
4 | [clojure.pprint :refer [pprint]]
5 | [clj-http.client :as http]
6 | [clojure.data.json :as json]
7 | [crypto.random :refer [url-part]]
8 | [cube.db :as db]))
9 |
10 | ;; Which images to use for the containers
11 | (def images {:go-ipfs "ipfs/go-ipfs:v0.4.18"
12 | :ipfs-cluster "ipfs/ipfs-cluster:v0.8.0"})
13 |
14 | ;; Keyword for this particular provider
15 | (def provider-type :docker)
16 |
17 | ;; Gets the IP from a container ID
18 | (defn get-ip [conn id]
19 | (-> (docker/inspect conn id)
20 | :network-settings
21 | :ip-address))
22 |
23 | (defn pull-images [conn]
24 | (doseq [[_ image] images]
25 | (docker/pull conn image)))
26 |
27 | ;; Good'ol http/get but with retries and hardcoded :9094/id suffix
28 | (defn get-retry [max-attempts ip]
29 | (http/get (str "http://" ip ":9094/id")
30 | {:socket-timeout 1000
31 | :conn-timeout 1000
32 | :as :json
33 | :retry-handler (fn [ex try-count ctx]
34 | (println (str "Ex" ex " Try: " try-count))
35 | (Thread/sleep 500)
36 | (< try-count max-attempts))}))
37 |
38 | ;; Gets the ipfs-cluster api endpoint from instance
39 | (defn get-api-multiaddr [conn instance]
40 | (let [ip (get-ip conn instance)
41 | res (get-retry 10 ip)
42 | id (-> res :body :id)]
43 | (str "http://" ip ":9094")))
44 |
45 | (defn get-webui-addr [conn instance]
46 | (let [ip (get-ip conn instance)
47 | res (get-retry 10 ip)
48 | id (-> res :body :id)]
49 | (str "http://" ip ":9095/webui")))
50 |
51 | (defn get-ipfs-proxy [conn instance]
52 | (let [ip (get-ip conn instance)
53 | res (get-retry 10 ip)
54 | id (-> res :body :id)]
55 | (str "http://" ip ":9095")))
56 |
57 | ;; Creates a map to map ID => containers for go-ipfs + ipfs-cluster
58 | (defn create-id [conn go-ipfs-id ipfs-cluster-id]
59 | [(keyword (url-part 8)) {:type provider-type
60 | :metadata {:go-ipfs-id go-ipfs-id
61 | :ipfs-cluster-id ipfs-cluster-id}
62 | :cluster-api (get-api-multiaddr conn ipfs-cluster-id)
63 | :webui (get-webui-addr conn ipfs-cluster-id)
64 | :ipfs-proxy (get-ipfs-proxy conn ipfs-cluster-id)}])
65 |
66 | ;; Saves containers of go-ipfs and ipfs-cluster into the global state
67 | ;; Returns the shared ID
68 | (defn save-instance [conn db go-ipfs-id ipfs-cluster-id]
69 | (let [[k v] (create-id conn go-ipfs-id ipfs-cluster-id) ]
70 | (db/put-in db [:instances :running k] v)))
71 |
72 | (defn get-start-cmd
73 | "Returns a bootstrap argument if existing cluster is running, otherwise empty
74 | string"
75 | [db conn]
76 | (let [instances (db/access-in db [:instances :running])]
77 | (if (> (count instances) 0)
78 | (let [ip (get-ip conn (-> instances first second :metadata :ipfs-cluster-id))
79 | res (get-retry 10 ip)
80 | id (-> res :body :id)]
81 | (str "daemon --bootstrap /ip4/" ip "/tcp/9096/ipfs/" id))
82 | "")))
83 |
84 | (defn create-go-ipfs [conn]
85 | (docker/run conn (:go-ipfs images) "daemon" {} {} true))
86 |
87 | (defn create-ipfs-cluster [conn start-cmd go-ipfs-ip secret]
88 | (docker/run conn
89 | (:ipfs-cluster images)
90 | start-cmd
91 | {:IPFS_API (str "/ip4/" go-ipfs-ip "/tcp/5001")
92 | :CLUSTER_SECRET secret}
93 | {}
94 | true))
95 |
96 | (defn create [conn db]
97 | (let [go-ipfs-id (create-go-ipfs conn)
98 | go-ipfs-ip (get-ip conn go-ipfs-id)
99 | start-cmd (get-start-cmd db conn)
100 | secret (db/access-in db [:instances :cluster-secret])
101 | ipfs-cluster-id (create-ipfs-cluster conn start-cmd go-ipfs-ip secret)]
102 | (save-instance conn db go-ipfs-id ipfs-cluster-id)))
103 |
104 | (defn destroy [conn instance]
105 | (let [metadata (:metadata instance)
106 | go-ipfs-id (:go-ipfs-id metadata)
107 | ipfs-cluster-id (:ipfs-cluster-id metadata)]
108 | (doseq [id [ipfs-cluster-id go-ipfs-id]]
109 | (docker/kill conn id)
110 | (docker/rm conn id))))
111 |
112 | (defn initialize [conn]
113 | (pull-images conn))
114 |
115 | (defrecord ProviderDocker []
116 | c/Lifecycle
117 | (start [this]
118 | (let [connection (docker/connect)]
119 | (initialize connection)
120 | (assoc this :connection connection)))
121 | (stop [this]
122 | (docker/disconnect (:connection this))
123 | (assoc this :connection nil)))
124 |
125 | (defn new [url]
126 | (map->ProviderDocker {:url url}))
127 |
128 |
--------------------------------------------------------------------------------
/test/cube/auth_test.clj:
--------------------------------------------------------------------------------
1 | (ns cube.auth-test
2 | (:require [cube.auth :as auth]
3 | [cube.db :as db]
4 | [crypto.password.bcrypt :as bcrypt])
5 | (:use clojure.test))
6 |
7 | (defn test-db [] {:db-path "/tmp/test-cube-db.clj"
8 | :state (atom {:name "barry"
9 | :age 16})})
10 |
11 | (defn user [username, password, role]
12 | {:username username
13 | :password (bcrypt/encrypt password)
14 | :roles #{role}})
15 |
16 | (def permissions {:guest []
17 | :reader [[:name :read]]
18 | :writer [[:name :read] [:name :write]]})
19 |
20 | (def users {"guest" (user "guest" "guest" :guest)
21 | "reader" (user "reader" "reader" :reader)
22 | "writer" (user "writer" "writer" :writer)})
23 |
24 | (defn get-user [n]
25 | (get-in users [n]))
26 |
27 | (deftest authorization
28 | (testing "turns role(s) into permissions"
29 | (is (= (auth/roles->permissions permissions #{}) []))
30 | (is (= (auth/roles->permissions permissions #{:guest}) []))
31 | (is (= (auth/roles->permissions permissions #{:reader}) [[:name :read]]))
32 | (is (= (auth/roles->permissions permissions #{:writer}) [[:name :read] [:name :write]])))
33 |
34 | (testing "can check permissions against keys and access-type"
35 | (is (= (auth/allowed? (:guest permissions) :name :read) false))
36 | (is (= (auth/allowed? (:guest permissions) :name :write) false))
37 | (is (= (auth/allowed? (:guest permissions) :random :read) false))
38 |
39 | (is (= (auth/allowed? (:reader permissions) :name :read) true))
40 | (is (= (auth/allowed? (:reader permissions) :name :write) false))
41 | (is (= (auth/allowed? (:reader permissions) :random :read) false))
42 |
43 | (is (= (auth/allowed? (:writer permissions) :name :read) true))
44 | (is (= (auth/allowed? (:writer permissions) :name :write) true))
45 | (is (= (auth/allowed? (:writer permissions) :random :read) false))
46 |
47 | ;; Invalid access-type, needs to be :read or :write
48 | (is (thrown? Exception (auth/allowed? (:writer permissions) :name :lol))))
49 |
50 | (testing "can check user with permissions against keys and access-type"
51 | (is (= (auth/authorized? permissions (get-user "guest") :name :read) false))
52 | (is (= (auth/authorized? permissions (get-user "guest") :name :write) false))
53 | (is (= (auth/authorized? permissions (get-user "guest") :random :read) false))
54 |
55 | (is (= (auth/authorized? permissions (get-user "reader") :name :read) true))
56 | (is (= (auth/authorized? permissions (get-user "reader") :name :write) false))
57 | (is (= (auth/authorized? permissions (get-user "reader") :random :read) false))
58 |
59 | (is (= (auth/authorized? permissions (get-user "writer") :name :read) true))
60 | (is (= (auth/authorized? permissions (get-user "writer") :name :write) true))
61 | (is (= (auth/authorized? permissions (get-user "writer") :random :read) false))
62 |
63 | ;; Invalid access-type, needs to be :read or :write
64 | (is (thrown? Exception (auth/authorized? permissions (get-user "writer") :name :lol)))))
65 |
66 | (deftest authentication
67 | (testing "authenticated?"
68 | (is (= (auth/authenticated? users (auth/split-auth "")) false))
69 | (is (= (auth/authenticated? users (auth/split-auth "guest")) false))
70 | (is (= (auth/authenticated? users (auth/split-auth "guest:g")) false))
71 | (is (= (auth/authenticated? users (auth/split-auth "guest:guest")) true))))
72 |
73 | (deftest web-authentication
74 | (testing "parsing cookie authentication format username:password"
75 | (is (= (auth/split-auth nil) {:username "" :password ""}))
76 | (is (= (auth/split-auth "") {:username "" :password ""}))
77 | (is (= (auth/split-auth "a") {:username "" :password ""}))
78 | (is (= (auth/split-auth "a:") {:username "" :password ""}))
79 | (is (= (auth/split-auth "a:b") {:username "a" :password "b"}))))
80 |
81 | (deftest db-interface
82 | (testing "protects db access function"
83 | (is (thrown? Exception (auth/protected-access permissions (get-user "guest") (test-db) :name)))
84 | (is (= (auth/protected-access permissions (get-user "reader") (test-db) :name) "barry"))
85 | (is (= (auth/protected-access permissions (get-user "writer") (test-db) :name) "barry")))
86 | (testing "protects db write function"
87 | (is (thrown? Exception (auth/protected-put permissions (get-user "guest") (test-db) :name "john")))
88 | (is (thrown? Exception (auth/protected-put permissions (get-user "reader") (test-db) :name "john")))
89 | (is (= (auth/protected-put permissions (get-user "writer") (test-db) :name "john")))))
90 |
91 | (deftest db-filtering
92 | (testing "protects the entire db based on auth of user"
93 | (is (= (db/access (auth/filter-db permissions (get-user "guest") (test-db)) :name) nil))
94 | (is (= (db/access (auth/filter-db permissions (get-user "reader") (test-db)) :name) "barry"))
95 | (is (= (db/access (auth/filter-db permissions (get-user "writer") (test-db)) :name) "barry"))))
96 |
--------------------------------------------------------------------------------
/src/ui/pages/pins.cljs:
--------------------------------------------------------------------------------
1 | (ns ui.pages.pins
2 | (:require [re-frame.core :as rf]
3 | [reagent.core :as r]
4 | [ui.components.button :as button]
5 | [ui.components.text-input :as text-input]
6 | [ui.pins :as pins]
7 | [clojure.contrib.humanize :refer [filesize]]
8 | ))
9 |
10 | (defn no-pins-message []
11 | [:p "Seems you have no pins currently"])
12 |
13 | (def current-name (r/atom (str "copy of ipld.io from " (.toISOString (js/Date.)))))
14 | (def current-hash (r/atom "QmXb2bKQdgNhC7vaiKQgXFtt7daUZD382L54UTTNXnwQTD"))
15 | (def pin-disabled? (r/atom false))
16 |
17 | (defn add-pin-name []
18 | (text-input/text-input {:id "name"
19 | :label "Name"
20 | :description "Descriptive name of this Pin"
21 | :value @current-name
22 | :onChange #(reset! current-name (-> % .-target .-value))
23 | }))
24 |
25 | (defn add-pin-hash []
26 | (text-input/text-input {:id "hash"
27 | :label "Multihash"
28 | :description "The Multihash of this pin"
29 | :value @current-hash
30 | :onChange #(reset! current-hash (-> % .-target .-value))
31 | }))
32 |
33 | (defn add-pin []
34 | [:div
35 | [:div
36 | (add-pin-name)]
37 | [:div.mt3
38 | (add-pin-hash)]
39 | [:div.mt1
40 | (button/button {:text "Pin!"
41 | :disabled @pin-disabled?
42 | :onClick #(do (pins/add-pin @current-hash @current-name)
43 | (reset! current-name "")
44 | (reset! current-hash "")
45 | (reset! pin-disabled? true)
46 | (.setTimeout
47 | js/window
48 | (fn [] (reset! pin-disabled? false))
49 | 500)
50 | )})]])
51 |
52 | (defn group-by-status-and-count [info status]
53 | (count (get (group-by :status (:peer-map info)) status)))
54 |
55 | (defn count-pinned [info]
56 | (group-by-status-and-count info "pinned"))
57 |
58 | (defn count-pinning [info]
59 | (group-by-status-and-count info "pinning"))
60 |
61 | (defn count-errors [info]
62 | (+ (group-by-status-and-count info "pin_error")
63 | (group-by-status-and-count info "unpin_error")))
64 |
65 | (defn get-ipfs-io-link [pin]
66 | (str "https://ipfs.io/ipfs/" (:cid pin)))
67 |
68 | (defn details-link [cid]
69 | [:a.f5.aqua {:href "#"
70 | :onClick #(do (.preventDefault %)
71 | (rf/dispatch [:add-subpage cid]))} "Details"])
72 |
73 | (defn pin-table [pins]
74 | [:div
75 | [:div.overflow-auto
76 | [:table.center
77 | [:thead
78 | [:tr.stripe-dark
79 | [:th.fw6.tl.pa3.bg-white "Hash"]
80 | [:th.fw6.tl.pa3.bg-white "Name"]
81 | [:th.fw6.tl.pa3.bg-white "Size"]
82 | [:th.fw6.tl.pa3.bg-white "Pinning"]
83 | [:th.fw6.tl.pa3.bg-white "Pinned"]
84 | [:th.fw6.tl.pa3.bg-white "Error"]
85 | [:th.fw6.tl.pa3.bg-white ""]
86 | [:th.fw6.tl.pa3.bg-white ""]
87 | [:th.fw6.tl.pa3.bg-white ""]
88 | [:th.fw6.tl.pa3.bg-white ""]
89 | ]]
90 | [:tbody.1h-copy
91 | (for [pin pins]
92 | [:tr.stripe-dark {:key (:cid pin)}
93 | [:td.pa3 (:cid pin)]
94 | [:td.pa3 (:name pin)]
95 | [:td.pa3 (filesize (:size pin))]
96 | [:td.pa3 (count-pinning pin)]
97 | [:td.pa3 (count-pinned pin)]
98 | (let [err (count-errors pin)]
99 | [:td.pa3 {:class (when (> err 0) "red")} err])
100 | [:td.pa3 (details-link (:cid pin))]
101 | [:td.pa3 [:a.f5.aqua "View in webui"]]
102 | [:td.pa3 [:a.f5.aqua {:href (get-ipfs-io-link pin)} "View on ipfs.io"]]
103 | [:td.pa3 [:a.f5.aqua {:href "#"
104 | :onClick #(rf/dispatch [:delete-pin (:cid pin)])
105 | } "Delete"]]])]]]])
106 |
107 | (defn single-pin [info]
108 | [:div (str (:cid info) " - Pinned on: #" (count-pinned info))])
109 |
110 | (defn render []
111 | [:div
112 | [:div.w-100.fl
113 | [:div.w-30.fl.pa3
114 | [:h3.f3 "Your Pins"]
115 | [:p "Here you can manage your pins, like editing the
116 | meta-data, remove some of them to clear space or simply browse
117 | your pinned content"]]
118 | [:div.w-30.fl.pa3
119 | [:div.w-100
120 | [:h3.f3 "Add new pin"]
121 | (add-pin)]]
122 | [:div.w-30.fl.pa3
123 | [:h3.f3 "Pin manually with ipfs-cluster-ctl"]
124 | [:p
125 | [:span "Wanna pin your content manually? You can use "]
126 | [:code [:a {:href "https://cluster.ipfs.io/download/"} "ipfs-cluster-ctl"]]
127 | [:span " directly if you want:"]]
128 | [:pre.f6 "ipfs-cluster-ctl --host /ip4/172.17.0.5/tcp/9094 id"]
129 | [:p "Try the command above to connect to your running cluster"]]]
130 | [:div.w-100.fl
131 | [:div.pa4]
132 | (let [pins @(rf/subscribe [:pins])]
133 | (if (= 0 (count pins))
134 | (no-pins-message)
135 | (pin-table pins)))]
136 | [:div.cf]])
137 |
--------------------------------------------------------------------------------
/docs/overview.md:
--------------------------------------------------------------------------------
1 | ## Cube Architecture Overview
2 |
3 | *Notice: All of this is currently in prototyping stage and can rapidly change
4 | without notice*
5 |
6 | Cube will act as a controller for a group of ipfs-cluster backed instances
7 | hosted in various configurations.
8 |
9 | In it's most basic shape, Cube manages how many instances of what instance image
10 | runs where. It'll act a bit like CloudFormation but cloud-agnostic.
11 |
12 | When starting Cube, Cube will ask a few questions regarding where to host the
13 | cluster, what groups to create with what permissions, what users belong to what
14 | group and what the default settings for a `pin` is.
15 |
16 | Once the setup is complete, Cube will ensure that what the user wants, is actually
17 | running in a live production environment in the chosen hosting platform.
18 |
19 | When it's up-and-running, Cube will monitor the health of the cluster. This means
20 | make sure it's responsive and check other user-specified attributes (like
21 | min-space available).
22 |
23 | While ipfs-cluster will continue with it's own state sharing while Cube is not
24 | running, the monitoring and convergance of local<>remote state will only
25 | happen when Cube itself is running. So it's advisable to deploy Cube somewhere
26 | to run it 24/7.
27 |
28 | Cube should also be able to deploy itself in the future.
29 |
30 | ### Birdview Architecture
31 |
32 | ```
33 | +----------------------+
34 | | Provider A |
35 | | |
36 | | +------------------+ |
37 | | | | |
38 | +-------------> | | Instance | |
39 | | | | | |
40 | | | | +--------------+ | |
41 | | | | | | | |
42 | | | | | IPFS+Cluster | | |
43 | | | | | | | |
44 | | | | +--------------+ | |
45 | | | | | |
46 | | | +------------------+ |
47 | | | |
48 | | +----------------------+
49 | Cube |
50 | |
51 | +----------------+ | +----------------------+
52 | | | | | Provider B |
53 | | Cube+API | | | |
54 | | +------------+ | | | +------------------+ |
55 | | |*Auth | | | | | | |
56 | | |*Persistance| | +-------------> | | Instance | |
57 | +------> | |*Web | | | | | | |
58 | | | |*Monitoring | | | | | +--------------+ | |
59 | | | |*Instances | +--------------+ | | | | | |
60 | | | +------------+ | | | | | IPFS+Cluster | | |
61 | | | | | | | | | | |
62 | | +----------------+ | | | +--------------+ | |
63 | | | | | | |
64 | +-----+-----+ | | +------------------+ |
65 | | | | | |
66 | | Browser | | | +------------------+ |
67 | | | | | | | |
68 | +-----------+ +-------------> | | Instance | |
69 | |Cube Web UI| | | | |
70 | +-----------+ | | +--------------+ | |
71 | | | | | | |
72 | | | | IPFS+Cluster | | |
73 | | | | | | |
74 | | | +--------------+ | |
75 | | | | |
76 | | +------------------+ |
77 | | |
78 | +----------------------+
79 | ```
80 |
81 | ### Components
82 |
83 | #### Basic Shape
84 |
85 | A component follows a traditional lifecycle with injectable dependencies to
86 | be flexible in testing and composition.
87 |
88 | ```
89 | (defprotocol LifeCycle
90 | "Controls starting/stopping of a component"
91 | (start [component] "Starts a component passing in the global state")
92 | (stop [component] "Stops a component"))
93 | ```
94 |
95 | #### DB (Persistance)
96 |
97 | DB handles connection to a local/remote DB to persist the current state
98 | of the running system. It establish the connection on `start` and disconnects
99 | on `stop`.
100 |
101 | Currently defaults to a `edn` file in `~/.cube`
102 |
103 | #### Instances
104 |
105 | Instances handles the creation/destruction of instances that runs ipfs-cluster
106 | nodes. Different strategies for creating/destroying instances will be created,
107 | with the default and most basic one being "Keep X number of nodes running". If
108 | the number of currently running instances is below X, Instances will handle
109 | the creation of the nodes. Another strategy in the future could be to make
110 | sure free harddrive space is always above Y.
111 |
112 | ##### Providers
113 |
114 | Different cloud-providers works differently. As long as included ones implement
115 | the `Instances` protocol, it should be available to be used in Cube.
116 |
117 | #### Cluster
118 |
119 | Cluster components handles all connections to the running ipfs-cluster nodes.
120 |
121 | #### Web
122 |
123 | Web is the component that spins up a webserver and uses the other components
124 | to allow the user to control the system via HTTP API endpoints.
125 |
126 | It just implements the component LifeCycle protocol to start/stop the server.
127 |
128 | ### Not Yet Implemented Components
129 |
130 | #### Monitoring
131 |
132 | Monitoring handles gathering of metrics, persistance via Persistance component
133 | and alerting if needed.
134 |
135 | #### Auth
136 |
137 | The Auth component handles users and groups. Users have username, passwords and
138 | belong to one group. Groups have names and a list of permissions.
139 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | 🚧🚧🚧🚧 WARNING: This is a pre-alpha experiment. Expect drastic changes as we iterate and learn. 🚧🚧🚧🚧
2 |
3 |
4 | Cube
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 | > IPFS Cube will help people deploy and manage their own IPFS pinning services
15 | > on top of existing cheap hardware, or cloud storage.
16 |
17 | Note: This is meant to be a tool that anyone can use. Protocol Labs/IPFS is
18 | *not* running its own pinning service.
19 |
20 | ## What is the problem we’re trying to solve?
21 |
22 | * Users need to run their own IPFS pinning services easily.
23 | * Running an IPFS node on its own, or even running an IPFS Cluster, doesn’t
24 | accomplish much for everyday users. For a large portion of current IPFS users,
25 | and for a much larger set of potential adopters, you need to be able to run
26 | and manage your own IPFS pinning service -- allocating storage, deciding who
27 | can pin stuff, seeing what’s been pinned (and by whom), observing how that
28 | service contributes to the overall IPFS network, and managing the pinned
29 | content over time.
30 |
31 | This combination of uses is not only compelling on its own, it’s also a basis
32 | for a plethora of more specific IPFS products and tools that could address use
33 | cases like users of apps like [PeerPad](https://peerpad.net) who need a place to
34 | pin their documents and edits government agencies publishing open data and
35 | measuring impact of the data research labs pinning and redistributing data
36 | they’ve produced or relied on libraries pinning, cataloging, indexing, and
37 | preserving the data their patrons rely on participants in a community wifi
38 | network maintaining content for their local peers to access independently of
39 | broader internet connectivity
40 |
41 | All of these use cases depend on reliable, easy to use, easily managed pinning
42 | services.
43 |
44 | * We need to know our users.
45 | * IPFS, along with the broader peer-to-peer web, will only gain broad adoption
46 | when these technologies feel robust, reliable, and predictable while also
47 | offering clear, novel benefits that centralized infrastructure can’t provide.
48 | While technical features play some role in achieving this quality of experience,
49 | adoption will ultimately rely on delivering consistent, high quality User
50 | Experience. This requires sustained, focused, iterative user discovery, design,
51 | and development. Currently we don’t have enough fine-grained information about
52 | our users, their needs, nor how they think about the data they share on the
53 | web. This prevents us from carrying out the design and iterative delivery of
54 | a product that will achieve those goals.
55 |
56 | We need a thread that weaves together all the dependencies and interacting
57 | modules across Protocol Labs to create a cohesive path towards broader user
58 | adoption of our technologies. We need to make it easier for people to make the
59 | choice between local pinning (just running `ipfs pin` locally), remote centralized
60 | pinning (pinning with Cube), and remote replicated pinning (pinning with Cluster).
61 |
62 | ## The vision
63 |
64 | *What would it mean to run a Cube?*
65 |
66 | Running an IPFS Cube is running an IPFS pinning service that has
67 | members/subscribers, controls for managing usage, and a great UX overall. By
68 | default a Cube will be backed by an IPFS Cluster, but it can be re-configured
69 | to use other storage services such as Microsoft Azure, the Cloudflare IPFS
70 | gateway, or Amazon S3.
71 |
72 | An example of a target user for IPFS Cube might be a tech-savvy librarian at a
73 | public library, who already runs a couple websites and is an admin on their
74 | Drupal instance. They probably have sysadmin privileges on a server or two, but
75 | their real motivation is to support their community’s ability to store, share,
76 | access and preserve knowledge. They want to run a pinning service for their
77 | community and would prefer to have a complete experience from install through
78 | management and most debugging that doesn’t involve hacking around on the command
79 | line.
80 |
81 | This is just one example of a target user. Our first effort will focus on
82 | choosing their optimal set of target users and identifying real people who we
83 | can engage with as exemplars of the use cases.
84 |
85 | *How does this relate to IPFS Cluster?*
86 |
87 | Cube will be a tool that many people will use together with IPFS Cluster. They
88 | will use Cube to run and manage a pinning service and, by default, that Cube
89 | will create an IPFS Cluster to handle storage. Because of this relationship,
90 | Cube’s use cases strongly overlap with some of the use cases for Cluster. If we
91 | are successful at building a great UX for Cube, thousands or millions of people
92 | will use Cube to run and manage their own IPFS Clusters, with Cube as their
93 | main interface while Cluster functions primarily as an underlying system that
94 | they don’t have to worry about unless they choose to.
95 |
96 | Running a Cluster is running a group of nodes with some strategy for
97 | understanding what content gets pinned. The target users are system
98 | administrators of some sort who are comfortable with ideas like virtualization,
99 | kubernetes, and CLIs. By contrast, running a Cube gives you a pinning service
100 | with tools for managing and monitoring the service, its users, its configuration,
101 | etc. By default a Cube will spin up an IPFS Cluster as its storage layer. Its
102 | target users are mainly focused on the people pinning data on their Cube, the
103 | costs and benefits of running the Cube, and quality of service rather than
104 | focusing on the storage equipment, pinning strategies, etc. They prefer non-CLI
105 | tools and might not have deep familiarity with ideas like virtualization,
106 | kubernetes, etc.
107 |
108 | Building out Cube is good for Cluster product development because we will have
109 | the opportunity to grapple with what should (or should not) be in the core
110 | Cluster product. For example, for a basic Cube to work, it needs to have things
111 | like:
112 |
113 | seamless automated creation and configuration of an IPFS Cluster through simple UI
114 | authentication and authenticated pinning
115 | per user and per group of user allocation of storage
116 | reporting on storage usage
117 | tooling for configuration (how are you going to store this stuff, how redundant)
118 |
119 | To implement these features well, we need end user input for both Cluster and
120 | Cube. Building Cube will help disambiguate which functionality lives in which
121 | module for it, and other third-party services seeking to use Cluster to support
122 | their work.
123 |
124 | ## Running the prototype
125 |
126 | Easiest way to try out the latest build is to download the latest built version from master. You can find that in [the directory of artifacts on Jenkins](https://ci.ipfs.team/job/IPFS%20Shipyard/job/cube/job/master/lastSuccessfulBuild/artifact/target/). Find the file that fits the pattern `cube-$version-standalone.jar`, download and run it. GUI should start and the setup process should start.
127 |
128 | If you're interested in building from source, please see [the guide on how to contribute](https://github.com/ipfs-shipyard/cube/blob/master/docs/contributing.md).
129 |
130 | ## Team
131 |
132 | * [Michelle Hertzfeld](https://github.com/meiqimichelle)
133 | * [Victor Bjelkholm](https://github.com/victorb)
134 |
135 | ## Contribute
136 |
137 | Cube is a work in progress. As such, there's a few things you can do right now to help out:
138 |
139 | * **[Check out the existing issues](https://github.com/ipfs-shipyard/cube/issues)**!
140 | * **Perform code reviews**. More eyes will help a) speed the project along b) ensure quality and c) reduce possible future bugs.
141 | * **Add tests**. There can never be enough tests.
142 |
143 | Read Cube [contributing.md](docs/contributing.md) for details on the latest development flow.
144 |
145 | ### Want to hack on Cube?
146 |
147 | [](docs/contributing.md)
148 |
149 | # License
150 |
151 | The MIT License (MIT)
152 |
153 | Copyright (c) 2017 Protocol Labs Inc.
154 |
155 | Permission is hereby granted, free of charge, to any person obtaining a copy
156 | of this software and associated documentation files (the "Software"), to deal
157 | in the Software without restriction, including without limitation the rights
158 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
159 | copies of the Software, and to permit persons to whom the Software is
160 | furnished to do so, subject to the following conditions:
161 |
162 | The above copyright notice and this permission notice shall be included in
163 | all copies or substantial portions of the Software.
164 |
165 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
166 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
167 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
168 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
169 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
170 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
171 | THE SOFTWARE.
172 |
--------------------------------------------------------------------------------
/src/cube/web.clj:
--------------------------------------------------------------------------------
1 | (ns cube.web
2 | (:require [com.stuartsierra.component :as c]
3 | [org.httpkit.server :as httpkit]
4 | [compojure.core :as compojure]
5 | [compojure.route :as route]
6 | [ring.util.response :refer [resource-response]]
7 | [compojure.coercions :as coercions]
8 | [clojure.data.json :as json]
9 | [buddy.auth.backends :as backends]
10 | [buddy.auth.middleware :refer (wrap-authentication authentication-request)]
11 | [buddy.sign.jwt :as jwt]
12 | [clojure.pprint :refer [pprint]]
13 | [cube.db :as db]
14 | [cube.auth :as auth]
15 | [cube.monitoring :as monitoring]
16 | [cube.instances :as instances]
17 | [cube.cluster :as cluster]
18 | [ring.middleware.reload :refer [wrap-reload]]
19 | [compojure.handler :as handler]
20 | [ring.middleware.keyword-params :refer [wrap-keyword-params]]
21 | [ring.middleware.params :refer [wrap-params]]
22 | [hiccup.middleware :refer [wrap-base-url]]
23 | [ring.middleware.json :refer [wrap-json-response wrap-json-body]]
24 | [crypto.password.bcrypt :as bcrypt]))
25 |
26 | ;; Move into it's own file
27 | (defn read-perm [k]
28 | [k :read])
29 |
30 | (defn write-perm [k]
31 | [k :write])
32 |
33 | (def instances-read (read-perm :instances))
34 | (def monitoring-read (read-perm :monitoring))
35 | (def pins-read (read-perm :pins))
36 | (def users-read (read-perm :users))
37 | (def groups-read (read-perm :groups))
38 | (def preferences-read (read-perm :preferences))
39 | (def upload-read (read-perm :upload))
40 |
41 | (def instances-write (write-perm :instances))
42 | (def monitoring-write (write-perm :monitoring))
43 | (def pins-write (write-perm :pins))
44 | (def users-write (write-perm :users))
45 | (def groups-write (write-perm :groups))
46 | (def preferences-write (write-perm :preferences))
47 | (def upload-write (write-perm :upload))
48 |
49 | (def instances-readwrite [instances-read instances-write])
50 | (def monitoring-readwrite [monitoring-read monitoring-write])
51 | (def pins-readwrite [pins-read pins-write])
52 | (def users-readwrite [users-read users-write])
53 | (def groups-readwrite [groups-read groups-write])
54 | (def preferences-readwrite [preferences-read preferences-write])
55 | (def upload-readwrite [upload-read upload-write])
56 |
57 | (defn flat-add-vector [acc curr]
58 | (if (vector? (get curr 0))
59 | (into acc curr)
60 | (into acc [curr])))
61 |
62 | (defn join-perms [& perms]
63 | (vec (reduce flat-add-vector [] perms)))
64 |
65 | (def permissions {:admin (join-perms instances-readwrite
66 | monitoring-readwrite
67 | pins-readwrite
68 | users-readwrite
69 | groups-readwrite
70 | preferences-readwrite
71 | upload-readwrite)
72 |
73 | :manager (join-perms instances-read
74 | monitoring-read
75 | pins-readwrite
76 | users-readwrite
77 | preferences-read
78 | upload-readwrite)
79 |
80 | :devops (join-perms instances-readwrite
81 | monitoring-readwrite
82 | pins-readwrite
83 | preferences-readwrite
84 | upload-readwrite)
85 |
86 | :pinner (join-perms pins-readwrite
87 | monitoring-read
88 | upload-readwrite)
89 |
90 | :viewer (join-perms pins-read upload-read)
91 | :guest []})
92 |
93 | (def open-channels (atom []))
94 |
95 | (defn send-update-over-channel! [ch to-send]
96 | (httpkit/send! ch (json/write-str to-send)))
97 |
98 | (defn filtered-db-state [user permissions db]
99 | (auth/filter-db permissions user db))
100 |
101 | (defn send-update-over-channels! [to-send]
102 | (doseq [ch @open-channels]
103 | (let [filtered-db (filtered-db-state (:user ch) permissions {:state (atom to-send)})]
104 | (send-update-over-channel! (:channel ch) @(:state filtered-db)))))
105 |
106 | (defn create-user [username role]
107 | {:username username
108 | :password (bcrypt/encrypt username)
109 | :roles #{role}
110 | :permissions (role permissions)})
111 |
112 | (def users {"admin" (create-user "admin" :admin)
113 | "manager" (create-user "manager" :manager)
114 | "devops" (create-user "devops" :devops)
115 | "pinner" (create-user "pinner" :pinner)
116 | "viewer" (create-user "viewer" :viewer)
117 | "guest" (create-user "guest" :guest)})
118 |
119 | (def http-unauthorized {:status 401})
120 |
121 | (def secret "mysecret")
122 | (def backend (backends/jws {:secret secret}))
123 |
124 | (defn ws-handler
125 | [db]
126 | (fn [request]
127 | (let [login-token (get-in request [:cookies "login-token" :value])]
128 | (if-not (nil? login-token)
129 | (let [username (:user (jwt/unsign login-token secret))
130 | user (get-in users [username])]
131 | (httpkit/with-channel request channel
132 | (httpkit/on-close channel (fn [status] (println "[web] Closed WS channel " status)))
133 | (when (httpkit/websocket? channel)
134 | (do (swap! open-channels conj {:channel channel :user user})
135 | ;; listening for changes on the db, send connected users the
136 | ;; new version
137 | (db/on-change db send-update-over-channels!)
138 | (let [filtered-db (filtered-db-state user permissions db)]
139 | (send-update-over-channel! channel @(:state filtered-db)))))))
140 | http-unauthorized))))
141 |
142 | (defn login-handler
143 | [request]
144 | (let [data (:body request)]
145 | (if (auth/authenticated? users data)
146 | (let [user (get-in users [(:username data)])
147 | token (jwt/sign {:user (:username user)} secret)]
148 | {:status 200
149 | :body {:token token}
150 | :headers {"Content-Type" "application/json"}})
151 | http-unauthorized)))
152 |
153 | (defn auth-handler [success-handler]
154 | (wrap-authentication
155 | (fn [request]
156 | (if (nil? (:identity request))
157 | http-unauthorized
158 | (success-handler request)))
159 | backend))
160 |
161 | (defn profile-handler [request] (auth-handler
162 | #(let [user (get-in users [(-> % :identity :user)])]
163 | {:status 200
164 | :body (dissoc user :password)})))
165 |
166 | ;; Wraps the routes in bunch of middleware
167 | (defn wrap [routes]
168 | (-> routes
169 | (handler/site)
170 | (wrap-keyword-params)
171 | (wrap-params)
172 | (wrap-base-url)
173 | (wrap-json-response)
174 | (wrap-json-body {:keywords? true :bigdecimals? true})))
175 |
176 | ;; cluster service to use everywhere
177 | (defn routes [db instances cluster]
178 | (wrap
179 | (compojure/routes
180 | (route/resources "/")
181 | (compojure/GET "/" []
182 | (resource-response "index.html" {:root "public"}))
183 | (compojure/context "/api" []
184 | (compojure/POST "/login" req (login-handler req))
185 | (compojure/GET "/profile" req (profile-handler req))
186 | ;; TODO Creating and removing pins should be protected
187 | ;; Protected and needs `:pins :write` permission
188 | (compojure/POST "/pins/:cid/:cid-name" [cid cid-name]
189 | (cluster/pin cluster cid cid-name))
190 | (compojure/DELETE "/pins/:cid" [cid]
191 | (cluster/remove-pin cluster cid))
192 | (compojure/GET "/db/ws" [] (ws-handler db))
193 | (compojure/GET "/instances/wanted" [] (str (instances/get-wanted instances)))
194 | (compojure/POST "/instances/wanted/:instance-type/:instance-count"
195 | [instance-type
196 | instance-count :<< coercions/as-int]
197 | (do
198 | (instances/set-wanted
199 | instances
200 | (keyword instance-type)
201 | instance-count)
202 | {:status 200}))
203 | (compojure/GET "/monitoring" [] (json/write-str @cube.monitoring/state)))
204 | ;; TODO leading to issues in uberjar with `Stream Closed` and what-not
205 | ;; (route/not-found (resource-response "index.html" {:root "public"}))
206 | (compojure/GET "/*" []
207 | (resource-response "index.html" {:root "public"}))
208 | (route/not-found {:status 404})
209 | )))
210 |
211 | (defrecord Web [db instances cluster]
212 | c/Lifecycle
213 | (start [this]
214 | (println "[web] Starting")
215 | (assoc this :server (httpkit/run-server (routes db instances cluster) {:port (:port this)})))
216 | (stop [this]
217 | (print "[web] Stopping")
218 | ((:server this)) ;; stops httpkit server, run-server returns function to stop
219 | (assoc this :server nil)))
220 |
221 | (defn new [port]
222 | (map->Web {:port port}))
223 |
--------------------------------------------------------------------------------