1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2017, CWI Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(user_profile,
   36	  [ profile_open_db/1,		% +Options
   37
   38	    profile_create/2,		% ?ProfileId, +Attributes
   39	    current_profile/1,		% ?ProfileId
   40	    current_profile/2,		% ?ProfileId, -Attributes
   41	    profile_property/2,		% ?ProfileId, ?Attribute
   42	    set_profile/2,		% +ProfileId, +Property
   43	    set_profile/3,		% +ProfileId, +Property, -Modified
   44	    profile_remove/2,		% +ProfileId, +Property
   45	    profile_remove/1,		% +ProfileId
   46
   47	    profile_add_session/3,	% +ProfileId, +SessionID, +Options
   48	    profile_remove_session/2,	% +ProfileId, +SessionID
   49	    profile_session/2,		% ?ProfileId, ?SessionID
   50	    profile_refresh_session/2,	% +ProfileId, +SessionID
   51
   52	    profile_canonical_value/3	% +Attribute, +Value0, -Value
   53	  ]).   54:- use_module(library(uuid)).   55:- use_module(library(error)).   56:- use_module(library(apply)).   57:- use_module(library(option)).   58:- use_module(library(settings)).   59:- use_module(library(uri)).   60:- use_module(library(lists)).

:- use_module(library(http/user_profile)).
:- use_module(library(http/impl/profile_prolog)).
:- set_setting(user_profile:backend, impl_profile_prolog).

:- multifile
        user_profile:attribute/3.

user_profile:attribute_type(name, string, []).
...

   89:- multifile
   90	attribute/3.			% ?Attribute, ?Type, ?Options
   91
   92:- setting(backend, atom, user_profile_prolog,
   93	   "Backend to use (name of the module").   94:- setting(session_timeout, number, 900,
   95	   "Default timeout for session based logins").   96:- setting(session_persistency, boolean, false,
   97	   "Default session persistency handling").   98
   99
  100		 /*******************************
  101		 *	      DATABASE		*
  102		 *******************************/

 profile_open_db(+Options) is det

Open the profile database. Must be called before any of the other profile API predicates. Options depend on the used backend.

  110profile_open_db(Options) :-
  111	setting(backend, Backend),
  112	Backend:impl_profile_open_db(Options).
  113
  114
  115		 /*******************************
  116		 *	       CREATE		*
  117		 *******************************/

 profile_create(?ProfileID, +Attributes) is det

Create a new user profile with the given initial attributes.

Arguments:

Attributes

- is a list of Name(Value) terms.

  125profile_create(ProfileID, Attributes) :-
  126	instantiate_profile_id(ProfileID),
  127	maplist(typecheck_attribute, Attributes, CanAttributes),
  128	(   current_profile(ProfileID)
  129	->  permission_error(redefine, user_profile, ProfileID)
  130	;   true
  131	),
  132	setting(backend, Backend),
  133	Backend:impl_profile_create(ProfileID, CanAttributes).
  134
  135instantiate_profile_id(ProfileID) :-
  136	var(ProfileID), !,
  137	uuid(ProfileID).
  138instantiate_profile_id(ProfileID) :-
  139	must_be(atom, ProfileID).
  140
  141typecheck_attribute(Term, Canonical) :-
  142	attribute_nv(Term, Name, Value0),
  143	profile_canonical_value(Name, Value0, Value),
  144	Canonical =.. [Name,Value].

 profile_canonical_value(+Attribute, +ValueIn, -Value) is det

True when Value is the canonical value for Attribute that satisfies the type constraint for Attribute.

Errors

- type_error(Type, ValueIn) if the type is wrong

- existence_error(profile_attribute, Attribute) if the attribute is unknown.

  155profile_canonical_value(Name, Value0, Value) :-
  156	(   attribute(Name, Type, _)
  157	->  must_be(ground, Type),
  158	    (   convert_attribute_value(Type, Value0, Value)
  159	    ->	true
  160	    ;	Value = Value0,
  161		must_be(Type, Value)
  162	    )
  163	;   existence_error(profile_attribute, Name)
  164	).

 convert_attribute_value(+Type, +Input, -Value)

