1:- module(login_database, [
    2          authenticate_user/3,
    3          add_user/3,
    4          current_user/1,
    5          current_user//0,
    6          use_default_db/0,
    7          user_property/2,
    8          set_user_property/2,
    9          assert_user_property/2,
   10          retract_user_property/2,
   11          retractall_user_property/2
   12          ]).   13% TODO document all 'known' properties
   14% eg password_hash, role
   15%
   16:- use_module(library(http/http_session)).   17:- use_module(library(http/html_write)).   18:- use_module(library(identity/login_crypto)).   19:- use_module(library(identity/customize)).   20:- use_module(library(identity/login_email)).   21
   22authenticate_user(UName, Password, ok) :-
   23    user_property(UName, password_hash(Hash)),
   24    password_hash(Password, Hash), % test requires both ground
   25    !.
   26authenticate_user(UName, _, IUOP) :-
   27    local('Invalid user or password', IUOP), % for security, same as next
   28    user_property(UName, _),
   29    !.
   30authenticate_user(_, _, IUOP) :-
   31    local('Invalid user or password', IUOP).
   32
   33% TODO this can fail - probably not handled
   34% % TODO decide - should it throw?
   35% TODO - handle attempt to add user when they exist
   36% gracefully
   37add_user(UName, Password, Email) :-
   38    \+ user_property(UName, _),
   39    password_hash(Password, Hash),
   40    set_user_property(UName, password_hash(Hash)),
   41    set_user_property(UName, email(Email)),
   42    setting(identity:require_activation_email, ActivateEmail),
   43    (   ActivateEmail = true
   44    ->  assert_user_property(UName, role(needs_activation)),
   45        uuid(Key),
   46        assert_user_property(UName, activation_key(Key)),
   47        send_activation_email(UName, Email, Key)
   48    ;   assert_user_property(UName, role(user))
   49    ).
   50
   51current_user(UName) :-
   52    http_session_data(user(UName)).
   53current_user(guest).
   54
   55current_user -->
   56    { current_user(UName) },
   57    html(UName).
   58
   59
   60		 /*******************************
   61		 *            USER DATA		*
   62		 *******************************/
   63
   64:- multifile
   65    user_property_expansion/2,
   66    set_user_property_expansion/2,
   67    assert_user_property_expansion/2,
   68    retract_user_property_expansion/2,
   69    retractall_user_property_expansion/2.   70
   71:- dynamic using_default_db/0.   72
   73:- use_module(library(persistency)).   74
   75:- persistent
   76    u_prop(name:atom, prop:acyclic).
   77
   78use_default_db :-
   79    db_attach('users.db', [sync(flush)]),
   80    asserta(using_default_db).

 user_property(?UName, ?Property) is nondet

True when Property is a property of user. In a real application this should of course be a proper persistent database and passwords should be properly hashed.

   88user_property(UName, Property) :-
   89    user_property_expansion(UName, Property).
   90user_property(UName, Property) :-
   91    using_default_db,
   92    with_mutex(login_database,
   93               bagof(N-P, u_prop(N, P), L)),
   94    member(UName-Property, L).
   95
   96set_user_property(UName, Property) :-
   97    set_user_property_expansion(UName, Property).
   98set_user_property(UName, Property) :-
   99    using_default_db,
  100    Property =.. [PFunctor | Args],
  101    length(Args, Arity),
  102    length(Blanks, Arity),
  103    RetractProperty =.. [PFunctor | Blanks],
  104    with_mutex(login_database,
  105               (   retractall_u_prop(UName, RetractProperty),
  106                   assert_u_prop(UName, Property))).
  107
  108assert_user_property(UName, Property) :-
  109    assert_user_property_expansion(UName, Property).
  110assert_user_property(UName, Property) :-
  111    using_default_db,
  112    with_mutex(login_database,
  113               assert_u_prop(UName, Property)).
  114
  115retract_user_property(UName, Property) :-
  116    retract_user_property_expansion(UName, Property).
  117retract_user_property(UName, Property) :-
  118    using_default_db,
  119    with_mutex(login_database,
  120               retract_u_prop(UName, Property)).
  121
  122retractall_user_property(UName, Property) :-
  123    retractall_user_property_expansion(UName, Property).
  124retractall_user_property(UName, Property) :-
  125    using_default_db,
  126    with_mutex(login_database,
  127               retractall_u_prop(UName, Property))