🎉 Add simple telemetry server module.

backend/deps.edn

@@ -31,6 +31,8 @@
   info.sunng/ring-jetty9-adapter {:mvn/version "0.14.1"}
   seancorfield/next.jdbc {:mvn/version "1.1.613"}
   metosin/reitit-ring {:mvn/version "0.5.10"}
+  metosin/jsonista {:mvn/version "0.3.0"}
+
   org.postgresql/postgresql {:mvn/version "42.2.18"}
   com.zaxxer/HikariCP {:mvn/version "3.4.5"}
 
@@ -76,10 +78,6 @@
     mockery/mockery {:mvn/version "0.1.4"}}
    :extra-paths ["tests"]}
 
-  ;; :fn-media-loader
-  ;; {:exec-fn app.cli.media-loader/run
-  ;;  :args {}}
-
   :fn-fixtures
   {:exec-fn app.cli.fixtures/run
    :args {}}

backend/dev/user.clj

@@ -20,6 +20,7 @@
    [clojure.pprint :refer [pprint]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
+   [clojure.spec.gen.alpha :as sgen]
    [clojure.test :as test]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
@@ -30,6 +31,7 @@
 
 (defonce system nil)
 
+
 ;; --- Benchmarking Tools
 
 (defmacro run-quick-bench
@@ -68,7 +70,7 @@
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
-                             (-> (main/build-system-config @cfg/config)
+                             (-> (main/build-system-config cfg/config)
                                  (ig/prep)
                                  (ig/init))))
   :started)

backend/src/app/config.clj

@@ -120,6 +120,12 @@
 (s/def ::ldap-auth-fullname-attribute ::us/string)
 (s/def ::ldap-auth-avatar-attribute ::us/string)
 
+(s/def ::telemetry-enabled ::us/boolean)
+(s/def ::telemetry-url ::us/string)
+(s/def ::telemetry-server-enabled ::us/boolean)
+(s/def ::telemetry-server-port ::us/integer)
+
+
 (s/def ::config
   (s/keys :opt-un [::http-server-cors
                    ::http-server-debug
@@ -150,6 +156,10 @@
                    ::smtp-ssl
                    ::host
                    ::file-trimming-threshold
+                   ::telemetry-enabled
+                   ::telemetry-server-enabled
+                   ::telemetry-url
+                   ::telemetry-server-port
                    ::debug
                    ::allow-demo-users
                    ::registration-enabled
@@ -168,7 +178,7 @@
                    ::ldap-auth-fullname-attribute
                    ::ldap-auth-avatar-attribute]))
 
