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)  2006-2015, University of Amsterdam
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(http_parameters,
   37          [ http_parameters/2,          % +Request, -Params
   38            http_parameters/3,          % +Request, -Params, +TypeG
   39
   40            http_convert_parameter/4,   % +Options, +FieldName, +ValIn, -ValOut
   41            http_convert_parameters/2,  % +Data, +Params
   42            http_convert_parameters/3   % +Data, +Params, :DeclGoal
   43          ]).   44:- use_module(http_client).   45:- use_module(http_multipart_plugin).   46:- use_module(http_hook).   47:- use_module(library(debug)).   48:- use_module(library(option)).   49:- use_module(library(error)).   50:- use_module(library(broadcast)).   51
   52:- multifile
   53    http:convert_parameter/3.   54
   55:- predicate_options(http_parameters/3, 3,
   56                     [ form_data(-list),
   57                       attribute_declarations(callable)
   58                     ]).

:- http_handler('/register_user', register_user, []).

register_user(Request) :-
    http_parameters(Request,
                    [ name(Name, []),
                      sex(Sex, [oneof([male,female])]),
                      birth_year(BY, [between(1850,10000)])
                    ]),
    register_user(Name, Sex, BY),
    html_reply_page(title('New user added'),
                    ...).

   86:- meta_predicate
   87    http_parameters(+, ?, :),
   88    http_convert_parameters(+, ?, 2).

 http_parameters(+Request, ?Parms) is det

 http_parameters(+Request, ?Parms, :Options) is det

Get HTTP GET or POST form-data, applying type validation, default values, etc. Provided options are:

attribute_declarations(:Goal)

Causes the declarations for an attributed named A to be fetched using call(Goal, A, Declarations).

form_data(-Data)

Return the data read from the GET por POST request as a list Name = Value. All data, including name/value pairs used for Parms, is unified with Data.

The attribute_declarations hook allows sharing the declaration of attribute-properties between many http_parameters/3 calls. In this form, the requested attribute takes only one argument and the options are acquired by calling the hook. For example:

    ...,
    http_parameters(Request,
                    [ sex(Sex)
                    ],
                    [ attribute_declarations(http_param)
                    ]),
    ...

http_param(sex, [ oneof(male, female),
                  description('Sex of the person')
                ]).

bug

- If both request parameters (?name=value&...) and a POST are present the parameters are extracted from the request parameters. Still, as it is valid to have request parameters in a POST request this predicate should not process POST requests. We will keep the current behaviour as the it is not common for a request to have both request parameters and a POST data of the type application/x-www-form-urlencoded.

In the unlikely event this poses a problem the request may be specified as [method(get)|Request].

  135http_parameters(Request, Params) :-
  136    http_parameters(Request, Params, []).
  137
  138http_parameters(Request, Params, Options) :-
  139    must_be(list, Params),
  140    meta_options(is_meta, Options, QOptions),
  141    option(attribute_declarations(DeclGoal), QOptions, no_decl_goal),
  142    http_parms(Request, Params, DeclGoal, Form),
  143    (   memberchk(form_data(RForm), QOptions)
  144    ->  RForm = Form
  145    ;   true
  146    ).
  147
  148is_meta(attribute_declarations).
  149
  150
  151http_parms(Request, Params, DeclGoal, Search) :-
  152    memberchk(search(Search), Request),
  153    !,
  154    fill_parameters(Params, Search, DeclGoal).
  155http_parms(Request, Params, DeclGoal, Data) :-
  156    memberchk(method(Method), Request),
  157    Method == post,
  158    memberchk(content_type(Content), Request),
  159    form_data_content_type(Content),
  160    !,
  161    debug(post_request, 'POST Request: ~p', [Request]),
  162    posted_form(Request, Data),
  163    fill_parameters(Params, Data, DeclGoal).
  164http_parms(_Request, Params, DeclGoal, []) :-
  165    fill_parameters(Params, [], DeclGoal).
  166
  167:- multifile
  168    form_data_content_type/1.  169
  170form_data_content_type('application/x-www-form-urlencoded') :- !.
  171form_data_content_type(ContentType) :-
  172    sub_atom(ContentType, 0, _, _, 'application/x-www-form-urlencoded;').

 posted_form(+Request, -Data) is det

