username and password auth for Biff

auth.clj

(ns com.example.auth
  (:require [com.biffweb :as biff]
            [buddy.hashers :as hashers]
            [xtdb.api :as xt]
            [com.example.ui :as ui]
            [clojure.string :as s]))

(defn submit-new-auth-user [ctx username password]
  (biff/submit-tx ctx
                  [{:db/doc-type                   :biff.auth/username
                    :db.op/upsert                  {:biff.auth.username/username username
                                                    :biff.auth.username/password (hashers/derive password)}
                    :biff.auth.username/created-at :db/now}]))

(defn submit-new-user [ctx username]
  (biff/submit-tx ctx
                  [{:db/doc-type    :user
                    :db.op/upsert   {:user/username username}
                    :user/joined-at :db/now}]))

(defn get-auth-user-id [db username]
  (biff/lookup-id db :biff.auth.username/username username))

(defn get-auth-user-doc [db username]
  (biff/lookup db :biff.auth.username/username username))

(defn get-user-id [db username]
  (biff/lookup-id db :user/username username))

(defn get-user-doc [db username]
  (biff/lookup db :user/username username))

(defn validate-username? [username]
;; 大文字小文字数字で３−１６文字
  (let [regex #"^[a-zA-Z0-9_-]{3,16}$"]
    (boolean (re-matches regex username))))

(defn validate-password? [password]
  (let [regex #"^(?=.*[a-z])(?=.*[A-Z])(?=.*[^a-zA-Z0-9]).{8,}$"]
    (boolean (re-matches regex password))))


(defn create-account! [ctx username password]
  (submit-new-auth-user ctx username password)
  (submit-new-user ctx username)
  (biff/merge-context ctx))


(defn register-handler [{:keys [params biff/db session]
                         :as   ctx}]
  (let [{:keys [username password]} params]
    (cond
      (or (s/blank? username)
          (s/blank? password)) {:status 400
                                :body   {:error "ユーザ名とパスワードを挿入してください"}}
      (some? (get-auth-user-id db username)) {:status 400
                                              :body   {:error "このユーザ名はすでに使用されています"}}
      (false? (validate-username? username)) {:status 400
                                              :body   {:error "username は大文字小文字数字のいずれかで３−１６文字です。"}}
      (false? (validate-password? password)) {:status 400
                                              :body   {:error "password は大文字小文字数字と何かしらの記号を含んだ８文字以上です。"}}

      :else (let [ctx (create-account! ctx username password)
                  uid (get-user-id  (:biff/db ctx)  username)]

              {:status  303
               :headers {"location" "/test/app"}
               :session (assoc session :uid uid)}))))


(defn login-handler [{:keys [params biff/db session]
                      :as   ctx}]
  (let [{:keys [username password]} params
        user                        (get-user-id db username)
        auth-user-password          (:biff.auth.username/password (get-auth-user-doc db username))
        password-valid?             (:valid  (hashers/verify password auth-user-password))]
    (cond
      (or (s/blank? username)
          (s/blank? password)) {:status 400
                                :body   {:error "ユーザ名とパスワードを挿入してください"}}
      (not (some? user)) {:status 400
                          :body   {:error "登録ユーザではありません。"}}

      (false? password-valid?) {:status 400
                                :body   {:error "ユーザ名もしくはパスワードが異なります"}}
      :else {:status  303
             :headers {"location" "/test/app"}
             :session (assoc session
                             :uid (get-user-id db username))})))

(defn app [{:keys [session biff/db]
            :as   ctx}]
  (let [{:user/keys [username]} (xt/entity db (:uid session))]
    (ui/page
     {}
     [:div "logged in as " username ". "]
     (biff/form
      {:action "/auth/logout"
       :class  "inline"}
      [:button.text-blue-500.hover:text-blue-800 {:type "submit"}
       "log out"]))))

(defn logout [{:keys [session]}]
  {:status  303
   :headers {"location" "/test/login"}
   :session (dissoc session :uid)})


(defn register-form [{:keys [recaptcha/site-key]
                      :as   ctx}]
  (ui/page
   (assoc ctx ::ui/recaptcha true)
   [:p "ユーザ登録"
    [:div
     [:a {:href "/test/login"} "ログインはこちら"]]]
   (biff/form {:action "/auth/register"}
              [:input#username
               {:name        "username"
                :type        "string"
                :placeholder "ユーザー名を入れてください"}]
              [:.w-3]
              [:input#password
               {:name        "password"
                :type        "password"
                :placeholder "パスワードを入れてください"}]
              [:button.btn.g-recaptcha
               (merge (when site-key
                        {:data-sitekey  site-key
                         :data-callback "submitSignup"})
                      {:type "submit"})
               "ユーザ登録"])))


(defn login-form [{:keys [recaptcha/site-key]
                   :as   ctx}]
  (ui/page
   (assoc ctx ::ui/recaptcha true)
   [:p "ログイン"
    [:div
     [:a {:href "/test/register"} "登録はこちら"]]]
   (biff/form {:action "/auth/login"}
              [:input#username
               {:name        "username"
                :type        "string"
                :placeholder "ユーザー名を入れてください"}]
              [:.w-3]
              [:input#password
               {:name        "password"
                :type        "password"
                :placeholder "パスワードを入れてください"}]
              [:button.btn.g-recaptcha
               (merge (when site-key
                        {:data-sitekey  site-key
                         :data-callback "submitSignup"})
                      {:type "submit"})
               "ログイン"])))



(def default-options
  #:biff.auth{:app-path "/app"})

(defn wrap-options [handler options]
  (fn [ctx]
    (handler (merge options ctx))))

(defn module [options]
  {:schema {:biff.auth.username/id :uuid
            :biff.auth/username    [:map {:closed true}
                                    [:xt/id :biff.auth.username/id]
                                    [:biff.auth.username/username :string]
                                    [:biff.auth.username/password :string]
                                    [:biff.auth.username/created-at inst?]]}


   :routes [["/auth" {:middleware [[wrap-options (merge default-options options)]]}
             ["/logout"  {:post logout}]
             ["/register" {:post register-handler}]
             ["/login" {:post login-handler}]]
            ["/test" {:middleware []}
             ["/register" {:get register-form}]
             ["/login" {:get login-form}]
             ["/app" {:get app}]]]})

schema.clj

(ns com.example.schema)

(def schema
  {:user/id :uuid
   :user    [:map {:closed true}
             [:xt/id                     :user/id]
             #_[:user/email                :string]
             [:user/username             :string]
             [:user/joined-at            inst?]
             [:user/foo {:optional true} :string]
             [:user/bar {:optional true} :string]]

   :msg/id  :uuid
   :msg     [:map {:closed true}
             [:xt/id       :msg/id]
             [:msg/user    :user/id]
             [:msg/text    :string]
             [:msg/sent-at inst?]]})

(def module
  {:schema schema})