True when Value is the result of converting Input to Type.

  170convert_attribute_value(Type, Text, String) :-
  171	string_value(Type),
  172	text(Text), !,
  173	atom_string(Text, String).
  174convert_attribute_value(float, Int, Float) :-
  175	integer(Int),
  176	Float is float(Int).
  177convert_attribute_value(string, ip(A,B,C,D), String) :-
  178	format(string(String), '~w.~w.~w.~w', [A,B,C,D]).
  179convert_attribute_value(oneof(Values), Text, Value) :-
  180	member(Value, Values),
  181	string_value(Text, Value), !.
  182
  183string_value(string).
  184string_value(url).
  185string_value(url(_Scheme)).
  186string_value(email).
  187
  188string_value(Value, Value) :- !.
  189string_value(String, Value) :-
  190	atom(Value),
  191	atom_string(Value, String), !.
  192string_value(String, Value) :-
  193	number(Value),
  194	number_string(String, Value1),
  195	Value1 =:= Value.
  196
  197text(T) :- atom(T), !.
  198text(T) :- string(T), !.
  199
  200attribute_nv(Term, _Name, _Value) :-
  201	var(Term), !,
  202	instantiation_error(Term).
  203attribute_nv(Term, Name, Value) :-
  204	compound(Term),
  205	compound_name_arguments(Term, Name, [Value]), !.
  206attribute_nv(Name = Value, Name, Value) :- !,
  207	must_be(atom, Name).
  208attribute_nv(Name - Value, Name, Value) :- !,
  209	must_be(atom, Name).
  210attribute_nv(Term, _Name, _Value) :-
  211	type_error(name_value, Term).
  212
  213
  214		 /*******************************
  215		 *	       QUERY		*
  216		 *******************************/

 current_profile(?ProfileID) is nondet

True when ProfileID is a currently known user profile.

  222current_profile(ProfileID) :-
  223	setting(backend, Backend),
  224	Backend:impl_current_profile(ProfileID).

 current_profile(?ProfileID, -Attributes:dict) is nondet

True when ProfileID is a currently known user profile with the given attributes.

  231current_profile(ProfileID, Attributes) :-
  232	setting(backend, Backend),
  233	Backend:impl_current_profile(ProfileID, Attributes0),
  234	add_defaults(Attributes0, Attributes).
  235
  236add_defaults(Attributes0, Attributes) :-
  237	findall(Name-Value, default_attribute(Name, Value), Pairs),
  238	Pairs \== [], !,
  239	dict_pairs(Defaults, user_profile, Pairs),
  240	Attributes = Defaults.put(Attributes0).
  241add_defaults(Attributes, Attributes).
  242
  243default_attribute(Name, Value) :-
  244	attribute(Name, _Type, Options),
  245	memberchk(default(Value), Options).

 profile_property(?ProfileID, ?Property:compound) is nondet

True when the user with ProfileID has Property. Property is a term Name(Value).

  253profile_property(ProfileID, Property) :-
  254	nonvar(ProfileID),
  255	nonvar(Property), !,
  256	attribute_nv(Property, Name, Value),
  257	setting(backend, Backend),
  258	(   VarP =.. [Name,Value0],
  259	    Backend:impl_profile_property(ProfileID, VarP)
  260	->  Value = Value0
  261	;   default_attribute(Name, Value)
  262	).
  263profile_property(ProfileID, Property) :-
  264	setting(backend, Backend),
  265	Backend:impl_profile_property(ProfileID, Property).
  266
  267
  268		 /*******************************
  269		 *	       UPDATE		*
  270		 *******************************/

 set_profile(+ProfileID, +Attribute) is det

 set_profile(+ProfileID, +Attribute, -Modified) is det

Set an attribute of the profile.

Arguments:

Attribute	- is a term Name(Value)
Modified	- is unified with a boolean, indicating whether or not the value was modified.

  281set_profile(ProfileID, Attribute) :-
  282	set_profile(ProfileID, Attribute, _).
  283
  284set_profile(ProfileID, Attribute, Modified) :-
  285	must_be(atom, ProfileID),
  286	typecheck_attribute(Attribute, CanAttribute),
  287	setting(backend, Backend),
  288	Backend:impl_set_profile(ProfileID, CanAttribute, Modified).

 profile_remove(+ProfileID) is det

Completely destroy a profile.

  294profile_remove(ProfileID) :-
  295	must_be(atom, ProfileID),
  296	setting(backend, Backend),
  297	Backend:impl_profile_remove(ProfileID).

 profile_remove(+ProfileID, +Attribute) is det

Remove an attribute from a profile.

  303profile_remove(ProfileID, Attribute) :-
  304	must_be(atom, ProfileID),
  305	must_be(atom, Attribute),
  306	setting(backend, Backend),
  307	Backend:impl_profile_remove(ProfileID, Attribute).
  308
  309
  310		 /*******************************
  311		 *	SESSION MANAGEMENT	*
  312		 *******************************/

 profile_add_session(+ProfileID, +SessionID, +Options) is det

Associate a profile with a session (login). Options defined are:

timeout(+Seconds)

Max idle time for the session.

persistent(+Boolean)

If true, store the session association persistently, such that a server restart maintains the login.

  324profile_add_session(ProfileID, SessionID, Options) :-
  325	must_be(atom, ProfileID),
  326	must_be(atom, SessionID),
  327	setting(session_timeout, DefTimeOut),
  328	setting(session_persistency, DefPresistency),
  329	option(timeout(TimeOut), Options, DefTimeOut),
  330	option(persistent(Persistent), Options, DefPresistency),
  331	local_add_session(ProfileID, SessionID,
  332			  [ timeout(TimeOut),
  333			    persistent(Persistent)
  334			  ]).

 profile_refresh_session(+ProfileID, +SessionID) is det