True when Data is list of Name=Value pairs representing the posted data.

  179posted_form(Request, _Data) :-
  180    nb_current(http_post_data, read),
  181    !,
  182    option(request_uri(URI), Request),
  183    throw(error(permission_error('re-read', 'POST data', URI),
  184                context(_, 'Attempt to re-read POST data'))).
  185posted_form(Request, Data) :-
  186    http_read_data(Request, Data, []),
  187    nb_setval(http_post_data, read),
  188    debug(post, 'POST Data: ~p', [Data]).
  189
  190wipe_posted_data :-
  191    debug(post, 'Wiping posted data', []),
  192    nb_delete(http_post_data).
  193
  194:- listen(http(request_finished(_Id, _Code, _Status, _CPU, _Bytes)),
  195          wipe_posted_data).

 fill_parameters(+ParamDecls, +FormData, +DeclGoal)

Fill values from the parameter list

  202:- meta_predicate fill_parameters(+, +, 2).  203
  204fill_parameters([], _, _).
  205fill_parameters([H|T], FormData, DeclGoal) :-
  206    fill_parameter(H, FormData, DeclGoal),
  207    fill_parameters(T, FormData, DeclGoal).
  208
  209fill_parameter(H, _, _) :-
  210    var(H),
  211    !,
  212    instantiation_error(H).
  213fill_parameter(group(Members, _Options), FormData, DeclGoal) :-
  214    is_list(Members),
  215    !,
  216    fill_parameters(Members, FormData, DeclGoal).
  217fill_parameter(H, FormData, _) :-
  218    H =.. [Name,Value,Options],
  219    !,
  220    fill_param(Name, Value, Options, FormData).
  221fill_parameter(H, FormData, DeclGoal) :-
  222    H =.. [Name,Value],
  223    (   DeclGoal \== (-),
  224        call(DeclGoal, Name, Options)
  225    ->  true
  226    ;   throw(error(existence_error(attribute_declaration, Name), _))
  227    ),
  228    fill_param(Name, Value, Options, FormData).
  229
  230fill_param(Name, Values, Options, FormData) :-
  231    memberchk(zero_or_more, Options),
  232    !,
  233    fill_param_list(FormData, Name, Values, Options).
  234fill_param(Name, Values, Options, FormData) :-
  235    memberchk(list(Type), Options),
  236    !,
  237    fill_param_list(FormData, Name, Values, [Type|Options]).
  238fill_param(Name, Value, Options, FormData) :-
  239    (   memberchk(Name=Value0, FormData),
  240        Value0 \== ''               % Not sure
  241    ->  http_convert_parameter(Options, Name, Value0, Value)
  242    ;   memberchk(default(Value), Options)
  243    ->  true
  244    ;   memberchk(optional(true), Options)
  245    ->  true
  246    ;   throw(error(existence_error(http_parameter, Name), _))
  247    ).
  248
  249
  250fill_param_list([], _, [], _).
  251fill_param_list([Name=Value0|Form], Name, [Value|VT], Options) :-
  252    !,
  253    http_convert_parameter(Options, Name, Value0, Value),
  254    fill_param_list(Form, Name, VT, Options).
  255fill_param_list([_|Form], Name, VT, Options) :-
  256    fill_param_list(Form, Name, VT, Options).

 http_convert_parameters(+Data, ?Params) is det

 http_convert_parameters(+Data, ?Params, :AttrDecl) is det

Implements the parameter translation of http_parameters/2 or http_parameters/3. I.e., http_parameters/2 for a POST request can be implemented as:

