;; 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.rpc.commands.profile
  (:require
   [app.auth :as auth]
   [app.common.data :as d]
   [app.common.exceptions :as ex]
   [app.common.spec :as us]
   [app.common.uuid :as uuid]
   [app.config :as cf]
   [app.db :as db]
   [app.emails :as eml]
   [app.http.session :as session]
   [app.loggers.audit :as audit]
   [app.main :as-alias main]
   [app.media :as media]
   [app.rpc :as-alias rpc]
   [app.rpc.climit :as climit]
   [app.rpc.doc :as-alias doc]
   [app.rpc.helpers :as rph]
   [app.storage :as sto]
   [app.tokens :as tokens]
   [app.util.services :as sv]
   [app.util.time :as dt]
   [app.worker :as-alias wrk]
   [clojure.spec.alpha :as s]
   [cuerdas.core :as str]
   [promesa.core :as p]
   [promesa.exec :as px]))

(declare decode-row)
(declare get-profile)
(declare strip-private-attrs)
(declare filter-props)
(declare check-profile-existence!)

;; --- QUERY: Get profile (own)

(s/def ::get-profile
  (s/keys :opt [::rpc/profile-id]))

(sv/defmethod ::get-profile
  {::rpc/auth false
   ::doc/added "1.18"}
  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
  ;; We need to return the anonymous profile object in two cases, when
  ;; no profile-id is in session, and when db call raises not found. In all other
  ;; cases we need to reraise the exception.
  (try
    (-> (get-profile pool profile-id)
        (strip-private-attrs)
        (update :props filter-props))
    (catch Throwable _
      {:id uuid/zero :fullname "Anonymous User"})))

(defn get-profile
  "Get profile by id. Throws not-found exception if no profile found."
  [conn id & {:as attrs}]
  (-> (db/get-by-id conn :profile id attrs)
      (decode-row)))


;; --- MUTATION: Update Profile (own)

(s/def ::email ::us/email)
(s/def ::fullname ::us/not-empty-string)
(s/def ::lang ::us/string)
(s/def ::theme ::us/string)

(s/def ::update-profile
  (s/keys :req [::rpc/profile-id]
          :req-un [::fullname]
          :opt-un [::lang ::theme]))

(sv/defmethod ::update-profile
  {::doc/added "1.0"}
  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
  (db/with-atomic [conn pool]
    ;; 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 ::db/for-update? true)
                      (decode-row))

          ;; Update the profile map with direct params
          profile (-> profile
                      (assoc :fullname fullname)
                      (assoc :lang lang)
                      (assoc :theme theme))
          ]

      (db/update! conn :profile
                  {:fullname fullname
                   :lang lang
                   :theme theme
                   :props (db/tjson (:props profile))}
                  {:id profile-id})

      (-> profile
          (strip-private-attrs)
          (d/without-nils)
          (rph/with-meta {::audit/props (audit/profile->props profile)})))))


;; --- MUTATION: Update Password

(declare validate-password!)
(declare update-profile-password!)
(declare invalidate-profile-session!)

(s/def ::password ::us/not-empty-string)
(s/def ::old-password ::us/not-empty-string)

(s/def ::update-profile-password
  (s/keys :req [::rpc/profile-id]
          :req-un [::password ::old-password]))

(sv/defmethod ::update-profile-password
  {::climit/queue :auth}
  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}]
  (db/with-atomic [conn pool]
    (let [profile    (validate-password! conn (assoc params :profile-id profile-id))
          session-id (::session/id params)]

      (when (= (str/lower (:email profile))
               (str/lower (:password params)))
        (ex/raise :type :validation
                  :code :email-as-password
                  :hint "you can't use your email as password"))

      (update-profile-password! conn (assoc profile :password password))
      (invalidate-profile-session! conn profile-id session-id)
      nil)))

(defn- invalidate-profile-session!
  "Removes all sessions except the current one."
  [conn profile-id session-id]
  (let [sql "delete from http_session where profile_id = ? and id != ?"]
    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))