-(defn env->config
+(defn- env->config
   [env]
   (reduce-kv
    (fn [acc k v]
@@ -181,13 +191,13 @@
    {}
    env))
 
-(defn read-config
+(defn- read-config
   [env]
   (->> (env->config env)
        (merge defaults)
        (us/conform ::config)))
 
-(defn read-test-config
+(defn- read-test-config
   [env]
   (assoc (read-config env)
          :redis-uri "redis://redis/1"
@@ -196,31 +206,13 @@
          :assets-directory "/tmp/app/static"
          :migrations-verbose false))
 
-(def config
+(def version (v/parse "%version%"))
-  (delay (read-config env)))
+(def config (read-config env))
-
+(def test-config (read-test-config env))
-(def test-config
-  (delay (read-test-config env)))
 
 (def default-deletion-delay
   (dt/duration {:hours 48}))
 
-(def version
-  (delay (v/parse "%version%")))
-
-;; (defmethod ig/init-key ::secrets
-;;   [type {:keys [key] :as opts}]
-;;   (when (= key "default")
-;;     (log/warn "Using default SECRET-KEY, system will generate insecure tokens."))
-;;   {:key key
-;;    :factory
-;;    (fn [salt length]
-;;      (let [engine (bk/engine {:key key
-;;                               :salt (name salt)
-;;                               :alg :hkdf
-;;                               :digest :blake2b-512})]
-;;        (bk/get-bytes engine length)))})
-
 (prefer-method print-method
                clojure.lang.IRecord
                clojure.lang.IDeref)

backend/src/app/db.clj

@@ -9,13 +9,14 @@
 
 (ns app.db
   (:require
-   [app.common.spec :as us]
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
+   [app.common.spec :as us]
    [app.config :as cfg]
+   [app.util.json :as json]
+   [app.util.migrations :as mg]
    [app.util.time :as dt]
    [app.util.transit :as t]
-   [clojure.data.json :as json]
    [clojure.spec.alpha :as s]
    [clojure.string :as str]
    [integrant.core :as ig]
@@ -46,7 +47,7 @@
 (s/def ::name ::us/not-empty-string)
 (s/def ::min-pool-size ::us/integer)
 (s/def ::max-pool-size ::us/integer)
-(s/def ::migrations fn?)
+(s/def ::migrations map?)
 (s/def ::metrics map?)
 
 (defmethod ig/pre-init-spec ::pool [_]
@@ -55,14 +56,16 @@
 (defmethod ig/init-key ::pool
   [_ {:keys [migrations] :as cfg}]
   (let [pool (create-pool cfg)]
-    (when migrations
+    (when (seq migrations)
       (with-open [conn (open pool)]
-        (migrations conn)))
+        (mg/setup! conn)
+        (doseq [[mname steps] migrations]
+          (mg/migrate! conn {:name (name mname) :steps steps}))))
     pool))
 
 (defmethod ig/halt-key! ::pool
   [_ pool]
-  (.close ^com.zaxxer.hikari.HikariDataSource pool))
+  (.close ^HikariDataSource pool))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; API & Impl
@@ -72,7 +75,6 @@
   (str "SET statement_timeout = 10000;\n"
        "SET idle_in_transaction_session_timeout = 30000;"))
 
-
 (defn- create-datasource-config
   [{:keys [metrics] :as cfg}]
   (let [dburi    (:uri cfg)
@@ -106,7 +108,7 @@
 
 (defn pool-closed?
   [pool]
-  (.isClosed ^com.zaxxer.hikari.HikariDataSource pool))
+  (.isClosed ^HikariDataSource pool))
 
 (defn- create-pool
   [cfg]
@@ -254,7 +256,7 @@
         val (.getValue o)]
     (if (or (= typ "json")
             (= typ "jsonb"))
-      (json/read-str val :key-fn keyword)
+      (json/decode-str val)
       val)))
 
 (defn decode-transit-pgobject
@@ -278,7 +280,7 @@
   [data]
   (doto (org.postgresql.util.PGobject.)
     (.setType "jsonb")
-    (.setValue (json/write-str data))))
+    (.setValue (json/encode-str data))))
 
 (defn pgarray->set
   [v]

backend/src/app/http.clj

@@ -9,15 +9,11 @@
 
 (ns app.http
   (:require
-   [clojure.pprint]
+   [app.common.spec :as us]
    [app.config :as cfg]
    [app.http.auth :as auth]
-   ;; [app.http.auth.gitlab :as gitlab]
-   [app.http.auth.google :as google]
-   ;; [app.http.auth.ldap :as ldap]
    [app.http.errors :as errors]
    [app.http.middleware :as middleware]
-   ;; [app.http.ws :as ws]
    [app.metrics :as mtx]
    [clojure.tools.logging :as log]
    [integrant.core :as ig]
@@ -27,15 +23,25 @@
   (:import
    org.eclipse.jetty.server.handler.ErrorHandler))
 
+(s/def ::handler fn?)
+(s/def ::ws (s/map-of ::us/string fn?))
+(s/def ::port ::cfg/http-server-port)
+
+(defmethod ig/pre-init-spec ::server [_]
+  (s/keys :req-un [::handler ::port]
+          :opt-un [::ws]))
+
 (defmethod ig/init-key ::server
-  [_ {:keys [router ws port] :as opts}]
+  [_ {:keys [handler ws port] :as opts}]
-  (log/info "Starting http server.")
+  (log/infof "Starting http server on port %s." port)
-  (let [options {:port port
+  (let [options (merge
+                 {:port port
                   :h2c? true
                   :join? false
-                 :allow-null-path-info true
+                  :allow-null-path-info true}
-                 :websockets ws}
+                 (when (seq ws)
-        server  (jetty/run-jetty router options)
+                   {:websockets ws}))
+        server  (jetty/run-jetty handler options)
         handler (doto (ErrorHandler.)
                   (.setShowStacks true)
                   (.setServer server))]
@@ -45,7 +51,7 @@
 
 (defmethod ig/halt-key! ::server
   [_ server]
-  (log/info "Stoping http server." server)
+  (log/info "Stoping http server.")
   (.stop server))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/http/middleware.clj

@@ -13,7 +13,8 @@
    [app.config :as cfg]
    [app.metrics :as mtx]
    [app.util.transit :as t]
-   [clojure.data.json :as json]
+   [app.util.json :as json]
+   ;; [clojure.data.json :as json]
    [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
@@ -21,7 +22,7 @@
    [ring.middleware.params :refer [wrap-params]]
    [ring.middleware.resource :refer [wrap-resource]]))
 
-(defn- wrap-parse-request-body
+(defn wrap-parse-request-body
   [handler]
   (letfn [(parse-transit [body]
             (let [reader (t/reader body)]
@@ -70,7 +71,7 @@
 (defn- impl-format-response-body
   [response]
   (let [body (:body response)
-        type (if (:debug @cfg/config) :json-verbose :json)]
+        type (if (:debug cfg/config) :json-verbose :json)]
     (cond
       (coll? body)
       (-> response
@@ -96,12 +97,12 @@
   {:name ::format-response-body
    :compile (constantly wrap-format-response-body)})
 
-(defn- wrap-errors
+(defn wrap-errors
   [handler on-error]
   (fn [request]
     (try
       (handler request)
-      (catch Throwable e
+      (catch Exception e
         (on-error e request)))))
 
 (def errors
@@ -114,6 +115,7 @@
            (mtx/wrap-counter handler {:id "http__requests_counter"
                                       :help "Absolute http requests counter."}))})
 
+
 (def cookies
   {:name ::cookies
    :compile (constantly wrap-cookies)})
@@ -129,34 +131,3 @@
 (def keyword-params
   {:name ::keyword-params
    :compile (constantly wrap-keyword-params)})
-
-(defn- wrap-development-cors
-  [handler]
-  (letfn [(add-cors-headers [response]
-            (update response :headers
-                    (fn [headers]
-                      (-> headers
-                          (assoc "access-control-allow-origin" "http://localhost:3449")
-                          (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH")
-                          (assoc "access-control-allow-credentials" "true")
-                          (assoc "access-control-expose-headers" "x-requested-with, content-type, cookie")
-                          (assoc "access-control-allow-headers" "content-type")))))]
-    (fn [request]
-      (if (= (:request-method request) :options)
-        (-> {:status 200 :body ""}
-            (add-cors-headers))
-        (let [response (handler request)]
-          (add-cors-headers response))))))
-
-(def development-cors
-  {:name ::development-cors
-   :compile (fn [& _args]
-              (when *assert*
-                wrap-development-cors))})
-
-(def development-resources
-  {:name ::development-resources
-   :compile (fn [& _args]
-              (when *assert*
-                #(wrap-resource % "public")))})
-

backend/src/app/main.clj

@@ -16,18 +16,21 @@
    [integrant.core :as ig]))
 
 ;; Set value for all new threads bindings.
-(alter-var-root #'*assert* (constantly (:enable-asserts @cfg/config)))
+(alter-var-root #'*assert* (constantly (:enable-asserts cfg/config)))
+
+(derive :app.telemetry/server :app.http/server)
 
 ;; --- Entry point
 
 (defn build-system-config
   [config]
+  (merge
    {:app.db/pool
     {:uri        (:database-uri config)
      :username   (:database-username config)
      :password   (:database-password config)
      :metrics    (ig/ref :app.metrics/metrics)
-    :migrations (ig/ref :app.migrations/migrations)
+     :migrations (ig/ref :app.migrations/all)
      :name "main"
      :min-pool-size 0
      :max-pool-size 10}
@@ -35,9 +38,16 @@
     :app.metrics/metrics
     {}
 
+    :app.migrations/all
+    {:uxbox-main (ig/ref :app.migrations/migrations)
+     :telemetry  (ig/ref :app.telemetry/migrations)}
+
     :app.migrations/migrations
     {}
 
+    :app.telemetry/migrations
+    {}
+
     :app.redis/redis
     {:uri (:redis-uri config)}
 
@@ -54,7 +64,7 @@
 
     :app.http/server
     {:port    (:http-server-port config)
-    :router (ig/ref :app.http/router)
+     :handler (ig/ref :app.http/router)
      :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
 
     :app.http/router
@@ -175,10 +185,21 @@
      :max-age (dt/duration {:hours 12})
      :metrics (ig/ref :app.metrics/metrics)}
 
-   :app.srepl/server
+    ;; :app.tasks.telemetry/handler
-   {:port 6062}
+    ;; {:pool    (ig/ref :app.db/pool)}
+
+    :app.srepl/server
+    {:port 6062}}
+
+   (when (:telemetry-server-enabled cfg/config true)
+     {:app.telemetry/handler
+      {:pool     (ig/ref :app.db/pool)
+       :executor (ig/ref :app.worker/executor)}
+
+      :app.telemetry/server
+      {:port    (:telemetry-server-port config 6063)
+       :handler (ig/ref :app.telemetry/handler)}})))
 
-   })
 
 (defmethod ig/init-key :default [_ data] data)
 (defmethod ig/prep-key :default [_ data] (d/without-nils data))
@@ -187,7 +208,7 @@
 
 (defn start
   []
-  (let [system-config (build-system-config @cfg/config)]
+  (let [system-config (build-system-config cfg/config)]
     (ig/load-namespaces system-config)
     (alter-var-root #'system (fn [sys]
                                (when sys (ig/halt! sys))
@@ -195,7 +216,7 @@
                                    (ig/prep)
                                    (ig/init))))
     (log/infof "Welcome to penpot! Version: '%s'."
-               (:full @cfg/version))))
+               (:full cfg/version))))
 
 (defn stop
   []

backend/src/app/migrations.clj

@@ -11,12 +11,10 @@
   (:require
    [integrant.core :as ig]
    [app.db :as db]
-   [app.migrations.migration-0023 :as mg0023]
+   [app.util.migrations :as mg]
-   [app.util.migrations :as mg]))
+   [app.migrations.migration-0023 :as mg0023]))
 
-(def main-migrations
+(def migrations
-  {:name "uxbox-main"
-   :steps
   [{:name "0001-add-extensions"
     :fn (mg/resource "app/migrations/sql/0001-add-extensions.sql")}
 
@@ -118,16 +116,7 @@
 
    {:name "0034-mod-profile-table-add-props-field"
     :fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
-    ]})
+   ])
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod ig/init-key ::migrations [_ _] migrations)
-;; Entry point
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod ig/init-key ::migrations
-  [_ _]
-  (fn [conn]
-    (mg/setup! conn)
-    (mg/migrate! conn main-migrations)))
-

backend/src/app/telemetry.clj

@@ -0,0 +1,116 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.telemetry
+  (:require
+   [clojure.tools.logging :as log]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.http.middleware :refer [wrap-parse-request-body wrap-errors]]
+   [promesa.exec :as px]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
+   [ring.middleware.params :refer [wrap-params]]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Migrations
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def sql:create-info-table
+  "CREATE TABLE telemetry.info (
+     instance_id uuid,
+     created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+     data jsonb NOT NULL,
+
+     PRIMARY KEY (instance_id, created_at)
+  ) PARTITION BY RANGE(created_at);
+
+  CREATE TABLE telemetry.info_default (LIKE telemetry.info INCLUDING ALL);
+
+  ALTER TABLE telemetry.info
+    ATTACH PARTITION telemetry.info_default DEFAULT;")
+
+;; Research on this
+;; ALTER TABLE telemetry.instance_info
+;;   SET (autovacuum_freeze_min_age = 0,
+;;        autovacuum_freeze_max_age = 100000);")
+
+(def sql:create-instance-table
+  "CREATE TABLE IF NOT EXISTS telemetry.instance (
+    id uuid PRIMARY KEY,
+    created_at timestamptz NOT NULL DEFAULT now()
+  );")
+
+(def migrations
+  [{:name "0001-add-telemetry-schema"
+    :fn #(db/exec! % ["CREATE SCHEMA IF NOT EXISTS telemetry;"])}
+
+   {:name "0002-add-instance-table"
+    :fn #(db/exec! % [sql:create-instance-table])}
+
+   {:name "0003-add-info-table"
+    :fn #(db/exec! % [sql:create-info-table])}])
+
+(defmethod ig/init-key ::migrations [_ _] migrations)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Router Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare handler)
+(declare process-request)
+
+(defmethod ig/init-key ::handler
+  [_ cfg]
+  (-> (partial handler cfg)
+      (wrap-keyword-params)
+      (wrap-params)
+      (wrap-parse-request-body)))
+
+(s/def ::instance-id ::us/uuid)
+(s/def ::params (s/keys :req-un [::instance-id]))
+
+(defn handler
+  [{:keys [executor] :as cfg} {:keys [params] :as request}]
+  (try
+    (let [params (us/conform ::params params)
+          cfg    (assoc cfg
+                        :instance-id (:instance-id params)
+                        :data (dissoc params :instance-id))]
+      (px/run! executor (partial process-request cfg)))
+    (catch Exception e
+      (log/errorf e "Unexpected error.")))
+  {:status 200
+   :body "OK\n"})
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Request Processing
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def sql:insert-instance-info
+  "insert into telemetry.instance_info (instance_id, data, created_at)
+   values (?, ?, date_trunc('day', now()))
+       on conflict (instance_id, created_at)
+       do update set data = ?")
+
+(defn- process-request
+  [{:keys [pool instance-id data]}]
+  (try
+    (db/with-atomic [conn pool]
+      (let [data (db/json data)]
+        (db/exec! conn [sql:insert-instance-info
+                        instance-id
+                        data
+                        data])))
+    (catch Exception e
+      (log/errorf e "Error on procesing request."))))

backend/src/app/util/json.clj

@@ -0,0 +1,25 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.util.json
+  (:refer-clojure :exclude [read])
+  (:require
+   [jsonista.core :as j]))
+
+(defn encode-str
+  [v]
+  (j/write-value-as-string v j/keyword-keys-object-mapper))
+
+(defn decode-str
+  [v]
+  (j/read-value v j/keyword-keys-object-mapper))
+
+(defn read
+  [v]
+  (j/read-value v j/keyword-keys-object-mapper))

backend/src/app/worker.clj

@@ -293,11 +293,12 @@
 (s/def ::cron dt/cron?)
 (s/def ::props (s/nilable map?))
 
-(s/def ::scheduled-task
+(s/def ::scheduled-task-spec
   (s/keys :req-un [::id ::cron ::fn]
           :opt-un [::props]))
 
-(s/def ::schedule (s/coll-of ::scheduled-task))
+(s/def ::schedule
+  (s/coll-of (s/nilable ::scheduled-task-spec)))
 
 (defmethod ig/pre-init-spec ::scheduler [_]
   (s/keys :req-un [::executor ::db/pool ::schedule]))
@@ -307,7 +308,8 @@
   (let [scheduler (Executors/newScheduledThreadPool (int 1))
         cfg       (assoc cfg :scheduler scheduler)]
     (synchronize-schedule cfg)
-    (run! (partial schedule-task cfg) schedule)
+    (run! (partial schedule-task cfg)
+          (filter some? schedule))
     (reify
       java.lang.AutoCloseable
       (close [_]

backend/tests/app/tests/helpers.clj

@@ -38,7 +38,7 @@
 
 (defn state-init
   [next]
-  (let [config (-> (main/build-system-config @cfg/test-config)
+  (let [config (-> (main/build-system-config cfg/test-config)
                    (dissoc :app.srepl/server
                            :app.http/server
                            :app.http/router