%
% AKT-Bus service library
%
:- module(absl,[compose_message/4,		%compose a message
		send_message/1,			%send a composed message
		get_receiver_uri/2,		%get receiver's URI from message
		receive_message/2,		%receive a message from a port
		xml_to_terms/2,			%access to Pillow's XML-term conversion predicate
		get_env_attrib_value/3,		%get the attribs & value of a specific environment
		print_string/1
		]
		).
:- ['prolog/util/prolog_detect'].		%load the Prolog-detecting module
:- ['prolog/pillow/pillow'].			%use Pillow's HTTP/XML stuff
:- ['prolog/socket_lib/a_sockets'].		%use Aberdeen's socket lib
:- ['prolog/util/flatten'].			%use the flatten module
:- prolog_detect:prolog(Prolog),
	(	(	Prolog=sicstus,			%SICStus & PFDM (SICStus Version 3.7.x)
			use_module(library(lists))	%need to load the lists module
		);
		(	Prolog=pfdm,
			use_module(library(lists))
		);
		true					%SWI & ECLiPSe are fine
	).

crlf([13,10]).				%the CR-LF string according to HTTP


%
% compose a message, system will fill in date & time stamps
%
% compose_message(+Sender,+Receiver,+Content,-Rdf_msg)
%
% Sender	=	sender's URI (currently HTTP only)
% Receiver	=	receiver's URi
% Content	=	content to be put into message
% Rdf_msg	=	the composed message
%

compose_message(Sender,Receiver,Content,Rdf_msg) :-
	compose_message(Sender,Receiver,_,_,Content,Rdf_msg).

%
% compose a message, providing date & time stamps
%
% compose_message(+Sender,+Receiver,?Date,?Time,+Content,-Rdf_msg)
%
% Sender	=	sender's URI (currently HTTP only)
% Receiver	=	receiver's URi
% Date		=	date (if instantiated) in date/3 format
% Time		=	time (if instantiated) in time/3 format
% Content	=	content to be put into message
% Rdf_msg	=	the composed message
%

compose_message(Sender,Receiver,Date,Time,Content,Rdf_msg) :-
	my_http_url(url(_,_,_),Sender,[]),					%parse & make sure that they're valid URLs
	my_http_url(url(_,_,_),Receiver,[]),					%
	make_date_time_string(Date,Time,Date_string,Time_string),	%fill in date & time
	Rdf_msg=[Xml_header,Rdf_body],					%the message in RDF
	Xml_header=xmldecl([version="1.0"]),    			%XML version in header
	Rdf_body=env('rdf:RDF',Name_space_def_attribs,[Container]),
	Name_space_def_attribs=
		[	'xmlns:rdf'="http://www.w3.org/1999/02/22-rdf-syntax-ns#",
			'xmlns:rdfs'="http://www.w3.org/2000/01/rdf-schema#",
			'xmlns:aktbus'="http://www.csd.abdn.ac.uk/~khui/akt/aktbus.xml#",
			'xmlns:kraft'="http://www.csd.abdn.ac.uk/kraft/arch#"
		],
	Container=env('aktbus:Container',Msg_id_attrib,[Has_header,Has_content]),
%	Msg_id_attrib=['aktbus:id'="http://akt.csd.abdn.ac.uk/akt/agent/me/whatever-id"],
	flatten([Sender,"/",Date_string,"/",Time_string,"/prolog-something"],Msg_id_string),
	Msg_id_attrib=['aktbus:id'=Msg_id_string],
	Has_header=env('aktbus:hasSimpleHeader',[],Simple_header),
	Simple_header=env('aktbus:SimpleHeader',[],[Has_sender_uri,Has_receiver_uri,Has_date,Has_time]),
	Has_sender_uri=env('aktbus:hasSenderURI',[],Sender),		%sender's URI
	Has_receiver_uri=env('aktbus:hasReceiverURI',[],Receiver),	%receiver's URI
	Has_date=env('aktbus:hasDateString',[],[Date_string]),
	Has_time=env('aktbus:hasTimeString',[],[Time_string]),
	Has_content=env('aktbus:hasContent',[],[Has_simple_message]),
	Has_simple_message=env('aktbus:hasSimpleMessage',['rdf:parseType'="Literal"],[Message]),
	Message=env('kraft:Message',[],Content).

