auth.clj

(ns ucv.models.user
  (:require #?@(:clj  [[datomic.api :as d]
                       [ucv.util :as util :refer [spy when-clj]]]
                :cljs [[ucv.auth :as auth]
                       [ucv.util :as util :refer-macros [spy when-clj]]])
            [clojure.spec.alpha :as s]
            [taoensso.timbre :as log]
            [fulcro.client.primitives :as prim :refer [defsc]]

            [ucv.util :as util]
            )
  #?(:clj
     (:import (java.security SecureRandom)
              (javax.crypto SecretKeyFactory)
              (javax.crypto.spec PBEKeySpec)
              (java.util Base64$Encoder Base64))))

(defsc User [this props]
  {:query         [:db/id :user/email :user/first-name
                   :user/last-name :firm-id :jwt]
   :ident         (fn [] [:user/current-user :singleton])
   :initial-state (fn [_]
                    #?(:clj  {}
                       :cljs {:jwt (auth/get-token)}))})

(when-clj []

  (defn ^String gen-salt []
    (let [sr   (SecureRandom/getInstance "SHA1PRNG")
          salt (byte-array 16)]
      (.nextBytes sr salt)
      (String. salt)))

  (defn ^String encrypt
    "Encrypt the given password, returning a string."
    [^String password ^String salt ^Long iterations]
    (let [keyLength           512
          password-characters (.toCharArray password)
          salt-bytes          (.getBytes salt "UTF-8")
          skf                 (SecretKeyFactory/getInstance "PBKDF2WithHmacSHA512")
          spec                (new PBEKeySpec password-characters salt-bytes iterations keyLength)
          key                 (.generateSecret skf spec)
          res                 (.getEncoded key)
          hashed-pw           (.encodeToString (Base64/getEncoder) res)]
      hashed-pw))

  (defn validate-user
    "Validate a user. Returns boolean true if they are valid."
    [db incoming-email incoming-password]
    (let [{:user/keys [email
                       encrypted-password
                       password-salt
                       password-iterations]} (d/pull db [:user/email
                                                         :user/encrypted-password
                                                         :user/password-salt
                                                         :user/password-iterations]
                                               [:user/email incoming-email])

          hashed (when (and email encrypted-password password-salt password-iterations)
                   (encrypt incoming-password password-salt password-iterations))]
      (cond
        (not= incoming-email email)
        (do
          (log/error "Attempted validation for invalid username" incoming-email)
          false)

        (= hashed encrypted-password)
        (do
          (log/info "Valid credentials for" incoming-email)
          true)

        :else (do
                (log/error "Invalid credentials for username" incoming-email)
                false))))

  (defn new-user
    ([email password iterations]
     (new-user email password iterations {}))
    ([email password iterations {:keys [first-name id
                                        last-name org]}]
     (let [salt (gen-salt)]
       (util/remove-nils
         {:db/id                    (or id (d/tempid :db.part/user))
          :user/email               email
          :user/encrypted-password  (encrypt password salt 100)
          :user/password-salt       salt
          :user/password-iterations iterations
          :user/first-name          first-name
          :user/last-name           last-name
          :entity/firm        org}))))

  )

mutation.clj

