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'),
                    ...).

   82:- meta_predicate
   83    http_parameters(+, ?, :),
   84    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].

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

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

 fill_parameters(+ParamDecls, +FormData, +DeclGoal)

Fill values from the parameter list

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

  268http_convert_parameters(Data, ParamDecls) :-
  269    fill_parameters(ParamDecls, Data, no_decl_goal).
  270http_convert_parameters(Data, ParamDecls, DeclGoal) :-
  271    fill_parameters(ParamDecls, Data, DeclGoal).
  272
  273no_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)

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

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

HTTP parameter type-check for types that need converting.

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

  359check_type2(oneof(Set), Value) :-
  360    !,
  361    memberchk(Value, Set).
  362check_type2(length > N, Value) :-
  363    !,
  364    atom_length(Value, Len),
  365    Len > N.
  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(_, _).

 truth(+In, -Boolean) is semidet

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

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