%
% compose date & time strings
%
make_date_time_string(Date,Time,Date_string,Time_string) :-
	datime(datime(Y,M,D,H,Min,S)),		%get current date & time
	(	(var(Date),			%if Date is uninstantiated, put in current date
		!,
		Date=date(Y,M,D)
		);
		true
	),
	(	(var(Time),			%if Time is uninstantiated, put in current time
		!,
		Time=time(H,Min,S)
		);
		true
	),
	my_date(Date,Date_string,[]),
	my_time(Time,Time_string,[]).


%
% receive a message from a special port
%
receive_message(Port,Message) :-
	receive_http_message(Port,_,Request_string),
	xml2terms(Request_string,Message),
	write('***XML message:'),
	write(Message),nl.


%
% receive a message by HTTP with optional timeout
%
receive_http_message(Port,_,Body) :-
	crlf(Crlf),
	socket('AF_INET',Socket),			%create server socket
	socket_bind(Socket,'AF_INET'(_Host,Port)),	%bind with port
	socket_listen(Socket,5),			%set queue length
	socket_accept(Socket,Stream),			%accept incoming connection
	read_until_lf(Stream,Start_line),		%get the request line
	write('*** start-line:'),nl,
	print_string(Start_line),nl,
	my_request_line(_Method,_Url,Version,Start_line,[]),	%parse request line
	read_until_blank_line(Stream,Lines),			%read until hitting a blank line
	write('*** header lines:'),nl,
	flatten(Lines,F_lines),
	print_string(F_lines),nl,
	my_null_or_more_header(Headers,F_lines,Crlf),		%parse list of header
	write('****'),nl,
	get_content_length(Headers,Length),			%look for content-length value
	read_number_of_char(Stream,Length,Body),
	print_string(Body),nl,
	send_response(Stream,Version),
	close(Stream).

get_content_length(Headers,Length) :-
	member(Field_name,[	'Content-Length',
				'content-length',
				'content-Length',
				'Content-length'
				]),
	member(Field_name:Length,Headers).

send_response(W,Version) :-
	Code_string="200",
	Reason_string="OK",
	crlf(Crlf),
	atom_codes(Version,Version_string),
	flatten([	"HTTP/",
			Version_string,
			" ",
			Code_string,
			" ",
			Reason_string,
			Crlf
		],Response_string),
	write_string(W,Response_string),
	flush_output(W).


read_until_lf(R,[C|Cs]) :-
	get0(R,C),		%read a char
	(	(	C=10,
			!,
			Cs=[]
		);
		(	C>=10,
			!,
			read_until_lf(R,Cs)
		);
		Cs=[]
	).

read_until_blank_line(R,[L|Ls]) :-
	read_until_lf(R,L),
	(	(	L=[13,10],
			!,
			Ls=[]
		);
		read_until_blank_line(R,Ls)
	).


read_until_eof(R,[C|Cs]) :-
	get0(R,C),
	C >= 0,		%not yet EOF
	!,
	read_until_eof(R,Cs).

read_until_eof(_,[]).

read_number_of_char(_,0,[]) :-
	!.

read_number_of_char(R,N,[C|Cs]) :-
	get0(R,C),
	!,
	C>=0,
	M is N-1,
	read_number_of_char(R,M,Cs).

read_number_of_char(_,_,[]).



%
% xml_to_terms/2
%
xml_to_terms(Xml,Terms) :-
	xml2terms(Xml,Terms).	%call Pillow to translate a term to XML & vice versa


%
% Msg is a term
%
send_message(Msg) :-
	send_message(Msg,off).

send_message(Msg,Timeout) :-
	get_receiver_uri(Msg,Receiver_uri),	%extract receiver's URI from msg
	xml2terms(String,Msg),			%convert msg term to a string
	send_http_post(Receiver_uri,String,Timeout).


%
% send to URI (in string)
%
send_http_post(Uri,String,Timeout) :-
	url_info(Uri,http(Host,Port,Doc)),			%get host & port from URI string
	crlf(Crlf_string),					%get the CR-LF string
	Start_line=["POST ",Doc," HTTP/1.1",Crlf_string],	%start-line according to HTTP
	Body_string=String,					%HTTP body in a string
	length(Body_string,Length),
	name(Length,Length_string),
	Header_string=[	"Connection: close",Crlf_string,
			"Content-Length: ",Length_string,Crlf_string
			],					%HTTP header, if any
	flatten([Start_line,			%request line w/ CF-LF
		Header_string,			%header lines w/ CF-LF
		Crlf_string,			%a blank line
		Body_string,			%POST body
		Crlf_string],Request_string),	%and CF-LF
	http_transaction(Host,Port,Request_string,Timeout,Response_string),	%send request string to http server
	print_string(Response_string),nl,
	http_response(Response,Response_string,[]),				%parse response string
	write(Response),nl.
