mirror of
https://github.com/penpot/penpot.git
synced 2026-08-14 08:48:55 +00:00
815 lines
30 KiB
Clojure
815 lines
30 KiB
Clojure
;; 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 Sucursal en España SL
|
|
|
|
(ns app.main.data.team
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.logging :as log]
|
|
[app.common.schema :as sm]
|
|
[app.common.types.nitrate-permissions :as nitrate-perms]
|
|
[app.common.types.team :as ctt]
|
|
[app.common.uri :as u]
|
|
[app.config :as cf]
|
|
[app.main.data.event :as ev]
|
|
[app.main.data.helpers :as dsh]
|
|
[app.main.data.media :as di]
|
|
[app.main.data.modal :as modal]
|
|
[app.main.data.profile :as dp]
|
|
[app.main.features :as features]
|
|
[app.main.repo :as rp]
|
|
[app.main.router :as rt]
|
|
[app.util.clipboard :as clipboard]
|
|
[app.util.i18n :refer [tr]]
|
|
[app.util.storage :as storage]
|
|
[beicon.v2.core :as rx]
|
|
[clojure.string :as str]
|
|
[potok.v2.core :as ptk]))
|
|
|
|
(log/set-level! :warn)
|
|
|
|
(defn get-last-team-id
|
|
"Get last accessed team id"
|
|
[]
|
|
(::current-team-id storage/global))
|
|
|
|
(defn resolve-login-team-id
|
|
"Resolve the team to navigate to after login. Falls back to the
|
|
default team when the candidate requires SSO and the user has no
|
|
valid SSO session for it."
|
|
[{:keys [team-id default-team-id]}]
|
|
(if (or (not (contains? cf/flags :nitrate))
|
|
(= team-id default-team-id))
|
|
(rx/of team-id)
|
|
(->> (rp/cmd! :check-nitrate-sso {:team-id team-id :url (rt/get-current-href)})
|
|
(rx/map (fn [{:keys [authorized]}]
|
|
(if authorized team-id default-team-id))))))
|
|
|
|
(defn teams-fetched
|
|
[teams]
|
|
(ptk/reify ::teams-fetched
|
|
IDeref
|
|
(-deref [_] teams)
|
|
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [team-ids (map :id teams)
|
|
;; Delete old teams from state
|
|
state (update state :teams #(select-keys % team-ids))]
|
|
(reduce (fn [state {:keys [id organization-id] :as team}]
|
|
(let [team-updated (cond-> (merge (dm/get-in state [:teams id]) team)
|
|
(not organization-id) (dissoc :organization-id
|
|
:organization-name
|
|
:organization-slug
|
|
:organization-owner-id
|
|
:organization-avatar-bg-url
|
|
:organization-permissions))]
|
|
(update state :teams assoc id team-updated)))
|
|
state
|
|
teams)))))
|
|
|
|
(defn fetch-teams
|
|
[]
|
|
(ptk/reify ::fetch-teams
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(->> (rp/cmd! :get-teams)
|
|
(rx/map teams-fetched)))))
|
|
|
|
(defn- update-team-data
|
|
[state team-id f & args]
|
|
(cond
|
|
(contains? (:teams state) team-id)
|
|
(apply update-in state [:teams team-id] f args)
|
|
|
|
(= team-id (dm/get-in state [:current-team :id]))
|
|
(apply update state :current-team f args)
|
|
|
|
:else
|
|
state))
|
|
|
|
(defn with-refreshed-team
|
|
"Fetches fresh team data from the server to ensure up-to-date org
|
|
permissions, updates the app state, and calls f with the fresh team data.
|
|
Returns an observable of events."
|
|
[team-id f]
|
|
(->> (rp/cmd! :get-teams)
|
|
(rx/mapcat
|
|
(fn [teams]
|
|
(let [team (d/seek #(= (:id %) team-id) teams)]
|
|
(rx/concat
|
|
(rx/of (teams-fetched teams))
|
|
(f team)))))))
|
|
|
|
(defn check-and-create-team
|
|
"Fetches fresh team data from the server to ensure up-to-date org
|
|
permissions, then shows the team-form modal or a no-permission modal."
|
|
[team-id]
|
|
(ptk/reify ::check-and-create-team
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [profile-id (dm/get-in state [:profile :id])]
|
|
(with-refreshed-team team-id
|
|
(fn [team]
|
|
(let [organization (:organization team)
|
|
in-org? (and (contains? cf/flags :nitrate) organization)
|
|
can-create? (if in-org?
|
|
(nitrate-perms/allowed? :create-team
|
|
{:org-perms {:owner-id (:owner-id organization)
|
|
:permissions (:permissions organization)}
|
|
:profile-id profile-id
|
|
:team-perms (:permissions team)})
|
|
true)]
|
|
(rx/of (if can-create?
|
|
(modal/show :team-form (if in-org?
|
|
{:organization-id (:id organization)
|
|
:organization-name (:name organization)}
|
|
{}))
|
|
(modal/show :no-permission-modal {:type :create-team}))))))))))
|
|
|
|
(defn check-and-delete-team
|
|
"Fetches fresh team data from the server to ensure up-to-date org
|
|
permissions, then shows the confirmation modal or a no-permission modal."
|
|
[{:keys [team-id delete-fn]}]
|
|
(ptk/reify ::check-and-delete-team
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [profile-id (dm/get-in state [:profile :id])]
|
|
(with-refreshed-team team-id
|
|
(fn [team]
|
|
(let [org (:organization team)
|
|
in-org? (and (contains? cf/flags :nitrate) org)
|
|
can-delete? (if in-org?
|
|
(nitrate-perms/allowed? :delete-team
|
|
{:org-perms {:owner-id (:owner-id org)
|
|
:permissions (:permissions org)}
|
|
:profile-id profile-id
|
|
:team-perms (:permissions team)})
|
|
(boolean (dm/get-in team [:permissions :is-owner])))
|
|
message (if in-org?
|
|
(tr "modals.delete-org-team-confirm.message" (:name org))
|
|
(tr "modals.delete-team-confirm.message"))]
|
|
(rx/of (if can-delete?
|
|
(modal/show
|
|
{:type :confirm
|
|
:title (tr "modals.delete-team-confirm.title")
|
|
:message message
|
|
:accept-label (tr "modals.delete-team-confirm.accept")
|
|
:on-accept delete-fn})
|
|
(modal/show :no-permission-modal {:type :delete-team}))))))))))
|
|
|
|
(defn- check-new-team-members-permission-and-show-invite-members
|
|
"Receives refreshed team data with up-to-date org
|
|
permissions, then shows the invite members modal or an appropriate alert."
|
|
[{:keys [team invite-email origin]}]
|
|
(ptk/reify ::check-new-team-members-permission-and-show-invite-members
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [show-invite (rx/of (modal/show {:type :invite-members
|
|
:team team
|
|
:origin (or origin :team)
|
|
:invite-email invite-email}))]
|
|
(if (and (contains? cf/flags :nitrate)
|
|
(not (nitrate-perms/allowed? :add-anybody-to-team
|
|
{:org-perms (:organization team)})))
|
|
(->> (rp/cmd! :all-org-members-in-team
|
|
{:team-id (:id team)
|
|
:organization-id (get-in team [:organization :id])})
|
|
(rx/mapcat
|
|
(fn [all-org-members-in-team?]
|
|
(if all-org-members-in-team?
|
|
(rx/of (modal/show
|
|
{:type :alert
|
|
:message (tr "modals.invite-restricted-members.all-org-members-in-team" (get-in team [:organization :name]))
|
|
:accept-label (tr "labels.accept")
|
|
:accept-style :primary
|
|
:title (tr "modals.invite-team-member.title")}))
|
|
show-invite))))
|
|
show-invite)))))
|
|
|
|
(defn check-and-invite-members
|
|
"Fetches fresh team data from the server to ensure up-to-date org
|
|
permissions, then shows invite-members modal or a permission error."
|
|
[{:keys [team-id origin invite-email]
|
|
:or {origin :team}}]
|
|
(ptk/reify ::check-and-invite-members
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [profile-id (dm/get-in state [:profile :id])]
|
|
(with-refreshed-team team-id
|
|
(fn [team]
|
|
(let [org (:organization team)
|
|
can-invite? (nitrate-perms/can-send-invitations?
|
|
{:nitrate-enabled? (contains? cf/flags :nitrate)
|
|
:organization org
|
|
:profile-id profile-id
|
|
:team-permissions (:permissions team)})]
|
|
(rx/of (if can-invite?
|
|
(check-new-team-members-permission-and-show-invite-members {:team team
|
|
:origin origin
|
|
:invite-email invite-email})
|
|
(modal/show :no-permission-modal {:type :invite-members}))))))))))
|
|
|
|
;; --- EVENT: fetch-members
|
|
|
|
(defn- members-fetched
|
|
[team-id members]
|
|
(ptk/reify ::members-fetched
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(update-team-data team-id assoc :members members)
|
|
(update :profiles merge (d/index-by :id members))))))
|
|
|
|
(defn fetch-members
|
|
([] (fetch-members nil))
|
|
([team-id]
|
|
(ptk/reify ::fetch-members
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when-let [team-id (or team-id (:current-team-id state))]
|
|
(->> (rp/cmd! :get-team-members {:team-id team-id})
|
|
(rx/map (partial members-fetched team-id))
|
|
(rx/catch (fn [cause]
|
|
(let [{:keys [type]} (ex-data cause)]
|
|
(if (= :not-found type)
|
|
(do
|
|
(log/warn :hint "fetch-members: team not found, skipping"
|
|
:team-id (str team-id))
|
|
(rx/empty))
|
|
(rx/throw cause)))))))))))
|
|
|
|
(defn- invitations-fetched
|
|
[team-id invitations]
|
|
(ptk/reify ::invitations-fetched
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-team-data state team-id assoc :invitations invitations))))
|
|
|
|
(defn fetch-invitations
|
|
[]
|
|
(ptk/reify ::fetch-invitations
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)]
|
|
(->> (rp/cmd! :get-team-invitations {:team-id team-id})
|
|
(rx/map (partial invitations-fetched team-id)))))))
|
|
|
|
(defn- team-initialized
|
|
[team-id]
|
|
(ptk/reify ::team-initialized
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team (dsh/lookup-team state team-id)]
|
|
(if team
|
|
(let [permissions (get team :permissions)
|
|
features (get team :features)]
|
|
(rx/of #(-> %
|
|
(assoc :current-team team)
|
|
(assoc :permissions permissions))
|
|
(features/initialize features)
|
|
(fetch-members team-id)))
|
|
(->> (rp/cmd! :get-team {:id team-id})
|
|
(rx/mapcat (fn [team]
|
|
(let [permissions (get team :permissions)
|
|
features (get team :features)]
|
|
(rx/of #(-> %
|
|
(assoc :current-team team)
|
|
(assoc :permissions permissions))
|
|
(features/initialize features)
|
|
(fetch-members team-id)))))))))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ _ _]
|
|
(swap! storage/global assoc ::current-team-id team-id))))
|
|
|
|
(defn initialize-team
|
|
[team-id]
|
|
(ptk/reify ::initialize-team
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(-> state
|
|
(assoc :current-team-id team-id)
|
|
(dissoc :current-team)))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ _ stream]
|
|
(let [stopper (rx/filter (ptk/type? ::finalize-team) stream)]
|
|
(->> (rx/merge
|
|
(rx/of (fetch-teams))
|
|
(->> stream
|
|
(rx/filter (ptk/type? ::teams-fetched))
|
|
(rx/map (partial team-initialized team-id))))
|
|
(rx/take-until stopper))))))
|
|
|
|
(defn finalize-team
|
|
[team-id]
|
|
(ptk/reify ::finalize-team
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [team-id' (get state :current-team-id)]
|
|
(if (= team-id' team-id)
|
|
(-> state
|
|
(dissoc :current-team-id)
|
|
(dissoc :current-team)
|
|
(dissoc :shared-files)
|
|
(dissoc :fonts))
|
|
state)))))
|
|
|
|
;; --- ROLES
|
|
|
|
(defn update-member-role
|
|
[{:keys [role member-id] :as params}]
|
|
|
|
(assert (uuid? member-id))
|
|
(assert (contains? ctt/valid-roles role))
|
|
|
|
(ptk/reify ::update-member-role
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)
|
|
params (assoc params :team-id team-id)]
|
|
(->> (rp/cmd! :update-team-member-role params)
|
|
(rx/mapcat (fn [_]
|
|
(rx/of (dp/refresh-profile)
|
|
(fetch-members team-id)
|
|
(fetch-teams)
|
|
(ev/event {::ev/name "update-team-member-role"
|
|
:team-id team-id
|
|
:role role
|
|
:member-id member-id})))))))))
|
|
|
|
(defn delete-member
|
|
[{:keys [member-id] :as params}]
|
|
(dm/assert! (uuid? member-id))
|
|
(ptk/reify ::delete-member
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)
|
|
params (assoc params :team-id team-id)]
|
|
(->> (rp/cmd! :delete-team-member params)
|
|
(rx/mapcat (fn [_]
|
|
(rx/of (dp/refresh-profile)
|
|
(fetch-members team-id)
|
|
(fetch-teams)
|
|
(ev/event
|
|
{::ev/name "delete-team-member"
|
|
:team-id team-id
|
|
:member-id member-id})))))))))
|
|
|
|
|
|
(defn- stats-fetched
|
|
[team-id stats]
|
|
(ptk/reify ::stats-fetched
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-team-data state team-id assoc :stats stats))))
|
|
|
|
(defn fetch-stats
|
|
[]
|
|
(ptk/reify ::fetch-stats
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)]
|
|
(->> (rp/cmd! :get-team-stats {:team-id team-id})
|
|
(rx/map (partial stats-fetched team-id)))))))
|
|
|
|
(defn- webhooks-fetched
|
|
[team-id webhooks]
|
|
(ptk/reify ::webhooks-fetched
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update-team-data state team-id assoc :webhooks webhooks))))
|
|
|
|
(defn fetch-webhooks
|
|
[]
|
|
(ptk/reify ::fetch-webhooks
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)]
|
|
(->> (rp/cmd! :get-webhooks {:team-id team-id})
|
|
(rx/map (partial webhooks-fetched team-id)))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Data Modification
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn update-team-photo
|
|
[file]
|
|
(dm/assert!
|
|
"expected a valid blob for `file` param"
|
|
(di/blob? file))
|
|
(ptk/reify ::update-team-photo
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [on-success di/notify-finished-loading
|
|
on-error #(do (di/notify-finished-loading)
|
|
(di/process-error %))
|
|
team-id (:current-team-id state)
|
|
prepare #(hash-map :file % :team-id team-id)]
|
|
|
|
(di/notify-start-loading)
|
|
(->> (rx/of file)
|
|
(rx/map di/validate-file)
|
|
(rx/map prepare)
|
|
(rx/mapcat #(rp/cmd! :update-team-photo %))
|
|
(rx/tap on-success)
|
|
(rx/mapcat (fn [_]
|
|
(rx/of (fetch-teams)
|
|
(ev/event
|
|
{::ev/name "update-team-photo"
|
|
:team-id team-id}))))
|
|
(rx/catch on-error))))))
|
|
|
|
|
|
;; --- EVENT: create-team
|
|
|
|
(defn- team-created
|
|
[team]
|
|
(ptk/reify ::team-created
|
|
IDeref
|
|
(-deref [_] team)))
|
|
|
|
(defn create-team
|
|
[{:keys [name organization-id] :as params}]
|
|
(dm/assert! (string? name))
|
|
(ptk/reify ::create-team
|
|
ptk/WatchEvent
|
|
(watch [it _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)
|
|
features features/global-enabled-features
|
|
params (cond-> {:name name :features features}
|
|
organization-id (assoc :organization-id organization-id))]
|
|
(->> (rp/cmd! :create-team (with-meta params (meta it)))
|
|
(rx/tap on-success)
|
|
(rx/map team-created)
|
|
(rx/catch on-error))))))
|
|
|
|
;; --- EVENT: create-team-with-invitations
|
|
|
|
(defn create-team-with-invitations
|
|
[{:keys [name emails role] :as params}]
|
|
(ptk/reify ::create-team-with-invitations
|
|
ptk/WatchEvent
|
|
(watch [it _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)
|
|
features features/global-enabled-features
|
|
params {:name name
|
|
:emails emails
|
|
:role role
|
|
:features features}]
|
|
(->> (rp/cmd! :create-team-with-invitations (with-meta params (meta it)))
|
|
(rx/tap on-success)
|
|
(rx/map team-created)
|
|
(rx/catch on-error))))))
|
|
|
|
(defn update-team
|
|
[{:keys [id name] :as params}]
|
|
(ptk/reify ::update-team
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(assoc-in state [:teams id :name] name))
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(->> (rp/cmd! :update-team params)
|
|
(rx/ignore)))))
|
|
|
|
(defn- team-leaved
|
|
[{:keys [id] :as params}]
|
|
(ptk/reify ::team-leaved
|
|
IDeref
|
|
(-deref [_] params)
|
|
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :teams dissoc id))
|
|
|
|
ptk/EffectEvent
|
|
(effect [_ state _]
|
|
(let [teams (get state :teams)]
|
|
(when-let [ctid (::current-team-id storage/user)]
|
|
(when-not (contains? teams ctid)
|
|
(swap! storage/user dissoc ::current-team-id)))))))
|
|
|
|
(defn leave-current-team
|
|
"High-level event for leave team, mainly executed from the
|
|
dashboard. It automatically redirects user to the default team, once
|
|
the team-leave operation succeed"
|
|
[{:keys [reassign-to] :as params}]
|
|
|
|
(when reassign-to
|
|
(assert (uuid? reassign-to) "expect a valid uuid for `reassign-to`"))
|
|
|
|
(ptk/reify ::leave-current-team
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (get state :current-team-id)
|
|
params (assoc params :id team-id)
|
|
|
|
{:keys [on-error on-success]
|
|
:or {on-success rx/empty
|
|
on-error rx/throw}}
|
|
(meta params)]
|
|
|
|
(->> (rp/cmd! :leave-team params)
|
|
(rx/mapcat
|
|
(fn [_]
|
|
(rx/merge
|
|
(rx/of (team-leaved params)
|
|
(fetch-teams)
|
|
(ev/event
|
|
{::ev/name "leave-team"
|
|
:reassign-to reassign-to
|
|
:team-id team-id}))
|
|
(on-success))))
|
|
(rx/catch on-error))))))
|
|
|
|
|
|
(def ^:private schema:create-invitation
|
|
[:and
|
|
[:map
|
|
[:emails {:optional true} [::sm/set ::sm/email]]
|
|
[:invitations {:optional true}
|
|
[:vector
|
|
[:map
|
|
[:email ::sm/email]
|
|
[:role [::sm/one-of ctt/valid-roles]]]]]
|
|
[:team-id ::sm/uuid]
|
|
[:resend? {:optional true} ::sm/boolean]]
|
|
[:fn (fn [attrs]
|
|
(or (contains? attrs :emails)
|
|
(contains? attrs :invitations)))]])
|
|
|
|
(def ^:private check-create-invitations-params
|
|
(sm/check-fn schema:create-invitation))
|
|
|
|
(defn create-invitations
|
|
"Unified function to create invitations. Supports two parameter formats:
|
|
1. {:emails #{...} :role :admin :team-id uuid} - single role for all emails
|
|
2. {:invitations [{:email ... :role ...}] :team-id uuid} - individual roles per email"
|
|
[{:keys [emails role team-id invitations resend?] :as params}]
|
|
(check-create-invitations-params params)
|
|
|
|
(ptk/reify ::create-invitations
|
|
ev/Event
|
|
(-data [_]
|
|
{:role (if invitations
|
|
(->> invitations (map :role) distinct (map name) (str/join ", "))
|
|
(name role))
|
|
:team-id team-id
|
|
:resend (boolean resend?)})
|
|
|
|
ptk/WatchEvent
|
|
(watch [it _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)
|
|
;; Prepare parameters based on format
|
|
rpc-params (cond
|
|
;; Format 1: emails + single role
|
|
(and emails role)
|
|
{:emails emails :role role :team-id team-id}
|
|
|
|
;; Format 2: invitations with individual roles
|
|
invitations
|
|
{:invitations invitations :team-id team-id}
|
|
|
|
:else
|
|
(throw (ex-info " Invalid parameters " params)))]
|
|
(->> (rp/cmd! :create-team-invitations (with-meta rpc-params (meta it)))
|
|
(rx/tap on-success)
|
|
(rx/catch on-error))))))
|
|
|
|
(defn check-and-submit-invite-members
|
|
"Fetches fresh team data from the server to ensure up-to-date org
|
|
permissions, then submits member invitations or shows a restriction modal."
|
|
[{:keys [team-id] :as params} origin do-invite-members]
|
|
(ptk/reify ::check-and-submit-invite-members
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(if (contains? cf/flags :nitrate)
|
|
(with-refreshed-team team-id
|
|
(fn [team]
|
|
(if (not (nitrate-perms/allowed? :add-anybody-to-team
|
|
{:org-perms (:organization team)}))
|
|
(->> (rp/cmd! :check-org-members {:organization-id (get-in team [:organization :id])
|
|
:emails (vec (:emails params))})
|
|
(rx/mapcat
|
|
(fn [result]
|
|
(let [blocked (into [] (comp (filter (fn [[_ v]] (not v)))
|
|
(map first))
|
|
result)]
|
|
(cond
|
|
(empty? blocked)
|
|
(do (do-invite-members params origin) (rx/empty))
|
|
|
|
(= (count blocked) (count result))
|
|
(rx/of
|
|
(modal/show
|
|
{:type :alert
|
|
:title (tr "modals.invite-restricted-members.all-blocked-title")
|
|
:message (tr "modals.invite-restricted-members.all-blocked")
|
|
:accept-label (tr "labels.accept")
|
|
:accept-style :primary}))
|
|
|
|
:else
|
|
(rx/of
|
|
(modal/show
|
|
{:type :invite-restricted-members
|
|
:blocked-emails blocked
|
|
:on-accept (fn []
|
|
(let [valid-emails (into #{} (filter (fn [e] (get result e)))
|
|
(:emails params))
|
|
params' (assoc params :emails valid-emails)]
|
|
(do-invite-members params' origin)))})))))))
|
|
(do (do-invite-members params origin)
|
|
(rx/empty)))))
|
|
(do (do-invite-members params origin)
|
|
(rx/empty))))))
|
|
|
|
(defn copy-invitation-link
|
|
[{:keys [email team-id] :as params}]
|
|
(assert (sm/check-email email))
|
|
(assert (uuid? team-id))
|
|
|
|
(ptk/reify ::copy-invitation-link
|
|
IDeref
|
|
(-deref [_] {:email email :team-id team-id})
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)
|
|
router (:router state)]
|
|
|
|
(->> (rp/cmd! :get-team-invitation-token params)
|
|
(rx/map (fn [params]
|
|
(rt/resolve router :auth-verify-token params)))
|
|
(rx/map (fn [fragment]
|
|
(assoc cf/public-uri :fragment fragment)))
|
|
(rx/tap (fn [uri]
|
|
(clipboard/to-clipboard (str uri))))
|
|
(rx/tap on-success)
|
|
(rx/ignore)
|
|
(rx/catch on-error))))))
|
|
|
|
(defn update-invitation-role
|
|
[{:keys [email team-id role] :as params}]
|
|
(assert (sm/check-email email))
|
|
(assert (uuid? team-id))
|
|
(assert (contains? ctt/valid-roles role))
|
|
|
|
(ptk/reify ::update-invitation-role
|
|
IDeref
|
|
(-deref [_] {:role role})
|
|
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)]
|
|
(->> (rp/cmd! :update-team-invitation-role params)
|
|
(rx/tap on-success)
|
|
(rx/catch on-error))))))
|
|
|
|
(defn delete-invitation
|
|
[{:keys [email team-id] :as params}]
|
|
(assert (sm/check-email email))
|
|
(assert (uuid? team-id))
|
|
|
|
(ptk/reify ::delete-invitation
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)]
|
|
(->> (rp/cmd! :delete-team-invitation params)
|
|
(rx/tap on-success)
|
|
(rx/catch on-error))))))
|
|
|
|
(defn- team-deleted
|
|
[id]
|
|
(ptk/reify ::team-deleted
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(update state :teams dissoc id))))
|
|
|
|
(defn delete-team
|
|
[{:keys [id] :as params}]
|
|
(ptk/reify ::delete-team
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [{:keys [on-success on-error]
|
|
:or {on-success rx/empty
|
|
on-error rx/throw}}
|
|
(meta params)]
|
|
|
|
(->> (rp/cmd! :delete-team {:id id})
|
|
(rx/mapcat (fn [result]
|
|
(rx/concat
|
|
(rx/of (team-deleted id))
|
|
(on-success result))))
|
|
(rx/catch on-error))))))
|
|
|
|
(defn delete-webhook
|
|
[{:keys [id] :as params}]
|
|
(dm/assert! (uuid? id))
|
|
|
|
(ptk/reify ::delete-webhook
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)
|
|
params (assoc params :team-id team-id)
|
|
{:keys [on-success on-error]
|
|
:or {on-success identity
|
|
on-error rx/throw}} (meta params)]
|
|
(->> (rp/cmd! :delete-webhook params)
|
|
(rx/tap on-success)
|
|
(rx/catch on-error))))))
|
|
|
|
(def valid-mtypes
|
|
#{"application/json"
|
|
"application/x-www-form-urlencoded"
|
|
"application/transit+json"})
|
|
|
|
(defn update-webhook
|
|
[{:keys [id uri mtype is-active] :as params}]
|
|
(dm/assert! (uuid? id))
|
|
(dm/assert! (contains? valid-mtypes mtype))
|
|
(dm/assert! (boolean? is-active))
|
|
(dm/assert! (u/uri? uri))
|
|
|
|
(ptk/reify ::update-webhook
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)
|
|
params (assoc params :team-id team-id)
|
|
{:keys [on-success on-error]
|
|
:or {on-success rx/empty
|
|
on-error rx/throw}} (meta params)]
|
|
(->> (rp/cmd! :update-webhook params)
|
|
(rx/mapcat (fn [_]
|
|
(rx/concat
|
|
(on-success)
|
|
(rx/of (fetch-webhooks)))))
|
|
(rx/catch on-error))))))
|
|
|
|
(defn create-webhook
|
|
[{:keys [uri mtype is-active] :as params}]
|
|
|
|
(assert (contains? valid-mtypes mtype))
|
|
(assert (boolean? is-active))
|
|
(assert (u/uri? uri))
|
|
|
|
(ptk/reify ::create-webhook
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(let [team-id (:current-team-id state)
|
|
params (-> params
|
|
(assoc :team-id team-id)
|
|
(update :uri str))
|
|
{:keys [on-success on-error]
|
|
:or {on-success rx/empty
|
|
on-error rx/throw}} (meta params)]
|
|
(->> (rp/cmd! :create-webhook params)
|
|
(rx/mapcat (fn [_]
|
|
(rx/concat
|
|
(on-success)
|
|
(rx/of (fetch-webhooks)))))
|
|
(rx/catch on-error))))))
|
|
|
|
(defn- shared-files-fetched
|
|
[files]
|
|
(ptk/reify ::shared-files-fetched
|
|
ptk/UpdateEvent
|
|
(update [_ state]
|
|
(let [files (d/index-by :id files)]
|
|
(update state :shared-files merge files)))))
|
|
|
|
(defn fetch-shared-files
|
|
"Event mainly used for fetch a list of shared libraries for a team,
|
|
this list does not includes the content of the library per se. It
|
|
is used mainly for show available libraries and a summary of it."
|
|
([] (fetch-shared-files nil))
|
|
([team-id]
|
|
(ptk/reify ::fetch-shared-files
|
|
ptk/WatchEvent
|
|
(watch [_ state _]
|
|
(when-let [team-id (or team-id (:current-team-id state))]
|
|
(->> (rp/cmd! :get-team-shared-files {:team-id team-id})
|
|
(rx/map shared-files-fetched)))))))
|
|
|
|
|
|
(defn team->organization [team]
|
|
(when-let [org (:organization team)]
|
|
(assoc org :default-team-id (:id team))))
|