Merge remote-tracking branch 'origin/staging' into develop

backend/src/app/db/sql.clj

@@ -53,8 +53,15 @@
          opts (cond-> opts
                 (::order-by opts)   (assoc :order-by (::order-by opts))
                 (::columns opts)    (assoc :columns (::columns opts))
-                (::for-update opts) (assoc :suffix "FOR UPDATE")
-                (::for-share opts)  (assoc :suffix "FOR SHARE"))]
+
+                (or (::db/for-update opts)
+                    (::for-update opts))
+                (assoc :suffix "FOR UPDATE")
+
+                (or (::db/for-share opts)
+                    (::for-share opts))
+                (assoc :suffix "FOR SHARE"))]
+
      (sql/for-query table where-params opts))))
 
 (defn update

backend/src/app/http.clj

@@ -17,6 +17,7 @@
    [app.http.awsns :as-alias awsns]
    [app.http.debug :as-alias debug]
    [app.http.errors :as errors]
+   [app.http.management :as mgmt]
    [app.http.middleware :as mw]
    [app.http.session :as session]
    [app.http.websocket :as-alias ws]
@@ -143,6 +144,7 @@
    [::debug/routes schema:routes]
    [::mtx/routes schema:routes]
    [::awsns/routes schema:routes]
+   [::mgmt/routes schema:routes]
    ::session/manager
    ::setup/props
    ::db/pool])
@@ -170,6 +172,9 @@
      ["/webhooks"
       (::awsns/routes cfg)]
 
