1:- module(bc_data_user, [
    2    bc_user_auth/2,         % +Auth, -Info
    3    bc_user_save/3,         % +Actor, +User, -Id
    4    bc_user_save_initial/1, % +User
    5    bc_user_update/2,       % +Actor, +User
    6    bc_user_remove/2,       % +Actor, +Id
    7    bc_user_list/2,         % +Actor, -Users
    8    bc_user/3               % +Actor, +Id, -User
    9]).

Handles the user and authentication data */

   13:- use_module(library(sort_dict)).   14:- use_module(library(docstore)).   15:- use_module(library(sha)).   16
   17:- use_module(bc_user).   18:- use_module(bc_access).   19:- use_module(bc_role).
 bc_user_auth(+Auth, -Info) is det
Authenticates the given user with username and password.
   26bc_user_auth(Auth, Info):-
   27    user_auth(Auth, User),
   28    login_access(User),
   29    Info = _{
   30        id: User.'$id',
   31        type: User.type,
   32        key: User.key },
   33    Username = Auth.username,
   34    debug(bc_data, 'authenticated user ~p', [Username]).
   35
   36login_access(User):-
   37    bc_login_access(User), !.
   38
   39login_access(_):-
   40    throw(error(no_login_access)).
   41
   42% Attempts to identify and authenticate
   43% the user based on supplied credentials.
   44
   45user_auth(Auth, User):-
   46    ds_find(user, username=Auth.username, [User]),
   47    password_hash(Auth.password, User.salt, User.password), !.
   48
   49user_auth(_, _):-
   50    throw(error(invalid_credentials)).
 bc_user_save(+Actor, +User, -Id) is det
Saves the new user.
   56bc_user_save(Actor, User, Id):-
   57    users_access(Actor),
   58    user_save_common(User, Id).
   59
   60users_access(Actor):-
   61    Actor.type = admin, !.
   62
   63users_access(_):-
   64    throw(error(no_access)).
 bc_user_save_initial(+User, -Id) is det
Same as bc_user_save/2 but does not run check against the current user. Used for populating the initial database.
   72bc_user_save_initial(User):-
   73    user_save_common(User, _).
   74
   75% Saves the new user. Used by
   76% wrapper predicates bc_user_save/2 and
   77% bc_user_save_initial/2.
   78
   79user_save_common(User, Id):-
   80    bc_valid_username(User.username),
   81    bc_unique_username(User.username),
   82    bc_valid_role(User.type),
   83    user_hash(User, Hashed),
   84    ds_uuid(Key),
   85    put_dict(key, Hashed, Key, Keyed),
   86    ds_insert(Keyed, Id),
   87    debug(bc_data, 'saved user ~p', [Id]).
 bc_user_update(+Actor, +Id, +User) is det
Updates the given user.
   93bc_user_update(Actor, User):-
   94    Id = User.'$id',
   95    users_access(Actor),
   96    bc_user_exists(Id),
   97    bc_valid_username(User.username),
   98    bc_unique_username(User.username, Id),
   99    bc_valid_role(User.type),
  100    (   User.type = admin
  101    ->  true
  102    ;   bc_remaining_admin(Id)),
  103    user_hash(User, Hashed),
  104    ds_update(Hashed),
  105    debug(bc_data, 'updated user ~p', [Id]).
  106
  107% (Re)hashes the user password when password
  108% is set in the user dict. Replaces the password
  109% in user dict with salted hash. Uses a freshly
  110% generated UUID as salt.
  111
  112user_hash(UserIn, UserOut):-
  113    (   get_dict(password, UserIn, Password)
  114    ->  ds_uuid(Salt),
  115        password_hash(Password, Salt, Hash),
  116        put_dict(_{ password: Hash, salt: Salt }, UserIn, UserOut)
  117    ;   UserOut = UserIn).
 bc_user_list(+Actor, -Sorted) is det
Retrieves the list of users. Retrieved fields are username, fullname and type.
  124bc_user_list(Actor, Sorted):-
  125    users_access(Actor),
  126    ds_all(user, [username, fullname, type], Users),
  127    sort_dict(username, asc, Users, Sorted),
  128    debug(bc_data, 'retrieved the users list', []).
 bc_user(+Actor, +Id, -User) is det
Retrieves the given user.
  134bc_user(Actor, Id, User):-
  135    users_access(Actor),
  136    bc_user_exists(Id),
  137    ds_col_get(user, Id,
  138        [username, fullname, type,
  139        link, comment_notifications], User),
  140    debug(bc_data, 'retrieved the user ~p', [Id]).
 bc_user_remove(+Actor, +Id) is det
Removes the given user.
  146bc_user_remove(Actor, Id):-
  147    users_access(Actor),
  148    bc_user_exists(Id),
  149    bc_remaining_admin(Id),
  150    bc_no_entries(Id),
  151    ds_col_remove(user, Id),
  152    debug(bc_data, 'removed user ~p', [Id]).
  153
  154% Produces hex-formatted hash from
  155% password and salt.
  156
  157password_hash(Password, Salt, Hash):-
  158    atom_concat(Salt, Password, Data),
  159    sha_hash(Data, Raw, [encoding(utf8), algorithm(sha256)]),
  160    hash_atom(Raw, Hash)