diff --git a/authorization/package.lisp b/authorization/package.lisp new file mode 100644 index 0000000..d7e01ce --- /dev/null +++ b/authorization/package.lisp @@ -0,0 +1,323 @@ +(defpackage #:io.github.cl-sdk.wst.authorization + (:use #:cl) + (:documentation "INCITS 359-inspired authorization primitives for wst. + +Provides: +- RBAC-flavored entity classes for users, roles, permissions, and sessions +- Pluggable store protocol generics +- Lazy policy specifications composed from first-class policy functions +- Small DSL helpers for named policies and policy sets") + (:export + #:user + #:user-id + #:role + #:role-name + #:permission + #:permission-operation + #:permission-object + #:session + #:session-store + #:assigned-roles + #:role-permissions + #:role-seniors + #:create-session + #:session-user + #:active-roles + #:activate-role + #:deactivate-role + #:session-authorized-p + #:evaluate-policy + #:defpolicy + #:defpolicy-set + #:require-authenticated + #:require-role + #:require-permission + #:require-predicate + #:all-of + #:any-of + #:invert + #:deny-overrides + #:permit-overrides + #:first-applicable + #:*decision-allow* + #:*decision-deny* + #:*decision-not-applicable*)) + +(in-package #:io.github.cl-sdk.wst.authorization) + +(defparameter *decision-allow* :allow) +(defparameter *decision-deny* :deny) +(defparameter *decision-not-applicable* :not-applicable) + +(defgeneric assigned-roles (store user) + (:documentation "Return the roles assigned to USER in STORE. +Default entity-backed methods read roles from USER directly.")) + +(defgeneric role-permissions (store role) + (:documentation "Return the permissions assigned to ROLE in STORE. +Default entity-backed methods read permissions from ROLE directly.")) + +(defgeneric role-seniors (store role) + (:documentation "Return inherited roles for ROLE in STORE. +Default entity-backed methods read the hierarchy from ROLE directly.")) + +(defgeneric create-session (store user &key roles) + (:documentation "Create a SESSION for USER in STORE. +ROLES, when provided, must be a subset of the roles assigned to USER.")) + +(defgeneric session-user (session) + (:documentation "Return the user associated with SESSION.")) + +(defgeneric active-roles (session) + (:documentation "Return the currently active roles for SESSION.")) + +(defgeneric activate-role (store session role) + (:documentation "Activate ROLE for SESSION in STORE and return SESSION.")) + +(defgeneric deactivate-role (store session role) + (:documentation "Deactivate ROLE for SESSION in STORE and return SESSION.")) + +(defgeneric session-authorized-p (store session operation object) + (:documentation "Return true when SESSION is authorized for OPERATION on OBJECT.")) + +(defgeneric evaluate-policy (policy context) + (:documentation "Evaluate POLICY against CONTEXT and return one of +`*decision-allow*`, `*decision-deny*`, or `*decision-not-applicable*`.")) + +(defclass user () + ((id :initarg :id :reader user-id :initform nil) + (roles :initarg :roles :accessor %user-roles :initform nil)) + (:documentation "Default RBAC user entity.")) + +(defclass role () + ((name :initarg :name :reader role-name :initform (error "role.name is required.")) + (permissions :initarg :permissions :accessor %role-permissions :initform nil) + (seniors :initarg :seniors :accessor %role-seniors :initform nil)) + (:documentation "Default RBAC role entity.")) + +(defclass permission () + ((operation :initarg :operation + :reader permission-operation + :initform (error "permission.operation is required.")) + (object :initarg :object + :reader permission-object + :initform (error "permission.object is required."))) + (:documentation "Default RBAC permission entity.")) + +(defclass session () + ((user :initarg :user + :accessor session-user + :initform (error "session.user is required.")) + (store :initarg :store + :reader session-store + :initform nil) + (active-roles-value :initarg :active-roles + :accessor active-roles + :initform nil)) + (:documentation "Default RBAC session entity.")) + +(defun %decision-p (value) + (member value (list *decision-allow* + *decision-deny* + *decision-not-applicable*) + :test #'eq)) + +(defun %ensure-decision (value) + (unless (%decision-p value) + (error "Invalid authorization decision: ~S" value)) + value) + +(defun %role-key (role) + (if (typep role 'role) + (role-name role) + role)) + +(defun %role= (left right) + (equal (%role-key left) (%role-key right))) + +(defun %permission-match-p (permission operation object) + (typecase permission + (permission + (and (equal (permission-operation permission) operation) + (equal (permission-object permission) object))) + (cons + (and (equal (car permission) operation) + (equal (cdr permission) object))) + (t nil))) + +(defun %member-role-p (role roles) + (member role roles :test #'%role=)) + +(defun %append-role (role roles) + (if (%member-role-p role roles) + roles + (append roles (list role)))) + +(defun %reachable-roles (store roles) + (labels ((walk (pending seen) + (if (endp pending) + seen + (let* ((role (car pending)) + (rest (cdr pending))) + (if (%member-role-p role seen) + (walk rest seen) + (walk (append rest (role-seniors store role)) + (%append-role role seen))))))) + (walk roles nil))) + +(defun %session-from-context (context) + (or (getf context :session) + (let ((subject (getf context :subject))) + (and (typep subject 'session) + subject)))) + +(defun %store-from-context (context session) + (or (getf context :store) + (and session (session-store session)) + t)) + +(defmethod assigned-roles ((store t) (user user)) + (%user-roles user)) + +(defmethod role-permissions ((store t) (role role)) + (%role-permissions role)) + +(defmethod role-seniors ((store t) (role role)) + (%role-seniors role)) + +(defmethod create-session ((store t) (user user) &key roles) + (let* ((assigned (assigned-roles store user)) + (selected (or roles assigned))) + (unless (every (lambda (role) (%member-role-p role assigned)) selected) + (error "Requested session roles must be a subset of the user's assigned roles.")) + (make-instance 'session + :user user + :store store + :active-roles (copy-list selected)))) + +(defmethod activate-role ((store t) (session session) role) + (unless (%member-role-p role (assigned-roles store (session-user session))) + (error "Cannot activate a role not assigned to the session user.")) + (setf (active-roles session) + (%append-role role (active-roles session))) + session) + +(defmethod deactivate-role ((store t) (session session) role) + (setf (active-roles session) + (remove role (active-roles session) :test #'%role=)) + session) + +(defmethod session-authorized-p ((store t) (session session) operation object) + (let ((roles (%reachable-roles store (active-roles session)))) + (loop :for role :in roles + :thereis (loop :for permission :in (role-permissions store role) + :thereis (%permission-match-p permission operation object))))) + +(defmethod evaluate-policy ((policy function) context) + (%ensure-decision (funcall policy context))) + +(defun require-authenticated () + "Return a policy that allows only when CONTEXT carries a session." + (lambda (context) + (if (%session-from-context context) + *decision-allow* + *decision-deny*))) + +(defun require-role (role) + "Return a policy that allows only when ROLE is active in the session." + (lambda (context) + (let ((session (%session-from-context context))) + (if (and session (%member-role-p role (active-roles session))) + *decision-allow* + *decision-deny*)))) + +(defun require-permission (operation object) + "Return a policy that allows only when the session authorizes OPERATION on OBJECT." + (lambda (context) + (let ((session (%session-from-context context))) + (if session + (if (session-authorized-p (%store-from-context context session) + session + operation + object) + *decision-allow* + *decision-deny*) + *decision-deny*)))) + +(defun require-predicate (predicate) + "Return a policy that delegates to PREDICATE. +Truthy values become `*decision-allow*`, false becomes `*decision-deny*`, +and explicit decisions are preserved." + (lambda (context) + (let ((value (funcall predicate context))) + (if (%decision-p value) + value + (if value + *decision-allow* + *decision-deny*))))) + +(defun all-of (&rest policies) + "Return a policy that allows only when all POLICIES allow." + (lambda (context) + (let ((saw-not-applicable nil)) + (dolist (policy policies (if saw-not-applicable + *decision-not-applicable* + *decision-allow*)) + (case (evaluate-policy policy context) + (:deny (return *decision-deny*)) + (:not-applicable (setf saw-not-applicable t))))))) + +(defun any-of (&rest policies) + "Return a policy that allows when any POLICY allows." + (lambda (context) + (let ((saw-deny nil)) + (dolist (policy policies (if saw-deny + *decision-deny* + *decision-not-applicable*)) + (case (evaluate-policy policy context) + (:allow (return *decision-allow*)) + (:deny (setf saw-deny t))))))) + +(defun invert (policy) + "Return a policy with allow and deny decisions inverted." + (lambda (context) + (case (evaluate-policy policy context) + (:allow *decision-deny*) + (:deny *decision-allow*) + (t *decision-not-applicable*)))) + +(defun deny-overrides (&rest policies) + "Return a policy-set where any deny decision wins." + (lambda (context) + (let ((saw-allow nil)) + (dolist (policy policies (if saw-allow + *decision-allow* + *decision-not-applicable*)) + (case (evaluate-policy policy context) + (:deny (return *decision-deny*)) + (:allow (setf saw-allow t))))))) + +(defun permit-overrides (&rest policies) + "Return a policy-set where any allow decision wins." + (lambda (context) + (let ((saw-deny nil)) + (dolist (policy policies (if saw-deny + *decision-deny* + *decision-not-applicable*)) + (case (evaluate-policy policy context) + (:allow (return *decision-allow*)) + (:deny (setf saw-deny t))))))) + +(defun first-applicable (&rest policies) + "Return a policy-set that chooses the first non-not-applicable decision." + (lambda (context) + (dolist (policy policies *decision-not-applicable*) + (let ((decision (evaluate-policy policy context))) + (unless (eq decision *decision-not-applicable*) + (return decision)))))) + +(defmacro defpolicy (name form) + `(defparameter ,name ,form)) + +(defmacro defpolicy-set (name &key combiner policies) + `(defparameter ,name (apply #',combiner ,policies))) diff --git a/authorization/routing.lisp b/authorization/routing.lisp new file mode 100644 index 0000000..1567fa8 --- /dev/null +++ b/authorization/routing.lisp @@ -0,0 +1,93 @@ +(defpackage #:io.github.cl-sdk.wst.authorization.routing + (:use #:cl #:io.github.cl-sdk.wst.authorization) + (:documentation "Routing adapter for request-scoped authorization checks.") + (:export + #:wrap-authorization + #:subject-of + #:resource-of + #:action-of + #:authorization-context-of + #:authorization-decision-of)) + +(in-package #:io.github.cl-sdk.wst.authorization.routing) + +(defun %plist-even-p (plist) + (and (listp plist) + (evenp (length plist)))) + +(defun %merge-contexts (&rest contexts) + (let ((result nil)) + (dolist (context contexts result) + (when context + (unless (%plist-even-p context) + (error "Authorization context must be a plist (even-length list).")) + (loop :for (key value) :on context :by #'cddr + :do (setf (getf result key) value)))))) + +(defun subject-of (request &key + (subject-key :subject) + (session-key :session)) + "Return the default authorization subject associated with REQUEST." + (or (getf (io.github.cl-sdk.wst.routing:request-data request) subject-key) + (getf (io.github.cl-sdk.wst.routing:request-data request) session-key))) + +(defun action-of (request) + "Return the default action associated with REQUEST." + (io.github.cl-sdk.wst.routing:request-method request)) + +(defun resource-of (request) + "Return the default resource associated with REQUEST." + (io.github.cl-sdk.wst.routing:request-uri request)) + +(defun authorization-context-of (request &key + (context-key :authorization-context) + (subject-key :subject) + (session-key :session) + (store-key :authorization-store)) + "Return the default authorization evaluation context for REQUEST." + (let* ((data (io.github.cl-sdk.wst.routing:request-data request)) + (subject (subject-of request :subject-key subject-key :session-key session-key)) + (session (or (and (typep subject 'session) subject) + (getf data session-key))) + (action (action-of request)) + (resource (resource-of request))) + (%merge-contexts + (getf data context-key) + (list :request request + :subject subject + :session session + :store (or (getf data store-key) + (and session (session-store session))) + :action action + :operation action + :resource resource + :object resource)))) + +(defun authorization-decision-of (request &key (decision-key :authorization-decision)) + "Return the last authorization decision stored in REQUEST." + (getf (io.github.cl-sdk.wst.routing:request-data request) decision-key)) + +(defun %default-on-deny (request response decision context) + (declare (ignore request decision)) + (if (getf context :session) + (cons :halt (io.github.cl-sdk.wst.routing:forbidden-response t response)) + (cons :halt (io.github.cl-sdk.wst.routing:unauthorized-response t response)))) + +(defun wrap-authorization (&key + policy + (context-fn #'authorization-context-of) + (on-deny #'%default-on-deny) + (decision-key :authorization-decision)) + "Create a before-middleware that evaluates POLICY for each request." + (unless policy + (error "wrap-authorization requires a policy.")) + (check-type decision-key keyword) + (lambda (request response) + (let* ((context (funcall context-fn request)) + (decision (evaluate-policy policy context))) + (setf (io.github.cl-sdk.wst.routing:request-data request) + (append (io.github.cl-sdk.wst.routing:request-data request) + (list decision-key decision))) + (if (eq decision *decision-allow*) + (cons :continue response) + (funcall on-deny request response decision context))))) diff --git a/io.github.cl-sdk.wst.authorization.asd b/io.github.cl-sdk.wst.authorization.asd new file mode 100644 index 0000000..8275779 --- /dev/null +++ b/io.github.cl-sdk.wst.authorization.asd @@ -0,0 +1,9 @@ +(asdf:defsystem #:io.github.cl-sdk.wst.authorization + :description "INCITS 359-inspired authorization primitives for wst." + :author "Bruno Dias" + :license "Unlicense" + :version "0.1.0" + :depends-on () + :pathname "authorization" + :serial t + :components ((:file "package"))) diff --git a/io.github.cl-sdk.wst.authorization.routing.asd b/io.github.cl-sdk.wst.authorization.routing.asd new file mode 100644 index 0000000..67179b3 --- /dev/null +++ b/io.github.cl-sdk.wst.authorization.routing.asd @@ -0,0 +1,10 @@ +(asdf:defsystem #:io.github.cl-sdk.wst.authorization.routing + :description "Routing adapter for request-scoped authorization checks." + :author "Bruno Dias" + :license "Unlicense" + :version "0.1.0" + :depends-on (#:io.github.cl-sdk.wst.authorization + #:io.github.cl-sdk.wst.routing) + :pathname "authorization" + :serial t + :components ((:file "routing"))) diff --git a/io.github.cl-sdk.wst.authorization.routing.test.asd b/io.github.cl-sdk.wst.authorization.routing.test.asd new file mode 100644 index 0000000..d38c592 --- /dev/null +++ b/io.github.cl-sdk.wst.authorization.routing.test.asd @@ -0,0 +1,12 @@ +(asdf:defsystem #:io.github.cl-sdk.wst.authorization.routing.test + :description "Tests for io.github.cl-sdk.wst.authorization.routing." + :author "Bruno Dias" + :license "Unlicense" + :version "0.1.0" + :depends-on (#:io.github.cl-sdk.wst.test.support + #:io.github.cl-sdk.wst.authorization + #:io.github.cl-sdk.wst.authorization.routing + #:io.github.cl-sdk.wst.routing) + :pathname "t" + :serial t + :components ((:file "authorization-routing-tests"))) diff --git a/io.github.cl-sdk.wst.authorization.test.asd b/io.github.cl-sdk.wst.authorization.test.asd new file mode 100644 index 0000000..d9c723e --- /dev/null +++ b/io.github.cl-sdk.wst.authorization.test.asd @@ -0,0 +1,10 @@ +(asdf:defsystem #:io.github.cl-sdk.wst.authorization.test + :description "Tests for io.github.cl-sdk.wst.authorization." + :author "Bruno Dias" + :license "Unlicense" + :version "0.1.0" + :depends-on (#:io.github.cl-sdk.wst.test.support + #:io.github.cl-sdk.wst.authorization) + :pathname "t" + :serial t + :components ((:file "authorization-tests"))) diff --git a/io.github.cl-sdk.wst.test.asd b/io.github.cl-sdk.wst.test.asd index 6a42c7d..f91adbd 100644 --- a/io.github.cl-sdk.wst.test.asd +++ b/io.github.cl-sdk.wst.test.asd @@ -3,7 +3,9 @@ :author "Bruno Dias" :license "Unlicense" :version "0.1.0" - :depends-on (#:io.github.cl-sdk.wst.circuit-breaker.test + :depends-on (#:io.github.cl-sdk.wst.authorization.routing.test + #:io.github.cl-sdk.wst.authorization.test + #:io.github.cl-sdk.wst.circuit-breaker.test #:io.github.cl-sdk.wst.cors.test #:io.github.cl-sdk.wst.flash.test #:io.github.cl-sdk.wst.feature-flag.routing.test diff --git a/readme.md b/readme.md index c2cbd4a..798b89c 100644 --- a/readme.md +++ b/readme.md @@ -25,6 +25,7 @@ Behavior is built from pipelines and composition, where middleware and handlers - Accept-aware response selection helpers (`io.github.cl-sdk.wst.request-accept`) - W3C Trace Context propagation (`traceparent`/`tracestate`) with routing adapter (`io.github.cl-sdk.wst.trace-context`) - Feature flags following the [openfeature specification](https://openfeature.dev) and routing adapter (`io.github.cl-sdk.wst.feature-flag`) +- INCITS 359-inspired authorization core and routing adapter (`io.github.cl-sdk.wst.authorization`) Example route composition: diff --git a/t/authorization-routing-tests.lisp b/t/authorization-routing-tests.lisp new file mode 100644 index 0000000..6f634b6 --- /dev/null +++ b/t/authorization-routing-tests.lisp @@ -0,0 +1,63 @@ +(defpackage #:io.github.cl-sdk.wst.authorization.routing.test + (:use #:cl #:fiveam + #:io.github.cl-sdk.wst.authorization + #:io.github.cl-sdk.wst.authorization.routing)) + +(in-package #:io.github.cl-sdk.wst.authorization.routing.test) + +(def-suite authorization-routing-suite) +(in-suite authorization-routing-suite) + +(test default-hooks-extract-subject-action-resource-and-context + (let* ((reader (make-instance 'role :name :reader)) + (user (make-instance 'user :id "u1" :roles (list reader))) + (session (create-session nil user)) + (request (io.github.cl-sdk.wst.routing:make-request :uri "/users" :method :get))) + (setf (io.github.cl-sdk.wst.routing:request-data request) + (append (io.github.cl-sdk.wst.routing:request-data request) + (list :session session :authorization-context '(:tenant "acme")))) + (let ((context (authorization-context-of request))) + (is (eq session (subject-of request))) + (is (eq session (getf context :session))) + (is (eq :get (action-of request))) + (is (string= "/users" (resource-of request))) + (is (string= "acme" (getf context :tenant)))))) + +(test wrap-authorization-halts-unauthenticated-requests-with-401 + (let* ((request (io.github.cl-sdk.wst.routing:make-request :uri "/users" :method :get)) + (response (io.github.cl-sdk.wst.routing:make-response)) + (middleware (wrap-authorization :policy (require-authenticated))) + (result (funcall middleware request response))) + (is (eq :halt (car result))) + (is (= 401 (io.github.cl-sdk.wst.routing:response-status (cdr result)))) + (is (eq *decision-deny* (authorization-decision-of request))))) + +(test wrap-authorization-allows-authorized-requests + (let* ((permission (make-instance 'permission :operation :get :object "/users")) + (reader (make-instance 'role :name :reader :permissions (list permission))) + (user (make-instance 'user :id "u2" :roles (list reader))) + (session (create-session nil user)) + (request (io.github.cl-sdk.wst.routing:make-request :uri "/users" :method :get)) + (response (io.github.cl-sdk.wst.routing:make-response)) + (middleware (wrap-authorization :policy (require-permission :get "/users")))) + (setf (io.github.cl-sdk.wst.routing:request-data request) + (append (io.github.cl-sdk.wst.routing:request-data request) + (list :session session))) + (let ((result (funcall middleware request response))) + (is (eq :continue (car result))) + (is (eq *decision-allow* (authorization-decision-of request)))))) + +(test wrap-authorization-halts-authenticated-but-forbidden-requests-with-403 + (let* ((reader (make-instance 'role :name :reader)) + (user (make-instance 'user :id "u3" :roles (list reader))) + (session (create-session nil user)) + (request (io.github.cl-sdk.wst.routing:make-request :uri "/users" :method :delete)) + (response (io.github.cl-sdk.wst.routing:make-response)) + (middleware (wrap-authorization :policy (require-permission :delete "/users")))) + (setf (io.github.cl-sdk.wst.routing:request-data request) + (append (io.github.cl-sdk.wst.routing:request-data request) + (list :session session))) + (let ((result (funcall middleware request response))) + (is (eq :halt (car result))) + (is (= 403 (io.github.cl-sdk.wst.routing:response-status (cdr result)))) + (is (eq *decision-deny* (authorization-decision-of request)))))) diff --git a/t/authorization-tests.lisp b/t/authorization-tests.lisp new file mode 100644 index 0000000..914719c --- /dev/null +++ b/t/authorization-tests.lisp @@ -0,0 +1,109 @@ +(defpackage #:io.github.cl-sdk.wst.authorization.test + (:use #:cl #:fiveam #:io.github.cl-sdk.wst.authorization)) + +(in-package #:io.github.cl-sdk.wst.authorization.test) + +(def-suite authorization-suite) +(in-suite authorization-suite) + +(defun account-active-p (context) + (getf context :account-active)) + +(defpolicy can-read-users + (all-of (require-authenticated) + (any-of (require-role :admin) + (require-role :reader)))) + +(defpolicy-set api-policies + :combiner deny-overrides + :policies (list can-read-users + (require-predicate #'account-active-p))) + +(test create-session-manages-active-roles + (let* ((reader (make-instance 'role :name :reader)) + (admin (make-instance 'role :name :admin)) + (user (make-instance 'user :id "u1" :roles (list reader admin))) + (session (create-session nil user :roles (list reader)))) + (is (= 1 (length (active-roles session)))) + (is (eq reader (car (active-roles session)))) + (activate-role nil session admin) + (is (= 2 (length (active-roles session)))) + (deactivate-role nil session reader) + (is (= 1 (length (active-roles session)))) + (is (eq admin (car (active-roles session)))))) + +(test session-authorization-checks-permissions-and-inherited-roles + (let* ((read-users (make-instance 'permission :operation :get :object "/users")) + (write-users (make-instance 'permission :operation :post :object "/users")) + (reader (make-instance 'role :name :reader :permissions (list read-users))) + (admin (make-instance 'role :name :admin + :permissions (list write-users) + :seniors (list reader))) + (user (make-instance 'user :id "u2" :roles (list admin))) + (session (create-session nil user))) + (is-true (session-authorized-p nil session :get "/users")) + (is-true (session-authorized-p nil session :post "/users")) + (is-false (session-authorized-p nil session :delete "/users")))) + +(test primitive-policies-and-combinators-produce-expected-decisions + (let* ((permission (make-instance 'permission :operation :get :object "/users")) + (reader (make-instance 'role :name :reader :permissions (list permission))) + (user (make-instance 'user :id "u3" :roles (list reader))) + (session (create-session nil user)) + (context (list :session session))) + (is (eq *decision-allow* + (evaluate-policy (require-authenticated) context))) + (is (eq *decision-deny* + (evaluate-policy (require-authenticated) nil))) + (is (eq *decision-allow* + (evaluate-policy (require-role :reader) context))) + (is (eq *decision-deny* + (evaluate-policy (require-role :admin) context))) + (is (eq *decision-allow* + (evaluate-policy (require-permission :get "/users") context))) + (is (eq *decision-deny* + (evaluate-policy (require-permission :delete "/users") context))) + (is (eq *decision-allow* + (evaluate-policy (all-of (require-authenticated) + (require-role :reader)) + context))) + (is (eq *decision-deny* + (evaluate-policy (any-of (require-role :admin) + (require-predicate (lambda (_context) + (declare (ignore _context)) + nil))) + context))) + (is (eq *decision-allow* + (evaluate-policy (invert (require-role :admin)) context))) + (is (eq *decision-deny* + (evaluate-policy (deny-overrides + (require-predicate (lambda (_context) + (declare (ignore _context)) + *decision-not-applicable*)) + (require-role :admin)) + context))) + (is (eq *decision-allow* + (evaluate-policy (permit-overrides + (require-role :admin) + (require-role :reader)) + context))) + (is (eq *decision-allow* + (evaluate-policy (first-applicable + (require-predicate (lambda (_context) + (declare (ignore _context)) + *decision-not-applicable*)) + (require-role :reader) + (require-role :admin)) + context))))) + +(test dsl-macros-build-composable-policies + (let* ((reader (make-instance 'role :name :reader)) + (user (make-instance 'user :id "u4" :roles (list reader))) + (session (create-session nil user)) + (context (list :session session :account-active t))) + (is (eq *decision-allow* + (evaluate-policy can-read-users context))) + (is (eq *decision-allow* + (evaluate-policy api-policies context))) + (is (eq *decision-deny* + (evaluate-policy api-policies (list :session session :account-active nil))))))