Add user role checks, see #14

Squashed commit of the following:

commit 393c481a21fa97881be2b6859e9acaa8ab7abb7f
Author: Arne Schlüter <arne@schlueter.is>
Date:   Wed Sep 5 12:04:56 2018 +0200

    Consider user roles when building up the navigation

commit d631cba1174ecf42b682664bf57c41b88b7f5ed4
Author: Arne Schlüter <arne@schlueter.is>
Date:   Wed Sep 5 11:52:05 2018 +0200

    Save user roles on login

commit e68ced335ccc11a2daebbf12bb4061a53935c268
Author: Arne Schlüter <arne@schlueter.is>
Date:   Wed Sep 5 10:25:19 2018 +0200

    Rename dispatch to muted-dispatch for easier disambiguation

src/cljs/airsonic_ui/api/subs.cljs

@@ -1,6 +1,7 @@
 (ns airsonic-ui.api.subs
   (:require [clojure.string :as str]
-            [re-frame.core :refer [reg-sub]]))
+            [re-frame.core :refer [reg-sub]]
+            [airsonic-ui.helpers :refer [kebabify]]))
 
 (defn response-for
   "Returns the cached response for a single endpoint"
@@ -18,9 +19,7 @@
   [endpoint-str]
   (-> (str/replace endpoint-str #"^(get|create|update|delete)" "")
       (str/replace #"\d+$" "")
-      (str/replace #"([a-z])([A-Z])" (fn [[_ a b]] (str a "-" b)))
+      (kebabify)))
-      (str/lower-case)
-      (keyword)))
 
 (defn route-data
   "Given a list of event vectors, returns that responses for all API requests."

src/cljs/airsonic_ui/components/audio_player/views.cljs

@@ -1,6 +1,6 @@
 (ns airsonic-ui.components.audio-player.views
   (:require [re-frame.core :refer [subscribe]]
-            [airsonic-ui.helpers :refer [add-classes dispatch]]
+            [airsonic-ui.helpers :refer [add-classes muted-dispatch]]
             [airsonic-ui.views.cover :refer [cover]]
             [airsonic-ui.views.icon :refer [icon]]))
 
@@ -20,19 +20,19 @@
                   [:media-step-forward :audio-player/next-song]]]
      (map (fn [[icon-glyph event]]
             ^{:key icon-glyph} [:p.control>button.button.is-light
-                                {:on-click (dispatch [event])}
+                                {:on-click (muted-dispatch [event])}
                                 [icon icon-glyph]])
           buttons))])
 
 (defn- toggle-shuffle [playback-mode]
-  (dispatch [:audio-player/set-playback-mode (if (= playback-mode :shuffled)
+  (muted-dispatch [:audio-player/set-playback-mode (if (= playback-mode :shuffled)
                                           :linear :shuffled)]))
 
 (defn- toggle-repeat-mode [current-mode]
   (let [modes (cycle '(:repeat-none :repeat-all :repeat-single))
         next-mode (->> (drop-while (partial not= current-mode) modes)
                        (second))]
-    (dispatch [:audio-player/set-repeat-mode next-mode])))
+    (muted-dispatch [:audio-player/set-repeat-mode next-mode])))
 
 (defn playback-mode-controls [playlist]
   (let [{:keys [repeat-mode playback-mode]} playlist

src/cljs/airsonic_ui/events.cljs

@@ -37,6 +37,8 @@
  [(re-frame/inject-cofx :store)]
  initialize-app)
 
+(re-frame/dispatch [:api/request "getUser" {:username "arne"}])
+
 (defn verify-credentials
   "Initializes the whole authentication chain when we have locally stored
   credentials that look plausible."
@@ -61,12 +63,13 @@
 (re-frame/reg-event-fx :credentials/user-login user-login)
 
 (defn authentication-request
-  "Tries to authenticate a user by pinging the server with credentials, saving
+  "Tries to authenticate a user by requesting info about the given user, saving
-  them when the request was successful. Bypasses the request when a user saved
+  the credentials when the request was successful."
-  their credentials."
   [cofx [_ credentials]]
   (assoc cofx :http-xhrio {:method :get
-                           :uri (api/url (:server credentials) "ping" (select-keys credentials [:u :p]))
+                           :uri (api/url (:server credentials) "getUser"
+                                         (merge (select-keys credentials [:u :p])
+                                                {:username (:u credentials)}))
                            :response-format (ajax/json-response-format {:keywords? true})
                            :on-success [:credentials/authentication-response credentials]
                            :on-failure [:api/failed-response]})) ; <- we don't need endpoint and params here because the response is not cached
@@ -79,7 +82,7 @@
   [fx [_ credentials response]]
   (assoc fx :dispatch (if (api/is-error? response)
                         [:credentials/authentication-failure response]
-                        [:credentials/authentication-success (assoc credentials :verified? true)])))
+                        [:credentials/authentication-success credentials response])))
 
 (re-frame/reg-event-fx :credentials/authentication-response authentication-response)
 
@@ -95,9 +98,10 @@
 (defn authentication-success
   "Gets called after the server indicates that the credentials entered by a user
   are correct (see `credentials-verification-request`)"
-  [{:keys [db]} [_ credentials]]
+  [{:keys [db]} [_ credentials auth-response]]
   {:store {:credentials credentials}
-   :db (assoc db :credentials (assoc credentials :verified? true))
+   :db (-> (assoc db :credentials (assoc credentials :verified? true))
+           (assoc :user (api/unwrap-response auth-response)))
    :dispatch [::logged-in]})
 
 (re-frame/reg-event-fx :credentials/authentication-success authentication-success)

src/cljs/airsonic_ui/helpers.cljs

@@ -1,6 +1,7 @@
 (ns airsonic-ui.helpers
   "Assorted helper functions"
-  (:require [re-frame.core :as rf]))
+  (:require [re-frame.core :as rf]
+            [clojure.string :as str]))
 
 (defn find-where
   "Returns the the first item in `coll` with its index for which `(p song)`
@@ -10,7 +11,7 @@
        (reduce (fn [_ [idx song]]
                  (when (p song) (reduced [idx song]))) nil)))
 
