integreat/src/clj/auto_ap/graphql/utils.clj

(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)))))