1% Things that need to be defined in the user module, so Swish finds them
    2% To start clout as daemon:
    3% sudo swipl user_module_file.pl ../../swish/daemon.pl --port=80 --no-fork --user=www-data --workers=16
    4% To start as local server:
    5% swipl -l user_module_file.pl -l ../../swish/server.pl -g server:server
    6
    7:- multifile sandbox:safe_primitive/1.    8 
    9% For debugging:
   10% sandbox:safe_primitive(swish_highlight:server_tokens(_)).  % swish_highlight:server_tokens(source).
   11% sandbox:safe_primitive(swish_highlight:show_mirror(_)).
   12% can not print output as usual, would interfere with http responses; uncomment the following for a log:
   13
   14
   15:- open('mylog.txt',write,S), assert(mylogFile(S)).   16mylog(M) :- mylogFile(S), thread_self(T), writeln(S,T:M), flush_output(S).
   17% :- asserta((prolog:message(A,B,C) :-  mylog(message-A), fail)).
   18sandbox:safe_primitive(user:mylog(_M)). 
   19
   20:- use_module(library(settings)).   21%:- use_module(library(http/http_log)). % uncomment to produce httpd.log
   22%:- set_setting_default(http:logfile, 'data/httpd.log'). % swish's writable sub directory
   23
   24:- multifile swish_config:config/2.   25swish_config:config(show_beware,true).
   26swish_config:config(community_examples,false).
   27% don't see the point: swish_config:config(public_access,true). % HACK here
   28swish_config:config(chat,false).
   29% Forcing SWISH to accept both of the following as legitimate; 
   30% only the first will get to the Javascript side, I think... but no harm done (apparently):
   31swish_config:config(include_alias,	example).
   32swish_config:config(include_alias,	system).
   33% the above facts must come before this...:
   34:- use_module('../../swish/swish').   35
   36:- use_module(swish(lib/render)).   37:- use_module(library(http/http_dispatch)).   38:- use_module(swish(lib/plugin/login)).   39:- use_module(swish(lib/authenticate)).   40:- use_module(library(settings)).   41
   42% LPS visualizations will appear courtesy of either of two SWISH answer renderers:
   43:- use_module(lps_2d_renderer,[]). % need not and can not import the rendering predicate into here
   44:- use_module(lps_timeline_renderer,[]).   45:- multifile user:'swish renderer'/2. % to avoid SWISH warnings in other files
   46:- use_rendering(lps_2d). % this will be the preferred... if available for the current visualization
   47:- use_rendering(lps_timeline).   48:- use_rendering(graphviz). % for state/transition diagrams
   49
   50:- multifile pengines:prepare_module/3.   51pengines:prepare_module(_Module, swish, _Options) :- 
   52	style_check(-discontiguous), style_check(-singleton).
   53
   54% If you consider refactoring this out to somewhere else: somehow these must be after use_module('../../swish/swish'):
   55:- use_module('../utils/visualizer.P'). % this loads LPS
   56:- use_module('../utils/psyntax.P',[
   57	syntax2p/4,dumploaded/2,term_colours/2,may_clear_hints/0,timeless_ref/1,set_top_term/1
   58	]).   59:- use_module('../utils/states_explorer.pl',[explore/2]).   60:- use_module('../utils/redisclient.pl').   61:- use_module('../utils/explanator').   62
   63
   64% This will be useful below, as file searching handling of relative paths differs from what's used
   65% by use_module and friends.
   66user:file_search_path(lps_engine_dir,D) :- interpreter:lps_engine_directory(D).
   67
   68sandbox:safe_primitive(interpreter:go(_File,Options)) :- \+ member(cycle_hook(_,_,_),Options).
   69sandbox:safe_primitive(interpreter:go). 
   70sandbox:safe_primitive(interpreter:lps_welcome_message). 
   71sandbox:safe_primitive(visualizer:gojson(_JSON)). 
   72sandbox:safe_primitive(visualizer:gojson(_File,_Options,_Results,_JSON,_DFAgraph)). 
   73sandbox:safe_primitive(psyntax:dumploaded(_,_)). 
   74sandbox:safe_primitive(psyntax:dumpjs(_,_)). 
   75sandbox:safe_primitive(states_explorer:explore(_,Options)) :- \+ member(cycle_hook(_,_,_),Options).
   76% TODO: make these depend on user autherntication:
   77sandbox:safe_primitive(redisclient:create(_,_,_)).
   78sandbox:safe_primitive(redisclient:create(_,_)).
   79sandbox:safe_primitive(redisclient:get_key(_,_)).
   80sandbox:safe_primitive(redisclient:set_key(_,_)).
   81sandbox:safe_primitive(redisclient:get_keys(_)).
   82sandbox:safe_primitive(redisclient:get_channels(_)).
   83sandbox:safe_primitive(redisclient:kill_all).
   84
   85/*
   86The following could be used to prevent pengines (remote goal) access... but bear in mind that swish (user) browsers communicate directly
   87to the server, so their IPs would have to be allowed. I guess full authentication is needed to prevent remote pengines usage.
   88:- initialization(( gethostname(H), tcp_host_to_address(H,ip(A,B,C,D)), format(atom(IP),'~w.~w.~w.~w',[A,B,C,D]), set_setting(pengines:allow_from, ['127.0.0.1',IP]))) .
   89*/
   90
   91% We'll fill this information at the beginning of each web request; can't use a thread_local fact because 
   92% SWISH uses more than one thread handling the HTTP request; so we just store it in user, the SWISH transient module
   93:- dynamic transaction_lps_user/2. % User unique id, e.g. Google's sub; and email
   94
   95% Access the user authenticated in the current web request
   96lps_user(User) :- lps_user(User,_).
   97
   98lps_user(User,Email) :- transaction_lps_user(User,Email), !.
   99lps_user(unknown_user,unknown_email).
  100
  101% hack SWISH's http authentication hook in lib/authenticate.pl to maintain the above:
  102:- dynamic(pengines:authentication_hook/3). % Needed for SWI Prolog 8.x
  103:- asserta((pengines:authentication_hook(Request, _Application, User) :- !,
  104    authenticate(Request, User), update_user(Request,User))).  105%TODO: try instead http_current_request(Request) ??
  106
  107update_user(Request,_User) :- 
  108	retractall(transaction_lps_user(_,_)), % hacky retract, good for all clauses...
  109	catch( (current_user_info(Request, Info), assert(transaction_lps_user(Info.sub,Info.email))), _Ex, fail), 
  110	!.
  111% the above clause may be dumb (or not...) because perhaps the following suffices... TODO: clean up this.
  112update_user(_Request,User) :- 
  113		catch(user_property(User,email(Email)),_,fail),
  114		!,
  115		assert(transaction_lps_user(User.identity,Email)).   % local (e.g. HTTP-authenticated) account
  116update_user(_Request,_User) :- 
  117	assert(transaction_lps_user(unknown_user,unknown_email)).
  118
  119% patch SWISH so that "local" (HTTP authenticated users) are kept sandboxed:
  120:- dynamic(swish_pep:approve/2). % Needed for SWI Prolog 8.x. 
  121:- asserta((
  122	swish_pep:approve(run(any, _), Auth) :- user_property(Auth, login(local)), !, fail
  123	)).  124
  125
  126:- multifile prolog_colour:term_colours/2, prolog_colour:goal_colours/2.  127% Wire our colouring logic into SWI's:
  128prolog_colour:term_colours(T,C) :- term_colours(T,C).
  129
  130:- multifile swish_highlight:style/3.  131% style(Spec_as_in_specified_item, Type_as_in_prolog_server.js/prolog.css, ? )
  132swish_highlight:style(lps_delimiter,lps_delimiter,[text,base(atom)]).
  133swish_highlight:style(fluent,fluent,[text,base(atom)]).
  134swish_highlight:style(event,event,[text,base(atom)]).
  135swish_highlight:style(action,action,[text,base(atom)]).
  136swish_highlight:style(time,time,[text,base(atom)]). % atom?
  137
  138% :- use_module('../engine/db.P',[head_hint/3]).
  139
  140% HACK colouring of Prolog clause heads when they're referred only by LPS clauses
  141:- dynamic(swish_highlight:style/3). % Needed in SWI Prolog 8.1.1... who knows for how long this will be admissible ;-)
  142:- asserta((swish_highlight:style(head(unreferenced, Head), Type, Attributes) :-
  143	nonvar(Head),
  144	functor(Head,F,N), 
  145	timeless_ref(F/N),
  146	% TODO: somehow this is not working, may be a thread context issue; 
  147	% would be nice to color external fluent and event definitions properly:
  148	% functor(HH,F,N), db:head_hint(HH,Type,_),
  149	!, % Head is referred as timeless, so it's not really unreferenced:
  150	swish_highlight:style(head(head, Head), Type, Attributes) )).  151
  152% hack to make the SWISH editor not consider this as undefined.
  153% future LPS system predicates depending on the execution state probably will need to be added here
  154real_time_beginning(B) :- interpreter:real_time_beginning(B).
  155
  156/* This might work for XPCE... different style attributes
  157% used Mac Digital Color Meter to pick visjs timeline colours:
  158prolog_colour:style(fluent,[colour('#1A1A1A'), background('#D5DD28')]). 
  159prolog_colour:style(event,[colour('#FDA428'), background('#FFFFFF')]). 
  160prolog_colour:style(time,S) :- prolog_colour:style(event,S).
  161prolog_colour:style(lps_delimiter,[bold(true)]) :- mylog(lps_delimiter). */
  162
  163dump :- psyntax:dumploaded(false,lps2p).
  164dumplps :- psyntax:dumploaded(true,lps2p).
  165
  166dumpjs :- psyntax:dumpjs(_,[swish,dc]).
  167
  168go(T,Options) :- \+ member(cycle_hook(_,_,_),Options), \+ member(background(_),Options), 
  169	(catch(lps_server_UI:lps_user_is_super,_,fail) -> true ; \+ member(timeout(_),Options)), 
  170		% TODO: refactor lps_user_is_super into this file?
  171	visualizer:gojson(_File,[dc,silent|Options],[],T,_DFAgraph).
  172godc(T) :- go(T,[]).
  173go(T) :- godc(T).
  174go :- interpreter:lps_welcome_message, writeln('Using dc:'),interpreter:go(_,[swish,dc]).
  175gov :- interpreter:lps_welcome_message, writeln('Using dc:'),interpreter:go(_,[swish,verbose,dc]).
  176
  177godfa(DFAgraph,Options_) :- 
  178	(is_list(Options_)->Options=Options_;Options_==true->Options=[abstract_numbers]; Options=[]),
  179	% check:
  180	visualization_options(SD),
  181	( forall(member(O,Options),member(O,SD)) -> true
  182		; throw(bad_visualization_options(Options))),
  183	visualizer:gojson(_File,[dc,silent|Options],[],_T,DFAgraph).
  184
  185godfa(G) :- godfa(G,[]).
  186
  187state_diagram(DFAgraph,AN) :- godfa(DFAgraph,AN).
  188state_diagram(DFAgraph) :- state_diagram(DFAgraph,[]).
  189
  190sd(G,AN) :- state_diagram(G,AN).
  191sd(G) :- sd(G,[]).
  192
  193explore :- explore(_,[abstract_numbers,swish,dc,phb_limit(0.05)]).
  194explore_numbers :- explore(_,[swish,dc,phb_limit(0.05)]).
  195	
  196:- multifile user:file_search_path/2.  197user:file_search_path(profile, lps_engine_dir('../swish/profiles')).
  198user:file_search_path(lps_resources, lps_engine_dir('../swish/web')).
  199user:file_search_path(swish_help, lps_resources(help)).
  200
  201% PATCH to swish to avoid duplicate example and help menu and profile entries on Linux
  202% list_without_duplicates(+L,-NL) 
  203% Remove duplicates from list L, but keeping first occurrences in their original order
  204list_without_duplicates([X|L],[X|NL]) :- remove_all(L,X,LL), !, list_without_duplicates(LL,NL).
  205list_without_duplicates([],[]).
  206remove_all(L,T,NL) :- select(T,L,LL), !, remove_all(LL,T,NL).
  207remove_all(L,_,L).
  208
  209:- dynamic(swish_help:help_files/1). % Needed in SWI Prolog 8.1.1... who knows for how long this will be admissible ;-)
  210:- asserta((
  211swish_help:help_files(AllExamples) :-
  212	findall(Index,
  213		absolute_file_name(swish_help(.), Index,
  214				   [ access(read),
  215				     file_type(directory),
  216				     file_errors(fail),
  217				     solutions(all)
  218				   ]),
  219		ExDirs_), 
  220	list_without_duplicates(ExDirs_,ExDirs), % patch
  221	maplist(swish_help:index_json, ExDirs, JSON),
  222	append(JSON, AllExamples),
  223	!
  224)).  225:- dynamic(swish_examples:swish_examples_no_cache/1). % Needed in SWI Prolog 8.1.1... who knows for how long this will be admissible ;-)
  226:- asserta((
  227	swish_examples:swish_examples_no_cache(SWISHExamples) :-
  228		http_absolute_location(swish(example), HREF, []),
  229		findall(Index,
  230			absolute_file_name(example(.), Index,
  231					   [ access(read),
  232						 file_type(directory),
  233						 file_errors(fail),
  234						 solutions(all)
  235					   ]),
  236			ExDirs_),
  237		list_without_duplicates(ExDirs_,ExDirs), % patch..
  238		maplist(swish_examples:index_json(HREF), ExDirs, SWISHExamples)
  239)).  240	
  241/* Somehow this is NOT working:
  242:- dynamic(swish_config:config/2). % Needed in SWI Prolog 8.1.1... who knows for how long this will be admissible ;-)
  243:- asserta((
  244swish_config:config(What, Profiles) :-
  245	What==profiles, !,  % hack to allow swish_config_dict/2 to... not lose config items;-)
  246	findall(Profile, swish_profiles:swish_profile(Profile), Profiles0_),
  247	list_without_duplicates(Profiles0_,Profiles0), % patch..
  248	sort(value, =<, Profiles0, Profiles1),
  249	swish_profiles:join_profiles(Profiles1, Profiles)
  250)).
  251:- asserta((
  252swish_config:config(What, A) :- 
  253	What==include_alias, !, % hack to allow swish_config_dict/2 to... not lose config items;-)
  254	once((A=example;A=system))
  255)).
  256*/
  257
  258
  259:- http_handler('/lps', serve_lps_resources, [prefix]). 
  260serve_lps_resources(Request) :- % http://localhost:3050/lps/foo/Gruntfile.js working :-)
  261		option(path(Info), Request),  
  262        http_reply_file(lps_resources(Info), [], Request).
  263
  264% hack SWISH to inject our CSS and Google Analytics fragment...
  265:- use_module(swish(lib/page)).  266:- use_module(library(http/html_write)).  267:- use_module(library(http/http_path)).  268
  269% The Google Analytics key file must be placed in the SWISH data directory:
  270:- catch(read_file_to_string('data/googleAnalyticsKey',Key,[]),_,Key=''), 
  271	format(atom(JS),'
  272  (function(i,s,o,g,r,a,m){i[\'GoogleAnalyticsObject\']=r;i[r]=i[r]||function(){
  273  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
  274  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
  275  })(window,document,\'script\',\'https://www.google-analytics.com/analytics.js\',\'ga\');
  276
  277  ga(\'create\', \'~w\', \'auto\');
  278  ga(\'send\', \'pageview\');
  279',[Key]), assert(google_analytics_script(JS)).  280
  281:- multifile swish_config:reply_page/1. % redefine SWISH's page maker:
  282swish_config:reply_page(Options) :- 
  283	reply_html_page(
  284	    swish(main),
  285	    \(swish_page:swish_title(Options)),
  286	    \my_swish_page(Options)).
  287
  288
  289:- multifile user:forbidden_url/1.  290forbidden_url(_) :- fail. % all URLs allowed by default
  291% Example:
  292% forbidden_url('/example/ISDAlabIntro.swinb') :- lps_user(unknown_user).
  293% forbidden_url('/example/bankTransfer.pl') :- lps_user(unknown_user).
  294
  295
  296my_swish_page(Options) -->
  297	{
  298		% mylog(my_swish_page_options/Options), 
  299		((option(url(URL),Options), forbidden_url(URL)) ->
  300			throw(no_permission_for(URL))
  301			; true)
  302	},
  303	my_swish_navbar(Options),
  304	swish_content(Options). % no need to inject resources here again... is there??
  305
  306my_swish_navbar(Options) -->
  307	my_swish_resources, % this may have to move to after the next call's inhards...
  308	swish_navbar(Options).
  309	
  310my_swish_resources -->
  311	{findall(R,extra_swish_resource(R),Resources)},
  312	html_post_resources(Resources).
  313
  314html_post_resources([R|Resources]) --> {!}, html_post(head, R), html_post_resources(Resources).
  315html_post_resources([]) --> {true}.
  316
  317:- multifile user:extra_swish_resource/1. % declare a link or script resource to include in the SWISH page
  318extra_swish_resource(link([ type('text/css'),rel('stylesheet'),href('/lps/lps.css') ])).
  319extra_swish_resource(script(JS)) :- google_analytics_script(JS).
  320
  321
  322% Stubs for system actions
  323% Redundancy here with db.P:
  324lps_ask(A,B,C) :- interpreter:lps_ask(A,B,C).
  325lps_ask(A,B) :- interpreter:lps_ask(A,B).
  326lps_outcome(A,B) :- interpreter:lps_outcome(A,B).
  327
  328% WARNING: these hacky primitives may led to subtle bugs, as the asserted predicates will be 
  329%  interpreted by the engine as "timeless" in fact
  330uassert(X) :- interpreter:uassert(X).
  331uasserta(X) :- interpreter:uasserta(X).
  332uassertz(X) :- interpreter:uassertz(X).
  333uretract(X) :- interpreter:uretract(X).
  334uretractall(X) :- interpreter:uretractall(X).
  335
  336sandbox:safe_primitive(interpreter:lps_ask(_A,_B,_C)). 
  337sandbox:safe_primitive(interpreter:lps_ask(_A,_B)). 
  338sandbox:safe_primitive(interpreter:lps_outcome(_A,_B)). 
  339sandbox:safe_primitive(interpreter:system_fluent(_)). 
  340sandbox:safe_primitive(interpreter:uassert(_)). 
  341sandbox:safe_primitive(interpreter:uasserta(_)). 
  342sandbox:safe_primitive(interpreter:uassertz(_)). 
  343sandbox:safe_primitive(interpreter:uretract(_)). 
  344sandbox:safe_primitive(interpreter:uretractall(_)). 

 system_fluent(Fluent) is det

system_fluent(+Fluent) Tests whether a given fluent is defined by the system (not declared by the user). */

  352system_fluent(Fl) :- interpreter:system_fluent(Fl)