|
From: Peter R. <pet...@mi...> - 2001-01-18 11:08:03
|
On Thu, Jan 18, 2001 at 05:13:24PM +1100, Ina Cheng wrote: > Hi, > > Can someone please take a look and give comments on my work even though > I haven't finish yet. I haven't cvs add the new files to the repository because > someone might want to change the filenames. > > Thanks > Ina > > ======================================================================== > > Estimated hours taken: 120 (after new year) > > webserver/server/web.m > a new module handling remote procedure calls using SOAP protocol > and generating corresponding respones > > webserver/server/foo.m > a new module containing definitions of methods supported > in the SOAP protocol > soap-methods.m sounds like a reasonable name to me. > ======================================================================== > > %---------------------------------------------------------------------------% > % Copyright (C) 2000, 2001 The University of Melbourne. > % This file may only be copied under the terms of the GNU Library General > % Public License - see the file COPYING.LIB in the Mercury distribution. > %---------------------------------------------------------------------------% > % > % File: web.m > % Author: inch > % > % Reference: > % http://www.w3.org/TR/SOAP > % > % This module handles remote procedure calls using SOAP protocol and > % generates corresponding responses. Depending on the name of the > % procedure call, different method will be called. > % a different method > %---------------------------------------------------------------------------% > > :- module web. > :- interface. > :- import_module io, list, string, std_util. > :- import_module http. > :- import_module xml, xml:ns. > > > :- type web_method_request > ---> web_method_request( > name :: string, % method name > params :: list(parameter), % list of parameters > uri :: nsURI % namespace (method) > ). > > :- type parameter > ---> parameter( > pName :: string, % parameter name > pType :: maybe(string), % type if any > pValue :: string, % data > pURI :: nsURI % namespace (param) > ). > Why are these types in the interface? Are they used in other modules? > % Converts method name and parameters in xml.ns format to > % a web request. > :- pred make_web_request(nsElement, list(nsContent), web_method_request). > :- mode make_web_request(in, in, out) is det. > > % Loads library, invokes method call and generates corresponding > % response. > :- pred load_dynamic_library(string::in, web_method_request::in, > maybe(string)::out, http_code::out, io__state::di, io__state::uo) > is det. > > %---------------------------------------------------------------------------% > > :- implementation. > :- import_module bool, int, require. > :- import_module dl, name_mangle, foo. > > > % FYI : regard to make_web_request(Proc, Params, Request) > % > % Eg. > % <m:GetStockPrice xmlns:m="some uri"> > % <stocknum xsi:type="xsd:int">1</stocksum> > % <date>30</date> > % </m:GetStockPrice> > % > % Proc will be: > % nsElement(qName("GetStockPrice", "some uri"), > % [nsAttribute(qName("m", "some uri"), "some uri")], > % [2, 4, 5, 7, 8], > % ["m" - "some uri"]) > % Where does this proc type come from? > % Params will be: > % [nsElement(nsElement(qName("date", ""), [], [6], [])), > % data("1"), > % nsElement(nsElement(qName("stocknum", ""), > % [nsAttribute(qName("type", ""), "xsd:int")], [3], [])), > % data("1"), > % > % XXX not sure what id is for > % <SOAP-ENC:int id="int1">1</SOAP-ENC:int> > % [nsElement(nsElement(qName("int", ""), > % [nsAttribute(qName("id", ""), "int1")], [3], [])), data("1")] > I would recommend putting this example closer to the types which it talks about. > > % Generates a web request using method and parameters > make_web_request(Proc, Params, Request) :- > Request^name = Proc^eName^localName, > Request^uri = Proc^eName^nsURI, > form_pair(Params, Params0), > retrieve_params(Params0, Request^params). > > % Transform parameter list from [parameter, data, parameter, data ..] > % to [(parameter - data)] to distinguish elements > :- pred form_pair(list(nsContent), list(pair(nsContent, nsContent))). > :- mode form_pair(in, out) is det. > > form_pair(ParamList , PairList) :- > ( > ParamList = [] > -> > PairList = [] > ; > list__split_list(2, ParamList, Start, End), > Start = [Param, Data] s/Start/Head/ s/End/Tail/ but I would use the following code instead ParamList = [Param, Data | Tail] which has exactly the same effect but without the call. > -> > PairList = [(Param - Data)|PairList0], s/|/ | / > form_pair(End, PairList0) > ; > error("Incorrect Data Format") > ). > > % Retrieve parameter name, uri, type if defined and data value. > :- pred retrieve_params(list(pair(nsContent, nsContent)), list(parameter)). > :- mode retrieve_params(in, out) is det. > > retrieve_params([],[]). > retrieve_params([Param_Data|Params], Parameters) :- s/|/ | / > fst(Param_Data, Param0), > snd(Param_Data, Data), > ( > Param0 = nsElement(Param), > Data = data(Value) > -> > Name = Param^eName^localName, > URI = Param^eName^nsURI, > ( > search_attributes(Param^eAttrs, Type0) > -> > Type = yes(Type0) > ; > Type = no > ), > Parameters = [parameter(Name, Type, Value, URI)|Parameters0], > retrieve_params(Params, Parameters0) > ; > error("Incorrect Data Format") > ). This is a good example of spot where higher order functions are useful. I would define a function retrieve_param which turns one pair(nsContent, nsContent) into a parameter and then use list__map to do it over the whole list, which saves me writing the recursive part. > > % Types in XML can be defined either by using xsi:type attribute > % or by using schema. This predicate is used to search if > % any attribute contains `xsi:type'. > % > % For all attribute list, each list can only contain one > % `xsi:type' attribute. What happens if a type has more then one type attribute? Is this possible, or would a validating XML parser catch the error? > :- pred search_attributes(list(nsAttribute)::in, string::out) is semidet. > > search_attributes([], _) :- fail. > search_attributes([Attr|Attrs], Type) :- > ( > is_type(Attr^aName^localName) > -> > Type = Attr^aValue > ; > search_attributes(Attrs, Type0), > Type = Type0 > ). > > :- pred is_type(string::in) is semidet. > is_type("type"). > > %---------------------------------------------------------------------------% > > % Opens library file, invokes desire function, and gets back > % corresponding response and http code. > load_dynamic_library(L, Request, Response, HttpCode) --> > dl__open(L, lazy, local, MaybeHandle), > ( > % XXX do I need to send error Msg to TCP stream > % or 500 Internal Server Error is sufficient It would be nice if we could print out the actual error message, I think all you need to do is set the response body to not be no_body but string_body when generating the response message. > { MaybeHandle = error(_Msg) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeHandle = ok(Handle) }, > ( > { Request^name = "GetStockPrice" } > -> > call_SP_func(Handle, Request, Response, HttpCode0) > ; > { Request^name = "Hello" } > -> > call_Hello_pred(Handle, Request, Response, HttpCode0) > ; > { Response = no }, > { HttpCode0 = 501 } % 501 Not Implemented Again it would be useful to return a more useful error message. > ), > > dl__close(Handle, Result), > ( > { Result = error(_CloseMsg) }, > { HttpCode1 = 500 }, > { ChangeHttpCode = yes } Ditto. > ; > { Result = ok }, > { HttpCode1 = HttpCode0 }, > { ChangeHttpCode = no } > ), > > ( > { ChangeHttpCode = yes } > -> > { HttpCode = HttpCode1 } > ; > { HttpCode = HttpCode0 } > ) > ). > > %---------------------------------------------------------------------------% > % For Hello > %---------------------------------------------------------------------------% > > :- pred call_Hello_pred(handle, web_method_request, maybe(string), http_code, > io__state, io__state). > :- mode call_Hello_pred(in, in, out, out, di, uo) is det. > > call_Hello_pred(Handle, Request, Response, HttpCode) --> > { HelloProc = mercury_proc(predicate, unqualified("foo"), > "hello", 2, 0) }, > dl__mercury_sym(Handle, HelloProc, MaybeHello), > ( > { MaybeHello = error(_Msg) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeHello = ok(HelloPred0) }, > > % Cast the higher-order term that we obtained > % to the correct higher-order inst. > { HelloPred = inst_cast_hello(HelloPred0) }, > > % Call the procedure whose address > % we just obtained. > HelloPred, > > { Response = yes("Hello World") }, > { HttpCode = 200 } > ). > > % dl__mercury_sym returns a higher-order term with inst `ground'. > % We need to cast it to the right higher-order inst, which for the > % `hello' procedure is `pred(di, uo) is det', before we can actually > % call it. The function inst_cast_hello/1 defined below does that. > > :- type io_pred == pred(io__state, io__state). > :- inst io_pred == (pred(di, uo) is det). > > :- func inst_cast_hello(io_pred) = io_pred. > :- mode inst_cast_hello(in) = out(io_pred) is det. > :- pragma c_code(inst_cast_hello(X::in) = (Y::out(io_pred)), > [will_not_call_mercury, thread_safe], "Y = X"). > > %---------------------------------------------------------------------------% > % For GetStockPrice > %---------------------------------------------------------------------------% > > % FYI: Format of Request > % > % Eg. 1 <stocknum>1</stocknum> > % web_method_request("GetStockPrice", > % [parameter("date", no, "1", ""), > % parameter("stocknum", no, "1", "")], "some uri") > % > % Eg. 2 <stocknum xsi:type="xsd:int">1</stocknum> > % web_method_request("GetStockPrice", > % [parameter("stocknum", yes("xsd:int"), "", "1")], "some uri") > % > % Eg. 3 <SOAP-ENC:int xmlns:SOAP-ENC="uri" id="int1">1</SOAP-ENC:int> > % web_method_request("GetStockPrice", > % [parameter("int", no, "uri", "1")], "some uri") > % > % > % > % > > :- pred call_SP_func(handle, web_method_request, maybe(string), http_code, > io__state, io__state). > :- mode call_SP_func(in, in, out, out, di, uo) is det. > > call_SP_func(Handle, Request, Response, HttpCode) --> > > % { list__length(Request^params, Arity) }, > % io__format("Arity = %i\n", [i(Arity)]), > % > % XXX need to test for function > % { GetSPProc = mercury_proc(function, unqualified("foo"), > % "get_stockprice", Arity, 0) }, > > { GetSPProc = mercury_proc(predicate, unqualified("foo"), > "get_sp", 2, 0) }, > > dl__mercury_sym(Handle, GetSPProc, MaybeGetStockPrice), > ( > { MaybeGetStockPrice = error(_Msg1) }, > { Response = no }, > { HttpCode = 500 } > ; > { MaybeGetStockPrice = ok(SPProc0) }, > > % Cast the higher-order term that we obtained > % to the correct higher-order inst. > { SPProc = inst_cast_sp(SPProc0) }, > > % message is parsed bottom up, therefore parameter > % list is in reverse order > { list__reverse(Request^params, ParameterList) }, > > % Convert parameters (string) to the corresponding types > { list__map(lookup_SP_schema, ParameterList, UnivList) }, > > % Call the procedure whose address we just obtained > { call(SPFunc, UnivList, SPUniv) }, > > % XXX need to test for function > % { wrapper(SPFunc) = inst_cast_stockprice(SPFunc0) }, > % { SP = SPFunc(1, 1) }, > > { det_univ_to_type(SPUniv, SPInt) }, > { string__int_to_string(SPInt, SPString) }, > > { Response = yes(SPString) }, > { HttpCode = 200 } > ). > > > % schema for GetStockPrice: > % <element name="stocknum" type="int"/> > % <element name="date" type="int"> > % </element> > > % Lookup element name in schema, find the corresponding type > % and type cast to that type. > :- pred lookup_SP_schema(parameter::in, univ::out) is det. > > lookup_SP_schema(Param, ValueAsUniv) :- > ( > Param^pName = "stocknum" > -> > type_cast_parameter("int", Param^pValue, ValueAsUniv) > ; > Param^pName = "date" > -> > type_cast_parameter("int", Param^pValue, ValueAsUniv) > ; > % assume Type must be simple type eg. int, float > % XXX type may contain prefix > % Eg. xsd:int, xsd:float > Param^pType = yes(Type) > -> > split_on_colon(Type, _Prefix, Suffix), > type_cast_parameter(Suffix, Param^pValue, ValueAsUniv) > ; > string__append("Element Name not defined in schema: ", > Param^pName, ErrorMsg), > require__error(ErrorMsg) > ). > > > % inst cast for get_sp (predicate) > :- type sp_pred == pred(list(univ), univ). > :- inst sp_pred == (pred(in, out) is det). > > :- func inst_cast_sp(sp_pred) = sp_pred. > :- mode inst_cast_sp(in) = out(sp_pred) is det. > :- pragma c_code(inst_cast_sp(X::in) = (Y::out(sp_pred)), > [will_not_call_mercury, thread_safe], "Y=X"). > > % inst cast for get_stockprice (function) > :- type stockprice == (func(int, int) = int). > :- type stockprice_wrapper ---> wrapper(stockprice). > :- inst stockprice_wrapper ---> wrapper(func(in, in) = out is det). > > :- func inst_cast_stockprice(stockprice_wrapper) = stockprice_wrapper. > :- mode inst_cast_stockprice(in) = out(stockprice_wrapper) is det. > :- pragma c_code(inst_cast_stockprice(X::in) = (Y::out(stockprice_wrapper)), > [will_not_call_mercury, thread_safe], "Y=X"). > > %---------------------------------------------------------------------------% > % Shared functions > %---------------------------------------------------------------------------% > > % Separates prefix and suffix. > :- pred split_on_colon(string::in, string::out, string::out) is det. > > split_on_colon(Name, Prefix, Suffix) :- > ( > string__sub_string_search(Name, ":", Index) > -> > string__length(Name, Length), > string__right(Name, Length-(Index+1), Suffix), > string__left(Name, Index, Prefix) > ; > Suffix = Name, > Prefix = "" > ). > > % Used to convert data value from string to the desire type > % and return it as a univ. > :- pred type_cast_parameter(string::in, string::in, univ::out) is det. > type_cast_parameter(Type, ValueAsString, ValueAsUniv) :- > ( > Type = "int", > string__to_int(ValueAsString, ValueAsInt) > -> > ValueAsUniv = univ(ValueAsInt) > ; > Type = "float", > string__to_float(ValueAsString, ValueAsFloat) > -> > ValueAsUniv = univ(ValueAsFloat) > ; > Type = "string" > -> > ValueAsUniv = univ(ValueAsString) > ; > Type = "char", > string__index(ValueAsString, 0, ValueAsChar) > -> > ValueAsUniv = univ(ValueAsChar) > ; > require__error("Type cast failed") > ). > > > > > %-------------------------------------------------------------------------% > % Copyright (C) 2000-2001 The University of Melbourne. > % This file may only be copied under the terms of the GNU General > % Public License - see the file COPYING in the Mercury distribution. > %-------------------------------------------------------------------------% > % > % File: foo.m > % Author: inch > % > % This module contains the definitions of methods that are supported > % using SOAP for RPC. > % > % All predicates and functions take in a list of univ and return a univ. > % Each list holds all parameters to each predicate / function. > % > % Assumption: > % Since all parameters are being held inside a list, the order of parameters > % are assumed to be sorted. > % > %-------------------------------------------------------------------------% > > :- module foo. > :- interface. > :- import_module io, int, list, std_util. > > :- pred hello(state::di, state::uo) is det. > > :- pred get_sp(list(univ)::in, univ::out) is det. > > % :- func get_stockprice(int) = int. > > %-------------------------------------------------------------------------% > > :- implementation. > :- import_module require. > > % remove_first_element(List, Elem, Rest) > % takes out first element of the List and gives back > % rest of the list > :- pred remove_first_element(list(univ)::in, univ::out, list(univ)::out) > is semidet. > > remove_first_element([], _, _) :- fail. > remove_first_element([Elem|Elems], Element, Rest) :- > Element = Elem, > Rest = Elems. > > %-------------------------------------------------------------------------% > % For Hello > %-------------------------------------------------------------------------% > > hello --> print("Hello, world\n"). > > %-------------------------------------------------------------------------% > % For GetStockPrice > %-------------------------------------------------------------------------% > > % get_sp has 1 parameter > % expect the parameter is of type int > get_sp(ParamList, ResultAsUniv) :- > ( > remove_first_element(ParamList, ParamAsUniv, _) > -> > det_univ_to_type(ParamAsUniv, ParamAsInt), > ResultAsInt = ParamAsInt + 1, > ResultAsUniv = univ(ResultAsInt) > ; > % XXX how to get rid of the require__error/1 > % ie. how to improve remove_first_element so that > % I don't need to call error for every method ? > require__error("Error in get_sp") > ). > > % get_stockprice(X) = X + 1. > > > > _______________________________________________ > Quicksilver-developers mailing list > Qui...@li... > http://lists.sourceforge.net/lists/listinfo/quicksilver-developers |