http_parameters(Request, Params) :-
    http_read_data(Request, Data, []),
    http_convert_parameters(Data, Params).

  272http_convert_parameters(Data, ParamDecls) :-
  273    fill_parameters(ParamDecls, Data, no_decl_goal).
  274http_convert_parameters(Data, ParamDecls, DeclGoal) :-
  275    fill_parameters(ParamDecls, Data, DeclGoal).
  276
  277no_decl_goal(_,_) :- fail.

 http_convert_parameter(+Options, +FieldName, +ValueIn, -ValueOut) is det

Conversion of an HTTP form value. First tries the multifile hook http:convert_parameter/3 and next the built-in checks.

Arguments:

Option	- List as provided with the parameter
FieldName	- Name of the HTTP field (for better message)
ValueIn	- Atom value as received from HTTP layer
ValueOut	- Possibly converted final value

Errors

- type_error(Type, Value)

  290http_convert_parameter([], _, Value, Value).
  291http_convert_parameter([H|T], Field, Value0, Value) :-
  292    (   check_type_no_error(H, Value0, Value1)
  293    ->  catch(http_convert_parameter(T, Field, Value1, Value),
  294              error(Formal, _),
  295              throw(error(Formal, context(_, http_parameter(Field)))))
  296    ;   throw(error(type_error(H, Value0),
  297                    context(_, http_parameter(Field))))
  298    ).
  299
  300check_type_no_error(Type, In, Out) :-
  301    http:convert_parameter(Type, In, Out),
  302    !.
  303check_type_no_error(Type, In, Out) :-
  304    check_type3(Type, In, Out).

 check_type3(+Type, +ValueIn, -ValueOut) is semidet

HTTP parameter type-check for types that need converting.

  310check_type3((T1;T2), In, Out) :-
  311    !,
  312    (   check_type_no_error(T1, In, Out)
  313    ->  true
  314    ;   check_type_no_error(T2, In, Out)
  315    ).
  316check_type3(string, Atom, String) :-
  317    !,
  318    to_string(Atom, String).
  319check_type3(number, Atom, Number) :-
  320    !,
  321    to_number(Atom, Number).
  322check_type3(integer, Atom, Integer) :-
  323    !,
  324    to_number(Atom, Integer),
  325    integer(Integer).
  326check_type3(nonneg, Atom, Integer) :-
  327    !,
  328    to_number(Atom, Integer),
  329    integer(Integer),
  330    Integer >= 0.
  331check_type3(float, Atom, Float) :-
  332    !,
  333    to_number(Atom, Number),
  334    Float is float(Number).
  335check_type3(between(Low, High), Atom, Value) :-
  336    !,
  337    to_number(Atom, Number),
  338    (   (float(Low) ; float(High))
  339    ->  Value is float(Number)
  340    ;   Value = Number
  341    ),
  342    is_of_type(between(Low, High), Value).
  343check_type3(boolean, Atom, Bool) :-
  344    !,
  345    truth(Atom, Bool).
  346check_type3(Type, Atom, Atom) :-
  347    check_type2(Type, Atom).
  348
  349to_number(In, Number) :-
  350    number(In), !, Number = In.
  351to_number(In, Number) :-
  352    atom(In),
  353    atom_number(In, Number).
  354
  355to_string(In, String) :- string(In), !, String = In.
  356to_string(In, String) :- atom(In),   !, atom_string(In, String).
  357to_string(In, String) :- number(In), !, number_string(In, String).

 check_type2(+Type, +ValueIn) is semidet

HTTP parameter type-check for types that need no conversion.

  363check_type2(oneof(Set), Value) :-
  364    !,
  365    memberchk(Value, Set).
  366check_type2(length > N, Value) :-
  367    !,
  368    atom_length(Value, Len),
  369    Len > N.
  370check_type2(length >= N, Value) :-
  371    !,
  372    atom_length(Value, Len),
  373    Len >= N.
  374check_type2(length < N, Value) :-
  375    !,
  376    atom_length(Value, Len),
  377    Len < N.
  378check_type2(length =< N, Value) :-
  379    !,
  380    atom_length(Value, Len),
  381    Len =< N.
  382check_type2(_, _).

 truth(+In, -Boolean) is semidet