-(defn dispatch
+(defn muted-dispatch
   "Dispatches a re-frame event while canceling default DOM behavior"
   [ev]
   (fn [e]
@@ -22,3 +23,11 @@
   [elem & classes]
   (keyword (apply str (name elem) (->> (filter identity classes)
                                        (map #(str "." (name %)))))))
+
+(defn kebabify
+  "Turns camelCased strings and keywords into kebab-cased keywords"
+  [x]
+  (-> (if (keyword? x) (name x) x)
+      (str/replace #"([a-z])([A-Z])" (fn [[_ a b]] (str a "-" b)))
+      (str/lower-case)
+      (keyword)))

src/cljs/airsonic_ui/subs.cljs

@@ -1,6 +1,9 @@
 (ns airsonic-ui.subs
   (:require [re-frame.core :refer [reg-sub subscribe]]
-            [airsonic-ui.api.helpers :as api]))
+            [airsonic-ui.api.helpers :as api]
+            [airsonic-ui.helpers :refer [kebabify]]
+            [debux.cs.core :refer-macros [dbg]]
+            [clojure.string :as str]))
 
 (defn is-booting?
   "The boot process starts with setting up routing and continues if we found
@@ -16,11 +19,46 @@
 (defn credentials [db _] (:credentials db))
 (reg-sub ::credentials credentials)
 
+;; ---
+;; user info and roles
+;; ---
+
+(defn user-info
+  "Returns the response to getUser?username=$name; this isn't cached like the
+  other responses because it's not retrieved via :api/request"
+  [db _]
+  (:user db))
+
+(reg-sub :user/info user-info)
+
+(defn user-roles
+  "Takes only the roles out of a getUser response to make it easier to work with"
+  [user-info _]
+  (->>
+   (filter (fn [[k _]] (re-find #"Role$" (name k))) user-info)
+   (keep (fn [[role has-role?]]
+           (when has-role? (str/replace (name role) #"Role$" ""))))
+   (map kebabify)
+   (set)))
+
 (reg-sub
- ::user
+ :user/roles
- (fn [_ _] [(subscribe [::credentials])])
+ :<- [:user/info]
- (fn [[credentials] _]
+ user-roles)
-   (when credentials {:name (:u credentials)})))
+
+(defn user-role
+  "Can be used to determine whether a user is allowed to do certain things"
+  [user-roles [_ role]]
+  (or (user-roles role) (user-roles :admin)))
+
+(reg-sub
+ :user/role
+ :<- [:user/roles]
+ user-role)
+
+;; ---
+;; misc
+;; ---
 
 (defn cover-url
   "Provides a convenient way for views to get cover images so they don't have

src/cljs/airsonic_ui/views.cljs

@@ -21,12 +21,18 @@
 
 (defn navbar-top
   "Contains search, some navigational links and the logo"
-  [_]
+  []
   (let [active? (r/atom false)
         toggle-active #(swap! active? not)
         navbar-item (fn navbar-item [{:keys [href]} label]
-                      [:a.navbar-item {:href href :on-click toggle-active} label])]
+                      [:a.navbar-item {:href href :on-click toggle-active} label])
-    (fn [{:keys [user]}]
+        user @(subscribe [:user/info])
+        stream-role @(subscribe [:user/roles :stream])
+        podcast-role @(subscribe [:user/roles :podcast])
+        playlist-role @(subscribe [:user/roles :playlist])
+        share-role @(subscribe [:user/roles :share])
+        settings-role @(subscribe [:user/roles :settings])]
+    (fn []
       [:nav.navbar.is-fixed-top.is-dark {:role "navigation", :aria-label "search and navigation"}
        ;; user is `nil` when we're not logged in, we can hide the extended navigation
        [:div.navbar-brand
@@ -37,25 +43,30 @@
           [:div.navbar-start
            [:div.navbar-item [search/form]]]
           [:div.navbar-end
-           [:div.navbar-item.has-dropdown.is-hoverable
+           (when stream-role
-            [:div.navbar-link "Library"]
+             [:div.navbar-item.has-dropdown.is-hoverable
-            [:div.navbar-dropdown
+              [:div.navbar-link "Library"]
-             [navbar-item {:href (url-for ::routes/library {:criteria "recent"})} "Recently played"]
+              [:div.navbar-dropdown
-             [navbar-item {:href (url-for ::routes/library {:criteria "newest"})} "Newest additions"]
+               [navbar-item {:href (url-for ::routes/library {:criteria "recent"})} "Recently played"]
-             [navbar-item {:href (url-for ::routes/library {:criteria "starred"})} "Starred"]]]
+               [navbar-item {:href (url-for ::routes/library {:criteria "newest"})} "Newest additions"]
-           [navbar-item {} "Podcasts"]
+               [navbar-item {:href (url-for ::routes/library {:criteria "starred"})} "Starred"]]])
-           [navbar-item {} "Playlists"]
+           (when podcast-role
-           [navbar-item {} "Shares"]
+             [navbar-item {} "Podcasts"])
+           (when playlist-role
+             [navbar-item {} "Playlists"])
+           (when share-role
+             [navbar-item {} "Shares"])
            [:div.navbar-item.has-dropdown.is-hoverable
             [:div.navbar-link "More"]
             [:div.navbar-dropdown.is-right
-             [navbar-item "Settings"]
+             (when settings-role
+               [navbar-item "Settings"])
              [:a.navbar-item
               {:on-click (fn [_]
                            (toggle-active)
                            (dispatch [::events/logout]))
                :href "#"}
-              (str "Logout (" (:name user) ")")]]]]])])))
+              (str "Logout (" (:username user) ")")]]]]])])))
 
 (defn media-content
   "Provides the complete UI to browse the media library, interact with search
@@ -77,14 +88,13 @@
 (defn main-panel []
   (let [notifications @(subscribe [::subs/notifications])
         is-booting? @(subscribe [::subs/is-booting?])
-        [route-id params query] @(subscribe [:routes/current-route])
+        [route-id params query] @(subscribe [:routes/current-route])]
-        user @(subscribe [::subs/user])]
     [(add-classes :div route-id)
      [notification-list notifications]
      (if is-booting?
        [:div.app-loading>div.loader]
        [:div
-        [navbar-top {:user user}]
+        [navbar-top]
         (case route-id
           ::routes/login [login-form]
           [media-content route-id params query])])]))

src/cljs/airsonic_ui/views/song.cljs

@@ -1,5 +1,5 @@
 (ns airsonic-ui.views.song
-  (:require [airsonic-ui.helpers :refer [dispatch]]
+  (:require [airsonic-ui.helpers :refer [muted-dispatch]]
             [airsonic-ui.routes :as routes :refer [url-for]]
             [airsonic-ui.views.icon :refer [icon]]))
 
@@ -11,7 +11,7 @@
        (:artist song))
      " - "
      [:a
-      {:href "#" :on-click (dispatch [:audio-player/play-all songs idx])}
+      {:href "#" :on-click (muted-dispatch [:audio-player/play-all songs idx])}
       (:title song)]]))
 
 (defn listing [songs]
@@ -19,12 +19,11 @@
    (for [[idx song] (map-indexed vector songs)]
      ^{:key idx} [:tr
                      [:td.grow [item songs song idx]]
-                     ;; FIXME: Not implemented yet
                   [:td>a {:title "Play next"
                           :href "#"
-                          :on-click (dispatch [:audio-player/enqueue-next song])}
+                          :on-click (muted-dispatch [:audio-player/enqueue-next song])}
                    [icon :plus]]
                   [:td>a {:title "Play last"
                           :href "#"
-                          :on-click (dispatch [:audio-player/enqueue-last song])}
+                          :on-click (muted-dispatch [:audio-player/enqueue-last song])}
                    [icon :caret-right]]])])

