;;;; cl-scopes/lib/auth - authentication services

(defpackage :scopes-auth
  (:use :common-lisp)
  (:local-nicknames (:config :scopes/config)
                    (:core :scopes/core)
                    (:shape :scopes/shape)
                    (:util :scopes/util))
  (:export #:config #:setup
           #:simple-credentials
           #:login))

(in-package :scopes-auth)

(defclass config (config:base)
  ((admin-credentials :reader admin-credentials :initarg :admin-credentials)))

(defclass context (core:context)
  ((authenticator :reader authenticator :initarg :authenticator)))

(defun setup (cfg)
  (let* ((auth (make-instance 'simple-authenticator))
         (ctx (core:default-setup cfg 'context :authenticator auth))
         (cred (admin-credentials cfg)))
    (setf (gethash :admin (principals auth)) cred)
    ctx))

;;;; simple / basic auth service implementation

(defclass simple-authenticator () 
  ((principals :reader principals :initform (make-hash-table))))

(defclass simple-credentials () 
  ((login-name)
   (password)))

(defclass principal (shape:record) 
  ((shape:head-fields :initform '(:organization :short-name))
   (shape:data-fields :initform '(:credentials :full-name :email :role))))

(defun authenticate (cred)
  (make-instance 'principal))

;;;; login entry point

(defun login (cred)
  (let* ((srv (core:find-service :auth))
         (auth (authenticator srv))
         (admin (gethash :admin (principals auth))))
    (util:lgi cred admin)))

;;;; auxiliary functions

(defun digest (pw)
  (ironclad:digest-sequence 
    :sha3/256 (flexi-streams:string-to-octets pw :external-format :utf8)))