1/*  Part of SWI-Prolog WSDL pack
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2012, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(wsdl,
   31	  [ wsdl_read/1,		% :WSDLFile
   32	    wsdl_ensure_loaded/1,	% :WSDLFile
   33	    wsdl_function/6		% ?Name, ?Version, ?URL, ?Action, ?Input, ?Output
   34	  ]).   35:- use_module(library(sgml)).   36:- use_module(library(xpath)).   37:- use_module(library(assoc)).   38:- use_module(library(option)).   39:- use_module(library(error)).   40:- use_module(xml_schema).   41
   42
   43:- meta_predicate
   44	wsdl_read(:),
   45	wsdl_ensure_loaded(:),
   46	wsdl_function(:, ?, ?, ?, ?, ?).

   63ns('http://schemas.xmlsoap.org/wsdl/soap/',   soap11).
   64ns('http://schemas.xmlsoap.org/wsdl/soap12/', soap12).
   65
   66:- dynamic
   67	wsdl_read/2.			% File, Module

 wsdl_ensure_loaded(:File) is det

True if File is loaded into the context.

   73wsdl_ensure_loaded(Module:File) :-
   74	wsdl_read(File, Module), !.
   75wsdl_ensure_loaded(Spec) :-
   76	wsdl_read(Spec),
   77	Spec = Module:File,
   78	assertz(wsdl_read(File, Module)).

 wsdl_read(:File) is det

Read operations from a WSDL file. This operation creates a number of predicates in the calling module:

• wsdl_operation(PortType, Operation, Input, Output) Where PortType is `library', Operation is the concrete operation and Input/Output are message names that describes the input and output types.
• wsdl_message(Type, Params) Defines the message types for input and output. Params is a list Name:Type.
• wsdl_binding(PortType, Binding, Style, Transport) General properties of the binding. Style must be document and Transport must be http.
• wsdl_binding_operation(Binding, Operation, Action, Version, Input, Output) Binding for a specific Operation. Action is the URL, and Input/Output document the encoding style. This is always literal
• wsdl_port(Binding, URL) HTTP location to contact for Binding.

  108wsdl_read(Module:File) :-
  109	retractall(Module:wsdl_message(_,_)),
  110	retractall(Module:wsdl_operation(_,_,_,_)),
  111	retractall(Module:wsdl_binding(_,_,_,_)),
  112	retractall(Module:wsdl_binding_operation(_,_,_,_,_,_)),
  113	retractall(Module:wsdl_port(_,_)),
  114	load_structure(File, [DOM],
  115		       [ dialect(xmlns),
  116			 space(remove)
  117		       ]),
  118	prefix_map(DOM, PrefixMap),
  119	(   xpath(DOM, /(_:definitions(@targetNamespace)), TargetNameSpace)
  120	->  TSOptions = [target_namespace(TargetNameSpace)]
  121	;   TSOptions = []
  122	),
  123	Options = [prefixmap(PrefixMap),file(File)|TSOptions],
  124	extract_messages(DOM, Module, Options),
  125	extract_operations(DOM, Module, Options),
  126	extract_bindings(DOM, Module, Options),
  127	extract_ports(DOM, Module, Options),
  128	extract_types(DOM, Module, Options).
  129
  130prefix_map(element(_, Attrs, _), PrefixMap) :-
  131	prefix_list(Attrs, Pairs),
  132	list_to_assoc(Pairs, PrefixMap).
  133
  134prefix_list([], []).
  135prefix_list([xmlns:Name=Prefix|T0], [Name-Prefix|T]) :- !,
  136	prefix_list(T0, T).
  137prefix_list([xmlns=Prefix|T0], [''-Prefix|T]) :- !,
  138	prefix_list(T0, T).
  139prefix_list([_|T0], T) :-
  140	prefix_list(T0, T).

 extract_messages(+DOM, +Module, +Options) is det

Extract the messages

  147extract_messages(DOM, Module, Options) :-
  148	forall(xpath(DOM, _:message(@name=Name), Message),
  149	       ( qualify_name(Name, QName, Options),
  150		 extract_message(Message, QName, Module, Options))).
  151
  152extract_message(Message, Name, Module, Options) :-
  153	findall(Arg,
  154		message_part(Message, Arg, Options),
  155		Arguments),
  156	assertz(Module:wsdl_message(Name, Arguments)).
  157
  158message_part(Message, arg(AName, element(QType)), Options) :-
  159	xpath(Message, _:part(@element=Element, @name=AName), _),
  160	qualify_name(Element, QType, Options).
  161message_part(Message, arg(AName, type(QType)), Options) :-
  162	xpath(Message, _:part(@type=Type, @name=AName), _),	qualify_name(Type, xmlns, QType, Options).

 extract_operations(+DOM, +Module, +Options) is det

  168extract_operations(DOM, Module, Options) :-
  169	forall(xpath(DOM, //(_:portType(@name=Name)), PT),
  170	       ( qualify_name(Name, QName, Options),
  171		 port_operations(PT, QName, Module, Options))).
  172
  173port_operations(PT, PortType, Module, Options) :-
  174	forall(xpath(PT, _:operation(@name=Name), Op),
  175	       ( qualify_name(Name, QName, Options),
  176		 port_operation(Op, PortType, QName, Module, Options))).
  177
  178port_operation(Op, PortType, Operation, Module, Options) :-
  179	(   xpath(Op, _:input(@message), Input)
  180	->  qualify_name(Input, QInput, Options)
  181	;   QInput = (-)
  182	),
  183	(   xpath(Op, _:output(@message), Output)
  184	->  qualify_name(Output, QOutput, Options)
  185	;   QOutput = (-)
  186	),
  187	assertz(Module:wsdl_operation(PortType, Operation, QInput, QOutput)).
  188
  189%%	extract_bindings(+DOM, +Module, +Options) is det.
  190%
  191%	Extract the binding declarations
  192
  193extract_bindings(DOM, Module, Options) :-
  194	forall(xpath(DOM, _:binding(@type=Type, @name=Name), Binding),
  195	       ( qualify_name(Name, QName, Options),
  196		 qualify_name(Type, xmlns, QType, Options),
  197	         extract_binding(Binding, QType, QName, Module, Options)
  198	       )).
  199
  200extract_binding(Binding, QType, QName, Module, Options) :-
  201	(   xpath(Binding, _:binding(@style=Style, @transport=Transport), _)
  202	->  true
  203	;   xpath(Binding, _:binding(@transport=Transport), _)
  204	->  Style = document
  205	),
  206	(   transport_id(Transport, TransportId)
  207	->  true
  208	;   domain_error(soap_transport, Transport)
  209	),
  210	assert(Module:wsdl_binding(QType, QName, Style, TransportId)),
  211	forall(xpath(Binding, _:operation(self), Operation),
  212	       extract_binding_operation(Operation, QName, Module, Options)), !.
  213extract_binding(Binding, QType, QName, Module, Options) :-
  214	xpath(Binding, _:binding(@verb=Verb), _), !,
  215	assert(Module:wsdl_binding(QType, QName, Verb, http)),
  216	forall(xpath(Binding, _:operation(self), Operation),
  217	       extract_binding_operation(Operation, QName, Module, Options)), !.
  218extract_binding(Binding, QType, QName, Module, Options) :-
  219	print_message(error, failed(extract_binding)),
  220	gtrace,
  221	extract_binding(Binding, QType, QName, Module, Options).
  222
  223
  224transport_id('http://schemas.xmlsoap.org/soap/http', http).
  225
  226extract_binding_operation(Operation, QName, Module, Options) :-
  227	xpath(Operation, NS:operation(@soapAction=Action), _),
  228	xpath(Operation, (_:input)/(_:body(@use=InputUse)), _),
  229	xpath(Operation, (_:output)/(_:body(@use=OutputUse)), _), !,
  230	(   Action == ''
  231	->  QAction = Action
  232	;   qualify_name(Action, QAction, Options)
  233	),
  234	(   ns(NS, Soap)
  235	->  true
  236	;   existence_error(wsdl_soap_namespace, NS)
  237	),
  238	(   xpath(Operation, /(_:operation(@name=OName)), _)
  239	->  qualify_name(OName, QOp, Options)
  240	;   QOp = QName
  241	),
  242	assertz(Module:wsdl_binding_operation(
  243			   QName, QOp, QAction, Soap, InputUse, OutputUse)).
  244extract_binding_operation(Operation, QName, Module, Options) :-
  245	xpath(Operation, _:operation(@location=Location), _),
  246	xpath(Operation, _:input(self), Input),
  247	xpath(Operation, _:output(self), Output),
  248	verb_input(Input, InputUse),
  249	verb_output(Output, OutputUse, Options), !,
  250	(   xpath(Operation, /(_:operation(@name=OName)), _)
  251	->  qualify_name(OName, QOp, Options)
  252	;   QOp = QName
  253	),
  254	assertz(Module:wsdl_binding_operation(
  255			   QName, QOp, Location, http, InputUse, OutputUse)).
  256extract_binding_operation(Operation, QName, Module, Options) :-
  257	print_message(error, failed(extract_binding_operation)),
  258	gtrace,
  259	extract_binding_operation(Operation, QName, Module, Options).
  260
  261verb_input(Input, url_encoded) :-
  262	xpath(Input, _:urlEncoded, _), !.
  263verb_input(Input, Type) :-
  264	xpath(Input, _:content(@type=Type), _), !.
  265
  266verb_output(Output, xml(QElement), Options) :-
  267	xpath(Output, _:mimeXml(@part=Element), _),
  268	qualify_name(Element, QElement, Options).

 extract_ports(+DOM, +Module, +Options) is det

Handle port elements that binds operations to actual HTTP addresses.

  276extract_ports(DOM, Module, Options) :-
  277	xpath_chk(DOM, _:service, Service),
  278	forall(xpath(Service, _:port(@binding=Binding), Port),
  279	       ( qualify_name(Binding, QBinding, Options),
  280		 extract_port(Port, QBinding, Module, Options))).
  281
  282extract_port(Port, QBinding, Module, _Options) :-
  283	xpath(Port, _:address(@location=Location), _), !,
  284	assertz(Module:wsdl_port(QBinding, Location)), !.
  285extract_port(_Port, QBinding, _Module, _Options) :- fail, !,
  286	print_message(warning, wsdl(missing_binding(QBinding))).
  287extract_port(Port, QBinding, Module, Options) :-
  288	print_message(error, failed(extract_port)),
  289	gtrace,
  290	extract_port(Port, QBinding, Module, Options).

 extract_types(+DOM, +Module, +Options) is det

Extract the XML schema types.

  297extract_types(DOM, Module, Options) :-
  298	xpath_chk(DOM, //(_:schema(self)), Schema),
  299	xsd_load(Module:Schema, Options).
  300
  301
  302		 /*******************************
  303		 *	      QUERY		*
  304		 *******************************/

 wsdl_function(:Name, -Version, -URL, -Action, -Input, -Output) is nondet

  309wsdl_function(Module:PortType/Operation, Version, URL, Action, Input, Output) :-
  310	Module:wsdl_operation(PortType, Operation, InputMsg, OutputMsg),
  311	Module:wsdl_binding(PortType, Binding, Document, HTTP),
  312	assertion(Document == document),
  313	assertion(HTTP == http),
  314	Module:wsdl_binding_operation(Binding, Operation, Action, Version,
  315				      InputBinding, OutputBinding),
  316	assertion(InputBinding == literal),
  317	assertion(OutputBinding == literal),
  318	once(Module:wsdl_message(InputMsg, Input)),
  319	once(Module:wsdl_message(OutputMsg, Output)),
  320	Module:wsdl_port(Binding, URL).
  321
  322
  323
  324		 /*******************************
  325		 *	       UTIL		*
  326		 *******************************/

 qualify_name(+Name, -QName, -Options) is det

  330qualify_name(Name, QName, Options) :-
  331	qualify_name(Name, tns, QName, Options).
  332
  333qualify_name(Name, _, QName, _Options) :-
  334	sub_atom(Name, 0, _, _, 'http://'), !,
  335	QName = Name.
  336qualify_name(Name, _, QName, _Options) :-
  337	sub_atom(Name, 0, _, _, 'https://'), !,
  338	QName = Name.
  339qualify_name(Name, _, Prefix:LN, Options) :-
  340	sub_atom(Name, B, _, A, :), !,
  341	sub_atom(Name, 0, B, _, NS),
  342	sub_atom(Name, _, A, 0, LN),
  343	option(prefixmap(PrefixMap), Options),
  344	(   get_assoc(NS, PrefixMap, Prefix)
  345	->  true
  346	;   existence_error(namespace, NS)
  347	).
  348qualify_name(Name, xmlns, Prefix:Name, Options) :- !,
  349	option(prefixmap(PrefixMap), Options),
  350	get_assoc('', PrefixMap, Prefix),
  351	(   Prefix == 'http://www.w3.org/2001/XMLSchema'
  352	->  true
  353	;   writeln(Prefix)
  354	).
  355qualify_name(Name, tns, Prefix:Name, Options) :-
  356	option(target_namespace(Prefix), Options)