(defmacro ^{:doc      "Defines a server-side Fulcro mutation. Based on
                      fulcro.server/defmutation but with authorization. See fulcro docs."
            :arglists '([sym docstring? arglist policy action])} defmutation
  [& args]
  (let [{:keys [sym doc arglist policy action]} (util/conform! ::mutation-args args)
        fqsym           (if (namespace sym)
                          sym
                          (symbol (name (ns-name *ns*)) (name sym)))
        intern?         (-> sym meta :intern)
        interned-symbol (cond
                          (string? intern?) (symbol (namespace fqsym) (str (name fqsym) intern?))
                          (symbol? intern?) intern?
                          :else fqsym)
        doc             (or doc "")
        policy          (:policy-fn policy)
        {:keys [action-args action-body]} (if action
                                            (util/conform! ::action action)
                                            {:action-args ['env] :action-body []})
        ex-msg          (str "Mutation " fqsym " unauthorized, " policy " violated")
        ex-body         {:status 401}
        multimethod
                        `(defmethod fulcro.server/server-mutate '~fqsym [env# k# params#]
                           {:action (fn []
                                      (let [~(first action-args) env#
                                            ~(first arglist) params#]
                                        (if (~policy {:env env# :k k# :params params#})
                                          (do
                                            ~@action-body)
                                          (throw (ex-info ~ex-msg ~ex-body)))))})]
    (if intern?
      `(def ~interned-symbol ~doc
         (do
           ~multimethod
           (fn [~(first action-args) ~(first arglist)]
             ~@action-body)))
      multimethod)))

;;; Example usage

(defmutation create-item
  [params]
  ;; With takes a function that gets params and env as input and returns true/false to decide if mutation is authorized
  (with [env] s.policy/existence)
  (action [{:keys [conn current/firm current/user]}]
    (item/create-item* conn {:firm   firm
                             :params params})))

parser.clj

(ns ucv.server.parser
  (:require [mount.core :refer [defstate]]
            [taoensso.timbre :as log]
            [datomic.api :as d]
            [fulcro.server :as server]
            [fulcro.incubator.pessimistic-mutations :as pm]
            [com.wsscode.pathom.connect :as pc]
            [com.wsscode.pathom.core :as p]
            [com.wsscode.pathom.profile :as pp]

            [ucv.server.database :as s.database]
            [ucv.server.config :as s.config]
            [ucv.util :as util]
            [ucv.server.sql :as s.sql]))

(defmulti resolver-fn pc/resolver-dispatch)
(defonce indexes (atom {}))
(defonce defresolver (pc/resolver-factory resolver-fn indexes))

(defn preprocess-parser-plugin
  "Helper to create a plugin that can view/modify the env/tx of a top-level request.

  f - (fn [{:keys [env tx]}] {:env new-env :tx new-tx})

  If the function returns no env or tx, then the parser will not be called (aborts the parse)"
  [f]
  {::p/wrap-parser
   (fn transform-parser-out-plugin-external [parser]
     (fn transform-parser-out-plugin-internal [env tx]
       (let [{:keys [env tx] :as req} (f {:env env :tx tx})]
         (if (and (map? env) (seq tx))
           (parser env tx)
           {}))))})

(defn log-requests [{:keys [env tx] :as req}]
  (let [{:current/keys [user firm]} env]
    (log/info "user-id:" (:db/id user)
      "firm-id:" (:db/id firm)
      "transaction:" (pr-str tx)))
  req)

(defn add-current-info
  "Adds current/information, such as current firm and user to env."
  [{:keys [env tx] :as req}]
  (let [{:keys [user-id]} env
        db   (d/db s.database/connection)
        env* (assoc env :db db)
        env* (assoc env* :conn s.database/connection)]
    ;; If the user is authenticated then user-id from sente is a db/id,
    ;; otherwise it's a string.
    (if (instance? java.lang.Long user-id)
      (let [current-user (d/touch (d/entity db user-id))
            current-firm (:entity/firm current-user)
            env*         (assoc env*
                           :current/firm current-firm
                           :current/firm-id (:db/id current-firm)
                           :current/user current-user
                           :current/user-id (:db/id current-user))]
        {:env env* :tx tx})
      {:env env* :tx tx})))

(defn process-error
  "If there were any exceptions in the parser their details are put in
  a place pm/pmutate! can recognize."
  [env err]
  (let [msg  (.getMessage err)
        data (or (ex-data err) {})]
    (log/error "Parser Error:" msg data)
    {::pm/mutation-errors {:message msg
                           :data    data}}))

(def parser
  (p/parser
    {::p/mutate     server/server-mutate
     ::p/fail-fast? false
     ::p/plugins    [(p/env-wrap-plugin (fn [env]
                                          (assoc env ::pc/indexes @indexes
                                                     :config s.config/config
                                                     :sql-dbspec {:dbtype     "postgresql"
                                                                  :datasource (:ucv s.sql/connection-pools)}
                                                     :connection s.database/connection)))
                     (p/env-plugin {::p/reader               [p/map-reader
                                                              pc/reader2
                                                              pc/ident-reader
                                                              (p/placeholder-reader ">")]
                                    ::p/placeholder-prefixes #{">"}
                                    ::pc/resolver-dispatch   resolver-fn
                                    ::p/process-error        process-error})
                     p/request-cache-plugin
                     pp/profile-plugin
                     p/error-handler-plugin
                     (preprocess-parser-plugin log-requests)
                     (preprocess-parser-plugin add-current-info)
                     (p/post-process-parser-plugin p/elide-not-found)]}))

policy.clj

(ns ucv.server.policy
  (:refer-clojure :exclude [namespace])
  (:require [taoensso.timbre :as log]
            [datomic.api :as d]
            [hardened.core :refer [namespace]]
            [ucv.util :as util]))

(defn existence [{:keys [env]}]
  (let [{:keys [current/user current/firm]} env]
    (and (:db/id user) (:db/id firm))))