(ns auto-ap.graphql.utils (:require [auto-ap.datomic :refer [conn]] [auto-ap.logging :as alog] [auto-ap.time :as atime] [buddy.auth :refer [throw-unauthorized]] [clj-time.coerce :as coerce] [clojure.set :as set] [clojure.string :as str] [clojure.walk :as walk] [com.brunobonacci.mulog :as mu] [com.walmartlabs.lacinia.util :refer [attach-resolvers]] [datomic.api :as dc] [iol-ion.query :refer [entid]] [slingshot.slingshot :refer [throw+]])) (defn snake->kebab [s] (str/replace s #"_" "-")) (defn kebab [x] (if (qualified-keyword? x) (keyword (snake->kebab (namespace x)) (snake->kebab (name x))) (keyword (snake->kebab (name x))))) (defn kebab->snake [s] (str/replace (str/replace s #"-" "_") #"\?$" "")) (defn snake [x] (keyword (kebab->snake (name x)))) (defn ->graphql [m] (walk/postwalk (fn [node] (cond (keyword? node) (snake node) :else node)) m)) (defn <-graphql [m] (walk/postwalk (fn [node] (cond (keyword? node) (kebab node) :else node)) m)) (defn is-admin? [id] (= "admin" (:user/role id))) (defn assert-admin [id] (when-not (= "admin" (:user/role id)) (alog/warn ::unauthorized :user id :role "admin") (throw-unauthorized))) (defn assert-present ([args key] (assert-present args key (name key))) ([args key name] (when (not (get args key)) (throw (ex-info (str "Missing field '" name "'.") {:validation-error (str "Missing field '" name "'.")}))))) (defn assert-failure ([message] (throw (ex-info message {:validation-error message})))) (defn assert-power-user [id] (when-not (#{"power-user" "admin"} (:user/role id)) (alog/warn ::unauthorized :user id :role "power-user") (throw-unauthorized))) (defn can-see-client? [identity client] (when (not client) (alog/error ::checking-for-null-client :id identity)) (or (= "admin" (:user/role identity)) ((set (map :db/id (:user/clients identity))) (:db/id client)) ((set (map :db/id (:user/clients identity))) client))) (defn assert-can-see-client [identity client] (when-not (can-see-client? identity client) (alog/warn ::unauthorized :id identity :client client) (throw-unauthorized))) (defn limited-clients [id] (cond (= (:user/role id) "none") [] (= (:user/role id) "admin") nil (#{"manager" "user" "power-user"} (:user/role id)) (:user/clients id []))) (defn result->page [results result-count key args] {key (map ->graphql results) :total result-count :count (count results) :start (:start args 0) :end (+ (:start args 0) (count results))}) (defn ident->enum-f [k] #(update % k (fn [value] (some-> value :db/ident name keyword)))) (defn enum->keyword [e namespace] (some->> e name snake->kebab (keyword namespace))) (defn get-locked-until [client-id] (:client/locked-until (dc/pull (dc/db conn) [:client/locked-until] client-id))) (defn assert-not-locked [client-id date] (let [locked-until (get-locked-until client-id)] (when (and locked-until (>= (compare locked-until (coerce/to-date date)) 0)) (assert-failure (str "Integreat has locked finances prior to " (-> locked-until coerce/to-date-time (atime/unparse-local atime/normal-date)) "."))))) #_{:clj-kondo/ignore [:clojure-lsp/unused-public-var]} (defn assert-none-locked [client-id dates] (doseq [d dates] (assert-not-locked client-id d))) (defn cleanse-query [q] (if (str/includes? q "&") (str "\"" q "\"~0.8") (let [parts (-> q (str/replace #"[\[\]\+\*\-\?]" "") (str/split #"\s+")) exacts (butlast parts) partial (some-> (last parts) not-empty (str "*")) query (as-> exacts e (filter #(not (str/blank? %)) e) (mapv #(str "+" %) e) (conj e partial) (str/join " " e))] (not-empty query)))) (defn trace-query [key f] (fn trace [a b c] (mu/with-context (merge (:log-context a {}) {:query key :mutation (boolean (= "mutation" (namespace key))) :user (:id a)}) (mu/trace (keyword "graphql" (name key)) [] (f a b c))))) (defn attach-tracing-resolvers [schema m] (attach-resolvers schema (reduce (fn [resolvers [resolver-key resolver-fn]] (assoc resolvers resolver-key (trace-query resolver-key resolver-fn))) {} m))) (defn extract-client-ids [user-clients & possible-clients] (let [coerce-client-ids (fn coerce-client-ids [x] (cond (and (map? x) (:db/id x)) [(:db/id x)] (nat-int? x) [x] (and (vector? x) (= :client/code (first x))) [(entid (dc/db conn) x)] (sequential? x) (mapcat coerce-client-ids x) :else [])) user-client-ids (set (mapcat coerce-client-ids user-clients)) extra-client-ids (set (mapcat coerce-client-ids possible-clients))] (if (seq extra-client-ids) (set/intersection user-client-ids extra-client-ids) user-client-ids))) (defn exception->notification [f] (try (f) (catch Throwable e (throw (ex-info (.getMessage e) {:type :notification} e))))) (defn exception->4xx [f] (try (f) (catch Throwable e (throw+ (ex-info (.getMessage e) {:type :form-validation :form-validation-errors [(.getMessage e)]})) #_(throw (ex-info (.getMessage e) {:type :notification} e))))) (defn notify-if-locked [client-id date] (try (assert-not-locked client-id date) (catch Exception e (throw (ex-info (.getMessage e) {:type :notification} e)))))