1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: jan@swi-prolog.org 5 WWW: https://www.swi-prolog.org 6 Copyright (C): 2015-2025, VU University Amsterdam 7 SWI-Prolog Solutions b.v. 8 9 This program is free software; you can redistribute it and/or 10 modify it under the terms of the GNU General Public License 11 as published by the Free Software Foundation; either version 2 12 of the License, or (at your option) any later version. 13 14 This program is distributed in the hope that it will be useful, 15 but WITHOUT ANY WARRANTY; without even the implied warranty of 16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 GNU General Public License for more details. 18 19 You should have received a copy of the GNU General Public 20 License along with this library; if not, write to the Free Software 21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 22 23 As a special exception, if you link this library with other files, 24 compiled with a Free Software compiler, to produce an executable, this 25 library does not by itself cause the resulting executable to be covered 26 by the GNU General Public License. This exception does not however 27 invalidate any other reasons why the executable file might be covered by 28 the GNU General Public License. 29*/ 30 31:- module(google_client, 32 [ oauth_authenticate/3, % +Request, +Site, +Options 33 openid_connect_discover/2 % +Site, -DiscoveryDict 34 ]). 35:- use_module(library(http/http_open)). 36:- use_module(library(http/http_dispatch)). 37:- use_module(library(http/http_host)). 38:- use_module(library(http/http_parameters)). 39:- use_module(library(http/http_path), []). 40:- use_module(library(http/http_ssl_plugin)). 41:- use_module(library(json)). 42:- use_module(library(uri)). 43:- use_module(library(lists)). 44:- use_module(library(debug)). 45:- use_module(library(settings)). 46 47:- use_module(jwt). 48 49/** <module> Sign in with Google OpenID Connect 50 51This module deals with the Google OpenID Connect federated 52authentication method. An HTTP handler that wishes to establish a login 53using Google uses the following flow of control. 54 55 - Call oauth_authenticate/3. This predicates redirects to Google, 56 which in turn redirects to oath2(auth_redirect), implemented by 57 oauth_handle_redirect/1. 58 59 - The predicate oauth_handle_redirect/1 establishes the Google unique 60 user identification (a string holding large integer) and email. It 61 calls the multifile hook google_client:login_existing_user/1, which 62 logs in the user (e.g., by starting an HTTP session and associating 63 the user with the session) and replies with a web page (or 64 redirect). 65 66 - If google_client:login_existing_user/1 *fails*, this library fetches 67 user profile information from Google and calls the hook 68 google_client:create_user/1. The create_user hook is passed the 69 basic Google profile information. Its task is to create a new user. 70 71@see https://developers.google.com/accounts/docs/OpenIDConnect 72*/ 73 74:- multifile 75 login_existing_user/1, % +Claim 76 create_user/1, % +Profile 77 key/2. % +Name, -Value 78 79httplocation(oath2, root(oauth2), [priority(-100)]). 80 81:- http_handler(oath2(auth_redirect), oauth_handle_redirect, []). 82 83:- dynamic 84 forgery_state/5. % State, Site, Redirect, ClientData, Time 85 86%% oauth_authenticate(+Request, +Site, +Options) 87% 88% Step 2: redirect to Google for obtaining an authorization code. 89% Google redirects back to oauth_handle_response/1. Options: 90% 91% - realm(+Realm) 92% Value for `openid.realm`. Normally, this is the site's 93% root URL. By default, it is not sent. 94% - login_hint(+Hint) 95% Hint to select the right account. Typically an email 96% address. By default, it is not sent. 97% - client_data(+Data) 98% Add the given Data (any Prolog term) to the dict that is 99% passed to the login hooks. 100 101oauth_authenticate(Request, Site, Options) :- 102 oauth_options(Options, Params), 103 openid_connect_discover(Site, DiscDoc), 104 key(client_id, ClientId), 105 http_link_to_id(oauth_handle_redirect, [], LocalRedirect), 106 public_url(Request, LocalRedirect, Redirect), 107 option(client_data(ClientData), Options, _), 108 anti_forgery_state(AntiForgery), 109 get_time(Now), 110 asserta(forgery_state(AntiForgery, Site, Redirect, ClientData, Now)), 111 url_extend(search([ client_id(ClientId), 112 response_type(code), 113 scope('openid email profile'), 114 state(AntiForgery), 115 redirect_uri(Redirect) 116 | Params 117 ]), 118 DiscDoc.authorization_endpoint, 119 URL), 120 http_redirect(moved_temporary, URL, Request). 121 122oauth_options([], []). 123oauth_options([H0|T0], [H|T]) :- 124 name_value(H0, Name, Value), 125 oauth_option(Name, NameTo), !, 126 H =.. [NameTo,Value], 127 oauth_options(T0, T). 128oauth_options([_|T0], T) :- 129 oauth_options(T0, T). 130 131oauth_option(realm, 'openid.realm'). 132oauth_option(login_hint, login_hint). 133 134name_value(Name = Value, Name, Value) :- !. 135name_value(Term, Name, Value) :- 136 Term =.. [Name,Value]. 137 138 139%% oauth_handle_redirect(Request) 140% 141% HTTP handler that deals with the redirect back from Google that 142% provides us the authorization code. This Implements steps 3 and 143% 4 of the OpenID Connect process: 144% 145% - Confirm anti-forgery state token 146% - Exchange code for access token and ID token 147 148oauth_handle_redirect(Request) :- 149 http_parameters(Request, 150 [ state(State, []), 151 code(Code, []) 152 ], 153 [ %form_data(Form) 154 ]), 155 validate_forgery_state(State, Site, Redirect, ClientData), 156 openid_connect_discover(Site, DiscDoc), 157 key(client_id, ClientId), 158 key(client_secret, ClientSecret), 159 http_open(DiscDoc.token_endpoint, 160 In, 161 [ cert_verify_hook(cert_verify), 162 post(form([ code(Code), 163 client_id(ClientId), 164 client_secret(ClientSecret), 165 redirect_uri(Redirect), 166 grant_type(authorization_code) 167 ])) 168 ]), 169 call_cleanup(json_read_dict(In, Response), 170 close(In)), 171 jwt(Response.id_token, Claim), 172 oauth_login(Claim, Response, DiscDoc, ClientData). 173 174%% oauth_login(+Claim, +Response, +DiscDoc, +ClientData) 175% 176% Handle the oauth claim. At least from Google, the claim contains 177% the following interesting fields: 178% 179% - sub: (long) integer representing the id in Google 180% - email: The user's email 181% - email_verified: boolean 182% 183% We now have two tasks. If `sub` is known, we are done. If not, 184% we must make a new account. To do so, we can prefill info by 185% extracting the Google _user profile information_ using the 186% _OpenID Connect_ method. 187% 188% @see https://developers.google.com/accounts/docs/OpenIDConnect#obtaininguserprofileinformation 189 190oauth_login(Claim, _, _, ClientData) :- 191 add_client_data(ClientData, Claim, Claim1), 192 login_existing_user(Claim1), !. 193oauth_login(_Claim, Response, DiscDoc, ClientData) :- 194 key(client_id, ClientId), 195 key(client_secret, ClientSecret), 196 url_extend(search([ access_token(Response.access_token), 197 client_id(ClientId), 198 client_secret(ClientSecret) 199 ]), 200 DiscDoc.userinfo_endpoint, 201 URL), 202 http_open(URL, 203 In, 204 [ cert_verify_hook(cert_verify) 205 ]), 206 call_cleanup(json_read_dict(In, Profile), 207 close(In)), 208 add_client_data(ClientData, Profile, Profile1), 209 create_user(Profile1). 210 211add_client_data(ClientData, Dict, Dict) :- var(ClientData), !. 212add_client_data(ClientData, Dict, Dict.put(client_data, ClientData)). 213 214validate_forgery_state(State, Site, Redirect, ClientData) :- 215 ( forgery_state(State, Site, Redirect, ClientData, Stamp) 216 -> retractall(forgery_state(State, Site, Redirect, ClientData, Stamp)) 217 ; throw(http_reply(not_acceptable('Invalid state parameter'))) 218 ). 219 220anti_forgery_state(State) :- 221 Rand is random(1<<100), 222 variant_sha1(Rand, State). 223 224%% openid_connect_discover(+Site, -Dict) is det. 225% 226% True when Dicr represents _The Discovery document_. 227 228:- dynamic 229 discovered_data/3. % URL, Time, Data 230 231openid_connect_discover(Site, Dict) :- 232 openid_connect_discover_url(Site, URL), 233 ( discovered_data(URL, Dict0) 234 -> Dict = Dict0 235 ; discover_data(URL, Expires, Dict0), 236 cache_data(URL, Expires, Dict0), 237 Dict = Dict0 238 ). 239 240discover_data(URL, Expires, Dict) :- 241 http_open(URL, In, 242 [ cert_verify_hook(cert_verify), 243 header(expires, Expires) 244 ]), 245 json_read_dict(In, Dict), 246 close(In). 247 248discovered_data(URL, Data) :- 249 discovered_data(URL, Expires, Data0), 250 get_time(Now), 251 ( Now =< Expires 252 -> Data = Data0 253 ; retractall(discovered_data(URL, Expires, _)), 254 fail 255 ). 256 257cache_data(URL, Expires, Data) :- 258 parse_time(Expires, _Format, Stamp), !, 259 asserta(discovered_data(URL, Stamp, Data)). 260cache_data(_, _, _). 261 262:- multifile 263 openid_connect_discover_url/2. 264 265openid_connect_discover_url( 266 'google.com', 267 'https://accounts.google.com/.well-known/openid-configuration'). 268 269 270 /******************************* 271 * HOOKS * 272 *******************************/ 273 274%% key(+Which, -Key) is det. 275% 276% This hook must provide the Google API keys. Key is one of the 277% values below. The keys are obtained from Google as explained in 278% https://developers.google.com/+/web/signin/add-button 279% 280% - client_id 281% - client_secret 282 283%% login_existing_user(+Claim) is semidet. 284% 285% Called after establishing the identify of the logged in user. 286% Claim is a dict containing 287% 288% - sub:string 289% String that uniquely indentifies the user inside Google. 290% - email:string 291% Email address of the user. 292% - client_data:Term 293% Present if oauth_authenticate/3 was called with the option 294% client_data(Term). Note that the term passed is a copy. 295% 296% This call must return an HTML document indicating that the user 297% logged in successfully or redirect to the URL supplied with 298% return to using http_redirect/3. 299 300%% create_user(+Profile) is det. 301% 302% Called after login_existing_user/1 fails and the Google profile 303% for the user has been fetched. Contains the same info as passed 304% to login_existing_user/1 as well as additional profile 305% information such as `family_name`, `gender`, `given_name`, 306% `locale`, `name`, `picture` and `profile`. Check the Google docs 307% for details. 308% 309% This call creates a new user, typically after verifying that the 310% user is human and completing the profile. As 311% login_existing_user/1, it must return a web page or redirect. 312 313 314 /******************************* 315 * SSL SUPPORT * 316 *******************************/ 317 318%% cert_verify(SSL, ProblemCert, AllCerts, FirstCert, Error) is det. 319% 320% Used by SSL to verify the certificate. 321 322:- public cert_verify/5. 323 324cert_verify(_SSL, _ProblemCert, _AllCerts, _FirstCert, _Error) :- 325 debug(ssl(cert_verify),'~s', ['Accepting certificate']). 326 327 328 /******************************* 329 * URI GOODIES * 330 *******************************/ 331 332%% url_extend(+Extend, +URL0, -URL) 333% 334% Extend a URL, typically by adding parameters to it. 335 336url_extend(search(Params), URL0, URL) :- 337 uri_components(URL0, Components0), 338 uri_data(search, Components0, Search0), 339 extend_search(Search0, Params, Search), 340 uri_data(search, Components0, Search, Components), 341 uri_components(URL, Components). 342 343extend_search(Var, Params, String) :- 344 var(Var), !, 345 uri_query_components(String, Params). 346extend_search(String0, Params, String) :- 347 uri_query_components(String0, Params0), 348 append(Params0, Params, AllParams), 349 uri_query_components(String, AllParams). 350 351 352%% public_url(+Request, +Path, -URL) is det. 353% 354% True when URL is a publically useable URL that leads to Path on 355% the current server. Needed for the redirect URL that we must 356% present with the authentication request. 357 358public_url(Request, Path, URL) :- 359 http_current_host(Request, Host, Port, 360 [ global(true) 361 ]), 362 setting(http:public_scheme, Scheme), 363 set_port(Scheme, Port, AuthC), 364 uri_authority_data(host, AuthC, Host), 365 uri_authority_components(Auth, AuthC), 366 uri_data(scheme, Components, Scheme), 367 uri_data(authority, Components, Auth), 368 uri_data(path, Components, Path), 369 uri_components(URL, Components). 370 371set_port(Scheme, Port, _) :- 372 scheme_port(Scheme, Port), !. 373set_port(_, Port, AuthC) :- 374 uri_authority_data(port, AuthC, Port). 375 376scheme_port(http, 80). 377scheme_port(https, 443)