1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2017, CWI Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(oauth2,
   36	  [ oauth2_login/2,			% +Request, +Options
   37	    oauth2_reply/2,			% +Request, +Options
   38	    oauth2_validate_access_token/3,	% +ServerID, +AccessToken,
   39						% -Info:dict
   40	    oauth2_user_info/3,			% +ServerID, +TokenInfo, -UserInfo
   41	    oauth2_claim/2			% +TokenInfo, -Claim
   42	  ]).   43:- use_module(library(http/http_dispatch)).   44:- use_module(library(http/http_parameters)).   45:- use_module(library(http/http_open)).   46:- use_module(library(http/http_path)).   47:- use_module(library(http/http_host)).   48:- use_module(library(http/http_wrapper)).   49:- use_module(library(http/http_header)).   50:- use_module(library(http/html_write)).   51:- use_module(library(http/json)).   52:- use_module(library(base64)).   53:- use_module(library(utf8)).   54:- use_module(library(uri)).   55:- use_module(library(debug)).   56:- use_module(library(error)).   57:- use_module(library(option)).   58:- use_module(library(apply)).   59
   60/** <module> Oauth2 based login
   61
   62This  module  provides  oauth2  based  login.  Oauth2  is  a  _federated
   63identity_  protocol.  It  allows  a  user  to  login  to  a  service  by
   64redirecting to an _identity provider_. After   validating  the user, the
   65identity provider redirects back  to  our   service.  In  the process we
   66obtain an anonymous  identifier  for  the   user  and  optionally  _user
   67attributes_ such as the user's name, email, etc.
   68
   69As oauth2 does not use HTTP  authentication   the  fact  that a user has
   70logged in must be handled using an HTTP session.
   71
   72Using this module requires the user to define two _hooks_:
   73
   74  - server_attribute/3 defines properties about one or more _identity
   75    providers_.
   76  - login/3 establishes the login, typically by ensuring an HTTP session
   77    and relating the identity to this session.
   78*/
   79
   80:- multifile
   81	server_attribute/3,		% +ServerID, +Attribute, -Value
   82	login/3,			% +Request, +ServerID, +TokenInfo
   83	login_failed/2.			% +Request, +Message
   84
   85:- multifile http:location/3.   86:- dynamic   http:location/3.   87
   88http:location(oauth2, root(oauth2), [priority(-100)]).
   89
   90:- http_handler(oauth2(.), oauth2, [prefix]).   91
   92%!	server_attribute(?ServerID, ?Attribute, ?Value) is nondet.
   93%
   94%	Multifile hook that defines available   oauth2 servers. ServerID
   95%	is our internal  nickname  for   the  oauth2  identity provider.
   96%	Attribute and Value provide the various   attributes  we need to
   97%	know to contact the server. Defined attributes are:
   98%
   99%	  - url
  100%	  Base URL for the identity provider.  Normally points at the
  101%	  root of the server.  Other locations are relative to this URL.
  102%
  103%	  - redirect_uri
  104%	  URI to which the identity provider will redirect back.  This
  105%	  is the public URL for oauth2(ServerID/reply).  It may be left
  106%	  undefined if the server can find its own location.  This URI
  107%	  is normally registered with the identity provider.
  108%
  109%	  - discovery_endpoint
  110%	  Endpoint for automatic configuration.  The default is `url`,
  111%	  followed by =|/.well-known/openid-configuration|=.  The
  112%	  discovery URL is used if one of the other required attributes
  113%	  is not defined by the hook.
  114%
  115%	  - authorization_endpoint
  116%	  Path on the identity provider that initiates a login.  The
  117%	  default is obtained from the `discovery_endpoint.
  118%
  119%	  - token_endpoint
  120%	  Location to validate the access code and obtain an access
  121%	  token.   The default is obtained from the `discovery_endpoint.
  122%
  123%	  - userinfo_endpoint
  124%	  Path to get info on the user from the access token. The
  125%	  default is obtained from the `discovery_endpoint.
  126%
  127%	  - tokeninfo_endpoint
  128%	  Needed for _implicit_ and _hybrid_ login flows (typically not
  129%	  used by servers)
  130%
  131%	  - client_id
  132%	  Identity by which we are known at the identity provider.
  133%
  134%	  - client_secret
  135%	  Secret we need to identify ourselves with the identity
  136%	  provider
  137%
  138%	  - scope
  139%	  Set of attributes we wish to have from the identity provider.
  140%
  141%	  - cert_verify_hook
  142%	  Set the certificate verification hook.  Default is to verify
  143%	  the certificate.  If set to `cert_accept_any`, any certificate
  144%	  is accepted. This can be used to deal with self-signed
  145%	  certificates in expertimental setups.
  146
  147%!	oauth2(+Request)
  148%
  149%	HTTP handler to deal with oauth2   requests. The addresses served
  150%	are
  151%
  152%	  * oauth2(Server/login)
  153%	  * oauth2(Server/reply)
  154
  155oauth2(Request) :-
  156	option(path_info(Path), Request),
  157	atomic_list_concat([ServerID,Action], /, Path), !,
  158	oauth2(Action, ServerID, Request).
  159oauth2(Request) :-
  160	http_404([], Request).
  161
  162oauth2(_, ServerID, Request) :-
  163	\+ server_attribute(ServerID, _, _), !,
  164	http_404([], Request).
  165oauth2(login, ServerID, Request) :- !,
  166	oauth2_login(Request, [server(ServerID)]).
  167oauth2(reply, ServerID, Request) :- !,
  168	oauth2_reply(Request, [server(ServerID)]).
  169oauth2(_, _, Request) :- !,
  170	http_404([], Request).
  171
  172
  173%!	oauth2_login(+Request, +Options)
  174%
  175%	HTTP handler to login using oauth2. It  causes a redirect to the
  176%	oauth2  identity  server,   which   will    redirect   back   to
  177%	oauth2(reply).
  178
  179oauth2_login(Request, Options) :-
  180	option(server(Server), Options),
  181	oauth2_redirect_uri(Server, URI),
  182	debug(oauth, 'Redirect to ~p', [URI]),
  183	http_redirect(see_other, URI, Request).
  184
  185oauth2_redirect_uri(ServerID, URI) :-
  186	server_attr(ServerID, url,		      ServerURI),
  187	server_attr(ServerID, authorization_endpoint, Path),
  188	server_attr(ServerID, redirect_uri,	      RedirectURI),
  189	server_attr(ServerID, client_id,	      ClientID),
  190	server_attr(ServerID, scope,		      Scope),
  191
  192	claims_attrs(ServerID, ClaimAttrs),
  193	anti_forgery_state(AntiForgery),
  194	get_time(Now),
  195	asserta(forgery_state(AntiForgery, ServerID, RedirectURI, Now)),
  196
  197	uri_extend(ServerURI, Path,
  198		   [ response_type(code),
  199		     client_id(ClientID),
  200		     redirect_uri(RedirectURI),
  201		     scope(Scope),
  202		     state(AntiForgery)
  203		   | ClaimAttrs
  204		   ], URI).
  205
  206
  207claims_attrs(ServerID, [claims=JSONString]) :-
  208	server_attr(ServerID, claims, Dict), !,
  209	with_output_to(string(JSONString),
  210		       json_write_dict(current_output, Dict)).
  211claims_attrs(_, []).
  212
  213%!	oauth2_reply(+Request, +Options)
  214%
  215%	HTTP handler for the  redirect  we   get  back  from  the oauth2
  216%	server.
  217%
  218%	@tbd Deal with `expires_in` and `id_token` fields.
  219
  220oauth2_reply(Request, Options) :-
  221	option(server(ServerID), Options),
  222	http_parameters(Request,
  223			[ code(AuthCode, [string, optional(true)]),
  224			  state(State, [optional(true)]),
  225			  error_description(Error, [optional(true)])
  226			]),
  227	(   nonvar(AuthCode),
  228	    nonvar(State)
  229	->  debug(oauth, 'Code: ~p', [AuthCode]),
  230	    validate_forgery_state(State, _ServerID, _Redirect),
  231	    debug(oauth, 'State: OK', []),
  232	    oauth2_token_details(ServerID, AuthCode, TokenInfo),
  233	    call_login(Request, ServerID, TokenInfo)
  234	;   nonvar(Error)
  235	->  call_login_failed(Request, Error)
  236	;   var(AuthCode)
  237	->  existence_error(http_parameter, code)
  238	;   existence_error(http_parameter, state)
  239	).
  240
  241%!	login(+Request, +ServerID, +TokenInfo) is semidet.
  242%
  243%	Multifile hook to realise the actual   login. Normally this hook
  244%	shall create a session  and  associate   the  session  with  the
  245%	identity of the user.  This  hook  may   keep  track  of  a user
  246%	profile.
  247%
  248%	If  this  hook  fails,  oauth2_reply/2  returns  a  `text/plain`
  249%	document with the obtained information.  This   can  be used for
  250%	debugging and development purposes.
  251%
  252%	@arg Request is the HTTP request dealing with the redirect back
  253%	from the identity provider.
  254%	@arg ServerID identifies the identity provider.
  255%	@arg TokenInfo is a dict containing information about the access
  256%	token.
  257%	@arg UserInfo is a dict containing information about the user.
  258
  259call_login(Request, ServerID, TokenInfo) :-
  260	login(Request, ServerID, TokenInfo),
  261	!.
  262call_login(_Request, ServerID, TokenInfo) :-
  263	oauth2_user_info(ServerID, TokenInfo, UserInfo),
  264	format('Content-type: text/plain~n~n'),
  265	format('Oauth2 login using ~w succeeded~n', [ServerID]),
  266	format('Token info: ~n'),
  267	print_term(TokenInfo, [output(current_output)]),
  268	format('~nUser info: ~n'),
  269	print_term(UserInfo, [output(current_output)]).
  270
  271call_login_failed(Request, Error) :-
  272	login_failed(Request, Error),
  273	!.
  274call_login_failed(_Request, Error) :-
  275	reply_html_page(
  276	    title('Login failed'),
  277	    h1('Login failed'),
  278	    p(['ERROR: ', Error])).
  279
  280
  281%!	oauth2_validate_access_token(+ServerID, +AccessToken, -Info:dict)
  282%
  283%	Validates the AccessToken with  Unity   (_implicit_  or _hybrid_
  284%	flow).
  285
  286oauth2_validate_access_token(ServerID, AuthCode, Info) :-
  287	server_attr(ServerID, url,		  ServerURI),
  288	server_attr(ServerID, tokeninfo_endpoint, Path),
  289	claims_attrs(ServerID, ClaimAttrs),
  290
  291	uri_extend(ServerURI, Path, ClaimAttrs, URI),
  292	http_options(ServerID, Options),
  293
  294	setup_call_cleanup(
  295	    http_open(URI, In,
  296		      [ authorization(bearer(AuthCode)),
  297			header(content_type, ContentType),
  298			status_code(Code)
  299		      | Options
  300		      ]),
  301	    read_reply(Code, ContentType, In, Info),
  302	    close(In)).
  303
  304%!	oauth2_user_info(+ServerID, +TokenInfo, -UserInfo) is det.
  305%
  306%	Given the token details obtained in oauth2_reply/2, get extended
  307%	information about the user from the identity provider. TokenInfo
  308%	is a dict that must contain `access_token`.
  309
  310oauth2_user_info(ServerID, TokenInfo, UserInfo) :-
  311	user_info(ServerID, TokenInfo.access_token, UserInfo).
  312
  313
  314%!	user_info(+ServerID, +BearerToken, -Info:dict) is det.
  315%
  316%	Ask info about a user.
  317
  318user_info(ServerID, AccessToken, Info) :-
  319	server_attr(ServerID, url,	     ServerURI),
  320	server_attr(ServerID, userinfo_endpoint, Path),
  321	claims_attrs(ServerID, ClaimAttrs),
  322
  323	uri_extend(ServerURI, Path, ClaimAttrs, URI),
  324	http_options(ServerID, Options),
  325	debug(oauth, 'Request user info using ~q', [URI]),
  326
  327	setup_call_cleanup(
  328	    http_open(URI, In,
  329		      [ authorization(bearer(AccessToken)),
  330			header(content_type, ContentType),
  331			status_code(Code)
  332		      | Options
  333		      ]),
  334	    read_reply(Code, ContentType, In, Info),
  335	    close(In)).
  336
  337%!	oauth2_token_details(+ServerID, +AuthCode, -Info:dict)
  338%
  339%	Get information using the provided code.   This  is used for the
  340%	_code_ flow.
  341
  342oauth2_token_details(ServerID, AuthCode, Dict) :-
  343	server_attr(ServerID, url,	      ServerURI),
  344	server_attr(ServerID, token_endpoint, Path),
  345	server_attr(ServerID, redirect_uri,   RedirectURI),
  346	server_attr(ServerID, client_id,      ClientID),
  347	server_attr(ServerID, client_secret,  ClientSecret),
  348	server_attr(ServerID, scope,	      Scope),
  349
  350	uri_extend(ServerURI, Path, [], URI),
  351	http_options(ServerID, Options),
  352
  353	setup_call_cleanup(
  354	    http_open(URI, In,
  355		      [ authorization(basic(ClientID, ClientSecret)),
  356			post(form([ grant_type(authorization_code),
  357				    scope(Scope),
  358				    code(AuthCode),
  359				    redirect_uri(RedirectURI),
  360				    client_id(ClientID),
  361				    client_secret(ClientSecret)
  362				  ])),
  363			request_header('Accept'='application/json;q=1.0,\c
  364					         */*;q=0.1'),
  365			header(content_type, ContentType),
  366			status_code(Code)
  367		      | Options
  368		      ]),
  369	    read_reply(Code, ContentType, In, Dict),
  370	    close(In)).
  371
  372read_reply(Code, ContentType, In, Dict) :-
  373	debug(oauth, 'Token details returned ~p ~p', [Code, ContentType]),
  374	http_parse_header_value(content_type, ContentType, Parsed),
  375	read_reply2(Code, Parsed, In, Dict).
  376
  377%!	read_reply2(+Code, +ContentType, +Stream, -Dict) is det.
  378%
  379%	Read the server reply as a dict.   Normally, the reply is a JSON
  380%	object, but stackexchange seems to send it as a www-form-encoded
  381%	string.
  382
  383read_reply2(200, media(application/json, _Attributes), In, Dict) :- !,
  384	json_read_dict(In, Dict, [default_tag(oauth2)]).
  385read_reply2(200, media(text/plain, _Attributes), In, Dict) :- !,
  386	read_string(In, _, Reply),
  387	uri_query_components(Reply, Fields0),
  388	maplist(convert_field, Fields0, Fields),
  389	dict_create(Dict, oauth2, Fields).
  390read_reply2(Code, media(application/json, _Attributes), In,
  391	   error{code:Code, details:Details}) :- !,
  392	json_read_dict(In, Details, [default_tag(error)]).
  393read_reply2(Code, Type, In,
  394	   error{code:Code, message:Reply}) :-
  395	debug(oauth(token), 'Got code ~w, type ~q', [Code, Type]),
  396	read_string(In, _, Reply).
  397
  398convert_field(expires=Atom, expires=Number) :-
  399	atom_number(Atom, Number), !.
  400convert_field(Field, Field).
  401
  402
  403%!	server_attr(+ServerID, +Attr, -Value) is det.
  404%
  405%	True when Value is the value for Attr on ServerID.
  406
  407server_attr(ServerID, Attr, Value) :-
  408	(   server_attribute(ServerID, Attr, Value0)
  409	->  Value = Value0
  410	;   debug(oauth, 'No endpoint for ~q; trying defaults', [Attr]),
  411	    default_attribute(Attr, ServerID, Value0)
  412	->  Value = Value0
  413	;   optional_attr(Attr)
  414	->  fail
  415	;   existence_error(oauth2_server_attribute, Attr)
  416	).
  417
  418%!	default_attribute(+Attr, +ServerID, -Value0) is semidet.
  419%
  420%	Compute a default value for a server attribute.
  421
  422default_attribute(redirect_uri, ServerID, URI) :- !,
  423	http_current_request(Request),
  424	http_public_host_url(Request, HostURL),
  425	http_absolute_location(oauth2(ServerID/reply), Path, []),
  426	atom_concat(HostURL, Path, URI).
  427default_attribute(discovery_endpoint, ServerID, URI) :- !,
  428	server_attr(ServerID, url, Base),
  429	uri_extend(Base, '/.well-known/openid-configuration', [], URI).
  430default_attribute(cert_verify_hook, _, Hook) :- !,
  431	Hook = default.
  432default_attribute(url, _, _) :- !,
  433	fail.
  434default_attribute(Attribute, ServerID, URI) :-
  435	oauth2_discover(ServerID, Dict),
  436	URI = Dict.get(Attribute).
  437
  438%!	optional_attr(+Attr) is semidet.
  439%
  440%	True when Attr is optional, i.e., it is ok to fail.
  441
  442optional_attr(claims).
  443
  444
  445%!	http_options(+ServerID, -Options:list) is det.
  446%
  447%	Provide additional options  for  http_open/3   to  talk  to  the
  448%	identity provider.
  449
  450http_options(ServerID, Options) :-
  451	server_attr(ServerID, cert_verify_hook, Hook),
  452	Hook \== default, !,
  453	Options = [ cert_verify_hook(Hook) ].
  454http_options(_, []).
  455
  456
  457		 /*******************************
  458		 *      ANTI FORGERY STATE	*
  459		 *******************************/
  460
  461:- dynamic forgery_state/4.  462
  463validate_forgery_state(State, Site, Redirect) :-
  464	(   forgery_state(State, Site, Redirect, Stamp)
  465	->  retractall(forgery_state(State, Site, Redirect, Stamp))
  466	;   throw(http_reply(not_acceptable('Invalid state parameter')))
  467	).
  468
  469anti_forgery_state(State) :-
  470	Rand is random(1<<100),
  471	variant_sha1(Rand, State).
  472
  473
  474		 /*******************************
  475		 *	METADATA DISCOVERY	*
  476		 *******************************/
  477
  478%%	oauth2_discover(+ServerID, -Dict) is det.
  479%
  480%	True when Dict represents _The Discovery document_.
  481
  482:- dynamic
  483	discovered_data/3.		% URL, Time, Data
  484
  485oauth2_discover(ServerID, Dict) :-
  486	(   discovered_data(ServerID, Dict0)
  487	->  Dict = Dict0
  488	;   discover_data(ServerID, Expires, Dict0),
  489	    cache_data(ServerID, Expires, Dict0),
  490	    Dict = Dict0
  491	).
  492
  493discover_data(ServerID, Expires, Dict) :-
  494	server_attr(ServerID, discovery_endpoint, DiscoverURL),
  495	http_options(ServerID, Options),
  496
  497	http_open(DiscoverURL, In,
  498                  [ header(expires, Expires),
  499		    status_code(Status)
  500		  | Options
  501		  ]),
  502	(   Status == 200
  503	->  json_read_dict(In, Dict)
  504	;   debug(oauth, 'Got status ~p from discovery endpoint; ignoring',
  505		  [Status]),
  506	    Dict = _{},
  507	    setup_call_cleanup(
  508		open_null_stream(Out),
  509		copy_stream_data(In, Out),
  510		close(Out))
  511	),
  512	close(In).
  513
  514discovered_data(URL, Data) :-
  515	discovered_data(URL, Expires, Data0),
  516	get_time(Now),
  517	(   Now =< Expires
  518	->  Data = Data0
  519	;   retractall(discovered_data(URL, Expires, _)),
  520	    fail
  521	).
  522
  523cache_data(URL, Expires, Data) :-
  524	atomic(Expires),
  525	parse_time(Expires, _Format, Stamp), !,
  526	asserta(discovered_data(URL, Stamp, Data)).
  527cache_data(_, _, _).
  528
  529
  530		 /*******************************
  531		 *	     URI BASICS		*
  532		 *******************************/
  533
  534%!	uri_extend(+Base:atom, +Rel:atom, +Query:list, -URI:atom) is det.
  535%
  536%	Create a URI from Base, A relative URI and a query.
  537
  538uri_extend(Base, Relative, Query, URI) :-
  539	uri_resolve(Relative, Base, URI0),
  540	uri_extend_query(URI0, Query, URI).
  541
  542%!	uri_extend_query(+URI0:atom, +Query:list, -URI:atom) is det.
  543%
  544%	Extend a URI with a query. If URI0 already has a query, keep all
  545%	parameters that do not conflict.
  546
  547uri_extend_query(URI0, Query, URI) :-
  548	uri_components(URI0, Components0),
  549	extend_query(Components0, Query, Query1),
  550	uri_data(search, Components0, Query1, Components1),
  551	uri_components(URI, Components1).
  552
  553extend_query(Components, QueryEx, Query) :-
  554	uri_data(search, Components, Query0),
  555	(   var(Query0)
  556	->  uri_query_components(Query, QueryEx)
  557	;   uri_query_components(Query0, Q0),
  558	    merge_components(Q0, QueryEx, Q),
  559	    uri_query_components(Query, Q)
  560	).
  561
  562merge_components([], Q, Q).
  563merge_components([N=_|T0], Q1, Q) :-
  564	memberchk(N=_, Q1), !,
  565	merge_components(T0, Q1, Q).
  566merge_components([H|T0], Q1, [H|Q]) :-
  567	merge_components(T0, Q1, Q).
  568
  569
  570		 /*******************************
  571		 *		JWT		*
  572		 *******************************/
  573
  574%%	oauth2_claim(+TokenInfo, -Claim) is semidet.
  575%
  576%	True when Claim is the claim made in TokenInfo.
  577
  578oauth2_claim(TokenInfo, Claim) :-
  579	jwt(TokenInfo.get(id_token), Claim).
  580
  581
  582%%	jwt(+String, -Object) is det.
  583%
  584%	True if Object is claimed in the JWT represented in String.
  585%
  586%	@tbd Currently does not validate the claim using the signature.
  587
  588jwt(String, Object) :-
  589	nonvar(String),
  590	split_string(String, ".", "", [Header64,Object64|_Parts]),
  591	base64url_json(Header64, _Header),
  592	base64url_json(Object64, Object).
  593
  594%%	base64url_json(+String, -JSONDict) is semidet.
  595%
  596%	True when JSONDict is represented  in   the  Base64URL and UTF-8
  597%	encoded String.
  598
  599base64url_json(String, JSON) :-
  600	string_codes(String, Codes),
  601	phrase(base64url(Bytes), Codes),
  602	phrase(utf8_codes(Text), Bytes),
  603	setup_call_cleanup(
  604	    open_string(Text, Stream),
  605	    json_read_dict(Stream, JSON),
  606	    close(Stream))