;;;; social.lisp --- Social-login (identity brokering) core logic.
;;;;
;;;; SPDX-License-Identifier: MIT
;;;;
;;;; Provider-agnostic pieces: registry, authorize-URL building, userinfo
;;;; parsing, and account provisioning/linking. The actual upstream HTTP calls
;;;; and web endpoints live in the full system (social-web.lisp).

(in-package #:usher)

(defparameter *social-defaults*
  '(("google" :authorize-url "https://accounts.google.com/o/oauth2/v2/auth"
              :token-url "https://oauth2.googleapis.com/token"
              :userinfo-url "https://openidconnect.googleapis.com/v1/userinfo"
              :scope "openid email profile" :style :oidc)
    ("github" :authorize-url "https://github.com/login/oauth/authorize"
              :token-url "https://github.com/login/oauth/access_token"
              :userinfo-url "https://api.github.com/user"
              :emails-url "https://api.github.com/user/emails"
              :scope "read:user user:email" :style :github))
  "Built-in endpoints per provider key; config :social supplies client creds.")

(defstruct social-provider
  key client-id client-secret authorize-url token-url userinfo-url emails-url
  (scope "") (style :oidc))

(defun social-provider (key)
  "Build a SOCIAL-PROVIDER for KEY from (config :social) merged over the
   built-in defaults, or NIL if not configured."
  (let* ((cfg (find key (config :social) :test #'equal
                    :key (lambda (e) (getf e :key))))
         (def (cdr (assoc key *social-defaults* :test #'equal))))
    (when (and cfg def)
      (flet ((g (k) (or (getf cfg k) (getf def k))))
        (make-social-provider :key key
                              :client-id (getf cfg :client-id)
                              :client-secret (getf cfg :client-secret)
                              :authorize-url (g :authorize-url)
                              :token-url (g :token-url)
                              :userinfo-url (g :userinfo-url)
                              :emails-url (g :emails-url)
                              :scope (g :scope) :style (g :style))))))

(defun social-providers ()
  "All configured social providers."
  (remove nil (mapcar (lambda (e) (social-provider (getf e :key))) (config :social))))

(defun social-callback-uri (key)
  (format nil "~A/social/~A/callback" (issuer) key))

(defun social-authorize-url (provider state)
  "The upstream authorization URL to redirect the browser to."
  (format nil "~A?response_type=code&client_id=~A&redirect_uri=~A&scope=~A&state=~A"
          (social-provider-authorize-url provider)
          (%pct-encode (social-provider-client-id provider))
          (%pct-encode (social-callback-uri (social-provider-key provider)))
          (%pct-encode (social-provider-scope provider))
          (%pct-encode state)))

;;; --- Userinfo parsing ---------------------------------------------------

(defun %g (h k) (let ((v (and (hash-table-p h) (gethash k h))))
                  (cond ((null v) nil)
                        ((eq v t) t)
                        ((stringp v) v)
                        (t (princ-to-string v)))))

(defun parse-social-userinfo (provider data)
  "Normalize an upstream userinfo hash-table to a plist:
   (:sub :email :email-verified :name :username)."
  (ecase (social-provider-style provider)
    (:oidc (list :sub (%g data "sub")
                 :email (%g data "email")
                 :email-verified (eq t (and (hash-table-p data) (gethash "email_verified" data)))
                 :name (%g data "name")
                 :username (%g data "preferred_username")))
    (:github (list :sub (%g data "id")
                   :email (%g data "email")
                   ;; set by the HTTP layer from /user/emails (primary+verified)
                   :email-verified (eq t (and (hash-table-p data) (gethash "email_verified" data)))
                   :name (%g data "name")
                   :username (%g data "login")))))

;;; --- Account provisioning / linking -------------------------------------

(defun %unique-username (store base)
  (let ((b (if (and base (plusp (length base))) base "user")) (i 1) (u nil))
    (setf u b)
    (loop while (store-find-user-by-username store u)
          do (setf u (format nil "~A~D" b (incf i))))
    u))

(defun provision-social-user (store key info)
  "Find or create the local user for a social login. KEY is the provider key,
   INFO the plist from PARSE-SOCIAL-USERINFO. Links the federated identity
   (credential kind \"social:KEY\" → upstream sub). Returns the user."
  (let* ((link-kind (format nil "social:~A" key))
         (sub (getf info :sub))
         (linked (and sub (store-find-subject-by-cred store link-kind sub))))
    (cond
      ;; (1) already linked → that account
      (linked (store-find-user-by-subject store linked))
      ;; (2) a local account with the same *verified* email → link it
      ((and (getf info :email) (getf info :email-verified)
            (store-find-user-by-email store (getf info :email)))
       (let ((user (store-find-user-by-email store (getf info :email))))
         (store-cred-add store (user-subject user) link-kind sub)
         user))
      ;; (3) otherwise provision a new account
      (t (let* ((email (getf info :email))
                (uname (%unique-username
                        store (or (getf info :username)
                                  (and email (subseq email 0 (position #\@ email)))
                                  (format nil "~A-user" key))))
                (user (make-user :subject (random-uuid) :username uname
                                 :name (getf info :name) :email email
                                 :email-verified (and (getf info :email-verified) t)
                                 :status "active")))
           (store-add-user store user)
           (store-cred-add store (user-subject user) link-kind sub)
           user)))))