3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-25 14:06:11 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Add automatic complaint and bouncing handling.

Browse source
This commit is contained in:
Andrey Antukh 2021-02-11 17:57:41 +01:00
parent 17229228a3
commit 7708752ad9
26 changed files with 1073 additions and 73 deletions
Download patch file Download diff file Expand all files Collapse all files

17
backend/src/app/config.clj
View file

@ -11,10 +11,10 @@
"A configuration management."
(:refer-clojure :exclude [get])
(:require
[clojure.core :as c]
[app.common.spec :as us]
[app.common.version :as v]
[app.util.time :as dt]
[clojure.core :as c]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[environ.core :refer [env]]))
@ -54,6 +54,12 @@
:smtp-default-reply-to "Penpot <no-reply@example.com>"
:smtp-default-from "Penpot <no-reply@example.com>"
:profile-complaint-max-age (dt/duration {:days 7})
:profile-complaint-threshold 2
:profile-bounce-max-age (dt/duration {:days 7})
:profile-bounce-threshold 10
:allow-demo-users true
:registration-enabled true
:registration-domain-whitelist ""
@ -100,6 +106,11 @@
(s/def ::feedback-enabled ::us/boolean)
(s/def ::feedback-destination ::us/string)
(s/def ::profile-complaint-max-age ::dt/duration)
(s/def ::profile-complaint-threshold ::us/integer)
(s/def ::profile-bounce-max-age ::dt/duration)
(s/def ::profile-bounce-threshold ::us/integer)
(s/def ::error-report-webhook ::us/string)
(s/def ::smtp-enabled ::us/boolean)
@ -187,6 +198,10 @@
::ldap-bind-dn
::ldap-bind-password
::public-uri
::profile-complaint-threshold
::profile-bounce-threshold
::profile-complaint-max-age
::profile-bounce-max-age
::redis-uri
::registration-domain-whitelist
::registration-enabled

52
backend/src/app/emails.clj
View file

@ -5,13 +5,15 @@
;; 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
;; Copyright (c) 2020-2021 UXBOX Labs SL
(ns app.emails
"Main api for send emails."
(:require
[app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.db.sql :as sql]
[app.tasks :as tasks]
[app.util.emails :as emails]
[clojure.spec.alpha :as s]))
@ -41,6 +43,54 @@
:priority 200
:props email})))
(def sql:profile-complaint-report
"select (select count(*)
from profile_complaint_report
where type = 'complaint'
and profile_id = ?
and created_at > now() - ?::interval) as complaints,
(select count(*)
from profile_complaint_report
where type = 'bounce'
and profile_id = ?
and created_at > now() - ?::interval) as bounces;")
(defn allow-send-emails?
[conn profile]
(when-not (:is-muted profile false)
(let [complaint-threshold (cfg/get :profile-complaint-threshold)
complaint-max-age (cfg/get :profile-complaint-max-age)
bounce-threshold (cfg/get :profile-bounce-threshold)
bounce-max-age (cfg/get :profile-bounce-max-age)
{:keys [complaints bounces] :as result}
(db/exec-one! conn [sql:profile-complaint-report
(:id profile)
(db/interval complaint-max-age)
(:id profile)
(db/interval bounce-max-age)])]
(and (< complaints complaint-threshold)
(< bounces bounce-threshold)))))
(defn has-complaint-reports?
([conn email] (has-complaint-reports? conn email nil))
([conn email {:keys [threshold] :or {threshold 1}}]
(let [reports (db/exec! conn (sql/select :global-complaint-report
{:email email :type "complaint"}
{:limit 10}))]
(>= (count reports) threshold))))
(defn has-bounce-reports?
([conn email] (has-bounce-reports? conn email nil))
([conn email {:keys [threshold] :or {threshold 1}}]
(let [reports (db/exec! conn (sql/select :global-complaint-report
{:email email :type "bounce"}
{:limit 10}))]
(>= (count reports) threshold))))
;; --- Emails
(s/def ::subject ::us/string)

3
backend/src/app/http.clj
View file