%	pillow:http_transaction(Host,Port,Request_string,Timeout,Response_string),	%send request string to http server
%	pillow:http_response(Response_string,Response,[]).				%parse response string


%
% prints CR-LF to a stream
%
write_crlf(W) :-
	put(W,13),
	put(W,10).


%
% extract an environment's attributes & value
%
get_env(env(Env,Attrib,Value),Env,Attrib,Value) :-
	!.

get_env(Rdf,Env,Attrib,Value) :-
	member(env(Env,Attrib,Value),Rdf),
	!.

get_env(env(_,_,Temp_value),Env,Attrib,Value) :-
	!,
	get_env(Temp_value,Env,Attrib,Value).

get_env(Rdf,Env,Attrib,Value) :-
	member(env(_,_,Temp_value),Rdf),
	get_env(Temp_value,Env,Attrib,Value).


get_env_attrib_value(Rdf_msg,Env,Attrib,Value) :-
	get_env(Rdf_msg,'rdf:RDF',_,Rdf_body),
	get_env(Rdf_body,Env,Attrib,Value).
	

get_receiver_uri(Rdf_msg,Uri) :-
	get_env(Rdf_msg,'rdf:RDF',_,Rdf_body),
	get_env(Rdf_body,'aktbus:hasReceiverURI',_,Uri).


print_string([]).
print_string([H|T]) :-
	put(H),
	print_string(T).



/*
http_post(Host,Port) :-
	socket('AF_INET',Socket),
	socket_connect(Socket,'AF_INET'(Host,Port),Stream),
	write_string(Stream,Request),
	flulsh_output(Stream),
	stream_select([Stream],Timeout:0,R),
	R \== [],	%fail if timeout
	stream_to_string(Stream,Response).

print_xml(S) :-
	print_xml(0,S).

print_xml(_,[]).
print_xml(Spaces,[H|T]) :-
	[H]=">",		%end of a tag
	!,
	write('>'),
	nl,
	S is Spaces-1,
	print_xml(S,T).
print_xml(Spaces,[H|T]) :-
	[H]="<",		%start of a tag
	print_spaces(Spaces),
	!,
	tag_or_end_tag(Spaces,T).
print_xml(Spaces,[H|T]) :-
	put(H),
	print_xml(Spaces,T).
tag_or_end_tag(Spaces,[H|T]) :-
	[H]="/",
	!,
	write('<'),	%print the bracket


print_spaces(0).
print_spaces(N) :-
	N>0,
	M is N-1,
	write(' '),
	print_spaces(M).
*/


my_http_request(request(Method,Url,Http_version,Header_lists,Body)) -->
	my_request_line(Method,Url,Http_version),
	my_null_or_more_header(Header_lists),
	http_crlf,
	my_message_body(Body).

my_request_line(Method,Url,Http_version) -->
	my_method(Method),
	" ",
	my_request_uri(Url),
%	my_http_url(Url),
	" ",
	my_http_version(Http_version),
	http_crlf.

my_request_uri(Url) -->
	my_http_url(Url).

my_request_uri(Doc) -->
	my_http_document_name(Doc).

my_request_uri('*') --> "*".
my_request_uri('/') --> "/".


my_http_url(url(Host,Port,Doc)) -->
	"http://",
	my_internet_host(Host),
	optional_port(Port),
	my_http_document_name(Doc).

my_http_document_name(D) -->
	"/",
	my_one_or_more_document_name_char(D),
	!.

my_http_document_name("/") -->
	"/",
	!.

my_http_document_name("/") --> "".

my_one_or_more_document_name_char([C|D]) -->
	my_document_name_char(C),
	my_one_or_more_document_name_char(D).

my_one_or_more_document_name_char([C]) -->
	my_document_name_char(C).



my_document_name_char(C) -->
	digit(C).

my_document_name_char(C) -->
	loalpha(C).

my_document_name_char(C) -->
	upalpha(C).

