1:- module(identity, [
    2          ]).

identity - pack to manage user identities on the SWI-Prolog web framework.

this pack depends on OpenSSL1.1.0 or greater /

    9:- use_module(library(http/http_dispatch)).   10:- use_module(library(http/html_write)).   11:- use_module(library(http/http_session)).   12
   13:- multifile http:location/3.   14:- dynamic   http:location/3.   15
   16http:location(login, root(login), [priority(-100)]).
   17
   18:- ensure_loaded(library(identity/customize)).   19:- ensure_loaded(library(identity/login_page)).   20:- ensure_loaded(library(identity/logout)).   21:- ensure_loaded(library(identity/login_email)).   22:- use_module(library(identity/login_database), [user_property/2]).   23:- ensure_loaded(library(identity/login_forgot)).   24
   25		 /*******************************
   26		 *            EXPAND		*
   27		 *******************************/
   28
   29% order is important, need user field in second
   30:- http_request_expansion(user_expand, 100).   31:- http_request_expansion(role_based_authorization_expand, 200).
 user_expand(+Request0, -Request, +Options) is semidet
HTTP request rewriter that figures out whether someone is logged in. using this technique we can use different techniques to establish the logged in status.

If the user is logged in, we add user(User) to the request

   41user_expand(Request0, Request, _Options) :-
   42    http_in_session(_),
   43    http_session_data(user(User)),
   44    Request = [user(User)|Request0].
 role_based_authorization_expand(+Request0, -Request, +Options) is semidet
Establish whether the user may proceed if the handler options contain a term role(Role). Acts as follows:
  1. If the user is logged in
    • If the user has the desired role, succeed.
    • Otherwise indicate the user is not authorized. The 3rd argument of the http_reply exception provides arbitrary context for the error page.
  2. Otherwise redirect to the login page
   59role_based_authorization_expand(Request, Request, Options) :-
   60    memberchk(role(Role), Options),
   61    (   memberchk(user(User), Request)
   62    ->  (   user_property(User, role(Role))
   63        ->  true
   64        ->  user_property(User, role(needs_activation)),
   65            memberchk(path(Path), Request),
   66            throw(http_reply(forbidden(Path), [], [needs_activation(User)]))
   67        ;   memberchk(path(Path), Request),
   68            throw(http_reply(forbidden(Path), [], [no_role(User, Role)]))
   69        )
   70    ;   memberchk(request_uri(Return), Request),
   71        local('The requested location requires login', Reason),
   72        http_link_to_id(login_form,
   73                        [ reason(Reason),
   74                          return_to(Return)
   75                        ], HREF),
   76        http_redirect(see_other, HREF, Request)
   77    ).
   78
   79
   80		 /*******************************
   81		 *            ERROR		*
   82		 *******************************/
   83
   84:- multifile
   85    http:status_page/3.   86
   87% TODO add activation page
   88%
   89%!  http:status_page(+Term, +Context, -HTML)
   90%
   91%   Provide a custom error page for the forbidden action.
   92
   93http:status_page(forbidden(Path), Context, HTML) :-
   94    phrase(page([ title(\local('Access denied'))
   95                ],
   96                [ h1(\local('Access denied')),
   97                  p([\local('You do not have sufficient privileges to access '),
   98                     Path]),
   99                  \forbidden_reason(Context)
  100                ]),
  101           HTML).
  102
  103forbidden_reason(Context) -->
  104    { memberchk(no_role(User, Role), Context) },
  105html(p(\local('The user ~p does not have role ~p'-[User,Role]))).
  106forbidden_reason(Context) -->
  107    { memberchk(needs_activation(User), Context) },
  108html([p(\local('The user ~p needs to activate their account'-[User])),
  109     a(href(location_by_id(login(resend/User))), \local('Resend activation email'))]).
  110
  111
  112
  113% TODO Let Jan know - throwing is awkward for making links that
  114% are disabled/invisible if the user can't access them.
  115% (not really Jan's problem)
  116%
  117%  TODO check that this can be overridden
  118%
  119% TODO move ERROR section to it's own module and update README.md
  120%
  121% TODO make rest endpoints work, or at least test that they do
  122% make sure pengines work