@ -126,6 +126,9 @@
["/dbg"
["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
["/webhooks"
["/sns" {:post (:sns-webhook cfg)}]]
["/api" {:middleware [[middleware/format-response-body]
[middleware/params]
[middleware/multipart-params]

1
backend/src/app/http/auth/github.clj
View file

@ -110,6 +110,7 @@
method-fn (get-in rpc [:methods :mutation :login-or-register])
profile (method-fn {:email (:email info)
:backend "github"
:fullname (:fullname info)})
token (tokens :generate
{:iss :auth

1
backend/src/app/http/auth/gitlab.clj
View file

@ -112,6 +112,7 @@
method-fn (get-in rpc [:methods :mutation :login-or-register])
profile (method-fn {:email (:email info)
:backend "gitlab"
:fullname (:fullname info)})
token (tokens :generate {:iss :auth
:exp (dt/in-future "15m")

1
backend/src/app/http/auth/google.clj
View file

@ -98,6 +98,7 @@
:code :unable-to-auth))
method-fn (get-in rpc [:methods :mutation :login-or-register])
profile (method-fn {:email (:email info)
:backend "google"
:fullname (:fullname info)})
token (tokens :generate {:iss :auth
:exp (dt/in-future "15m")

1
backend/src/app/http/auth/ldap.clj
View file

@ -64,6 +64,7 @@
:password (:password data)))]
(let [method-fn (get-in rpc [:methods :mutation :login-or-register])
profile (method-fn {:email (:email info)
:backend "ldap"
:fullname (:fullname info)})
sxf ((:create session) (:id profile))

207
backend/src/app/http/awsns.clj Normal file
View file

@ -0,0 +1,207 @@
;; 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 Andrey Antukh <niwi@niwi.nz>
(ns app.http.awsns
"AWS SNS webhook handler for bounces."
(:require
[app.common.exceptions :as ex]
[app.db :as db]
[app.db.sql :as sql]
[app.util.http :as http]
[clojure.pprint :refer [pprint]]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str]
[integrant.core :as ig]
[jsonista.core :as j]))
(declare parse-json)
(declare parse-notification)
(declare process-report)
(defn- pprint-report
[message]
(binding [clojure.pprint/*print-right-margin* 120]
(with-out-str (pprint message))))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool]))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [request]
(let [body (parse-json (slurp (:body request)))
mtype (get body "Type")]
(cond
(= mtype "SubscriptionConfirmation")
(let [surl (get body "SubscribeURL")
stopic (get body "TopicArn")]
(log/infof "Subscription received (topic=%s, url=%s)" stopic surl)
(http/send! {:uri surl :method :post :timeout 10000}))
(= mtype "Notification")
(when-let [message (parse-json (get body "Message"))]
;; (log/infof "Received: %s" (pr-str message))
(let [notification (parse-notification cfg message)]
(process-report cfg notification)))
:else
(log/warn (str "Unexpected data received.\n"
(pprint-report body))))
{:status 200 :body ""})))
(defn- parse-bounce
[data]
{:type "bounce"
:kind (str/lower (get data "bounceType"))
:category (str/lower (get data "bounceSubType"))
:feedback-id (get data "feedbackId")
:timestamp (get data "timestamp")
:recipients (->> (get data "bouncedRecipients")
(mapv (fn [item]
{:email (str/lower (get item "emailAddress"))
:status (get item "status")
:action (get item "action")
:dcode (get item "diagnosticCode")})))})
(defn- parse-complaint
[data]
{:type "complaint"
:user-agent (get data "userAgent")
:kind (get data "complaintFeedbackType")
:category (get data "complaintSubType")
:timestamp (get data "arrivalDate")
:feedback-id (get data "feedbackId")
:recipients (->> (get data "complainedRecipients")
(mapv #(get % "emailAddress"))
(mapv str/lower))})
(defn- extract-headers
[mail]
(reduce (fn [acc item]
(let [key (get item "name")
val (get item "value")]
(assoc acc (str/lower key) val)))
{}
(get mail "headers")))
(defn- extract-identity
[{:keys [tokens] :as cfg} headers]
(let [tdata (get headers "x-penpot-data")]
(when-not (str/empty? tdata)
(let [result (tokens :verify {:token tdata :iss :profile-identity})]
(:profile-id result)))))
(defn- parse-notification
[cfg message]
(let [type (get message "notificationType")
data (case type
"Bounce" (parse-bounce (get message "bounce"))
"Complaint" (parse-complaint (get message "complaint"))
{:type (keyword (str/lower type))
:message message})]
(when data
(let [mail (get message "mail")]
(when-not mail
(ex/raise :type :internal
:code :incomplete-notification
:hint "no email data received, please enable full headers report"))
(let [headers (extract-headers mail)
mail {:destination (get mail "destination")
:source (get mail "source")
:timestamp (get mail "timestamp")
:subject (get-in mail ["commonHeaders" "subject"])
:headers headers}]
(assoc data
:mail mail
:profile-id (extract-identity cfg headers)))))))
(defn- parse-json
[v]
(ex/ignoring
(j/read-value v)))
(defn- register-bounce-for-profile
[{:keys [pool]} {:keys [type kind profile-id] :as report}]
(when (= kind "permanent")
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by mail and if exists
;; register profile reports for them?
(doseq [recipient (:recipients report)]
(db/insert! conn :global-complaint-report
{:email (:email recipient)
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, can be caused when a user
;; registers with an invalid email or the user email is
;; permanently rejecting receiving the email. In this case we
;; have no option to mark the user as muted (and in this case
;; the profile will be also inactive.
(db/update! conn :profile
{:is-muted true}
{:id profile-id}))))))
(defn- register-complaint-for-profile
[{:keys [pool]} {:keys [type profile-id] :as report}]
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by email and if exists
;; register profile reports for them?
(doseq [email (:recipients report)]
(db/insert! conn :global-complaint-report
{:email email
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this
;; case just mark profile as muted (very rare case).
(db/update! conn :profile
{:is-muted true}
{:id profile-id})))))
(defn- process-report
[cfg {:keys [type profile-id] :as report}]
(log/debug (str "Procesing report:\n" (pprint-report report)))
(cond
;; In this case we receive a bounce/complaint notification without
;; confirmed identity, we just emit a warning but do nothing about
;; it because this is not a normal case. All notifications should
;; come with profile identity.
(nil? profile-id)
(log/warn (str "A notification without identity recevied from AWS\n"
(pprint-report report)))
(= "bounce" type)
(register-bounce-for-profile cfg report)
(= "complaint" type)
(register-complaint-for-profile cfg report)
:else
(log/warn (str "Unrecognized report received from AWS\n"
(pprint-report report)))))

5
backend/src/app/main.clj
View file

@ -71,6 +71,10 @@
{:pool (ig/ref :app.db/pool)
:cookie-name "auth-token"}
:app.http.awsns/handler
{:tokens (ig/ref :app.tokens/tokens)
:pool (ig/ref :app.db/pool)}
:app.http/server
{:port (:http-server-port config)
:handler (ig/ref :app.http/router)
@ -90,6 +94,7 @@
:assets (ig/ref :app.http.assets/handlers)
:svgparse (ig/ref :app.svgparse/handler)
:storage (ig/ref :app.storage/storage)
:sns-webhook (ig/ref :app.http.awsns/handler)
:error-report-handler (ig/ref :app.error-reporter/handler)}
:app.http.assets/handlers

4
backend/src/app/migrations.clj
View file

@ -148,6 +148,10 @@
{:name "0045-add-index-to-file-change-table"
:fn (mg/resource "app/migrations/sql/0045-add-index-to-file-change-table.sql")}
{:name "0046-add-profile-complaint-table"
:fn (mg/resource "app/migrations/sql/0046-add-profile-complaint-table.sql")}
])

45
backend/src/app/migrations/sql/0046-add-profile-complaint-table.sql Normal file
View file

@ -0,0 +1,45 @@
CREATE TABLE profile_complaint_report (
profile_id uuid NOT NULL REFERENCES profile(id) ON DELETE CASCADE,
created_at timestamptz NOT NULL DEFAULT now(),
type text NOT NULL,
content jsonb,
PRIMARY KEY (profile_id, created_at)
);
ALTER TABLE profile_complaint_report
ALTER COLUMN type SET STORAGE external,
ALTER COLUMN content SET STORAGE external;
ALTER TABLE profile
ADD COLUMN is_muted boolean DEFAULT false,
ADD COLUMN auth_backend text NULL;
ALTER TABLE profile
ALTER COLUMN auth_backend SET STORAGE external;
UPDATE profile
SET auth_backend = 'google'
WHERE password = '!';
UPDATE profile
SET auth_backend = 'penpot'
WHERE password != '!';
-- Table storing a permanent complaint table for register all
-- permanent bounces and spam reports (complaints) and avoid sending
-- more emails there.
CREATE TABLE global_complaint_report (
email text NOT NULL,
created_at timestamptz NOT NULL DEFAULT now(),
type text NOT NULL,
content jsonb,
PRIMARY KEY (email, created_at)
);
ALTER TABLE global_complaint_report
ALTER COLUMN type SET STORAGE external,
ALTER COLUMN content SET STORAGE external;

84
backend/src/app/rpc/mutations/profile.clj
View file

@ -55,12 +55,11 @@
(sv/defmethod ::register-profile {:auth false :rlimit :password}
[{:keys [pool tokens session] :as cfg} {:keys [token] :as params}]
(when-not (:registration-enabled cfg/config)
(when-not (cfg/get :registration-enabled)
(ex/raise :type :restriction
:code :registration-disabled))
(when-not (email-domain-in-whitelist? (:registration-domain-whitelist cfg/config)
(:email params))
(when-not (email-domain-in-whitelist? (cfg/get :registration-domain-whitelist) (:email params))
(ex/raise :type :validation
:code :email-domain-is-not-allowed))
@ -97,20 +96,30 @@
{:transform-response ((:create session) (:id profile))}))
;; If no token is provided, send a verification email
(let [token (tokens :generate
{:iss :verify-email
:exp (dt/in-future "48h")
:profile-id (:id profile)
:email (:email profile)})]
(let [vtoken (tokens :generate
{:iss :verify-email
:exp (dt/in-future "48h")
:profile-id (:id profile)
:email (:email profile)})
ptoken (tokens :generate-predefined
{:iss :profile-identity
:profile-id (:id profile)})]
;; Don't allow proceed in register page if the email is
;; already reported as permanent bounced
(when (emails/has-bounce-reports? conn (:email profile))
(ex/raise :type :validation
:code :email-has-permanent-bounces
:hint "looks like the email has one or many bounces reported"))
(emails/send! conn emails/register
{:to (:email profile)
:name (:fullname profile)
:token token})
:token vtoken
:extra-data ptoken})
profile)))))
(defn email-domain-in-whitelist?
"Returns true if email's domain is in the given whitelist or if given
whitelist is an empty string."
@ -155,8 +164,8 @@
(defn- create-profile
"Create the profile entry on the database with limited input
filling all the other fields with defaults."
[conn {:keys [id fullname email password demo? props is-active]
:or {is-active false}
[conn {:keys [id fullname email password demo? props is-active is-muted]
:or {is-active false is-muted false}
:as params}]
(let [id (or id (uuid/next))
demo? (if (boolean? demo?) demo? false)
@ -168,9 +177,11 @@
{:id id
:fullname fullname
:email (str/lower email)
:auth-backend "penpot"
:password password
:props props
:is-active active?
:is-muted is-muted
:is-demo demo?})
(update :props db/decode-transit-pgobject))
(catch org.postgresql.util.PSQLException e
@ -252,11 +263,12 @@
;; --- Mutation: Register if not exists
(s/def ::backend ::us/string)
(s/def ::login-or-register
(s/keys :req-un [::email ::fullname]))
(s/keys :req-un [::email ::fullname ::backend]))
(sv/defmethod ::login-or-register {:auth false}
[{:keys [pool] :as cfg} {:keys [email fullname] :as params}]
[{:keys [pool] :as cfg} {:keys [email backend fullname] :as params}]
(letfn [(populate-additional-data [conn profile]
(let [data (profile/retrieve-additional-data conn (:id profile))]
(merge profile data)))
@ -266,6 +278,7 @@
{:id (uuid/next)
:fullname fullname
:email (str/lower email)
:auth-backend backend
:is-active true
:password "!"
:is-demo false}))
@ -372,16 +385,30 @@
{:iss :change-email
:exp (dt/in-future "15m")
:profile-id profile-id
:email email})]
:email email})
ptoken (tokens :generate-predefined
{:iss :profile-identity
:profile-id (:id profile)})]
(when (not= email (:email profile))
(check-profile-existence! conn params))
(when-not (emails/allow-send-emails? conn profile)
(ex/raise :type :validation
:code :profile-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when (emails/has-bounce-reports? conn email)
(ex/raise :type :validation
:code :email-has-permanent-bounces
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
(emails/send! conn emails/change-email
{:to (:email profile)
:name (:fullname profile)
:pending-email email
:token token})
:token token
:extra-data ptoken})
nil)))
(defn select-profile-for-update
@ -403,11 +430,15 @@
(assoc profile :token token)))
(send-email-notification [conn profile]
(emails/send! conn emails/password-recovery
{:to (:email profile)
:token (:token profile)
:name (:fullname profile)})
nil)]
(let [ptoken (tokens :generate-predefined
{:iss :profile-identity
:profile-id (:id profile)})]
(emails/send! conn emails/password-recovery
{:to (:email profile)
:token (:token profile)
:name (:fullname profile)
:extra-data ptoken})
nil))]
(db/with-atomic [conn pool]
(when-let [profile (profile/retrieve-profile-data-by-email conn email)]
@ -415,6 +446,17 @@
(ex/raise :type :validation
:code :profile-not-verified
:hint "the user need to validate profile before recover password"))
(when-not (emails/allow-send-emails? conn profile)
(ex/raise :type :validation
:code :profile-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when (emails/has-bounce-reports? conn (:email profile))
(ex/raise :type :validation
:code :email-has-permanent-bounces
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
(->> profile
(create-recovery-token)
(send-email-notification conn))))))

48
backend/src/app/rpc/mutations/teams.clj
View file

@ -297,26 +297,48 @@
(sv/defmethod ::invite-team-member
[{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
(db/with-atomic [conn pool]
(let [perms (teams/check-edition-permissions! conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
member (profile/retrieve-profile-data-by-email conn email)
team (db/get-by-id conn :team team-id)
token (tokens :generate
{:iss :team-invitation
:exp (dt/in-future "24h")
:profile-id (:id profile)
:role role
:team-id team-id
:member-email (:email member email)
:member-id (:id member)})]
(let [perms (teams/check-edition-permissions! conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
member (profile/retrieve-profile-data-by-email conn email)
team (db/get-by-id conn :team team-id)
itoken (tokens :generate
{:iss :team-invitation
:exp (dt/in-future "24h")
:profile-id (:id profile)
:role role
:team-id team-id
:member-email (:email member email)
:member-id (:id member)})
ptoken (tokens :generate-predefined
{:iss :profile-identity
:profile-id (:id profile)})]
(when-not (some :is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
;; First check if the current profile is allowed to send emails.
(when-not (emails/allow-send-emails? conn profile)
(ex/raise :type :validation
:code :profile-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
(when (and member (not (emails/allow-send-emails? conn member)))
(ex/raise :type :validation
:code :member-is-muted
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
;; Secondly check if the invited member email is part of the
;; global spam/bounce report.
(when (emails/has-bounce-reports? conn email)
(ex/raise :type :validation
:code :email-has-permanent-bounces
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
(emails/send! conn emails/invite-to-team
{:to email
:invited-by (:fullname profile)
:team (:name team)
:token token})
:token itoken
:extra-data ptoken})
nil)))

10
backend/src/app/rpc/mutations/verify_token.clj
View file

@ -90,11 +90,19 @@
(let [params (merge {:team-id team-id
:profile-id member-id}
(teams/role->params role))
claims (assoc claims :state :created)]
claims (assoc claims :state :created)
member (profile/retrieve-profile conn member-id)]
(db/insert! conn :team-profile-rel params
{:on-conflict-do-nothing true})
;; If profile is not yet verified, mark it as verified because
;; accepting an invitation link serves as verification.
(when-not (:is-active member)
(db/update! conn :profile
{:is-active true}
{:id member-id}))
(if (and (uuid? profile-id)
(= member-id profile-id))
;; If the current session is already matches the invited

14
backend/src/app/tokens.clj
View file

@ -60,11 +60,25 @@
(defmethod ig/pre-init-spec ::tokens [_]
(s/keys :req-un [::sprops]))
(defn- generate-predefined
[cfg {:keys [iss profile-id] :as params}]
(case iss
:profile-identity
(do
(us/verify uuid? profile-id)
(generate cfg (assoc params
:exp (dt/in-future {:days 30}))))
(ex/raise :type :internal
:code :not-implemented
:hint "no predefined token")))
(defmethod ig/init-key ::tokens
[_ {:keys [sprops] :as cfg}]
(let [secret (derive-tokens-secret (:secret-key sprops))
cfg (assoc cfg ::secret secret)]
(fn [action params]
(case action
:generate-predefined (generate-predefined cfg params)
:verify (verify cfg params)
:generate (generate cfg params)))))