Translate some commonly used textual representations for true and false into their canonical representation.

  389truth(true,    true).
  390truth('TRUE',  true).
  391truth(yes,     true).
  392truth('YES',   true).
  393truth(on,      true).
  394truth('ON',    true).                   % IE7
  395truth('1',     true).
  396
  397truth(false,   false).
  398truth('FALSE', false).
  399truth(no,      false).
  400truth('NO',    false).
  401truth(off,     false).
  402truth('OFF',   false).
  403truth('0',     false).
  404
  405
  406                 /*******************************
  407                 *         XREF SUPPORT         *
  408                 *******************************/
  409
  410:- multifile
  411    prolog:called_by/2,
  412    emacs_prolog_colours:goal_colours/2.  413
  414prolog:called_by(http_parameters(_,_,Options), [G+2]) :-
  415    option(attribute_declarations(G), Options, _),
  416    callable(G),
  417    !.
  418
  419emacs_prolog_colours:goal_colours(http_parameters(_,_,Options),
  420                                  built_in-[classify, classify, Colours]) :-
  421    option_list_colours(Options, Colours).
  422
  423option_list_colours(Var, error) :-
  424    var(Var),
  425    !.
  426option_list_colours([], classify) :- !.
  427option_list_colours(Term, list-Elements) :-
  428    Term = [_|_],
  429    !,
  430    option_list_colours_2(Term, Elements).
  431option_list_colours(_, error).
  432
  433option_list_colours_2(Var, classify) :-
  434    var(Var).
  435option_list_colours_2([], []).
  436option_list_colours_2([H0|T0], [H|T]) :-
  437    option_colours(H0, H),
  438    option_list_colours_2(T0, T).
  439
  440option_colours(Var,  classify) :-
  441    var(Var),
  442    !.
  443option_colours(_=_,  built_in-[classify,classify]) :- !.
  444option_colours(attribute_declarations(_),               % DCG = is a hack!
  445               option(attribute_declarations)-[dcg]) :- !.
  446option_colours(Term, option(Name)-[classify]) :-
  447    compound(Term),
  448    Term =.. [Name,_Value],
  449    !.
  450option_colours(_, error).
  451
  452                 /*******************************
  453                 *            MESSAGES          *
  454                 *******************************/
  455
  456:- multifile prolog:error_message//1.  457:- multifile prolog:message//1.  458
  459prolog:error_message(existence_error(http_parameter, Name)) -->
  460    [ 'Missing value for parameter "~w".'-[Name] ].
  461prolog:message(error(type_error(Type, Term), context(_, http_parameter(Param)))) -->
  462    { atom(Param) },
  463    [ 'Parameter "~w" must be '-[Param] ],
  464    param_type(Type),
  465    ['.  Found "~w".'-[Term] ].
  466
  467param_type(length>N) -->
  468    !,
  469    ['longer than ~D characters'-[N]].
  470param_type(length>=N) -->
  471    !,
  472    ['at least ~D characters'-[N]].
  473param_type(length<N) -->
  474    !,
  475    ['shorter than ~D characters'-[N]].
  476param_type(length=<N) -->
  477    !,
  478    ['at most ~D characters'-[N]].
  479param_type(between(Low,High)) -->
  480    !,
  481    (   {float(Low);float(High)}
  482    ->  ['a number between ~w and ~w'-[Low,High]]
  483    ;   ['an integer between ~w and ~w'-[Low,High]]
  484    ).
  485param_type(oneof([Only])) -->
  486    !,
  487    ['"~w"'-[Only]].
  488param_type(oneof(List)) -->
  489    !,
  490    ['one of '-[]], oneof(List).
  491param_type(T) -->
  492    ['of type ~p'-[T]].
  493
  494
  495oneof([]) --> [].
  496oneof([H|T]) -->
  497    ['"~w"'-[H]],
  498    (   {T == []}
  499    ->  []
  500    ;   {T = [Last]}
  501    ->  [' or "~w"'-[Last] ]
  502    ;   [', '-[]],
  503        oneof(T)
  504    )