test/cljs/airsonic_ui/api/helpers_test.cljs

@@ -60,7 +60,7 @@
     (is (true? (api/is-error? (:auth-failure responses)))))
   (testing "Should pass on good responses"
     (is (false? (api/is-error? (:ok responses))))
-    (is (false? (api/is-error? (:auth-success responses))))))
+    (is (false? (api/is-error? (:ping-success responses))))))
 
 (deftest content-type
   (testing "Should detect whether the data we look at represents a song"

test/cljs/airsonic_ui/events_test.cljs

@@ -6,7 +6,8 @@
             [airsonic-ui.db :as db]
             [airsonic-ui.routes :as routes]
             [airsonic-ui.events :as events]
-            [airsonic-ui.subs :as subs]))
+            [airsonic-ui.subs :as subs]
+            ))
 
 (enable-console-print!)
 
@@ -53,10 +54,11 @@
         request (:http-xhrio fx)]
     (testing "uses correct server url"
       (let [uri (:uri request)]
-        (is (true? (str/starts-with? uri (:server fixtures/credentials))))
+        (is (str/starts-with? uri (:server fixtures/credentials)))
-        (is (true? (str/includes? uri "/ping")))
+        (is (str/includes? uri "/getUser"))
-        (is (true? (str/includes? uri (str "p=" (:p fixtures/credentials)))))
+        (is (str/includes? uri (str "p=" (:p fixtures/credentials))))
-        (is (true? (str/includes? uri (str "u=" (:u fixtures/credentials)))))))
+        (is (str/includes? uri (str "u=" (:u fixtures/credentials))))
+        (is (str/includes? uri (str "username=" (:u fixtures/credentials))))))
     (testing "invokes correct callback on server response"
       (is (= [:credentials/authentication-response fixtures/credentials] (:on-success request))))
     (testing "invokes correct callback when server is not reachable"
@@ -66,9 +68,12 @@
   (testing "On success"
     (let [cofx (-> (has-previous-session)
                    (events/authentication-response [:credentials/authentication-response (:auth-success fixtures/responses)])
-                   (events/authentication-success [:credentials/authentication-success]))]
+                   (events/authentication-success [:credentials/authentication-success fixtures/credentials (:auth-success fixtures/responses)]))]
       (testing "should mark the credentials as verified"
-        (is (true? (get-in cofx [:db :credentials :verified?]))))))
+        (is (true? (get-in cofx [:db :credentials :verified?]))))
+      (testing "should store the credentials in localstorage"
+        (let [stored-credentials (get-in cofx [:store :credentials])]
+          (is (= fixtures/credentials stored-credentials))))))
   (testing "On failure"
     (let [cofx (-> (has-previous-session)
                    (events/authentication-response [:credentials/authentication-response (:auth-failure fixtures/responses)])

test/cljs/airsonic_ui/fixtures.cljs

@@ -14,8 +14,29 @@
                                    :scanning false}
                       :status "ok"
                       :version "1.15.0"}}
-                :auth-success {:subsonic-response {:status "ok"
+                :ping-success {:subsonic-response {:status "ok"
                                                    :version "1.15.0"}}
+                :auth-success {:subsonic-response
+                               {:status "ok",
+                                :version "1.15.0",
+                                :user
+                                {:videoConversionRole false,
+                                 :playlistRole true,
+                                 :shareRole true,
+                                 :podcastRole true,
+                                 :email "admin@example.com",
+                                 :streamRole true,
+                                 :folder [0],
+                                 :username "admin",
+                                 :scrobblingEnabled false,
+                                 :adminRole true,
+                                 :settingsRole true,
+                                 :commentRole true,
+                                 :jukeboxRole true,
+                                 :coverArtRole true,
+                                 :downloadRole true,
+                                 :maxBitRate 320,
+                                 :uploadRole true}}}
                 :auth-failure {:subsonic-response {:status "failed"
                                                    :version "1.15.0"
                                                    :error {:code 40

test/cljs/airsonic_ui/helpers_test.cljs

@@ -21,3 +21,13 @@
   (testing "Should add classes to the innermost child of a nested hiccup element"
     (is (= :p>input.input (helpers/add-classes :p>input :input)))
     (is (= :div.field>p>input.input.has-background-red (helpers/add-classes :div.field>p>input.input :has-background-red)))))
+
+(deftest kebabify
+  (testing "Should turn camelCased and PascalCased strings into kebab-cased keywords"
+    (is (= :hello-world (helpers/kebabify "HelloWorld")))
+    (is (= :how-are-you (helpers/kebabify "howAreYou")))
+    (is (= :foobar (helpers/kebabify "foobar"))))
+  (testing "Should kebab-case camelCased and PascalCased keywords"
+    (is (= :hello-world (helpers/kebabify :HelloWorld)))
+    (is (= :how-are-you (helpers/kebabify :howAreYou)))
+    (is (= :foobar (helpers/kebabify :foobar)))))

test/cljs/airsonic_ui/subs_test.cljs

@@ -2,6 +2,7 @@
   (:require [cljs.test :refer [deftest testing is]]
             [airsonic-ui.fixtures :as fixtures]
             [airsonic-ui.api.helpers :as api]
+            [airsonic-ui.events :as events]
             [airsonic-ui.subs :as subs]))
 
 (deftest booting
@@ -33,3 +34,34 @@
                             fixtures/song
                             48)
              (subs/cover-url [credentials] [:subs/cover-image fixtures/song 48]))))))