Update the last access time for the indicated session.

  340profile_refresh_session(ProfileID, SessionID) :-
  341	must_be(atom, ProfileID),
  342	must_be(atom, SessionID),
  343	local_refresh_session(ProfileID, SessionID).

 profile_remove_session(+ProfileID, +SessionID) is det

Remove the association of a profile with a session (logout).

  349profile_remove_session(ProfileID, SessionID) :-
  350	must_be(atom, ProfileID),
  351	must_be(atom, SessionID),
  352	local_remove_session(ProfileID, SessionID).

 profile_session(?ProfileID, ?SessionID) is nondet

True when ProfileID is associated (logged in) with SessionID.

  358profile_session(ProfileID, SessionID) :-
  359	local_session(ProfileID, SessionID).
  360
  361
  362		 /*******************************
  363		 *	  LOCAL SESSIONS	*
  364		 *******************************/
  365
  366:- dynamic
  367	tmp_session/3,			% ProfileID, SessionID, DeadLine
  368	session_last_usage/2.		% SessionID, Time
  369:- volatile
  370	tmp_session/3,
  371	session_last_usage/2.  372
  373local_add_session(ProfileID, SessionID, Options) :-
  374	option(persistent(false), Options), !,
  375	option(timeout(Timeout), Options),
  376	get_time(Now),
  377	asserta(tmp_session(ProfileID, SessionID, Timeout)),
  378	asserta(session_last_usage(SessionID, Now)).
  379local_add_session(ProfileID, SessionID, Options) :-
  380	setting(backend, Backend),
  381	Backend:impl_profile_add_session(ProfileID, SessionID, Options).
  382
  383local_refresh_session(ProfileID, SessionID) :-
  384	tmp_session(ProfileID, SessionID, _Timeout), !,
  385	get_time(Now),
  386	retractall(session_last_usage(SessionID, _)),
  387	asserta(session_last_usage(SessionID, Now)).
  388local_refresh_session(ProfileID, SessionID) :-
  389	setting(backend, Backend),
  390	Backend:impl_profile_refresh_session(ProfileID, SessionID).
  391
  392local_remove_session(ProfileID, SessionID) :-
  393	retract(tmp_session(ProfileID, SessionID, _)), !.
  394local_remove_session(ProfileID, SessionID) :-
  395	setting(backend, Backend),
  396	Backend:impl_profile_remove_session(ProfileID, SessionID).
  397
  398local_session(ProfileID, SessionID) :-
  399	var(ProfileID), var(SessionID), !,
  400	(   tmp_session(_, SessionID, _),
  401	    local_session(ProfileID, SessionID)
  402	;   setting(backend, Backend),
  403	    Backend:impl_profile_session(ProfileID, SessionID)
  404	).
  405local_session(ProfileID, SessionID) :-
  406	tmp_session(ProfileID, SessionID, TimeOut), !,
  407	session_last_usage(SessionID, LastUsage),
  408	get_time(Now),
  409	(   LastUsage+TimeOut < Now
  410	->  true
  411	;   retractall(tmp_session(ProfileID, SessionID, _)),
  412	    retractall(session_last_usage(SessionID, _)),
  413	    fail
  414	).
  415local_session(ProfileID, SessionID) :-
  416	setting(backend, Backend),
  417	Backend:impl_profile_session(ProfileID, SessionID).
  418
  419
  420		 /*******************************
  421		 *	      TYPES		*
  422		 *******************************/
  423
  424:- multifile error:has_type/2.

 error:has_type(+Type, +Value) is semidet

True if Value satisfies Type. This implementation extends the type logic defined in library(error) with some types that commonly apply to user profiles.

To be done

- : extend with e.g., zip, country, phone, date

  434error:has_type(url(http), URI) :-
  435	string(URI),
  436	uri_components(URI, Components),
  437	valid_http_scheme(Components),
  438	valid_authority(Components).
  439error:has_type(email, Email) :-
  440	string(Email),
  441	split_string(Email, "@", "", [_,_]).
  442error:has_type(time_stamp(_Format), Stamp) :-
  443	number(Stamp).
  444
  445valid_http_scheme(Components) :-
  446	uri_data(scheme, Components, Scheme),
  447	nonvar(Scheme),
  448	http_scheme(Scheme).
  449
  450http_scheme(http).
  451http_scheme(https).
  452
  453valid_authority(Components) :-
  454	uri_data(authority, Components, Authority),
  455	nonvar(Authority).
  456
  457
  458		 /*******************************
  459		 *	      HOOKS		*
  460		 *******************************/

 attribute(?Attribute, ?Type, ?Options) is nondet

Multifile hook that defines that the profile attribute Attribute must have the type Type. Type are types as defined by must_be/2 from library(error). Options defined are:

access(+Access)

Defines whether or not the user can update the attribute value. Access is one of rw (default) or ro.

hidden(+Boolean)

If true, the attribute is not displayed in the user profile.

default(+Value)

Assumed default if the value is unknown.