;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.wiki)

;;;;;;
;;; Authorization rules

(def authorization/function-call wiki-authorization (&key effective-subject &allow-other-keys)
  (typecase effective-subject
    (null
     (unauthenticated-authorization -form-))
    (wiki-user
     (if (administrator-p effective-subject)
         (administrator-authorization -form-)
         (user-authorization -form-)))))

(def authorization/function-call unauthenticated-authorization (&key class slot &allow-other-keys)
  (case -name-
    (hu.dwim.presentation::inspect-slot-value ; TODO: rename?
     (case (class-name class)
       (login-data/identifier-and-password
        (member (slot-definition-name slot) '(hu.dwim.web-server::identifier hu.dwim.web-server::password)))
       (wiki-page
        (member (slot-definition-name slot) '(content title)))
       (wiki-menu-item
        (member (slot-definition-name slot) '(content)))))
    (hu.dwim.presentation::filter-slot-value ; TODO: rename?
     (and (eq (class-name class) 'wiki-page)
          (member (slot-definition-name slot) '(content title))))
    (make-execute-filter-command
     (eq (class-name class) 'wiki-page))
    ((make-inspector-menu make-filter-menu make-login-command make-content-presentation)
     #t)))

(def authorization/function-call user-authorization (&key class slot value &allow-other-keys)
  (or (unauthenticated-authorization -form-)
      (case -name-
        (hu.dwim.presentation::inspect-slot-value ; TODO: rename?
         (case (class-name class)
           (wiki-page
            (member (slot-definition-name slot) '(referring-menu-items)))
           (wiki-menu-item
            (member (slot-definition-name slot) '(referred-page)))))
        (hu.dwim.presentation::filter-slot-value ; TODO: rename?
         (and (eq (class-name class) 'wiki-menu-item)
              (member (slot-definition-name slot) '(content))))
        (make-switch-to-alternative-command
         (member (class-name class) '(wiki-page wiki-menu-item)))
        ((make-refresh-component-command make-make-new-instance-command
          make-editing-commands make-begin-editing-command make-save-editing-command make-cancel-editing-command)
         (member (class-name class) '(wiki-page wiki-menu-item)))
        (make-execute-filter-command
         (eq (class-name class) 'wiki-menu-item))
        ((make-maker-menu)
         #t)
        (join-editing
         (or (eq (class-name class) 'wiki-page)
             (stringp value)
             (and (typep value 'object-slot-place)
                  (typep (hu.dwim.presentation::instance-of value) 'wiki-page)
                  (member (slot-definition-name (hu.dwim.presentation::slot-of value)) '(content title))))))))

(def authorization/function-call administrator-authorization ()
  #t)