+     ["/management"
+      (::mgmt/routes cfg)]
+
      (::ws/routes cfg)
 
      ["/api" {:middleware [[mw/cors]]}

backend/src/app/http/management.clj

@@ -0,0 +1,234 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.http.management
+  "Internal mangement HTTP API"
+  (:require
+   [app.common.logging :as l]
+   [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.time :as ct]
+   [app.db :as db]
+   [app.main :as-alias main]
+   [app.rpc.commands.profile :as cmd.profile]
+   [app.setup :as-alias setup]
+   [app.tokens :as tokens]
+   [app.worker :as-alias wrk]
+   [integrant.core :as ig]
+   [yetti.response :as-alias yres]))
+
+;; ---- ROUTES
+
+(declare ^:private authenticate)
+(declare ^:private get-customer)
+(declare ^:private update-customer)
+
+(defmethod ig/assert-key ::routes
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
+
+(def ^:private default-system
+  {:name ::default-system
+   :compile
+   (fn [_ _]
+     (fn [handler cfg]
+       (fn [request]
+         (handler cfg request))))})
+
+(def ^:private transaction
+  {:name ::transaction
+   :compile
+   (fn [data _]
+     (when (:transaction data)
+       (fn [handler]
+         (fn [cfg request]
+           (db/tx-run! cfg handler request)))))})
+
+(defmethod ig/init-key ::routes
+  [_ cfg]
+  ["" {:middleware [[default-system cfg]
+                    [transaction]]}
+   ["/authenticate"
+    {:handler authenticate
+     :allowed-methods #{:post}}]
+
+   ["/get-customer"
+    {:handler get-customer
+     :transaction true
+     :allowed-methods #{:post}}]
+
+   ["/update-customer"
+    {:handler update-customer
+     :allowed-methods #{:post}
+     :transaction true}]])
+
+;; ---- HELPERS
+
+(defn- coercer
+  [schema & {:as opts}]
+  (let [decode-fn (sm/decoder schema sm/json-transformer)
+        check-fn  (sm/check-fn schema opts)]
+    (fn [data]
+      (-> data decode-fn check-fn))))
+
+;; ---- API: AUTHENTICATE
+
+(defn- authenticate
+  [cfg request]
+  (let [token  (-> request :params :token)
+        props  (get cfg ::setup/props)
+        result (tokens/verify props {:token token :iss "authentication"})]
+    {::yres/status 200
+     ::yres/body result}))
+
+;; ---- API: GET-CUSTOMER
+
+(def ^:private schema:get-customer
+  [:map [:id ::sm/uuid]])
+
+(def ^:private coerce-get-customer-params
+  (coercer schema:get-customer
+           :type :validation
+           :hint "invalid data provided for `get-customer` rpc call"))
+
+(def ^:private sql:get-customer-slots
+  "WITH teams AS (
+    SELECT tpr.team_id AS id,
+           tpr.profile_id AS profile_id
+      FROM team_profile_rel AS tpr
+     WHERE tpr.is_owner IS true
+       AND tpr.profile_id = ?
+  ), teams_with_slots AS (
+    SELECT tpr.team_id AS id,
+           count(*) AS total
+      FROM team_profile_rel AS tpr
+     WHERE tpr.team_id IN (SELECT id FROM teams)
+       AND tpr.can_edit IS true
+     GROUP BY 1
+     ORDER BY 2
+  )
+  SELECT max(total) AS total FROM teams_with_slots;")
+
+(defn- get-customer-slots
+  [cfg profile-id]
+  (let [result (db/exec-one! cfg [sql:get-customer-slots profile-id])]
+    (:total result)))
+
+(defn- get-customer
+  [cfg request]
+  (let [profile-id (-> request :params coerce-get-customer-params :id)
+        profile    (cmd.profile/get-profile cfg profile-id)
+        result     {:id (get profile :id)
+                    :name (get profile :fullname)
+                    :email (get profile :email)
+                    :num-editors (get-customer-slots cfg profile-id)
+                    :subscription (-> profile :props :subscription)}]
+    {::yres/status 200
+     ::yres/body result}))
+
+
+;; ---- API: UPDATE-CUSTOMER
+
+(def ^:private schema:timestamp
+  (sm/type-schema
+   {:type ::timestamp
+    :pred ct/inst?
+    :type-properties
+    {:title "inst"
+     :description "The same as :app.common.time/inst but encodes to epoch"
+     :error/message "should be an instant"
+     :gen/gen (->> (sg/small-int)
+                   (sg/fmap (fn [v] (ct/inst v))))
+     :decode/string ct/inst
+     :encode/string inst-ms
+     :decode/json ct/inst
+     :encode/json inst-ms}}))
+
+(def ^:private schema:subscription
+  [:map {:title "Subscription"}
+   [:id ::sm/text]
+   [:customer-id ::sm/text]
+   [:type [:enum
+           "unlimited"
+           "professional"
+           "enterprise"]]
+   [:status [:enum
+             "active"
+             "canceled"
+             "incomplete"
+             "incomplete_expired"
+             "past_due"
+             "paused"
+             "trialing"
+             "unpaid"]]
+
+   [:billing-period [:enum
+                     "month"
+                     "day"
+                     "week"
+                     "year"]]
+   [:quantity :int]
+   [:description [:maybe ::sm/text]]
+   [:created-at schema:timestamp]
+   [:start-date [:maybe schema:timestamp]]
+   [:ended-at [:maybe schema:timestamp]]
+   [:trial-end [:maybe schema:timestamp]]
+   [:trial-start [:maybe schema:timestamp]]
+   [:cancel-at [:maybe schema:timestamp]]
+   [:canceled-at [:maybe schema:timestamp]]
+   [:current-period-end [:maybe schema:timestamp]]
+   [:current-period-start [:maybe schema:timestamp]]
+   [:cancel-at-period-end :boolean]
+
+   [:cancellation-details
+    [:map {:title "CancellationDetails"}
+     [:comment [:maybe ::sm/text]]
+     [:reason [:maybe ::sm/text]]
+     [:feedback [:maybe
+                 [:enum
+                  "customer_service"
+                  "low_quality"
+                  "missing_feature"
+                  "other"
+                  "switched_service"
+                  "too_complex"
+                  "too_expensive"
+                  "unused"]]]]]])
+
+(def ^:private schema:update-customer
+  [:map
+   [:id ::sm/uuid]
+   [:subscription [:maybe schema:subscription]]])
+
+(def ^:private coerce-update-customer-params
+  (coercer schema:update-customer
+           :type :validation
+           :hint "invalid data provided for `update-customer` rpc call"))
+
+(defn- update-customer
+  [cfg request]
+  (let [{:keys [id subscription]}
+        (-> request :params coerce-update-customer-params)
+
+        {:keys [props] :as profile}
+        (cmd.profile/get-profile cfg id ::db/for-update true)
+
+        props
+        (assoc props :subscription subscription)]
+
+    (l/dbg :hint "update customer"
+           :profile-id (str id)
+           :subscription-type (get subscription :type)
+           :subscription-status (get subscription :status)
+           :subscription-quantity (get subscription :quantity))
+
+    (db/update! cfg :profile
+                {:props (db/tjson props)}
+                {:id id}
+                {::db/return-keys false})
+
+    {::yres/status 201
+     ::yres/body nil}))

backend/src/app/main.clj

@@ -20,6 +20,7 @@
    [app.http.awsns :as http.awsns]
    [app.http.client :as-alias http.client]
    [app.http.debug :as-alias http.debug]
+   [app.http.management :as mgmt]
    [app.http.session :as-alias session]
    [app.http.session.tasks :as-alias session.tasks]
    [app.http.websocket :as http.ws]
@@ -273,6 +274,10 @@
     ::email/blacklist    (ig/ref ::email/blacklist)
     ::email/whitelist    (ig/ref ::email/whitelist)}
 
+   ::mgmt/routes
+   {::db/pool            (ig/ref ::db/pool)
+    ::setup/props        (ig/ref ::setup/props)}
+
    :app.http/router
    {::session/manager    (ig/ref ::session/manager)
     ::db/pool            (ig/ref ::db/pool)
@@ -281,6 +286,7 @@
     ::setup/props        (ig/ref ::setup/props)
     ::mtx/routes         (ig/ref ::mtx/routes)
     ::oidc/routes        (ig/ref ::oidc/routes)
+    ::mgmt/routes        (ig/ref ::mgmt/routes)
     ::http.debug/routes  (ig/ref ::http.debug/routes)
     ::http.assets/routes (ig/ref ::http.assets/routes)
     ::http.ws/routes     (ig/ref ::http.ws/routes)

backend/src/app/rpc/commands/profile.clj

@@ -131,9 +131,7 @@
   ;; NOTE: we need to retrieve the profile independently if we use
   ;; it or not for explicit locking and avoid concurrent updates of
   ;; the same row/object.
-  (let [profile (-> (db/get-by-id conn :profile profile-id ::sql/for-update true)
-                    (decode-row))
-
+  (let [profile (get-profile conn profile-id ::db/for-update true)
         ;; Update the profile map with direct params
         profile (-> profile
                     (assoc :fullname fullname)
@@ -143,9 +141,9 @@
     (db/update! conn :profile
                 {:fullname fullname
                  :lang lang
-                 :theme theme
-                 :props (db/tjson (:props profile))}
-                {:id profile-id})
+                 :theme theme}
+                {:id profile-id}
+                {::db/return-keys false})
 
     (-> profile
         (strip-private-attrs)
@@ -228,21 +226,22 @@
 
 (defn- update-notifications!
   [{:keys [::db/conn] :as cfg} {:keys [profile-id dashboard-comments email-comments email-invites]}]
-  (let [profile (get-profile conn profile-id)
+  (let [profile
+        (get-profile conn profile-id ::db/for-update true)
 
         notifications
         {:dashboard-comments dashboard-comments
          :email-comments email-comments
-         :email-invites email-invites}]
+         :email-invites email-invites}
 
-    (db/update!
-     conn :profile
-     {:props
-      (-> (:props profile)
-          (assoc :notifications notifications)
-          (db/tjson))}
-     {:id (:id profile)})
+        props
+        (-> (get profile :props)
+            (assoc :notifications notifications))]
 
+    (db/update! conn :profile
+                {:props (db/tjson props)}
+                {:id profile-id}
+                {::db/return-keys false})
     nil))
 
 ;; --- MUTATION: Update Photo
@@ -411,7 +410,7 @@
 
 (defn update-profile-props
   [{:keys [::db/conn] :as cfg} profile-id props]
-  (let [profile (get-profile conn profile-id ::sql/for-update true)
+  (let [profile (get-profile conn profile-id ::db/for-update true)
         props   (reduce-kv (fn [props k v]
                              ;; We don't accept namespaced keys
                              (if (simple-ident? k)
@@ -424,16 +423,17 @@
 
     (db/update! conn :profile
                 {:props (db/tjson props)}
-                {:id profile-id})
+                {:id profile-id}
+                {::db/return-keys false})
 
     (filter-props props)))
 
 (sv/defmethod ::update-profile-props
   {::doc/added "1.0"
-   ::sm/params schema:update-profile-props}
+   ::sm/params schema:update-profile-props
+   ::db/transaction true}
   [cfg {:keys [::rpc/profile-id props]}]
-  (db/tx-run! cfg (fn [cfg]
-                    (update-profile-props cfg profile-id props))))
+  (update-profile-props cfg profile-id props))
 
 ;; --- MUTATION: Delete Profile
 
@@ -471,6 +471,26 @@
     (-> (rph/wrap nil)
         (rph/with-transform (session/delete-fn cfg)))))
 
+(def sql:get-subscription-editors
+  "SELECT DISTINCT
+          p.id,
+          p.fullname AS name,
+          p.email AS email
+     FROM team_profile_rel AS tpr1
+     JOIN team_profile_rel AS tpr2
+       ON (tpr1.team_id = tpr2.team_id)
+     JOIN profile AS p
+       ON (tpr2.profile_id = p.id)
+    WHERE tpr1.profile_id = ?
+      AND tpr1.is_owner IS true
+      AND tpr2.can_edit IS true")
+
+(sv/defmethod ::get-subscription-usage
+  {::doc/added "2.9"}
+  [cfg {:keys [::rpc/profile-id]}]
+  (let [editors (db/exec! cfg [sql:get-subscription-editors profile-id])]
+    {:editors editors}))
+
 ;; --- HELPERS
 
 (def sql:owned-teams

backend/test/backend_tests/http_management_test.clj

@@ -0,0 +1,96 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns backend-tests.http-management-test
+  (:require
+   [app.common.data :as d]
+   [app.common.time :as ct]
+   [app.db :as db]
+   [app.http.access-token]
+   [app.http.management :as mgmt]
+   [app.http.session :as sess]
+   [app.main :as-alias main]
+   [app.rpc :as-alias rpc]
+   [backend-tests.helpers :as th]
+   [clojure.test :as t]
+   [mockery.core :refer [with-mocks]]
+   [yetti.response :as-alias yres]))
+
+(t/use-fixtures :once th/state-init)
+(t/use-fixtures :each th/database-reset)
+
+
+(t/deftest authenticate-method
+  (let [profile  (th/create-profile* 1)
+        props    (get th/*system* :app.setup/props)
+        token    (#'sess/gen-token props {:profile-id (:id profile)})
+        request  {:params {:token token}}
+        response (#'mgmt/authenticate th/*system* request)]
+
+    (t/is (= 200 (::yres/status response)))
+    (t/is (= "authentication" (-> response ::yres/body :iss)))
+    (t/is (= (:id profile) (-> response ::yres/body :uid)))))
+
+(t/deftest get-customer-method
+  (let [profile  (th/create-profile* 1)
+        request  {:params {:id (:id profile)}}
+        response (#'mgmt/get-customer th/*system* request)]
+
+    (t/is (= 200 (::yres/status response)))
+    (t/is (= (:id profile) (-> response ::yres/body :id)))
+    (t/is (= (:fullname profile) (-> response ::yres/body :name)))
+    (t/is (= (:email profile) (-> response ::yres/body :email)))
+    (t/is (= 1 (-> response ::yres/body :num-editors)))
+    (t/is (nil? (-> response ::yres/body :subscription)))))
+
+(t/deftest update-customer-method
+  (let [profile  (th/create-profile* 1)
+
+        subs     {:type "unlimited"
+                  :description nil
+                  :id "foobar"
+                  :customer-id (str (:id profile))
+                  :status "past_due"
+                  :billing-period "week"
+                  :quantity 1
+                  :created-at (ct/truncate (ct/now) :day)
+                  :cancel-at-period-end true
+                  :start-date nil
+                  :ended-at nil
+                  :trial-end nil
+                  :trial-start nil
+                  :cancel-at nil
+                  :canceled-at nil
+                  :current-period-end nil
+                  :current-period-start nil
+
+                  :cancellation-details
+                  {:comment "other"
+                   :reason "other"
+                   :feedback "other"}}
+
+        request  {:params {:id (:id profile)
+                           :subscription subs}}
+        response (#'mgmt/update-customer th/*system* request)]
+
+    (t/is (= 201 (::yres/status response)))
+    (t/is (nil? (::yres/body response)))
+
+    (let [request  {:params {:id (:id profile)}}
+          response (#'mgmt/get-customer th/*system* request)]
+
+      (t/is (= 200 (::yres/status response)))
+      (t/is (= (:id profile) (-> response ::yres/body :id)))
+      (t/is (= (:fullname profile) (-> response ::yres/body :name)))
+      (t/is (= (:email profile) (-> response ::yres/body :email)))
+      (t/is (= 1 (-> response ::yres/body :num-editors)))
+
+      (let [subs' (-> response ::yres/body :subscription)]
+        (t/is (= subs' subs))))))
+
+
+
+