🎉 Add management http api

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,206 @@
+;; 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.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"))
+
+(defmethod ig/init-key ::routes
+  [_ cfg]
+  [["/authenticate"
+    {:handler (partial authenticate cfg)
+     :allowed-methods #{:post}}]
+
+   ["/get-customer"
+    {:handler (partial get-customer cfg)
+     :allowed-methods #{:post}}]
+
+   ["/update-customer"
+    {:handler (partial update-customer cfg)
+     :allowed-methods #{:post}}]])
+
+;; ---- 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)
+
+        props
+        (assoc props :subscription subscription)]
+
+    (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

@@ -19,6 +19,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]
@@ -272,6 +273,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)
@@ -280,6 +285,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/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))))))
+
+
+
+

common/src/app/common/time.cljc

@@ -7,14 +7,17 @@
 (ns app.common.time
   "Minimal cross-platoform date time api for specific use cases on types
   definition and other common code."
+  (:refer-clojure :exclude [inst?])
   #?(:cljs
      (:require
       ["luxon" :as lxn])
      :clj
      (:import
-      java.time.format.DateTimeFormatter
+      java.time.Duration
       java.time.Instant
-      java.time.Duration)))
+      java.time.format.DateTimeFormatter
+      java.time.temporal.ChronoUnit
+      java.time.temporal.TemporalUnit)))
 
 #?(:cljs
    (def DateTime lxn/DateTime))
@@ -22,6 +25,42 @@
 #?(:cljs
    (def Duration lxn/Duration))
 
+(defn- resolve-temporal-unit
+  [o]
+  (case o
+    (:nanos :nano)
+    #?(:clj ChronoUnit/NANOS
+       :cljs (throw (js/Error. "not supported nanos")))
+
+    (:micros :microsecond :micro)
+    #?(:clj ChronoUnit/MICROS
+       :cljs (throw (js/Error. "not supported nanos")))
+
+    (:millis :millisecond :milli)
+    #?(:clj ChronoUnit/MILLIS
+       :cljs "millisecond")
+
+    (:seconds :second)
+    #?(:clj ChronoUnit/SECONDS
+       :cljs "second")
+
+    (:minutes :minute)
+    #?(:clj ChronoUnit/MINUTES
+       :cljs "minute")
+
+    (:hours :hour)
+    #?(:clj ChronoUnit/HOURS
+       :cljs "hour")
+
+    (:days :day)
+    #?(:clj ChronoUnit/DAYS
+       :cljs "day")))
+
+(defn temporal-unit
+  [o]
+  #?(:clj (if (instance? TemporalUnit o) o (resolve-temporal-unit o))
+     :cljs (resolve-temporal-unit o)))
+
 (defn now
   []
   #?(:clj (Instant/now)
@@ -49,6 +88,11 @@
   #?(:clj (instance? Instant o)
      :cljs (instance? DateTime o)))
 
+(defn inst?
+  [o]
+  #?(:clj (instance? Instant o)
+     :cljs (instance? DateTime o)))
+
 (defn parse-instant
   [s]
   (cond
@@ -63,6 +107,24 @@
     #?(:clj (Instant/parse s)
        :cljs (.fromISO ^js DateTime s))))
 
+(defn inst
+  [s]
+  (parse-instant s))
+
+#?(:clj
+   (defn truncate
+     [o unit]
+     (let [unit (temporal-unit unit)]
+       (cond
+         (inst? o)
+         (.truncatedTo ^Instant o ^TemporalUnit unit)
+
+         (instance? Duration o)
+         (.truncatedTo ^Duration o ^TemporalUnit unit)
+
+         :else
+         (throw (IllegalArgumentException. "only instant and duration allowed"))))))
+
 (defn format-instant
   [v]
   #?(:clj (.format DateTimeFormatter/ISO_INSTANT ^Instant v)