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)).   61
   62/** <module> User Profile Management
   63
   64This module implements  user  profile   management,  in  particular  for
   65managing authentication and authorization for   HTTP  servers. It mainly
   66defines the interface that can be used within an HTTP application.
   67
   68The  actual  storage  is  left  to    a  plugin  providing  the  backend
   69implementation. Backend choices may  depend   on  integration needs with
   70other services, scale of the site  (number of users), distribution, ease
   71of installation.
   72
   73The typical setup sequence is
   74
   75```
   76:- use_module(library(http/user_profile)).
   77:- use_module(library(http/impl/profile_prolog)).
   78:- set_setting(user_profile:backend, impl_profile_prolog).
   79
   80:- multifile
   81	user_profile:attribute/3.
   82
   83user_profile:attribute_type(name, string, []).
   84...
   85
   86```
   87*/
   88
   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		 *******************************/
  103
  104%%	profile_open_db(+Options) is det.
  105%
  106%	Open the profile database. Must  be   called  before  any of the
  107%	other  profile  API  predicates.  Options  depend  on  the  used
  108%	backend.
  109
  110profile_open_db(Options) :-
  111	setting(backend, Backend),
  112	Backend:impl_profile_open_db(Options).
  113
  114
  115		 /*******************************
  116		 *	       CREATE		*
  117		 *******************************/
  118
  119%%	profile_create(?ProfileID, +Attributes) is det.
  120%
  121%	Create a new user profile with the given initial attributes.
  122%
  123%	@arg	Attributes is a list of Name(Value) terms.
  124
  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].
  145
  146%!	profile_canonical_value(+Attribute, +ValueIn, -Value) is det.
  147%
  148%	True when Value is  the  canonical   value  for  Attribute  that
  149%	satisfies the type constraint for Attribute.
  150%
  151%	@error type_error(Type, ValueIn) if the type is wrong
  152%	@error existence_error(profile_attribute, Attribute) if the
  153%	       attribute is unknown.
  154
  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	).
  165
  166%!	convert_attribute_value(+Type, +Input, -Value)
  167%
  168%	True when Value is the result of converting Input to Type.
  169
  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		 *******************************/
  217
  218%%	current_profile(?ProfileID) is nondet.
  219%
  220%	True when ProfileID is a currently known user profile.
  221
  222current_profile(ProfileID) :-
  223	setting(backend, Backend),
  224	Backend:impl_current_profile(ProfileID).
  225
  226%%	current_profile(?ProfileID, -Attributes:dict) is nondet.
  227%
  228%	True when ProfileID is a currently   known user profile with the
  229%	given attributes.
  230
  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).
  246
  247
  248%%	profile_property(?ProfileID, ?Property:compound) is nondet.
  249%
  250%	True when the user with ProfileID   has  Property. Property is a
  251%	term Name(Value).
  252
  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		 *******************************/
  271
  272%%	set_profile(+ProfileID, +Attribute) is det.
  273%%	set_profile(+ProfileID, +Attribute, -Modified) is det.
  274%
  275%	Set an attribute of the profile.
  276%
  277%	@arg Attribute is a term Name(Value)
  278%	@arg Modified is unified with a boolean, indicating whether
  279%	     or not the value was modified.
  280
  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).
  289
  290%%	profile_remove(+ProfileID) is det.
  291%
  292%	Completely destroy a profile.
  293
  294profile_remove(ProfileID) :-
  295	must_be(atom, ProfileID),
  296	setting(backend, Backend),
  297	Backend:impl_profile_remove(ProfileID).
  298
  299%%	profile_remove(+ProfileID, +Attribute) is det.
  300%
  301%	Remove an attribute from a profile.
  302
  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		 *******************************/
  313
  314%%	profile_add_session(+ProfileID, +SessionID, +Options) is det.
  315%
  316%	Associate a profile with a session (login). Options defined are:
  317%
  318%	  - timeout(+Seconds)
  319%	  Max idle time for the session.
  320%	  - persistent(+Boolean)
  321%	  If `true`, store the session association persistently, such
  322%	  that a server restart maintains the login.
  323
  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			  ]).
  335
  336%%	profile_refresh_session(+ProfileID, +SessionID) is det.
  337%
  338%	Update the last access time for the indicated session.
  339
  340profile_refresh_session(ProfileID, SessionID) :-
  341	must_be(atom, ProfileID),
  342	must_be(atom, SessionID),
  343	local_refresh_session(ProfileID, SessionID).
  344
  345%%	profile_remove_session(+ProfileID, +SessionID) is det.
  346%
  347%	Remove the association of a profile with a session (logout).
  348
  349profile_remove_session(ProfileID, SessionID) :-
  350	must_be(atom, ProfileID),
  351	must_be(atom, SessionID),
  352	local_remove_session(ProfileID, SessionID).
  353
  354%%	profile_session(?ProfileID, ?SessionID) is nondet.
  355%
  356%	True when ProfileID is associated (logged in) with SessionID.
  357
  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.  425
  426%!	error:has_type(+Type, +Value) is semidet.
  427%
  428%	True if Value satisfies Type.   This  implementation extends the
  429%	type logic defined  in  library(error)   with  some  types  that
  430%	commonly apply to user profiles.
  431%
  432%	@tbd: extend with e.g., zip, country, phone, date
  433
  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		 *******************************/
  461
  462%%	attribute(?Attribute, ?Type, ?Options) is nondet.
  463%
  464%	Multifile hook that defines that the profile attribute Attribute
  465%	must have the type Type. Type are  types as defined by must_be/2
  466%	from library(error).  Options defined are:
  467%
  468%	  - access(+Access)
  469%	  Defines whether or not the user can update the attribute
  470%	  value. Access is one of `rw` (default) or `ro`.
  471%	  - hidden(+Boolean)
  472%	  If `true`, the attribute is not displayed in the user
  473%	  profile.
  474%	  - default(+Value)
  475%	  Assumed default if the value is unknown.