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)  2007-2025, University of Amsterdam
    7                              VU University Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(http_json,
   38          [ reply_json/1,               % +JSON
   39            reply_json/2,               % +JSON, Options
   40            reply_json_dict/1,          % +JSON
   41            reply_json_dict/2,          % +JSON, Options
   42            http_read_json/2,           % +Request, -JSON
   43            http_read_json/3,           % +Request, -JSON, +Options
   44            http_read_json_dict/2,      % +Request, -Dict
   45            http_read_json_dict/3,      % +Request, -Dict, +Options
   46
   47            is_json_content_type/1      % +HeaderValue
   48          ]).   49:- use_module(library(http/http_client)).   50:- use_module(library(http/http_header)).   51:- use_module(library(http/http_stream)).   52:- use_module(library(json)).   53:- use_module(library(option)).   54:- use_module(library(error)).   55:- use_module(library(lists)).   56:- use_module(library(memfile)).   57
   58:- multifile
   59    http_client:http_convert_data/4,
   60    http:post_data_hook/3,
   61    json_type/1.   62
   63:- public
   64    json_type/1.   65
   66:- predicate_options(http_read_json/3, 3,
   67                     [ content_type(any),
   68                       false(ground),
   69                       null(ground),
   70                       true(ground),
   71                       value_string_as(oneof([atom, string])),
   72                       json_object(oneof([term,dict]))
   73                     ]).   74:- predicate_options(reply_json/2, 2,
   75                     [ content_type(any),
   76                       status(integer),
   77                       json_object(oneof([term,dict])),
   78                       pass_to(json:json_write/3, 3)
   79                     ]).   80
   81
   82/** <module> HTTP JSON Plugin module
   83
   84Most   code   doesn't   need  to   use  this   directly;  instead   use
   85library(http/http_server),  which  combines   this  library  with   the
   86typical HTTP libraries that most servers need.
   87
   88This module adds hooks to several parts   of  the HTTP libraries, making
   89them JSON-aware.  Notably:
   90
   91  - Make http_read_data/3 convert `application/json` and
   92    `application/jsonrequest` content to a JSON term.
   93  - Cause http_open/3 to accept post(json(Term)) to issue a POST
   94    request with JSON content.
   95  - Provide HTTP server and client utility predicates for reading
   96    and replying JSON:
   97    - http_read_json/2
   98    - http_read_json/3
   99    - http_read_json_dict/2
  100    - http_read_json_dict/3
  101    - reply_json/1
  102    - reply_json/2
  103    - reply_json_dict/1
  104    - reply_json_dict/2
  105  - Reply to exceptions in the server using an JSON document rather
  106    then HTML if the =|Accept|= header prefers application/json over
  107    text/html.
  108
  109Typically JSON is used by Prolog HTTP  servers. This module supports two
  110JSON  representations:  the  classical  representation    and   the  new
  111representation supported by  the  SWI-Prolog   version  7  extended data
  112types. Below is a skeleton for  handling   a  JSON request, answering in
  113JSON using the classical interface.
  114
  115  ==
  116  handle(Request) :-
  117        http_read_json(Request, JSONIn),
  118        json_to_prolog(JSONIn, PrologIn),
  119        <compute>(PrologIn, PrologOut),         % application body
  120        prolog_to_json(PrologOut, JSONOut),
  121        reply_json(JSONOut).
  122  ==
  123
  124When using dicts, the conversion step is   generally  not needed and the
  125code becomes:
  126
  127  ==
  128  handle(Request) :-
  129        http_read_json_dict(Request, DictIn),
  130        <compute>(DictIn, DictOut),
  131        reply_json(DictOut).
  132  ==
  133
  134This module also integrates JSON support   into the http client provided
  135by http_client.pl. Posting a JSON query   and  processing the JSON reply
  136(or any other reply understood  by   http_read_data/3)  is  as simple as
  137below, where Term is a JSON term as described in json.pl and reply is of
  138the same format if the server replies with JSON.
  139
  140  ==
  141        ...,
  142        http_post(URL, json(Term), Reply, [])
  143  ==
  144
  145@see    JSON Requests are discussed in http://json.org/JSONRequest.html
  146@see    json.pl describes how JSON objects are represented in Prolog terms.
  147@see    json_convert.pl converts between more natural Prolog terms and json
  148terms.
  149*/
  150
  151%!  http_client:http_convert_data(+In, +Fields, -Data, +Options)
  152%
  153%   Hook implementation that supports  reading   JSON  documents. It
  154%   processes the following option:
  155%
  156%     * json_object(+As)
  157%     Where As is one of =term= or =dict=.  If the value is =dict=,
  158%     json_read_dict/3 is used.
  159
  160http_client:http_convert_data(In, Fields, Data, Options) :-
  161    memberchk(content_type(Type), Fields),
  162    is_json_content_type(Type),
  163    !,
  164    (   memberchk(content_length(Bytes), Fields)
  165    ->  setup_call_cleanup(
  166            ( stream_range_open(In, Range, [size(Bytes)]),
  167              set_stream(Range, encoding(utf8))
  168            ),
  169            json_read_to(Range, Data, Options),
  170            close(Range))
  171    ;   set_stream(In, encoding(utf8)),
  172        json_read_to(In, Data, Options)
  173    ).
  174
  175
  176%!  is_json_content_type(+ContentType) is semidet.
  177%
  178%   True  if  ContentType  is  a  header  value  (either  parsed  or  as
  179%   atom/string) that denotes a JSON value.
  180
  181is_json_content_type(String) :-
  182    http_parse_header_value(content_type, String,
  183                            media(Type, _Attributes)),
  184    json_type(Type),
  185    !.
  186
  187json_read_to(In, Data, Options) :-
  188    memberchk(json_object(dict), Options),
  189    !,
  190    json_read_dict(In, Data, Options).
  191json_read_to(In, Data, Options) :-
  192    json_read(In, Data, Options).
  193
  194%!  json_type(?MediaType) is semidet.
  195%
  196%   True if MediaType is a JSON media type. http_json:json_type/1 is
  197%   a  multifile  predicate  and  may   be  extended  to  facilitate
  198%   non-conforming clients.
  199%
  200%   @arg MediaType is a term `Type`/`SubType`, where both `Type` and
  201%   `SubType` are atoms.
  202
  203json_type(application/jsonrequest).
  204json_type(application/json).
  205
  206
  207%!  http:post_data_hook(+Data, +Out:stream, +HdrExtra) is semidet.
  208%
  209%   Hook implementation that allows   http_post_data/3  posting JSON
  210%   objects using one of the  forms   below.
  211%
  212%     ==
  213%     http_post(URL, json(Term), Reply, Options)
  214%     http_post(URL, json(Term, Options), Reply, Options)
  215%     ==
  216%
  217%   If Options are passed, these are handed to json_write/3. In
  218%   addition, this option is processed:
  219%
  220%     * json_object(As)
  221%     If As is =dict=, json_write_dict/3 is used to write the
  222%     output.  This is default if json(Dict) is passed.
  223%
  224%   @tbd avoid creation of intermediate data using chunked output.
  225
  226http:post_data_hook(json(Dict), Out, HdrExtra) :-
  227    is_dict(Dict),
  228    !,
  229    http:post_data_hook(json(Dict, [json_object(dict)]),
  230                        Out, HdrExtra).
  231http:post_data_hook(json(Term), Out, HdrExtra) :-
  232    http:post_data_hook(json(Term, []), Out, HdrExtra).
  233http:post_data_hook(json(Term, Options), Out, HdrExtra) :-
  234    option(content_type(Type), HdrExtra, 'application/json'),
  235    setup_call_cleanup(
  236        ( new_memory_file(MemFile),
  237          open_memory_file(MemFile, write, Handle)
  238        ),
  239        ( format(Handle, 'Content-type: ~w~n~n', [Type]),
  240          json_write_to(Handle, Term, Options)
  241        ),
  242        close(Handle)),
  243    setup_call_cleanup(
  244        open_memory_file(MemFile, read, RdHandle,
  245                         [ free_on_close(true)
  246                         ]),
  247        http_post_data(cgi_stream(RdHandle), Out, HdrExtra),
  248        close(RdHandle)).
  249
  250json_write_to(Out, Term, Options) :-
  251    memberchk(json_object(dict), Options),
  252    !,
  253    json_write_dict(Out, Term, Options).
  254json_write_to(Out, Term, Options) :-
  255    json_write(Out, Term, Options).
  256
  257
  258%!  http_read_json(+Request, -JSON) is det.
  259%!  http_read_json(+Request, -JSON, +Options) is det.
  260%
  261%   Extract JSON data posted  to  this   HTTP  request.  Options are
  262%   passed to json_read/3.  In addition, this option is processed:
  263%
  264%     - json_object(+As)
  265%       One of `term` (default) to generate a classical Prolog
  266%       term or `dict` to exploit the SWI-Prolog version 7 data type
  267%       extensions.  See json_read_dict/3.
  268%
  269%   @error  domain_error(mimetype, Found) if the mimetype is
  270%           not known (see json_type/1).
  271%   @error  domain_error(method, Method) if the request method is not
  272%           a =POST=, =PUT= or =PATCH=.
  273
  274http_read_json(Request, JSON) :-
  275    http_read_json(Request, JSON, []).
  276
  277http_read_json(Request, JSON, Options) :-
  278    select_option(content_type(Type), Options, Rest),
  279    !,
  280    delete(Request, content_type(_), Request2),
  281    request_to_json([content_type(Type)|Request2], JSON, Rest).
  282http_read_json(Request, JSON, Options) :-
  283    request_to_json(Request, JSON, Options).
  284
  285request_to_json(Request, JSON, Options) :-
  286    option(method(Method), Request),
  287    option(content_type(Type), Request),
  288    (   data_method(Method)
  289    ->  true
  290    ;   domain_error(method, Method)
  291    ),
  292    (   is_json_content_type(Type)
  293    ->  true
  294    ;   domain_error(mimetype, Type)
  295    ),
  296    http_read_data(Request, JSON, Options).
  297
  298data_method(post).
  299data_method(put).
  300data_method(patch).
  301
  302%!  http_read_json_dict(+Request, -Dict) is det.
  303%!  http_read_json_dict(+Request, -Dict, +Options) is det.
  304%
  305%   Similar to http_read_json/2,3, but by default uses the version 7
  306%   extended datatypes.
  307
  308http_read_json_dict(Request, Dict) :-
  309    http_read_json_dict(Request, Dict, []).
  310
  311http_read_json_dict(Request, Dict, Options) :-
  312    merge_options([json_object(dict)], Options, Options1),
  313    http_read_json(Request, Dict, Options1).
  314
  315%!  reply_json(+JSONTerm) is det.
  316%!  reply_json(+JSONTerm, +Options) is det.
  317%
  318%   Formulate a JSON  HTTP  reply.   See  json_write/2  for details.
  319%   The processed options are listed below.  Remaining options are
  320%   forwarded to json_write/3.
  321%
  322%       * content_type(+Type)
  323%       The default =|Content-type|= is =|application/json;
  324%       charset=UTF8|=. =|charset=UTF8|= should not be required
  325%       because JSON is defined to be UTF-8 encoded, but some
  326%       clients insist on it.
  327%
  328%       * status(+Code)
  329%       The default status is 200.  REST API functions may use
  330%       other values from the 2XX range, such as 201 (created).
  331%
  332%       * json_object(+As)
  333%       One of =term= (classical json representation) or =dict=
  334%       to use the new dict representation.  If omitted and Term
  335%       is a dict, =dict= is assumed.  SWI-Prolog Version 7.
  336
  337reply_json(Dict) :-
  338    is_dict(Dict),
  339    !,
  340    reply_json_dict(Dict).
  341reply_json(Term) :-
  342    default_json_content_type(Type),
  343    format('Content-type: ~w~n~n', [Type]),
  344    json_write(current_output, Term).
  345
  346reply_json(Dict, Options) :-
  347    is_dict(Dict),
  348    !,
  349    reply_json_dict(Dict, Options).
  350reply_json(Term, Options) :-
  351    reply_json2(Term, Options).
  352
  353%!  reply_json_dict(+JSONTerm) is det.
  354%!  reply_json_dict(+JSONTerm, +Options) is det.
  355%
  356%   As reply_json/1 and reply_json/2, but assumes the new dict based
  357%   data representation. Note that this is  the default if the outer
  358%   object is a dict. This predicate is   needed to serialize a list
  359%   of   objects   correctly   and     provides   consistency   with
  360%   http_read_json_dict/2 and friends.
  361
  362reply_json_dict(Dict) :-
  363    default_json_content_type(Type),
  364    format('Content-type: ~w~n~n', [Type]),
  365    json_write_dict(current_output, Dict).
  366
  367reply_json_dict(Dict, Options) :-
  368    merge_options([json_object(dict)], Options, Options1),
  369    reply_json2(Dict, Options1).
  370
  371reply_json2(Term, Options) :-
  372    default_json_content_type(DefType),
  373    select_option(content_type(Type), Options, Rest0, DefType),
  374    (   select_option(status(Code), Rest0, Rest)
  375    ->  format('Status: ~d~n', [Code])
  376    ;   Rest = Rest0
  377    ),
  378    format('Content-type: ~w~n~n', [Type]),
  379    json_write_to(current_output, Term, Rest).
  380
  381default_json_content_type('application/json; charset=UTF-8').
  382
  383
  384		 /*******************************
  385		 *       STATUS HANDLING	*
  386		 *******************************/
  387
  388:- multifile
  389    http:status_reply/3,
  390    http:serialize_reply/2.  391
  392http:serialize_reply(json(Term), body(application/json, utf8, Content)) :-
  393    with_output_to(string(Content),
  394                   json_write_dict(current_output, Term, [])).
  395
  396http:status_reply(Term, json(Reply), Options) :-
  397    prefer_json(Options.get(accept)),
  398    json_status_reply(Term, Lines, Extra),
  399    phrase(txt_message_lines(Lines), Codes),
  400    string_codes(Message, Codes),
  401    Reply = _{code:Options.code, message:Message}.put(Extra).
  402
  403txt_message_lines([]) -->
  404    [].
  405txt_message_lines([nl|T]) -->
  406    !,
  407    "\n",
  408    txt_message_lines(T).
  409txt_message_lines([flush]) -->
  410    !.
  411txt_message_lines([FmtArgs|T]) -->
  412    dcg_format(FmtArgs),
  413    txt_message_lines(T).
  414
  415dcg_format(Fmt-Args, List, Tail) :-
  416    !,
  417    format(codes(List,Tail), Fmt, Args).
  418dcg_format(ansi(_Style, Fmt,Args), List, Tail) :-
  419    !,
  420    format(codes(List,Tail), Fmt, Args).
  421dcg_format(url(Pos), List, Tail) :-
  422    !,
  423    dcg_url(Pos, List, Tail).
  424dcg_format(url(_URL, Label), List, Tail) :-
  425    !,
  426    format(codes(List,Tail), '~w', [Label]).
  427dcg_format(Fmt, List, Tail) :-
  428    format(codes(List,Tail), Fmt, []).
  429
  430dcg_url(File:Line:Column, List, Tail) :-
  431    !,
  432    format(codes(List,Tail), '~w:~d:~d', [File, Line, Column]).
  433dcg_url(File:Line, List, Tail) :-
  434    !,
  435    format(codes(List,Tail), '~w:~d', [File, Line]).
  436dcg_url(File, List, Tail) :-
  437    !,
  438    format(codes(List,Tail), '~w', [File]).
  439
  440
  441%!  prefer_json(+Accept)
  442%
  443%   True when the accept encoding prefers JSON.
  444
  445prefer_json(Accept) :-
  446    memberchk(media(application/json, _, JSONP,  []), Accept),
  447    (   member(media(text/html, _, HTMLP,  []), Accept)
  448    ->  JSONP > HTMLP
  449    ;   true
  450    ).
  451
  452%!  json_status_reply(+Term, -MsgLines, -ExtraJSON) is semidet.
  453
  454json_status_reply(created(Location),
  455                  [ 'Created: ~w'-[Location] ],
  456                  _{location:Location}).
  457json_status_reply(moved(Location),
  458                  [ 'Moved to: ~w'-[Location] ],
  459                  _{location:Location}).
  460json_status_reply(moved_temporary(Location),
  461                  [ 'Moved temporary to: ~w'-[Location] ],
  462                  _{location:Location}).
  463json_status_reply(see_other(Location),
  464                  [ 'See: ~w'-[Location] ],
  465                  _{location:Location}).
  466json_status_reply(bad_request(ErrorTerm), Lines, _{}) :-
  467    '$messages':translate_message(ErrorTerm, Lines, []).
  468json_status_reply(authorise(Method),
  469                  [ 'Authorization (~p) required'-[Method] ],
  470                  _{}).
  471json_status_reply(forbidden(Location),
  472                  [ 'You have no permission to access: ~w'-[Location] ],
  473                  _{location:Location}).
  474json_status_reply(not_found(Location),
  475                  [ 'Path not found: ~w'-[Location] ],
  476                  _{location:Location}).
  477json_status_reply(method_not_allowed(Method,Location),
  478                  [ 'Method not allowed: ~w'-[UMethod] ],
  479                  _{location:Location, method:UMethod}) :-
  480    upcase_atom(Method, UMethod).
  481json_status_reply(not_acceptable(Why),
  482                  [ 'Request is not acceptable: ~p'-[Why]
  483                  ],
  484                  _{}).
  485json_status_reply(server_error(ErrorTerm), Lines, _{}) :-
  486    '$messages':translate_message(ErrorTerm, Lines, []).
  487json_status_reply(service_unavailable(Why),
  488                  [ 'Service unavailable: ~p'-[Why]
  489                  ],
  490                  _{})