+
+(def successful-auth-db
+  "For the details see event_test.cljs"
+  (-> {:store {:credentials fixtures/credentials}}
+      (events/initialize-app [::events/initialize-app])
+      (events/authentication-response [:credentials/authentication-response (:auth-success fixtures/responses)])
+      (events/authentication-success [:credentials/authentication-success fixtures/credentials (:auth-success fixtures/responses)])
+      (:db)))
+
+(deftest user-roles
+  (testing "Should be available after a successful authentication"
+    (let [user-roles (-> (subs/user-info successful-auth-db [:user/info])
+                         (subs/user-roles [:user/roles]))]
+      (is (set? user-roles))
+      (is (every? keyword? user-roles))
+      (is (not (user-roles :username)) "and contain only roles")))
+  (testing "Should indicate whether a user has a given role"
+    (letfn [(role [role]
+              (-> (subs/user-info successful-auth-db [:user/info])
+                  (subs/user-roles [:user/roles])
+                  (disj :admin) ; <- makes sure we're not allowed everything
+                  (subs/user-role [:user/role role])))]
+      (is (some? (role :stream)))
+      (is (not (some? (role :video-conversion))))))
+  (testing "Should allow everything to an admin"
+    (letfn [(admin-role [role]
+              (-> (subs/user-info successful-auth-db [:user/info])
+                  (subs/user-roles [:user/roles])
+                  (subs/user-role [:user/role role])))]
+      (is (some? (admin-role :stream)))
+      (is (some? (admin-role :video-conversion))))))