(defn- validate-password!
  [conn {:keys [profile-id old-password] :as params}]
  (let [profile (db/get-by-id conn :profile profile-id ::db/for-update? true)]
    (when-not (:valid (auth/verify-password old-password (:password profile)))
      (ex/raise :type :validation
                :code :old-password-not-match))
    profile))

(defn update-profile-password!
  [conn {:keys [id password] :as profile}]
  (db/update! conn :profile
              {:password (auth/derive-password password)}
              {:id id}))

;; --- MUTATION: Update Photo

(declare upload-photo)
(declare update-profile-photo)

(s/def ::file ::media/upload)
(s/def ::update-profile-photo
  (s/keys :req [::rpc/profile-id]
          :req-un [::file]))

(sv/defmethod ::update-profile-photo
  [cfg {:keys [::rpc/profile-id file] :as params}]
  ;; Validate incoming mime type
  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
    (update-profile-photo cfg (assoc params :profile-id profile-id))))

;; TODO: reimplement it without p/let

(defn update-profile-photo
  [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
  (letfn [(on-uploaded [photo]
            (let [profile (db/get-by-id pool :profile profile-id ::db/for-update? true)]

              ;; Schedule deletion of old photo
              (when-let [id (:photo-id profile)]
                (sto/touch-object! storage id))

              ;; Save new photo
              (db/update! pool :profile
                          {:photo-id (:id photo)}
                          {:id profile-id})

              (-> (rph/wrap)
                  (rph/with-meta {::audit/replace-props
                                  {:file-name (:filename file)
                                   :file-size (:size file)
                                   :file-path (str (:path file))
                                   :file-mtype (:mtype file)}}))))]
    (->> (upload-photo cfg params)
         (p/fmap executor on-uploaded))))

(defn upload-photo
  [{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
  (letfn [(get-info [content]
            (climit/with-dispatch (:process-image climit)
              (media/run {:cmd :info :input content})))

          (generate-thumbnail [info]
            (climit/with-dispatch (:process-image climit)
              (media/run {:cmd :profile-thumbnail
                          :format :jpeg
                          :quality 85
                          :width 256
                          :height 256
                          :input info})))

          ;; Function responsible of calculating cryptographyc hash of
          ;; the provided data.
          (calculate-hash [data]
            (px/with-dispatch executor
              (sto/calculate-hash data)))]

    (p/let [info    (get-info file)
            thumb   (generate-thumbnail info)
            hash    (calculate-hash (:data thumb))
            content (-> (sto/content (:data thumb) (:size thumb))
                        (sto/wrap-with-hash hash))]
      (sto/put-object! storage {::sto/content content
                                ::sto/deduplicate? true
                                :bucket "profile"
                                :content-type (:mtype thumb)}))))


;; --- MUTATION: Request Email Change

(declare ^:private request-email-change!)
(declare ^:private change-email-immediately!)

(s/def ::request-email-change
  (s/keys :req [::rpc/profile-id]
          :req-un [::email]))

(sv/defmethod ::request-email-change
  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
  (db/with-atomic [conn pool]
    (let [profile (db/get-by-id conn :profile profile-id)
          cfg     (assoc cfg ::conn conn)
          params  (assoc params
                         :profile profile
                         :email (str/lower email))]
      (if (contains? cf/flags :smtp)
        (request-email-change! cfg params)
        (change-email-immediately! cfg params)))))

(defn- change-email-immediately!
  [{:keys [::conn]} {:keys [profile email] :as params}]
  (when (not= email (:email profile))
    (check-profile-existence! conn params))

  (db/update! conn :profile
              {:email email}
              {:id (:id profile)})

  {:changed true})

(defn- request-email-change!
  [{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
  (let [token   (tokens/generate (::main/props cfg)
                                 {:iss :change-email
                                  :exp (dt/in-future "15m")
                                  :profile-id (:id profile)
                                  :email email})
        ptoken  (tokens/generate (::main/props cfg)
                                 {:iss :profile-identity
                                  :profile-id (:id profile)
                                  :exp (dt/in-future {:days 30})})]

    (when (not= email (:email profile))
      (check-profile-existence! conn params))

    (when-not (eml/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 (eml/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"))

    (eml/send! {::eml/conn conn
                ::eml/factory eml/change-email
                :public-uri (cf/get :public-uri)
                :to (:email profile)
                :name (:fullname profile)
                :pending-email email
                :token token
                :extra-data ptoken})
    nil))


;; --- MUTATION: Update Profile Props

(s/def ::props map?)
(s/def ::update-profile-props
  (s/keys :req [::rpc/profile-id]
          :req-un [::props]))

(sv/defmethod ::update-profile-props
  [{:keys [::db/pool]} {:keys [::rpc/profile-id props]}]
  (db/with-atomic [conn pool]
    (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)
                                 (if (nil? v)
                                   (dissoc props k)
                                   (assoc props k v))
                                 props))
                             (:props profile)
                             props)]

      (db/update! conn :profile
                  {:props (db/tjson props)}
                  {:id profile-id})

      (filter-props props))))


;; --- MUTATION: Delete Profile

(declare ^:private get-owned-teams-with-participants)

(s/def ::delete-profile
  (s/keys :req [::rpc/profile-id]))

(sv/defmethod ::delete-profile
  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
  (db/with-atomic [conn pool]
    (let [teams      (get-owned-teams-with-participants conn profile-id)
          deleted-at (dt/now)]

      ;; If we found owned teams with participants, we don't allow
      ;; delete profile until the user properly transfer ownership or
      ;; explicitly removes all participants from the team
      (when (some pos? (map :participants teams))
        (ex/raise :type :validation
                  :code :owner-teams-with-people
                  :hint "The user need to transfer ownership of owned teams."
                  :context {:teams (mapv :id teams)}))

      (doseq [{:keys [id]} teams]
        (db/update! conn :team
                    {:deleted-at deleted-at}
                    {:id id}))

      (db/update! conn :profile
                  {:deleted-at deleted-at}
                  {:id profile-id})

      (rph/with-transform {} (session/delete-fn cfg)))))


;; --- HELPERS

(def sql:owned-teams
  "with owner_teams as (
      select tpr.team_id as id
        from team_profile_rel as tpr
       where tpr.is_owner is true
         and tpr.profile_id = ?
   )
   select tpr.team_id as id,
          count(tpr.profile_id) - 1 as participants
     from team_profile_rel as tpr
    where tpr.team_id in (select id from owner_teams)
      and tpr.profile_id != ?
    group by 1")

(defn- get-owned-teams-with-participants
  [conn profile-id]
  (db/exec! conn [sql:owned-teams profile-id profile-id]))

(def ^:private sql:profile-existence
  "select exists (select * from profile
                   where email = ?
                     and deleted_at is null) as val")

(defn check-profile-existence!
  [conn {:keys [email] :as params}]
  (let [email  (str/lower email)
        result (db/exec-one! conn [sql:profile-existence email])]
    (when (:val result)
      (ex/raise :type :validation
                :code :email-already-exists))
    params))

(def ^:private sql:profile-by-email
  "select p.* from profile as p
    where p.email = ?
      and (p.deleted_at is null or
           p.deleted_at > now())")

(defn get-profile-by-email
  "Returns a profile looked up by email or `nil` if not match found."
  [conn email]
  (->> (db/exec! conn [sql:profile-by-email (str/lower email)])
       (map decode-row)
       (first)))

(defn strip-private-attrs
  "Only selects a publicly visible profile attrs."
  [row]
  (dissoc row :password :deleted-at))

(defn filter-props
  "Removes all namespace qualified props from `props` attr."
  [props]
  (into {} (filter (fn [[k _]] (simple-ident? k))) props))

(defn decode-row
  [{:keys [props] :as row}]
  (cond-> row
    (db/pgobject? props "jsonb")
    (assoc :props (db/decode-transit-pgobject props))))