my_document_name_char(0'.) -->
	".".

my_document_name_char(0'~) -->
	"~".

my_document_name_char(0'/) -->
	"/".

my_http_version('1.1') --> "HTTP/1.1".
my_http_version('1.0') --> "HTTP/1.0".

my_method(get) --> "GET".
my_method(post) --> "POST".

my_null_or_more_header([Field_name:Value|Rest]) -->
	my_field_name(Field_name),
	":",
	my_optional_space,
	my_field_value(Value),
	http_crlf,
	my_null_or_more_header(Rest).

my_null_or_more_header([]) -->
	"".

my_message_body(Body) -->
	my_rest(Body).


my_internet_host(Host) -->
	my_one_or_more_internet_token(Host).

my_one_or_more_internet_token(Host) -->
	my_internet_host_token(T1),
	".",
	my_one_or_more_internet_token(T2),
	{	atom_codes(T1,T1_string),
		atom_codes(T2,T2_string),
		flatten([T1_string,".",T2_string],T),
		atom_codes(Host,T)
	}.

my_one_or_more_internet_token(T) -->
	my_internet_host_token(T).

my_internet_host_token(Token) -->
	my_internet_host_char(C),
	my_internet_host_token(T),
	{	atom_codes(T,T_string),
		atom_codes(Token,[C|T_string])
	}.

my_internet_host_token(T) -->
	my_internet_host_char(C),
	{	atom_codes(T,[C])
	}.


my_internet_host_char(C) --> digit(C).
my_internet_host_char(C) --> loalpha(C).
my_internet_host_char(C) --> upalpha(C).
my_internet_host_char(0'-) --> "-".

my_char_in_low(C) --> digit(C).
my_char_in_low(C) --> loupalpha(C).
my_char_in_low(0'-) --> "-".

my_symbol_char(0'*) --> "*".
my_symbol_char(0'/) --> "/".
my_symbol_char(0'.) --> ".".
my_symbol_char(0',) --> ",".
my_symbol_char(0'=) --> "=".
my_symbol_char(0'-) --> "-".
my_symbol_char(0':) --> ":".
my_symbol_char(0';) --> ";".



my_field_name(Token) -->
	my_token(Token).


my_field_value(Value) -->
	my_line(Line),
	{	name(Line,S),
		name(Value,S)
	}.

my_line(Line) -->
	my_field_value_char(C),
	my_line(L2),
	{	atom_codes(L2,L2_string),
		atom_codes(Line,[C|L2_string])
	}.

my_line(Token) -->
	my_field_value_char(C),
	{	atom_codes(Token,[C])
	}.

my_field_value_char(C) -->
	digit(C).

my_field_value_char(C) -->
	loalpha(C).

my_field_value_char(C) -->
	upalpha(C).

my_field_value_char(C) -->
	my_symbol_char(C).

my_field_value_char(32) -->
	" ".
/*
my_field_value(Value) -->
	my_token(Token),
	{	name(Token,S),		%convert the atom to a string
		name(Value,S)		%and back to atom (fix 'integer as atom' problem)
	}.
*(/
/*
my_token_in_low(Token) -->
	my_char_in_low(C),
	my_token_in_low(T2),
	{	atom_codes(T2,T2_string),
		atom_codes(Token,[C|T2_string])
	}.

my_token_in_low(Token) -->
	my_char_in_low(C),
	{	atom_codes(Token,[C])
	}.
*/

my_token(Token) -->
	my_internet_host_char(C),
	my_token(T2),
	{	atom_codes(T2,T2_string),
		atom_codes(Token,[C|T2_string])
	}.

my_token(Token) -->
	my_internet_host_char(C),
	{	atom_codes(Token,[C])
	}.

my_rest(S,S,[]).


my_date(date(Y,M,D)) -->
	my_parse_integer(Y),
	"-",
	my_parse_integer(M),
	"-",
	my_parse_integer(D).

my_time(time(H,M,S)) -->
	my_parse_integer(H),
	":",
	my_parse_integer(M),
	":",
	my_parse_integer(S).

%
% parsing a string into an integer
% or generating a string from an integer
%
my_parse_integer(Num,String,Rest) :-
	var(String),
	!,
	number_codes(Num,Num_string),
	append(Num_string,Rest,String).

my_parse_integer(Num,String,Rest) :-
	parse_integer(Num,String,Rest).

my_optional_space --> " ".
my_optional_space --> "".

