1:- module(bc_access, [
    2    bc_read_access_id/2,      % +Actor, +Id
    3    bc_read_access_entry/2,   % +Actor, +Entry
    4    bc_remove_access_id/2,    % +Actor, +Id
    5    bc_remove_access_entry/2, % +Actor, +Entry
    6    bc_update_access_id/2,    % +Actor, +Id
    7    bc_create_access_type/2,  % +Actor, +Type
    8    bc_files_access_id/2,     % +Actor, +Id
    9    bc_publish_access_id/2,   % +Actor, +Id
   10    bc_login_access/1         % +Actor
   11]).   12
   13:- use_module(library(error)).   14:- use_module(bc_type).   15:- use_module(bc_role).   16:- use_module(bc_entry).   17
   18% Succeeds when the Actor has
   19% read access to the entry.
   20
   21bc_read_access_entry(Actor, _):-
   22    Actor.type = admin, !.
   23
   24bc_read_access_entry(Actor, Entry):-
   25    bc_type_actor_grants(Entry.type, Actor, Grants),
   26    (   member(read_any, Grants)
   27    ;   member(read_own, Grants),
   28        Actor.'$id' = Entry.author), !.
   29
   30% Succeeds when the Actor has
   31% read access to the entry id.
   32
   33bc_read_access_id(Actor, _):-
   34    Actor.type = admin, !.
   35
   36bc_read_access_id(Actor, Id):-
   37    bc_entry_type(Id, Type),
   38    bc_type_actor_grants(Type, Actor, Grants),
   39    (   member(read_any, Grants)
   40    ;   member(read_own, Grants),
   41        bc_entry_author(Id, AuthorId),
   42        Actor.'$id' = AuthorId), !.
   43
   44% Succeeds when the Actor has
   45% remove access to the entry.
   46
   47bc_remove_access_id(Actor, _):-
   48    Actor.type = admin, !.
   49
   50bc_remove_access_id(Actor, Id):-
   51    bc_entry_type(Id, Type),
   52    bc_type_actor_grants(Type, Actor, Grants),
   53    (   member(remove_any, Grants)
   54    ;   member(remove_own, Grants),
   55        bc_entry_author(Id, AuthorId),
   56        Actor.'$id' = AuthorId), !.
   57
   58% Succeeds when the Actor has
   59% remove access to the entry.
   60
   61bc_remove_access_entry(Actor, _):-
   62    Actor.type = admin, !.
   63
   64bc_remove_access_entry(Actor, Entry):-
   65    bc_type_actor_grants(Entry.type, Actor, Grants),
   66    (   member(remove_any, Grants)
   67    ;   member(remove_own, Grants),
   68        Actor.'$id' = Entry.author), !.
   69
   70% Succeeds when the Actor has
   71% update access to the entry.
   72
   73bc_update_access_id(Actor, _):-
   74    Actor.type = admin, !.
   75
   76bc_update_access_id(Actor, Id):-
   77    bc_entry_type(Id, Type),
   78    bc_type_actor_grants(Type, Actor, Grants),
   79    (   member(update_any, Grants)
   80    ;   member(update_own, Grants),
   81        bc_entry_author(Id, AuthorId),
   82        Actor.'$id' = AuthorId), !.
   83
   84% Succeeds when the Actor has
   85% create acess to the entry type.
   86
   87bc_create_access_type(Actor, _):-
   88    Actor.type = admin, !.
   89
   90bc_create_access_type(Actor, Type):-
   91    bc_type_actor_grants(Type, Actor, Grants),
   92    memberchk(create, Grants).
   93
   94% Succeeds when the Actor has
   95% files acess to the entry.
   96
   97bc_files_access_id(Actor, _):-
   98    Actor.type = admin, !.
   99
  100bc_files_access_id(Actor, Id):-
  101    bc_entry_type(Id, Type),
  102    bc_type_actor_grants(Type, Actor, Grants),
  103    memberchk(files, Grants).
  104
  105% Succeeds when the Actor has
  106% publish access to the entry.
  107
  108bc_publish_access_id(Actor, _):-
  109    Actor.type = admin, !.
  110
  111bc_publish_access_id(Actor, Id):-
  112    bc_entry_type(Id, Type),
  113    bc_type_actor_grants(Type, Actor, Grants),
  114    bc_entry_author(Id, AuthorId),
  115    (   member(publish_any, Grants)
  116    ;   member(publish_own, Grants),
  117        Actor.'$id' = AuthorId), !.
  118
  119% Succeeds if the user has
  120% login access.
  121
  122bc_login_access(Actor):-
  123    bc_role(Actor.type, _, true).
  124
  125% Finds actor permissions for
  126% the given type. Fails when no
  127% permissions are granted for the
  128% actor.
  129
  130bc_type_actor_grants(Type, Actor, Grants):-
  131    bc_type(Type, _, _, Roles, _),
  132    member(Role, Roles),
  133    Role =.. [Name|Grants],
  134    Actor.type = Name, !