/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - Written in December 2020 by Adrián Arroyo (adrian.arroyocalle@gmail.com) Updated in March 2022 by Adrián Arroyo to use the Hyper backend Part of Scryer Prolog This library provides an starting point to build HTTP server based applications. It is based on Hyper, which allows for HTTP/1.0, HTTP/1.1 and HTTP/2. However, some advanced features that Hyper provides are still not accesible. Usage ========== The main predicate of the library is http_listen/2, which needs a port number (usually 80) and a list of handlers. A handler is a compound term with the functor as one HTTP method (in lowercase) and followed by a Route Match and a predicate which will handle the call. text_handler(Request, Response) :- http_status_code(Response, 200), http_body(Response, text("Welcome to Scryer Prolog!")). parameter_handler(User, Request, Response) :- http_body(Response, text(User)). http_listen(7890, [ get(echo, text_handler), % GET /echo post(user/User, parameter_handler(User)) % POST /user/ ]). Every handler predicate will have at least 2-arity, with Request and Response. Although you can work directly with http_request and http_response terms, it is recommeded to use the helper predicates, which are easier to understand and cleaner: - http_headers(Response/Request, Headers) - http_status_code(Responde, StatusCode) - http_body(Response/Request, text(Body)) - http_body(Response/Request, binary(Body)) - http_body(Request, form(Form)) - http_body(Response, file(Filename)) - http_redirect(Response, Url) - http_query(Request, QueryName, QueryValue) Some things that are still missing: - Read forms in multipart format - HTTP Basic Auth - Session handling via cookies - HTML Templating I place this code in the public domain. Use it in any way you want. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ :- module(http_server, [ http_listen/2, http_headers/2, http_status_code/2, http_body/2, http_redirect/2, http_query/3 ]). :- meta_predicate http_listen(?, :). :- use_module(library(charsio)). :- use_module(library(crypto)). :- use_module(library(error)). :- use_module(library(format)). :- use_module(library(iso_ext)). :- use_module(library(lists)). :- use_module(library(pio)). :- use_module(library(time)). http_listen(Port, Module:Handlers0) :- must_be(integer, Port), must_be(list, Handlers0), maplist(module_qualification(Module), Handlers0, Handlers), http_listen_(Port, Handlers). module_qualification(M, H0, H) :- H0 =.. [Method, Path, Goal], H =.. [Method, Path, M:Goal]. http_listen_(Port, Handlers) :- phrase(format_("0.0.0.0:~d", [Port]), Addr), '$http_listen'(Addr, HttpListener),!, format("Listening at ~s\n", [Addr]), http_loop(HttpListener, Handlers). http_loop(HttpListener, Handlers) :- '$http_accept'(HttpListener, RequestMethod, RequestPath, RequestHeaders, RequestQuery, RequestStream, ResponseHandle), current_time(Time), phrase(format_time("%Y-%m-%d (%H:%M:%S)", Time), TimeString), format("~s ~w ~s\n", [TimeString, RequestMethod, RequestPath]), maplist(map_header_kv, RequestHeaders, RequestHeadersKV), phrase(parse_queries(RequestQueries), RequestQuery), ( match_handler(Handlers, RequestMethod, RequestPath, Handler) -> ( HttpRequest = http_request(RequestHeadersKV, stream(RequestStream), RequestQueries), HttpResponse = http_response(_, _, _), (call(Handler, HttpRequest, HttpResponse) -> send_response(ResponseHandle, HttpResponse) ; ( '$http_answer'(ResponseHandle, 500, [], ResponseStream), call_cleanup(format(ResponseStream, "Internal Server Error", []), close(ResponseStream))) ) ) ; ( '$http_answer'(ResponseHandle, 404, [], ResponseStream), call_cleanup(format(ResponseStream, "Not Found"), close(ResponseStream))) ), http_loop(HttpListener, Handlers). send_response(ResponseHandle, http_response(StatusCode0, text(ResponseText), ResponseHeaders0)) :- default(StatusCode0, 200, StatusCode), maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0), '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream), call_cleanup( format(ResponseStream, "~s", [ResponseText]), close(ResponseStream) ). send_response(ResponseHandle, http_response(StatusCode0, bytes(ResponseBytes), ResponseHeaders0)) :- default(StatusCode0, 200, StatusCode), maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0), '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream), call_cleanup( format(ResponseStream, "~s", [ResponseBytes]), close(ResponseStream) ). send_response(ResponseHandle, http_response(StatusCode0, file(Filename), ResponseHeaders0)) :- default(StatusCode0, 200, StatusCode), maplist(map_header_kv_2, ResponseHeaders, ResponseHeaders0), '$http_answer'(ResponseHandle, StatusCode, ResponseHeaders, ResponseStream), call_cleanup( setup_call_cleanup( open(Filename, read, FileStream, [type(binary)]), ( get_n_chars(FileStream, _, FileCs), format(ResponseStream, "~s", [FileCs]) ), close(FileStream) ), close(ResponseStream) ). default(Var, Default, Out) :- (var(Var) -> Out = Default ; Var = Out ). map_header_kv(T, K-V) :- T =.. [K0, V], atom_chars(K0, K). map_header_kv_2(T, K-V) :- atom_chars(K0, K), T =.. [K0, V]. match_handler(Handlers, Method, "/", Handler) :- member(H, Handlers), H =.. [Method, /, Handler]. match_handler(Handlers, Method, Path, Handler) :- member(H, Handlers), copy_term(H, H1), H1 =.. [Method, Pattern, Handler], \+ var(Pattern), phrase(path(Pattern), Path). match_handler(Handlers, Method, Path, Handler) :- member(H, Handlers), copy_term(H, H1), H1 =.. [Method, Var, Handler], var(Var), Var = Path. path(Pattern) --> { Pattern =.. Parts, length(Parts, 3), nth0(1, Parts, Pattern0), nth0(2, Parts, PartAtom), (var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part)) }, path(Pattern0), "/", string_without("/", Part). path(Pattern) --> { Pattern =.. Parts, Parts = [PartAtom], (var(PartAtom) -> Part = PartAtom; atom_chars(PartAtom, Part)) }, "/", string_without("/", Part). path([]) --> []. string_without(Not, [Char|String]) --> [Char], { \+ member(Char, Not) }, string_without(Not, String). string_without(_, []) --> []. http_headers(http_request(Headers, _, _), Headers). http_headers(http_response(_, _, Headers), Headers). http_body(http_request(_, stream(StreamBody), _), bytes(BytesBody)) :- get_n_chars(StreamBody, _, BytesBody). http_body(http_request(_, stream(StreamBody), _), text(TextBody)) :- get_n_chars(StreamBody, _, TextBody). http_body(http_request(Headers, stream(StreamBody), _), form(FormBody)) :- member("content-type"-"application/x-www-form-urlencoded", Headers), get_n_chars(StreamBody, _, TextBody), phrase(parse_queries(FormBody), TextBody). http_body(http_request(_, Body, _), Body). http_body(http_response(_, Body, _), Body). http_status_code(http_response(StatusCode, _, _), StatusCode). http_redirect(http_response(307, text("Moved Temporarily"), ["Location"-Uri]), Uri). http_query(http_request(_, _, Queries), Key, Value) :- member(Key-Value, Queries). parse_queries([Key-Value|Queries]) --> string_without("=", Key0), { phrase(url_decode(Key), Key0) }, "=", string_without("&", Value0), { phrase(url_decode(Value), Value0) }, "&", parse_queries(Queries). parse_queries([Key-Value]) --> string_without("=", Key0), { phrase(url_decode(Key), Key0) }, "=", string_without(" ", Value0), { phrase(url_decode(Value), Value0) }. parse_queries([]) --> []. % Decodes a UTF-8 URL Encoded string: RFC-1738 url_decode([Char|Chars]) --> [Char], { Char \= '%' }, url_decode(Chars). url_decode([Char|Chars]) --> "%", [A], [B], { hex_bytes([A,B], Bytes), Bytes = [FirstByte|_], FirstByte < 128, chars_utf8bytes(Chars0, Bytes), Chars0 = [Char] }, url_decode(Chars). url_decode([Char|Chars]) --> "%", [A, B], "%", [C, D], { hex_bytes([A,B,C,D], Bytes), Bytes = [FirstByte|_], FirstByte < 224, chars_utf8bytes(Chars0, Bytes), Chars0 = [Char] }, url_decode(Chars). url_decode([Char|Chars]) --> "%", [A, B], "%", [C, D], "%", [E, F], { hex_bytes([A,B,C,D,E,F], Bytes), Bytes = [FirstByte|_], FirstByte < 240, chars_utf8bytes(Chars0, Bytes), Chars0 = [Char] }, url_decode(Chars). url_decode([Char|Chars]) --> "%", [A, B], "%", [C, D], "%", [E, F], "%", [H, I], { hex_bytes([A,B,C,D,E,F,H,I], Bytes), chars_utf8bytes(Chars0, Bytes), Chars0 = [Char] }, url_decode(Chars). url_decode([]) --> [].