;;;; email.lisp --- Email delivery + email-address verification.
;;;;
;;;; SPDX-License-Identifier: MIT
;;;;
;;;; The SMTP backend loads cl-smtp lazily (uiop:symbol-call) so usher/core has
;;;; no hard SMTP dependency; tests use the :capture backend.

(in-package #:usher)

(defvar *captured-emails* nil
  "When the :capture backend is active, a list of (TO SUBJECT BODY) plists,
   most recent first. Used by tests and development.")

(defun email-backend ()
  (getf (config :smtp) :backend :capture))

(defun send-email (to subject body)
  "Send (or capture) an email. Returns T."
  (ecase (email-backend)
    (:capture
     (push (list :to to :subject subject :body body) *captured-emails*)
     t)
    (:smtp
     (let ((smtp (config :smtp)))
       (uiop:symbol-call
        :cl-smtp :send-email
        (getf smtp :host "localhost")
        (getf smtp :from "no-reply@localhost")
        to subject body
        :port (getf smtp :port 25)
        :ssl (getf smtp :ssl nil))
       t))))

;;; --- Single-use, expiring credential tokens -----------------------------
;;;
;;; Email-verification and password-reset tokens are single-use *and* time-
;;; bounded. The credential store has no expiry column, so the expiry travels
;;; inside the stored value as "<expires-at-unix>:<sha256-hex-of-token>". The
;;; secret half is still only ever stored hashed and compared in constant time;
;;; the (non-secret) expiry prefix is parsed in the clear.

(defun issue-cred-token (store subject kind ttl)
  "Mint a single-use token for (SUBJECT,KIND) that expires TTL seconds from now.
   Stores only its hash (+ expiry); returns the raw token to send to the user."
  (let ((raw (random-token 32)))
    (store-cred-put store subject kind
                    (format nil "~D:~A" (+ (unix-now) ttl) (sha256-hex raw)))
    raw))

(defun consume-cred-token (store subject kind token)
  "True iff TOKEN matches the stored single-use token for (SUBJECT,KIND) and it
   has not expired. Deletes it (single-use) on success. Expired tokens are
   cleared as a side effect."
  (let ((stored (and token (store-cred-get store subject kind))))
    (when stored
      (let* ((colon (position #\: stored))
             (expires (and colon (ignore-errors (parse-integer stored :end colon))))
             (hash (and colon (subseq stored (1+ colon)))))
        (cond
          ;; malformed or already expired → invalid; drop it.
          ((or (null expires) (null hash) (<= expires (unix-now)))
           (when expires (store-cred-del store subject kind))
           nil)
          ((constant-time-equal hash (sha256-hex token))
           (store-cred-del store subject kind)
           t))))))

;;; --- Email-address verification -----------------------------------------

(defun verification-link (subject raw-token)
  (format nil "~A/verify-email?sub=~A&token=~A"
          (issuer) (%pct-encode subject) (%pct-encode raw-token)))

(defun request-email-verification (provider user)
  "Issue a single-use email-verification token for USER, store its hash in the
   credential store, and send the verification email. Returns the raw token."
  (let ((raw (issue-cred-token (provider-store provider) (user-subject user)
                               "email-verify" (config :email-verify-ttl))))
    (when (user-email user)
      (send-email (user-email user)
                  "Verify your email address"
                  (format nil "Hello ~A,~%~%Please verify your email address by ~
                               visiting:~%~%  ~A~%~%If you did not request this, ~
                               ignore this message.~%"
                          (or (user-name user) (user-username user))
                          (verification-link (user-subject user) raw))))
    raw))

(defun verify-email-token (provider subject token)
  "Consume a verification TOKEN for SUBJECT. On success mark the user's email
   verified, clear the token (single-use), and return T."
  (let* ((store (provider-store provider))
         (user (store-find-user-by-subject store subject)))
    (when (and user (consume-cred-token store subject "email-verify" token))
      (setf (user-email-verified user) t)
      t)))

;;; --- Password reset (mirrors the verification flow) ---------------------

(defun reset-link (subject raw-token)
  (format nil "~A/reset-password?sub=~A&token=~A"
          (issuer) (%pct-encode subject) (%pct-encode raw-token)))

(defun request-password-reset (provider username-or-email)
  "Look up the user by username or email; if found, store a single-use reset
   token (hashed) and email a reset link. Enumeration-safe: callers should
   respond identically whether or not a user was found. Returns the raw token
   (for tests) or NIL if no such user."
  (let* ((store (provider-store provider))
         (user (or (store-find-user-by-username store username-or-email)
                   (store-find-user-by-email store username-or-email))))
    (when (and user (string= (user-status user) "active"))
      (let ((raw (issue-cred-token store (user-subject user) "pw-reset"
                                   (config :pw-reset-ttl))))
        (when (user-email user)
          (send-email (user-email user)
                      "Reset your password"
                      (format nil "Hello ~A,~%~%A password reset was requested. ~
                                   To choose a new password, visit:~%~%  ~A~%~%~
                                   If you did not request this, ignore this ~
                                   message; your password is unchanged.~%"
                              (or (user-name user) (user-username user))
                              (reset-link (user-subject user) raw))))
        raw))))

(defun reset-password (provider subject token new-password)
  "Consume a reset TOKEN for SUBJECT and set NEW-PASSWORD. On success the token
   is invalidated (single-use) and all of the user's refresh families are left
   intact for the caller to revoke if desired. Returns T on success."
  (let* ((store (provider-store provider))
         (user (store-find-user-by-subject store subject)))
    (when (and user new-password (plusp (length new-password))
               (consume-cred-token store subject "pw-reset" token))
      (setf (user-password-hash user) (hash-password new-password))
      t)))