diff --git a/Makefile b/Makefile index d9ffaefe6..3f888e5a6 100644 --- a/Makefile +++ b/Makefile @@ -237,7 +237,7 @@ COMMON_OPTIONS := -colorize-code -stars -sort eliomdoc_wiki = ODOC_WIKI_SUBPROJECT="$(1)" \ eliomdoc \ -$(1) \ - -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \ + -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1),jwt \ -intro doc/indexdoc.$(1) $(COMMON_OPTIONS) \ -i $(shell ocamlfind query wikidoc) \ -g odoc_wiki.cma \ @@ -248,7 +248,7 @@ eliomdoc_wiki = ODOC_WIKI_SUBPROJECT="$(1)" \ eliomdoc_html = ODOC_WIKI_SUBPROJECT="$(1)" \ eliomdoc \ -$(1) \ - -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1) \ + -ppx -package pgocaml,yojson,calendar,ocsigen-toolkit.$(1),jwt \ -intro doc/indexdoc.$(1) \ $(COMMON_OPTIONS) \ -html \ diff --git a/Makefile.options b/Makefile.options index 14fc986d2..e6d86ea28 100644 --- a/Makefile.options +++ b/Makefile.options @@ -55,7 +55,7 @@ SASS_TEMPORARY_PROJECT_NAME := os_temporary_project_name # OCamlfind packages for the server SERVER_PACKAGES := lwt.ppx js_of_ocaml.deriving.ppx calendar safepass \ - ocsigen-toolkit.server magick yojson + ocsigen-toolkit.server magick yojson jwt SERVER_DB_PACKAGES := pgocaml pgocaml.syntax macaque.syntax calendar safepass diff --git a/opam/opam b/opam/opam index 650d7cb7a..399410569 100644 --- a/opam/opam +++ b/opam/opam @@ -17,6 +17,7 @@ depends: [ "ocsigen-toolkit" {>= "dev"} "ppx_deriving" "yojson" + "jwt" ] depexts: [ [["debian"] ["imagemagick"]] diff --git a/src/os_connect_client.eliom b/src/os_connect_client.eliom new file mode 100644 index 000000000..89b73ea03 --- /dev/null +++ b/src/os_connect_client.eliom @@ -0,0 +1,181 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +open Os_oauth2_shared + +exception Bad_JSON_response + +exception No_such_saved_token + +module type IDTOKEN = + sig + type saved_token + + val saved_tokens : saved_token list ref + + val cycle_duration : int + + val number_of_cycle : int + + val id_server_of_saved_token : + saved_token -> + Os_types.OAuth2.Server.id + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val id_token_of_saved_token : + saved_token -> + Jwt.t + + val counter_of_saved_token : + saved_token -> + int ref + + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + val save_token : + saved_token -> + unit + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + end + +module Basic_scope = + struct + type scope = OpenID | Firstname | Lastname | Email | Unknown + + let default_scopes = [ OpenID ] + + let scope_to_str = function + | OpenID -> "openid" + | Firstname -> "firstname" + | Lastname -> "lastname" + | Email -> "email" + | Unknown -> "" + + let scope_of_str = function + | "openid" -> OpenID + | "firstname" -> Firstname + | "lastname" -> Lastname + | "email" -> Email + | _ -> Unknown + end + +module Basic_ID_token : IDTOKEN = + struct + type saved_token = + { + id_server : Os_types.OAuth2.Server.id ; + value : string ; + token_type : string ; + counter : int ref ; + id_token : Jwt.t + } + + let saved_tokens : saved_token list ref = ref [] + + let cycle_duration = 10 + + let number_of_cycle = 1 + + let id_server_of_saved_token t = t.id_server + + let value_of_saved_token t = t.value + + let token_type_of_saved_token t = t.token_type + + let id_token_of_saved_token t = t.id_token + + let counter_of_saved_token t = t.counter + + let parse_json_token id_server t = + try + let value = + Yojson.Basic.Util.to_string (Yojson.Basic.Util.member "token" t) + in + let token_type = + Yojson.Basic.Util.to_string (Yojson.Basic.Util.member "token_type" t) + in + let id_token = + Jwt.t_of_token + ( + Yojson.Basic.Util.to_string + (Yojson.Basic.Util.member "id_token" t) + ) + in + { id_server ; value ; token_type ; id_token ; counter = ref 0 } + with _ -> raise Bad_JSON_response + + let save_token token = + saved_tokens := (token :: (! saved_tokens)) + + let saved_token_of_id_server_and_value id_server value = + let saved_tokens_tmp = ! saved_tokens in + let rec locale = function + | [] -> raise No_such_saved_token + | head::tail -> + if head.id_server = id_server && head.value = value + then head + else locale tail + in + locale saved_tokens_tmp + + let list_tokens () = + (! saved_tokens) + + let remove_saved_token token = + let value = value_of_saved_token token in + let id_server = id_server_of_saved_token token in + saved_tokens := + ( + List.filter + (fun (x : saved_token) -> + x.value = value && x.id_server = id_server + ) + (! saved_tokens) + ) + end + +module Basic + : (Os_oauth2_client.CLIENT with + type scope = Basic_scope.scope and + type saved_token = Basic_ID_token.saved_token + ) = + Os_oauth2_client.MakeClient (Basic_scope) (Basic_ID_token) diff --git a/src/os_connect_client.eliomi b/src/os_connect_client.eliomi new file mode 100644 index 000000000..d12b232da --- /dev/null +++ b/src/os_connect_client.eliomi @@ -0,0 +1,170 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** OpenID Connect client with default scopes ({!Basic_scope}), ID Tokens + ({!Basic_ID_Token}) and client implementation ({!Basic}). + *) + +(** {1 Exceptions} *) + +(** Exception raised when the JSON received from the OpenID Connect server is + not well formated or if there is missing fields. + *) +exception Bad_JSON_response + +(** Exception raised when the given token doesn't exist. *) +exception No_such_saved_token + +(** {2 Token representation. } *) + +(** Interface for ID Token used by the OpenID Connect server. *) + +module type IDTOKEN = sig + (** Represent a saved token. The type is abstract to let the choice of the + implementation. + In addition to {!Os_oauth2_client.TOKEN.saved_token}, a token must contain + at least: + - the token type (for example ["bearer"]). + - the scopes list (of type {!scope}). Used to know which data the data + service must send. + + - the ID token as a JSON Web Token (JWT). + *) + type saved_token + + (** Represents the list of all saved tokens. *) + val saved_tokens : saved_token list ref + + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!cycle_duration} + seconds if the token has been generated after {!cycle_duration} * + {!number_of_cycle} seconds. If it's the case, the token is removed. + *) + (** The duration of a cycle. *) + val cycle_duration : int + + (** [number_of_cycle] the number of cycle. *) + val number_of_cycle : int + + (** Return the OpenID Connect server ID which delivered the token. *) + val id_server_of_saved_token : + saved_token -> + Os_types.OAuth2.Server.id + + (** Return the token value. *) + val value_of_saved_token : + saved_token -> + string + + (** Return the token type (for example ["bearer"]. *) + val token_type_of_saved_token : + saved_token -> + string + + (** Return the ID token as a JWT. *) + val id_token_of_saved_token : + saved_token -> + Jwt.t + + (** Return the number of remaining cycles. *) + val counter_of_saved_token : + saved_token -> + int ref + + (** [parse_json_token id_server token] parse the JSON data returned by the + token server (which has the ID [id_server] in the database) and returns + the corresponding {!save_token} OCaml type. The + Must raise {!Bad_JSON_response} if all needed information are not given. + Unrecognized JSON attributes must be ignored. + *) + val parse_json_token : + Os_types.OAuth2.Server.id -> + Yojson.Basic.json -> + saved_token + + (** [saved_token_of_id_server_and_value id_server value] returns the + saved_token delivered by the server with ID [id_server] and with value + [value]. + Raise an exception {!No_such_saved_token} if no token has been delivered by + [id_server] with value [value]. + + It implies OpenID Connect servers delivers unique token values, which is + logical for security. + *) + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + (** [save_token token] saves a new token. *) + val save_token : + saved_token -> + unit + + (** Return all saved tokens as a list. *) + val list_tokens : + unit -> + saved_token list + + (** [remove_saved_token token] removes [token] (used for example when [token] + is expired. + *) + val remove_saved_token : + saved_token -> + unit + end + +(** {3 Basic modules for scopes, tokens and client. } *) + +(** Basic scope for OpenID Connect. *) + +module Basic_scope : sig + (** Available scopes. When doing a request, [OpenID] is automatically + set. + *) + type scope = + | OpenID (** Mandatory in each requests (due to RFC).*) + | Firstname (** Get access to the first name *) + | Lastname (** Get access to the last name *) + | Email (** Get access to the email *) + | Unknown (** Used when an unknown scope is given. *) + + (** Default scopes is set to {{!scope}OpenID} (due to RFC). *) + val default_scopes : scope list + + (** Get a string representation of the scope. {{!scope}Unknown} string + representation is the empty string. + *) + val scope_to_str : scope -> string + + (** Converts a string scope to {!scope} type. *) + val scope_of_str : string -> scope +end + +(** Basic ID token implementation. *) + +module Basic_ID_token : IDTOKEN + +(** Basic OpenID Connect client implementation using {!Basic_scope} and + {!Basic_ID_token}. + *) +module Basic : (Os_oauth2_client.CLIENT with + type scope = Basic_scope.scope and + type saved_token = Basic_ID_token.saved_token) diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom new file mode 100644 index 000000000..19f1d02c0 --- /dev/null +++ b/src/os_connect_server.eliom @@ -0,0 +1,302 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +exception No_such_saved_token + +module type IDTOKEN = + sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + val cycle_duration : int + + val number_of_cycle : int + + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id + + val userid_of_saved_token : + saved_token -> + Os_types.User.id + + val token_type_of_saved_token : + saved_token -> + string + + val value_of_saved_token : + saved_token -> + string + + val id_token_of_saved_token : + saved_token -> + Jwt.t + + val scope_of_saved_token : + saved_token -> + scope list + + val secret_key_of_saved_token : + saved_token -> + string + + val counter_of_saved_token : + saved_token -> + int ref + + val token_exists : + saved_token -> + bool + + val generate_token_value : + unit -> + string + + val generate_token : + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> + saved_token Lwt.t + + val save_token : + saved_token -> + unit + + val remove_saved_token : + saved_token -> + unit + + val saved_token_of_id_client_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val saved_token_to_json : + saved_token -> + Yojson.Safe.json + end + +module MakeIDToken (Scope : Os_oauth2_server.SCOPE) + : (IDTOKEN with type scope = Scope.scope) = + struct + type scope = Scope.scope + + let cycle_duration = 10 + + let number_of_cycle = 1 + + type saved_token = + { + id_client : Os_types.OAuth2.Client.id ; + userid : Os_types.User.id ; + token_type : string ; + value : string ; + id_token : Jwt.t ; + scope : scope list ; + counter : int ref ; + secret_key : string + } + + let id_client_of_saved_token s = s.id_client + + let userid_of_saved_token s = s.userid + + let token_type_of_saved_token s = s.token_type + + let value_of_saved_token s = s.value + + let id_client_of_saved_token s = s.id_client + + let scope_of_saved_token s = s.scope + + let id_token_of_saved_token s = s.id_token + + let secret_key_of_saved_token s = s.secret_key + + let counter_of_saved_token s = s.counter + + let saved_tokens : saved_token list ref = ref [] + + (** Returns [true] if there exists a saved token with [id_client] and + [value]. + *) + let token_exists_by_id_client_and_value id_client value = + List.exists + (fun x -> x.id_client = id_client && x.value = value) + (! saved_tokens) + + let token_exists saved_token = + let id_client = id_client_of_saved_token saved_token in + let value = value_of_saved_token saved_token in + token_exists_by_id_client_and_value id_client value + + let generate_id_token ~id_client ~userid = + let%lwt (_, _, _, redirect_uri, client_id, _) = + Os_db.OAuth2_server.registered_client_of_id id_client + in + (* FIXME: the userid must be encoded in the sub_user value because it must + * be unique and the same between all token requests so we can't use a + * random string different for all token request. But the client must + * not be able to retrieve the userid from the sub_user value. For the + * moment we use a b64 on client_id with the userid but of course, it's + * not very secured. + *) + let sub_user = + B64.encode (client_id ^ (Int64.to_string userid)) + in + (* NOTE: The secret key is generated randomly and is saved in the + * saved_token type to be able to check if the token sent by the client is + * the same than the server generated. + *) + let secret_key = Os_oauth2_shared.generate_random_string 128 in + let header_token = + Jwt.header_of_algorithm_and_typ + (Jwt.HS256 secret_key) + "JWT" + in + let current_time = Unix.time () in + let exp_time = float_of_int (number_of_cycle * cycle_duration) in + let payload_token = + let open Jwt in + empty_payload + |> add_claim iss redirect_uri + |> add_claim sub sub_user + |> add_claim aud client_id + |> add_claim iat (string_of_float current_time) + |> add_claim exp (string_of_float (current_time +. exp_time)) + in + Lwt.return + ((Jwt.t_of_header_and_payload header_token payload_token), secret_key) + + let generate_token_value () = + Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_token + + let generate_token ~id_client ~userid ~scope = + let rec generate_token_if_doesnt_exists id_client = + let value = generate_token_value () in + if token_exists_by_id_client_and_value id_client value + then generate_token_if_doesnt_exists id_client + else value + in + let value = generate_token_if_doesnt_exists id_client in + let%lwt (id_token, secret_key) = generate_id_token ~id_client ~userid in + Lwt.return + { + id_client ; userid ; value ; token_type = "bearer" ; + id_token ; scope ; counter = ref 0 ; secret_key + } + + let save_token token = + saved_tokens := (token :: (! saved_tokens)) + + let remove_saved_token saved_token = + let value = value_of_saved_token saved_token in + let id_client = id_client_of_saved_token saved_token in + saved_tokens := + ( + List.filter + (fun x -> x.value = value && x.id_client = id_client) + (! saved_tokens) + ) + + let saved_token_of_id_client_and_value id_client value = + let tokens = ! saved_tokens in + let rec locale = function + | [] -> raise No_such_saved_token + | head::tail -> + if head.id_client = id_client && head.value = value + then head + else locale tail + in + locale tokens + + (* IMPROVEME: list tokens by client OAuth2 id *) + let list_tokens () = (! saved_tokens) + + let saved_token_to_json saved_token = + `Assoc + [ + ("token_type", `String "bearer") ; + ("token", `String (value_of_saved_token saved_token)) ; + ( + "id_token", + `String (Jwt.token_of_t (id_token_of_saved_token saved_token)) + ) ; + ("expires_in", `Int (cycle_duration * number_of_cycle)) + (* What about a refresh_token ? *) + (* ("refresh_token", `String refresh_token) ;*) + ] + end + +module Basic_scope : Os_oauth2_server.SCOPE = + struct + type scope = OpenID | Firstname | Lastname | Email | Unknown + + let scope_to_str = function + | OpenID -> "openid" + | Firstname -> "firstname" + | Lastname -> "lastname" + | Email -> "email" + | Unknown -> "" + + let scope_of_str = function + | "openid" -> OpenID + | "firstname" -> Firstname + | "lastname" -> Lastname + | "email" -> Email + | _ -> Unknown + + let check_scope_list scope_list = + if List.length scope_list = 0 + then false + else if List.length scope_list = 1 && List.hd scope_list = OpenID + then false + else if not (List.mem OpenID scope_list) + then false + else + List.for_all + (fun x -> match x with + | Unknown -> false + | _ -> true + ) + scope_list + end + +module Basic_ID_token + : (IDTOKEN with + type scope = Basic_scope.scope) + = + MakeIDToken (Basic_scope) + +module Basic + : (Os_oauth2_server.SERVER with + type scope = Basic_scope.scope and + type saved_token = Basic_ID_token.saved_token + ) = + Os_oauth2_server.MakeServer + (Basic_scope) + (Basic_ID_token) diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi new file mode 100644 index 000000000..a39a93c22 --- /dev/null +++ b/src/os_connect_server.eliomi @@ -0,0 +1,211 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** OpenID Connect server with default scopes ({!Basic_scope}), ID Tokens + ({!Basic_ID_Token}) and server implementation ({!Basic}). + *) + +(** {1 Exceptions. } *) + +(** Exception raised when the given token doesn't exist. *) +exception No_such_saved_token + +(** {2 Token representation. } *) + +(** Token interface used by the OpenID Connect server. *) + +module type IDTOKEN = sig + (** List of permissions. Used to type the [scope] field in {!saved_token} *) + type scope + + (** Token representation. The type is abstract to let the choice of the + implementation. + A token must contain at least: + - the userid to know which user authorized. + - the OAuth2.0 client ID to know the client to which the token is + assigned. The ID is related to the database. + - a value (the token value). + - the token type (for example ["bearer"]). + - the scopes list (of type {!scope}). Used to know which data the data + service must send. + - the ID token as a JSON Web Token (JWT). + - the secret key used to sign the JWT. It is useful to check if the + client sent the right ID token. This is the key used by HS256 to sign + the token. + - a counter which represents the number of times the token has been + checked by the timer. + *) + type saved_token + + (** The list of all saved tokens. *) + val saved_tokens : saved_token list ref + + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!cycle_duration} + seconds if the token has been generated after {!cycle_duration} * + {!number_of_cycle} seconds. If it's the case, the token is removed. + *) + + (** The duration of a cycle. *) + val cycle_duration : int + + (** The number of cycle. *) + val number_of_cycle : int + + (** Return the client ID. *) + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id + + (** Return the userid of the user who authorized. *) + val userid_of_saved_token : + saved_token -> + Os_types.User.id + + (** Return the token type. *) + val token_type_of_saved_token : + saved_token -> + string + + (** Return the token value. *) + val value_of_saved_token : + saved_token -> + string + + (** Return the ID token as a JWT. *) + val id_token_of_saved_token : + saved_token -> + Jwt.t + + (** Return the scope asked by the client. *) + val scope_of_saved_token : + saved_token -> + scope list + + (** Return the secret key used to sign the JWT. *) + val secret_key_of_saved_token : + saved_token -> + string + + (** Return the number of passed cycle. *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Return [true] if the token already exists *) + val token_exists : + saved_token -> + bool + + (* Generate a token value *) + val generate_token_value : + unit -> + string + + (* Generate a new token *) + val generate_token : + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> + saved_token Lwt.t + + (** Save a token *) + val save_token : + saved_token -> + unit + + (** Remove a token. *) + val remove_saved_token : + saved_token -> + unit + + (** Return the saved token assigned to the client with given ID and + value. + *) + val saved_token_of_id_client_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + (* List all saved tokens *) + val list_tokens : + unit -> + saved_token list + + (** Return the saved token as a JSON. Used to send to the client. *) + val saved_token_to_json : + saved_token -> + Yojson.Safe.json +end + +(** Basic module for scopes. + + [check_scope_list scope_list] returns [true] if every element in + [scope_list] is an available scope value. + If the list contains only [OpenID] or if the list doesn't contain [OpenID] + (mandatory scope in RFC), it returns [false]. + If an unknown scope value is in list (represented by [Unknown] value), + it returns [false]. + *) + +(** Basic scope *) +module Basic_scope : Os_oauth2_server.SCOPE + +(** MakeIDToken (Scope) returns a module of type {!IDTOKEN} with the type + {!IDTOKEN.scope} equals to {!Scope.scope}. + + Tokens are represented as a record with exactly the same fields available in + the inferface {!IDTOKEN}. + + The token type is always ["bearer"]. + + The related JSON contains the fields: + - ["token_type"] with value ["bearer"]. + - ["token"] with the token value. + - ["expires_in"] with the value [cycle_duration * number_of_cycle] i.e. 600 + seconds. + - ["id_token"] with the JWT. + + + NOTE: If you want to implement another type of tokens, you need to implement + another functor (with the [Scope.scope] type dependency) which returns a + module of type {!IDTOKEN}. The resulting module can be given as parameter to + the function {!Os_oauth2_server.MakeServer}. + *) +module MakeIDToken : functor + (Scope : Os_oauth2_server.SCOPE) -> + (IDTOKEN with type scope = Scope.scope) + +(** Basic ID Token based on the scope from {!Basic_scope}. *) +module Basic_ID_token + : (IDTOKEN with + type scope = Basic_scope.scope) + +(** [Basic (Scope) (Token)] returns a module representing a OpenID Connect + server. The available scopes come from {!Scope.scope} and the token related + functions, types and representation come from {!Token}. + + As an OpenID Connect server is based on an OAuth2.0, the server is generated + with {!Os_oauth2_server.MakeServer}. + *) +module Basic : (Os_oauth2_server.SERVER with + type scope = Basic_scope.scope and + type saved_token = Basic_ID_token.saved_token +) diff --git a/src/os_db.ml b/src/os_db.ml index 60914052a..1c4eccda3 100644 --- a/src/os_db.ml +++ b/src/os_db.ml @@ -169,7 +169,64 @@ let os_preregister_table = email citext NOT NULL ) >> +(** ------------------------ *) +(** Tables for OAuth2 server *) +(** An Eliom application can be a OAuth2.0 server. + Its client can be OAuth2.0 client which can be an Eliom application, but not + always. + *) + +(** Table to represent and register client *) +let oauth2_server_client_id_seq = + <:sequence< bigserial "ocsigen_start.oauth2_server_client_id_seq" >> + +let oauth2_server_client_table = + <:table< ocsigen_start.oauth2_server_client ( + id bigint NOT NULL DEFAULT(nextval $oauth2_server_client_id_seq$), + application_name text NOT NULL, + description text NOT NULL, + redirect_uri text NOT NULL, + client_id text NOT NULL, + client_secret text NOT NULL + ) >> + +(** ------------------------ *) + +(** ------------------------ *) +(** Tables for OAuth2 client *) + +(** An Eliom application can be a OAuth2.0 client of a OAuth2.0 server which can + be also an Eliom application, but not always. + *) + +let oauth2_client_credentials_id_seq = + <:sequence< bigserial "ocsigen_start.oauth2_client_credentials_id_seq" >> + +(** Table to represent the client credentials of the current OAuth2.0 client *) +(** The server id. A OAuth2 client registers all OAuth2 server he has + client credentials and he chooses an ID for each of them. Checks are + done if the server_id exists. All url's must begin with https (or http if + not, even if https is recommended) due to eliom external services. + *) +let oauth2_client_credentials_table = + <:table< ocsigen_start.oauth2_client_credentials ( + id bigint NOT NULL DEFAULT(nextval $oauth2_client_credentials_id_seq$), + server_id text NOT NULL, + (* server_authorization_url. The URI used to get an authorization code *) + server_authorization_url text NOT NULL, + (* server_token_url. The URI used to get an access token *) + server_token_url text NOT NULL, + (* server_data_url. The URI used to get data *) + server_data_url text NOT NULL, + (* The client id for this server id *) + client_id text NOT NULL, + (* The client secret for this server id *) + client_secret text NOT NULL + ) >> + +(** Tables for OAuth2 client *) +(** ------------------------ *) (*****************************************************************************) @@ -568,3 +625,472 @@ module Groups = struct Lwt.return @@ List.map (fun a -> (a#!groupid, a#!name, a#?description)) l end + +(* -------------------------------------------------------------------------- *) +(** Database management for OAuth2 server and client *) +module OAuth2_server = + struct + (* ---------------------------------------- *) + (* --------- Client registration ---------- *) + + (** Register a new client in the database and return the id associated *) + (** OK *) + let new_client + ~application_name ~description ~redirect_uri ~client_id ~client_secret = + full_transaction_block (fun dbh -> + lwt () = + Lwt_Query.query dbh + <:insert< + $oauth2_server_client_table$ := + { + id = oauth2_server_client_table?id ; + application_name = $string:application_name$ ; + description = $string:description$ ; + redirect_uri = $string:redirect_uri$ ; + client_id = $string:client_id$ ; + client_secret = $string:client_secret$ + } + >> + in + lwt id_client = + Lwt_Query.view_one dbh + <:view< {x = currval $oauth2_server_client_id_seq$ } >> + in + let id_client = id_client#!x in + Lwt.return id_client + ) + + (* --------- Client registration ---------- *) + (* ---------------------------------------- *) + + (* --------------------------- *) + (* --------- Client ---------- *) + + let client_of_id id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.id = $int64:id$ + >> + in + Lwt.return ( + r#!application_name, + r#!description, + r#!redirect_uri + ) + with No_such_resource -> Lwt.fail No_such_resource + ) + + (* --------- Client ---------- *) + (* --------------------------- *) + + (* --------------------------------------- *) + (* ---------- Registered client ---------- *) + + (** OK *) + let registered_client_of_client_id client_id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.client_id = $string:client_id$ + >> + in + Lwt.return ( + r#!id, + r#!application_name, + r#!description, + r#!redirect_uri, + r#!client_id, + r#!client_secret + ) + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** OK *) + let registered_client_of_id id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.id = $int64:id$ + >> + in + Lwt.return ( + r#!id, + r#!application_name, + r#!description, + r#!redirect_uri, + r#!client_id, + r#!client_secret + ) + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** OK *) + let registered_client_of_client_id client_id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.client_id = $string:client_id$ + >> + in + Lwt.return ( + r#!id, + r#!application_name, + r#!description, + r#!redirect_uri, + r#!client_id, + r#!client_secret + ) + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** OK *) + let registered_client_exists_by_client_id client_id = + full_transaction_block (fun dbh -> + try_lwt + lwt _ = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.client_id = $string:client_id$ + >> + in + Lwt.return_true + with No_such_resource -> Lwt.return_false + ) + + (* ---------- Registered client ---------- *) + (* --------------------------------------- *) + + (** OK *) + let client_secret_of_client_id client_id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.client_id = $string:client_id$ + >> + in + Lwt.return r#!client_secret + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** List all clients, with a limit of [limit] with a minimum id [min_i] *) + (** OK *) + let list_clients ?(min_id=Int64.of_int 0) ?(limit=Int64.of_int 10) () = + full_transaction_block (fun dbh -> + lwt l = Lwt_Query.query dbh + <:select< + a limit $int64:limit$ + | a in $oauth2_server_client_table$ ; + a.id >= $int64:min_id$ + >> + in + Lwt.return (List.map (fun a -> + ( + a#!id, + a#!application_name, + a#!description, + a#!redirect_uri, + a#!client_id, + a#!client_secret + )) l) + ) + + (** Get the id (primary key) of client represented by [client_id] in the + * oauth2_server_client table + *) + (** OK *) + let id_of_client_id client_id = + full_transaction_block (fun dbh -> + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_server_client_table$; + t.client_id = $string:client_id$ + >> + in + Lwt.return r#!id + ) + + (** Update a client with [application_name], [description] and + * [redirect_uri] + *) + let update_client id ~application_name ~description ~redirect_uri = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:update< + d in $oauth2_server_client_table$ + := + { + description = $string:description$ ; + application_name = $string:application_name$ ; + redirect_uri = $string:redirect_uri$ + } + | d.id = $int64:id$ + >> + ) + + (** Update the client description having the id [id] description with + * [description] + *) + let update_description id description = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:update< + d in $oauth2_server_client_table$ + := + { + description = $string:description$ + } + | d.id = $int64:id$ + >> + ) + + (** Update the client redirect_uri having the id [id] description with + * [redirect_uri] + *) + let update_redirect_uri id redirect_uri = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:update< + d in $oauth2_server_client_table$ + := + { + redirect_uri = $string:redirect_uri$ + } + | d.id = $int64:id$ + >> + ) + + (** Update the client credentials having the id [id] description with + * [client_id] and [client_secret] + *) + let update_client_credentials id client_id client_secret = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:update< + d in $oauth2_server_client_table$ + := + { + client_id = $string:client_id$ ; + client_secret = $string:client_secret$ + } + | d.id = $int64:id$ + >> + ) + + (** Update the client application_name having the id [id] description with + * [application_name] + *) + let update_application_name id application_name = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:update< + d in $oauth2_server_client_table$ + := + { + application_name = $string:application_name$ + } + | d.id = $int64:id$ + >> + ) + + (** Remove the client represented by [id] *) + let remove_client id = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:delete< + u in $oauth2_server_client_table$ + | u.id = $int64:id$ + >> + ) + + let remove_client_by_client_id client_id = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:delete< + u in $oauth2_server_client_table$ + | u.client_id = $string:client_id$ + >> + ) + + (* --------- Client registration ---------- *) + (* ---------------------------------------- *) + end + +module OAuth2_client = + struct + + (** Add new client credentials [client_id] and [client_secret] associated to + * the server [server_id] and return the id associated to this entry + *) + (** OK *) + let save_server + ~server_id ~server_authorization_url ~server_token_url ~server_data_url + ~client_id ~client_secret = + full_transaction_block (fun dbh -> + lwt () = Lwt_Query.query dbh + <:insert< + $oauth2_client_credentials_table$ := + { + id = oauth2_client_credentials_table?id ; + server_id = $string:server_id$ ; + server_authorization_url = $string:server_authorization_url$ ; + server_token_url = $string:server_token_url$ ; + server_data_url = $string:server_data_url$ ; + client_id = $string:client_id$ ; + client_secret = $string:client_secret$ + } + >> + in + lwt id = + Lwt_Query.view_one dbh + <:view< {x = currval $oauth2_client_credentials_id_seq$ } >> + in + Lwt.return id#!x + ) + + (** Remove the OAuth2 server registered with id [id] *) + let remove_server_by_id id = + full_transaction_block (fun dbh -> + try_lwt + Lwt_Query.query dbh + <:delete< + u in $oauth2_client_credentials_table$ + | u.id = $int64:id$ + >>; + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** Check if there exists a registered server with server_id [server_id]. + * Returns true if the server exists, else returns false. *) + (** OK *) + let server_id_exists server_id = + full_transaction_block (fun dbh -> + try_lwt + lwt _ = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_client_credentials_table$; + t.server_id = $string:server_id$ + >> + in + Lwt.return true + with No_such_resource -> Lwt.return false + ) + + (** Get the id of the OAuth2 server represented by [server_id] *) + (** OK *) + let id_of_server_id server_id = + full_transaction_block (fun dbh -> + try_lwt + lwt r = Lwt_Query.view_one dbh + <:view< + t | t in $oauth2_client_credentials_table$; + t.server_id = $string:server_id$ + >> + in + Lwt.return r#!id + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** Remove the client credentials of the server with id [id] *) + let remove_client_credentials id = + full_transaction_block (fun dbh -> + Lwt_Query.query dbh + <:delete< + u in $oauth2_client_credentials_table$ + | u.id = $int64:id$ + >> + ) + + (** Get the authorization URL of the OAuth2 server represented by + * [server_id] *) + (** OK *) + let get_server_authorization_url ~server_id = + full_transaction_block (fun dbh -> + lwt url = Lwt_Query.view_one dbh + <:view< + { + t.server_authorization_url; + } + | t in $oauth2_client_credentials_table$; + t.server_id = $string:server_id$ + >> + in + Lwt.return (url#!server_authorization_url) + ) + + (** Get the token URL of the OAuth2 server represented by + * [server_id] *) + (** OK *) + let get_server_token_url ~server_id = + full_transaction_block (fun dbh -> + try_lwt + lwt url = + Lwt_Query.view_one dbh + <:view< + { + t.server_token_url; + } + | t in $oauth2_client_credentials_table$; + t.server_id = $string:server_id$ + >> + in + Lwt.return (url#!server_token_url) + with No_such_resource -> Lwt.fail No_such_resource + ) + + + (** Fetch client credentials from the database. A OAuth2.0 can have multiple + * OAuth2.0 credentials for different OAuth2.0 server which can be + * recognized by the id used to register them. + * OK + *) + let get_client_credentials ~server_id = + full_transaction_block (fun dbh -> + try_lwt + lwt credentials = Lwt_Query.view_one dbh + <:view< + { + t.client_id ; + t.client_secret; + } + | t in $oauth2_client_credentials_table$; + t.server_id = $string:server_id$ + >> + in + Lwt.return (credentials#!client_id, credentials#!client_secret) + with No_such_resource -> Lwt.fail No_such_resource + ) + + (** Fetch all subscribed OAuth2.0 servers *) + (** OK *) + let list_servers () = + full_transaction_block (fun dbh -> + lwt l = Lwt_Query.query dbh + <:select< + a + | a in $oauth2_client_credentials_table$ + >> + in + Lwt.return (List.map (fun a -> + ( + a#!id, + a#!server_id, + a#!server_authorization_url, + a#!server_token_url, + a#!server_data_url, + a#!client_id, + a#!client_secret + )) l) + ) + end +(* -------------------------------------------------------------------------- *) diff --git a/src/os_db.mli b/src/os_db.mli index 06f05283c..c1b533395 100644 --- a/src/os_db.mli +++ b/src/os_db.mli @@ -3,9 +3,7 @@ * http://www.ocsigen.org/ocsigen-start * * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU Lesser General Public License as published by + * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published by * the Free Software Foundation, with linking exception; * either version 2.1 of the License, or (at your option) any later version. * @@ -256,3 +254,159 @@ module Groups : sig description)]. *) val all : unit -> (Os_types.Group.id * string * string option) list Lwt.t end + +module OAuth2_server : sig + val new_client : + application_name:string -> + description:string -> + redirect_uri:Ocsigen_lib.Url.t -> + client_id:Os_types.OAuth2.client_id -> + client_secret:Os_types.OAuth2.client_secret -> + Os_types.OAuth2.Server.id Lwt.t + + val client_of_id : + Os_types.OAuth2.Server.id -> + (string * string * string) Lwt.t + + val registered_client_of_id : + Os_types.OAuth2.Server.id -> + ( + Os_types.OAuth2.Server.id * + string * + string * + Ocsigen_lib.Url.t * + Os_types.OAuth2.client_id * + Os_types.OAuth2.client_secret + ) Lwt.t + + val registered_client_of_client_id : + Os_types.OAuth2.client_id -> + ( + Os_types.OAuth2.Server.id * + string * + string * + Ocsigen_lib.Url.t * + Os_types.OAuth2.client_id * + Os_types.OAuth2.client_secret + ) Lwt.t + + + val registered_client_exists_by_client_id : + Os_types.OAuth2.client_id -> + bool Lwt.t + + val client_secret_of_client_id : + Os_types.OAuth2.client_id -> + Os_types.OAuth2.client_secret Lwt.t + + val list_clients : + ?min_id:Os_types.OAuth2.Server.id -> + ?limit:int64 -> + unit -> + ( + Os_types.OAuth2.Server.id * + string * + string * + Ocsigen_lib.Url.t * + Os_types.OAuth2.client_id * + Os_types.OAuth2.client_secret + ) list Lwt.t + + val id_of_client_id : + Os_types.OAuth2.client_id -> + Os_types.OAuth2.Server.id Lwt.t + + val update_client : + Os_types.OAuth2.Server.id -> + application_name:string -> + description:string -> + redirect_uri:Ocsigen_lib.Url.t -> + unit Lwt.t + + val update_description : + Os_types.OAuth2.Server.id -> + string -> + unit Lwt.t + + val update_redirect_uri : + Os_types.OAuth2.Server.id -> + Ocsigen_lib.Url.t -> + unit Lwt.t + + val update_client_credentials : + Os_types.OAuth2.Server.id -> + Os_types.OAuth2.client_id -> + Os_types.OAuth2.client_secret -> + unit Lwt.t + + val update_application_name : + Os_types.OAuth2.Server.id -> + string -> + unit Lwt.t + + val remove_client : + Os_types.OAuth2.Server.id -> + unit Lwt.t + + (** Remove a client by using the client ID. + Raise an exception {!No_such_resource} if no client has the given client + ID. + *) + val remove_client_by_client_id : + Os_types.OAuth2.client_id -> + unit Lwt.t +end + +module OAuth2_client : sig + val save_server : + server_id:Os_types.OAuth2.Client.server_id -> + server_authorization_url:Ocsigen_lib.Url.t -> + server_token_url:Ocsigen_lib.Url.t -> + server_data_url:Ocsigen_lib.Url.t -> + client_id:Os_types.OAuth2.client_id -> + client_secret:Os_types.OAuth2.client_secret -> + Os_types.OAuth2.Client.id Lwt.t + + val remove_server_by_id : + Os_types.OAuth2.Client.id -> + unit Lwt.t + + val server_id_exists : + Os_types.OAuth2.Client.server_id -> + bool Lwt.t + + val id_of_server_id : + Os_types.OAuth2.Client.server_id -> + Os_types.OAuth2.Client.id Lwt.t + + val remove_client_credentials : + Os_types.OAuth2.Client.id -> + unit Lwt.t + + val get_server_authorization_url : + server_id:Os_types.OAuth2.Client.server_id -> + Ocsigen_lib.Url.t Lwt.t + + val get_server_token_url : + server_id:Os_types.OAuth2.Client.server_id -> + Ocsigen_lib.Url.t Lwt.t + + val get_client_credentials : + server_id:Os_types.OAuth2.Client.server_id -> + ( + Os_types.OAuth2.client_id * + Os_types.OAuth2.client_secret + ) Lwt.t + + val list_servers : + unit -> + ( + Os_types.OAuth2.Client.id * + Os_types.OAuth2.Client.server_id * + Ocsigen_lib.Url.t * + Ocsigen_lib.Url.t * + Ocsigen_lib.Url.t * + Os_types.OAuth2.client_id * + Os_types.OAuth2.client_secret + ) list Lwt.t +end diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom new file mode 100644 index 000000000..0c244a2fc --- /dev/null +++ b/src/os_oauth2_client.eliom @@ -0,0 +1,579 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +open Eliom_parameter +open Lwt.Infix + +exception State_not_found +exception No_such_client + +exception Server_id_exists +exception No_such_server + +exception No_such_saved_token +exception Bad_JSON_respoonse + +type registered_server = + { + id : Os_types.OAuth2.Server.id ; + server_id : string ; + authorization_url : Ocsigen_lib.Url.t ; + token_url : Ocsigen_lib.Url.t ; + data_url : Ocsigen_lib.Url.t ; + client_credentials :Os_oauth2_shared.client_credentials + } + +let id_of_registered_server s = s.id +let server_id_of_registered_server s = s.server_id +let authorization_url_of_registered_server s = s.authorization_url +let token_url_of_registered_server s = s.token_url +let data_url_of_registered_server s = s.data_url +let client_credentials_of_registered_server s = s.client_credentials + +let to_registered_server + ~id ~server_id ~authorization_url ~token_url ~data_url + ~client_credentials = + { + id ; server_id ; authorization_url ; token_url ; data_url ; + client_credentials + } + +let list_servers () = + let%lwt servers = Os_db.OAuth2_client.list_servers () in + Lwt.return ( + List.map ( + fun ( id, server_id, authorization_url, token_url, data_url, client_id, + client_secret) -> + to_registered_server + ~id ~server_id ~authorization_url ~token_url ~data_url + ~client_credentials: + (Os_oauth2_shared.client_credentials_of_string + client_id client_secret) + ) servers + ) + +let get_client_credentials ~server_id = + try%lwt + (Os_db.OAuth2_client.get_client_credentials ~server_id) + >>= + (fun (client_id, client_secret) -> + Lwt.return (Os_oauth2_shared.client_credentials_of_string + ~client_id ~client_secret + ) + ) + with Os_db.No_such_resource -> Lwt.fail No_such_server + +let get_server_url_authorization ~server_id = + try%lwt + let%lwt url = + Os_db.OAuth2_client.get_server_authorization_url ~server_id + in + Lwt.return (Os_oauth2_shared.prefix_and_path_of_url url) + with Os_db.No_such_resource -> Lwt.fail No_such_server + +let get_server_url_token ~server_id = + try%lwt + Os_db.OAuth2_client.get_server_token_url ~server_id + with Os_db.No_such_resource -> Lwt.fail No_such_server + +let save_server + ~server_id ~server_authorization_url ~server_token_url + ~server_data_url ~client_id ~client_secret = + let%lwt exists = Os_db.OAuth2_client.server_id_exists server_id in + if not exists then + ( + Lwt.ignore_result ( + Os_db.OAuth2_client.save_server + ~server_id ~server_authorization_url ~server_token_url + ~server_data_url ~client_id ~client_secret + ); + Lwt.return () + ) + else Lwt.fail Server_id_exists + +let remove_server_by_id id = + try%lwt + Os_db.OAuth2_client.remove_server_by_id id + with Os_db.No_such_resource -> Lwt.fail No_such_server + +module type SCOPE = sig + type scope + + val default_scopes : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string +end + +module type TOKEN = sig + type saved_token + + val saved_tokens : saved_token list ref + + val cycle_duration : int + + val number_of_cycle : int + + val id_server_of_saved_token : + saved_token -> + Os_types.OAuth2.Server.id + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val counter_of_saved_token : + saved_token -> + int ref + + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + val save_token : + saved_token -> + unit + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + end + +module type CLIENT = sig + type scope + + val default_scopes : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + val scope_list_of_str_list : + string list -> + scope list + + val scope_list_to_str_list : + scope list -> + string list + + type saved_token + + val id_server_of_saved_token : saved_token -> Os_types.OAuth2.Server.id + val value_of_saved_token : saved_token -> string + val token_type_of_saved_token : saved_token -> string + + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + + val register_redirect_uri : + redirect_uri:Ocsigen_lib.Url.t -> + success_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + error_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + unit Lwt.t + + val request_authorization_code : + redirect_uri:Ocsigen_lib.Url.t -> + server_id:string -> + scope:scope list -> + unit Lwt.t +end + +module MakeClient + (Scope : SCOPE) + (Token : TOKEN) : + (CLIENT with + type scope = Scope.scope and + type saved_token = Token.saved_token + ) = struct + + type scope = Scope.scope + + let default_scopes = Scope.default_scopes + + let scope_of_str = Scope.scope_of_str + + let scope_to_str = Scope.scope_to_str + + let scope_list_of_str_list l = List.map scope_of_str l + + let scope_list_to_str_list l = List.map scope_to_str l + + (* ---------------------------------------- *) + (* --------- Request information ---------- *) + + type request_info = + { + state : string ; + server_id : string ; + scope : scope list ; + } + + let state_of_request_info v = v.state + let server_id_of_request_info v = v.server_id + let scope_of_request_info v = v.scope + + (* Remember server_id, redirect_uri and scope for an authorization code + * request. site_scope is used because, with default_process_scope + * and default_session_group, if the page is reloaded, it is considered to + * be a new process and the reference is removed. While redirection, + * volatile reference saved with default_session_group are removed. + *) + + let request_info : request_info list ref = ref [] + + (** Print all registered request information *) + let print_request_info_state_list () = + let states = (! request_info) in + if List.length states = 0 then + print_endline "No registered states" + else + List.iter + (fun r -> + print_endline ("State: " ^ (state_of_request_info r)) ; + print_endline ("Server_id: " ^ (server_id_of_request_info r)) + ) + states + + (** Creates a new request_info value and add it in the volatile reference. *) + let add_request_info state server_id scope = + let new_request_info = {state ; server_id ; scope} in + request_info := (new_request_info :: (! request_info)) + + (** Removes the request info which has [state] as state. *) + let remove_request_info_by_state state = + request_info := + (List.filter + (fun x -> x.state = state) + (!request_info) + ) + + (** Get the request_info value which has state [state] *) + let request_info_of_state state = + let rec request_info_of_state_intern l = match l with + | [] -> raise State_not_found + | head::tail -> + if head.state = state then head + else request_info_of_state_intern tail + in + request_info_of_state_intern (! request_info) + + (* ---------- Request information ---------- *) + (* ----------------------------------------- *) + + (** ---------------------------------------- *) + (** ---------- Authorization code ---------- *) + + (** Generate a random state for the authorization process. *) + (** IMPROVEME: add it in the interface to let the OAuth2.0 client generates + * the state, pass it to request_authorization_code and use this state (and + * the server_id) to be able to get back the token ? It means we need to add + * the state in the token, which can be done when adding the access_token. + *) + let generate_state () = + Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_state + + (* TODO: add a optional parameter for other parameters to send. *) + let request_authorization_code ~redirect_uri ~server_id ~scope + = + let%lwt (prefix, path) = get_server_url_authorization ~server_id in + let scope_str_list = + scope_list_to_str_list (default_scopes @ scope) + in + (* ------------------------------ *) + (* in raw to easily change later. *) + let response_type = "code" in + (* ------------------------------ *) + let%lwt client_credentials = get_client_credentials ~server_id in + let client_id = + Os_oauth2_shared.client_id_of_client_credentials client_credentials + in + let state = generate_state () in + + let service_url = Eliom_service.extern + ~prefix + ~path + ~meth:Os_oauth2_shared.param_authorization_code + () + in + let scope_str = String.concat " " scope_str_list in + add_request_info state server_id scope; + ignore ([%client ( + Eliom_client.change_page + ~service:~%service_url + (~%response_type, (~%client_id, (~%redirect_uri, (~%scope_str, + ~%state)))) + () + : unit Lwt.t) + ]); + + Lwt.return () + + type saved_token = Token.saved_token + + let id_server_of_saved_token = Token.id_server_of_saved_token + + let value_of_saved_token = Token.value_of_saved_token + + let token_type_of_saved_token = Token.token_type_of_saved_token + + let saved_token_of_id_server_and_value = + Token.saved_token_of_id_server_and_value + + let list_tokens = Token.list_tokens + + let remove_saved_token = Token.remove_saved_token + + (** Request a token to the server represented as ~server_id in the + * database. + * TODO: add an optional parameter for other parameters to send. + * NOTE: an exception No_such_server is raised if [server_id] doesn't exist. + *) + let request_access_token ~state ~code ~redirect_uri ~server_id = + let%lwt client_credentials = get_client_credentials ~server_id in + let%lwt server_url = get_server_url_token ~server_id in + (* ----------------------------- *) + (* in raw to easily change later. *) + let grant_type = "authorization_code" in + (* ----------------------------- *) + let client_id = + Os_oauth2_shared.client_id_of_client_credentials client_credentials + in + let client_secret = + Os_oauth2_shared.client_secret_of_client_credentials client_credentials + in + + let base64_credentials = + (B64.encode (client_id ^ ":" ^ client_secret)) + in + let content = + "grant_type=" ^ grant_type ^ + "&code=" ^ code ^ + "&redirect_uri=" ^ (Ocsigen_lib.Url.encode redirect_uri) ^ + "&state=" ^ state ^ + "&client_id=" ^ client_id + in + let headers = + Http_headers.add + Http_headers.authorization + ("Basic " ^ base64_credentials) + Http_headers.empty + in + Ocsigen_http_client.post_string_url + ~headers + ~content + ~content_type:("application", "x-www-form-urlencoded") + server_url + + (** Use a default handler for the moment *) + let register_redirect_uri + ~redirect_uri ~success_redirection ~error_redirection + = + let (prefix, path) = Os_oauth2_shared.prefix_and_path_of_url redirect_uri in + let success = + Eliom_service.create + ~path:(Eliom_service.Path path) + ~meth:Os_oauth2_shared.param_authorization_code_response + () + in + let error = + Eliom_service.create + ~path:(Eliom_service.Path path) + ~meth:Os_oauth2_shared.param_authorization_code_response_error + () + in + + Os_oauth2_shared.update_list_timer + Token.cycle_duration + (fun x -> let c = Token.counter_of_saved_token x in !c >= + Token.number_of_cycle) + (fun x -> let c = Token.counter_of_saved_token x in incr c) + Token.saved_tokens + (); + + (* We register the service while we succeed to get an authorization code. + * This service will request a token with request_token. + *) + Eliom_registration.Redirection.register + ~service:success + (fun (code, state) () -> + (* --------------------- *) + (* Get the server_id which will be used to get client credentials and + * the the token server + *) + let request_info = + request_info_of_state state + in + let server_id = + (server_id_of_request_info request_info) + in + let%lwt id = + Os_db.OAuth2_client.id_of_server_id server_id + in + (* --------------------- *) + + (* Request a token. The content reponse is JSON. response_token is + * of type Ocsigen_http_frame.t *) + let%lwt response_token = + request_access_token ~state ~code ~redirect_uri ~server_id + in + let _ = remove_request_info_by_state state in + (* read the frame content to get the JSON as string *) + let%lwt content = + match Ocsigen_http_frame.(response_token.frame_content) with + | None -> Lwt.return "" (* FIXME: raise an exception *) + | Some x -> Os_lib.Http.string_of_stream x + in + let json_content_response = + Yojson.Safe.to_basic (Yojson.Safe.from_string content) + in + let saved_token = Token.parse_json_token id json_content_response in + Token.save_token saved_token; + (* Some code checking the code, requesting a token, etc *) + Lwt.return success_redirection + ); + + Eliom_registration.Redirection.register + ~service:error + (fun (error, (error_description, error_uri)) () -> + + (* Do we do something else? *) + Lwt.return error_redirection + ); + + Lwt.return () +end + +module Basic_scope = + struct + type scope = OAuth | Firstname | Lastname | Email | Unknown + + let default_scopes = [ OAuth ] + + let scope_to_str = function + | OAuth -> "oauth" + | Firstname -> "firstname" + | Lastname -> "lastname" + | Email -> "email" + | Unknown -> "" + + let scope_of_str = function + | "oauth" -> OAuth + | "firstname" -> Firstname + | "lastname" -> Lastname + | "email" -> Email + | _ -> Unknown + end + +module Basic_token : TOKEN = struct + type saved_token = + { + id_server : Os_types.OAuth2.Server.id ; + value : string ; + token_type : string ; + counter : int ref + } + + let cycle_duration = 10 + let number_of_cycle = 1 + + let id_server_of_saved_token t = t.id_server + let value_of_saved_token t = t.value + let token_type_of_saved_token t = t.token_type + let counter_of_saved_token t = t.counter + + let parse_json_token id_server t = + try + let value = + Yojson.Basic.Util.to_string (Yojson.Basic.Util.member "token" t) + in + let token_type = + Yojson.Basic.Util.to_string (Yojson.Basic.Util.member "token_type" t) + in + { id_server ; value ; token_type ; counter = ref 0} + with _ -> raise Bad_JSON_respoonse + + let saved_tokens : saved_token list ref = ref [] + + let save_token token = + saved_tokens := (token :: (! saved_tokens)) + + let saved_token_of_id_server_and_value id_server value = + let saved_tokens_tmp = ! saved_tokens in + let rec locale = function + | [] -> raise No_such_saved_token + | head::tail -> + if head.id_server = id_server && head.value = value + then head + else locale tail + in + locale saved_tokens_tmp + + let list_tokens () = + !saved_tokens + + let remove_saved_token token = + let value = value_of_saved_token token in + let id_server = id_server_of_saved_token token in + saved_tokens := + ( + List.filter + (fun (x : saved_token) -> + x.value = value && x.id_server = id_server + ) + (!saved_tokens) + ) +end + +module Basic = MakeClient (Basic_scope) (Basic_token) diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi new file mode 100644 index 000000000..fb553292a --- /dev/null +++ b/src/os_oauth2_client.eliomi @@ -0,0 +1,406 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** OAuth2.0 client with default scopes ({!Basic_scope}), Tokens + ({!Basic_token}) and client implementation ({!Basic}). + *) + +(** {1 Exceptions } *) + +(** Raised if a state is not found. *) +exception State_not_found + +(** Raised if no such client has been found. *) +exception No_such_client + +(** Raised if the given server ID already exists. *) +exception Server_id_exists + +(** Raised if a bad server ID has been given. *) +exception No_such_server + +(** Exception raised when the given token doesn't exist. *) +exception No_such_saved_token + +(** Exception raised when the JSON received from the OpenID Connect server is + not well formated or if there is missing fields. + *) +exception Bad_JSON_respoonse + +(** {2 About OAuth2.0 servers and client credentials. } *) + +(** The type representing a registered server. + A registered server is a server saved in the database with: + - an ID. + - a server ID which is a string to recognize the OAuth2.0 server easily + (instead of using the ID). + - an authorization URL which must be used to get an authorization code. + - a token URL which must be used to get a token when an authorization code + has been delivered by the authorization server. + - a data URL which must be used to get the data. + - the client credentials (client ID and client secret) which must be used to + be recognized by the server. + *) +type registered_server + +(** Get the ID database. *) +val id_of_registered_server : + registered_server -> + Os_types.OAuth2.Server.id + +(** Get the server ID which is a string to recognize it easily. *) +val server_id_of_registered_server : + registered_server -> + string + +(** Get the authorization URL which must be used to get an authorization + code. + *) +val authorization_url_of_registered_server : + registered_server -> + Ocsigen_lib.Url.t + +(** Get the token URL which must be used to get a token after requesting an + authorization code. + *) +val token_url_of_registered_server : + registered_server -> + Ocsigen_lib.Url.t + +(** Get the data URL which must be used to get the data. *) +val data_url_of_registered_server : + registered_server -> + Ocsigen_lib.Url.t + +(** Get the client credentials. *) +val client_credentials_of_registered_server : + registered_server -> + Os_oauth2_shared.client_credentials + +(** Build a type {!registered_server}. *) +val to_registered_server : + id:Os_types.OAuth2.Server.id -> + server_id:string -> + authorization_url:Ocsigen_lib.Url.t -> + token_url:Ocsigen_lib.Url.t -> + data_url:Ocsigen_lib.Url.t -> + client_credentials:Os_oauth2_shared.client_credentials -> + registered_server + +(** List all registered servers. Data are retrieved from the database. *) +val list_servers : + unit -> + registered_server list Lwt.t + +(** Save a new server in the database. + If an OAuth2.0 is already registered with [server_id] exists, the exception + {!Server_id_exists} is raised. + *) +val save_server : + server_id:string -> + server_authorization_url:Ocsigen_lib.Url.t -> + server_token_url:Ocsigen_lib.Url.t -> + server_data_url:Ocsigen_lib.Url.t -> + client_id:Os_types.OAuth2.client_id -> + client_secret:Os_types.OAuth2.client_secret -> + unit Lwt.t + +(** [remove_server_by_id id] removes from the database the registered server + with ID [id]. + *) +val remove_server_by_id : + Os_types.OAuth2.Server.id -> + unit Lwt.t + +(** Get the client credientials for a given OAuth2.0 server. *) +val get_client_credentials : + server_id:string -> + Os_oauth2_shared.client_credentials Lwt.t + +(** {3 About scopes, tokens and basic client. } *) + +(** Module type for scopes. *) + +module type SCOPE = sig + (** Available scopes. *) + type scope + + (** Default scopes set in all requests where scope is needed. *) + val default_scopes : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string +end + +(** Module type for tokens. Represents tokens used by the OAuth2.0 server. *) + +module type TOKEN = sig + + (** Represents a saved token. The type is abstract to let the choice of the + implementation. + A token must contain at least: + - the OAuth2.0 server ID to know which server delivers the token. + The ID is related to the database. + - a value. It's the token value. + - the token type. For example ["bearer"]. + - the ID token as a JSON Web Token (JWT). + - a counter which represents the number of times the token has been + checked by the timer. + *) + type saved_token + + (** Represents the list of all saved tokens. *) + val saved_tokens : saved_token list ref + + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!cycle_duration} + seconds if the token has been generated after {!cycle_duration} * + {!number_of_cycle} seconds. If it's the case, the token is removed. + *) + (** The duration of a cycle. *) + val cycle_duration : int + + (** [number_of_cycle] is the number of cycle. *) + val number_of_cycle : int + + (** Return the OpenID Connect server ID which delivered the token. *) + val id_server_of_saved_token : + saved_token -> + Os_types.OAuth2.Server.id + + (** Return the token value. *) + val value_of_saved_token : + saved_token -> + string + + (** Return the token type (for example ["bearer"]). *) + val token_type_of_saved_token : + saved_token -> + string + + (** Return the number of passed cycles. *) + val counter_of_saved_token : + saved_token -> + int ref + + (** [parse_json_token id_server token] parse the JSON data returned by the + token server (which has the ID [id_server] in the database) and returns + the corresponding {!save_token} OCaml type. The + Must raise {!Bad_JSON_response} if all needed information are not given. + Unrecognized JSON attributes must be ignored. + *) + val parse_json_token : + Os_types.OAuth2.Server.id -> + Yojson.Basic.json -> + saved_token + + (** [saved_token_of_id_server_and_value id_server value] returns the + saved_token delivered by the server with ID [id_server] and with value + [value]. + Raise an exception {!No_such_saved_token} if no token has been delivered by + [id_server] with value [value]. + + It implies OpenID Connect servers delivers unique token values, which is + logical for security. + *) + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + (** [save_token token] saves a new token. *) + val save_token : + saved_token -> + unit + + (** Return all saved tokens as a list. *) + val list_tokens : + unit -> + saved_token list + + (** [remove_saved_token token] removes [token] (used for example when [token] + is expired). + *) + val remove_saved_token : + saved_token -> + unit + end + +(** Module type representing a OAuth2.0 client. *) + +module type CLIENT = sig + (** The following types and functions related to tokens and scopes are + aliases to the same types and functions from the modules types given in + the functor {!MakeClient}. These aliases avoid to know the modules used to + build the client. + *) + + type scope + + val default_scopes : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + val scope_list_of_str_list : + string list -> + scope list + + val scope_list_to_str_list : + scope list -> + string list + + type saved_token + + val id_server_of_saved_token : + saved_token -> + Os_types.OAuth2.Server.id + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val saved_token_of_id_server_and_value : + Os_types.OAuth2.Server.id -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + + (** When registering, clients must specify a redirection URL where the code + will be sent as GET parameter (or the authorization code error). + [register_redirect_uri ~redirect_uri ~success_redirection + ~error_rediction] registers two services at the url [redirect_uri] : + - for successfull authorization code response. + - for error authorization code response. + + In the case of a successfull authorization code, this service will + request an access token to the token server and if the token server + responds with success, the token is saved and a redirection is done to the + service [success_redirection]. + + In the case of an error response (while requesting an authorization code + or a token), we redirect the user to the service [error_redirection]. + *) + + val register_redirect_uri : + redirect_uri:Ocsigen_lib.Url.t -> + success_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + error_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + unit Lwt.t + + (** + [request_authorization_code + ~redirect_uri ~server_id ~scope=["firstname", "lastname"] + ] + requests an authorization code to the OAuth2 server represented by + [~server_id] to get access to the firstname and lastname of the resource + owner. [~server_id] is needed to get credentials. [~redirect_uri] is used + to redirect the user-agent on the client OAuth2. + + You will never manipulate the authorization code. The code is temporarily + saved server side until expiration. + The next time you request an access token, authorization code will + be checked and if it's not expired, request an access token to the + OAuth2.0 server. + + The default scopes {!SCOPE.default_scopes} are set in addition to [~scope]. + + An exception {!No_such_server} is raised if no server is registered with + [server_id]. + *) + val request_authorization_code : + redirect_uri:Ocsigen_lib.Url.t -> + server_id:string -> + scope:scope list -> + unit Lwt.t + +end + +(** Basic_scope is a {!SCOPE} module representing a basic scope list (firstname, + lastname and email). + This scope representation is used in {!Os_oauth2_server.Basic} so you can + use this module if the OAuth2.0 server is an instance of + {!Os_oauth2_server.Basic}. + + See {!Os_oauth2_client.Basic} for a basic OAuth2 client compatible with + the OAuth2 server {!Os_oauth2_server.Basic}. + *) +module Basic_scope : sig + type scope = OAuth | Firstname | Lastname | Email | Unknown + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + end + +(** Basic_token is a {!TOKEN} module representing a basic token (id_server, + value and token_type). + This token representation is used in {!Os_oauth2_server.Basic} so you can to + use this module if the OAuth2 server is an instance of + {!Os_oauth2_server.Basic}. + + See {!Os_oauth2_client.Basic} for a basic OAuth2 client compatible with + the OAuth2 server {!Os_oauth2_server.Basic}. + *) +module Basic_token : TOKEN + +(** Build a OAuth2 client from a module of type {!SCOPE} and a module of type + {!TOKEN}. In this way, you have a personalized OAuth2.0 client. + *) +module MakeClient : functor + (Scope : SCOPE) -> functor + (Token : TOKEN) -> + (CLIENT with + type scope = Scope.scope and + type saved_token = Token.saved_token + ) + +(** Basic OAuth2 client, compatible with OAuth2.0 server + {!Os_oauth2_server.Basic}. + *) +module Basic : (CLIENT with type scope = Basic_scope.scope and type saved_token += Basic_token.saved_token) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom new file mode 100644 index 000000000..7a668626c --- /dev/null +++ b/src/os_oauth2_server.eliom @@ -0,0 +1,1189 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(* GENERAL FIXME: always use HTTPS !!!! *) + +exception State_not_found + +exception No_such_client + +exception No_such_saved_token + +exception No_such_request_info_code +exception No_such_userid_registered + +(* Split a string representing a list of scope value separated by space *) +let split_scope_list s = Re.split (Re.compile (Re.rep1 Re.space)) s + +let generate_client_credentials () = + let client_id = + Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_client_id + in + let client_secret = + Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_client_secret + in + Os_oauth2_shared.client_credentials_of_string ~client_id ~client_secret + +(* Check if the client id and the client secret has been set in the header while + * requesting a token and if they are correct. + *) +let check_authorization_header client_id header = + try%lwt + let%lwt client_secret = + Os_db.OAuth2_server.client_secret_of_client_id client_id + in + let base64_credentials = + (B64.encode (client_id ^ ":" ^ client_secret)) + in + let basic = + Ocsigen_http_frame.Http_header.get_headers_value + header + Http_headers.authorization + in + Lwt.return (basic = "Basic " ^ base64_credentials) + (* if the authorization value is not defined *) + with Not_found -> Lwt.return_false + +(** Generates an authorization code. *) +let generate_authorization_code () = + Os_oauth2_shared.generate_random_string + Os_oauth2_shared.size_authorization_code + +type client = +{ + application_name: string; + description: string; + redirect_uri: string +} + +let client_of_string ~application_name ~description ~redirect_uri = +{ application_name; description; redirect_uri } + +let application_name_of_client c = c.application_name + +let description_of_client c = c.description + +let redirect_uri_of_client c = c.redirect_uri + +let client_of_id id = + try%lwt + let%lwt (application_name, description, redirect_uri) = + Os_db.OAuth2_server.client_of_id id + in + Lwt.return { application_name ; description ; redirect_uri } + with Os_db.No_such_resource -> Lwt.fail No_such_client + +let new_client ~application_name ~description ~redirect_uri = + let credentials = generate_client_credentials () in + Os_db.OAuth2_server.new_client + application_name + description + redirect_uri + (Os_oauth2_shared.client_id_of_client_credentials credentials) + (Os_oauth2_shared.client_secret_of_client_credentials credentials) + +let remove_client_by_id id = + Os_db.OAuth2_server.remove_client id + +let remove_client_by_client_id client_id = + Os_db.OAuth2_server.remove_client_by_client_id client_id + +type registered_client = +{ + id : int64 ; + client : client ; + credentials : Os_oauth2_shared.client_credentials ; +} + +let id_of_registered_client t = t.id + +let client_of_registered_client t = t.client + +let credentials_of_registered_client t = t.credentials + +let to_registered_client id client credentials = { id ; client ; credentials } + +let registered_client_of_client_id client_id = + try%lwt + let%lwt (id, application_name, description, redirect_uri, + client_id, client_secret) = + Os_db.OAuth2_server.registered_client_of_client_id client_id + in + let info = + client_of_string ~application_name ~description ~redirect_uri + in + let credentials = + Os_oauth2_shared.client_credentials_of_string ~client_id ~client_secret + in + Lwt.return (to_registered_client id info credentials) + with Os_db.No_such_resource -> Lwt.fail No_such_client + +let list_clients ?(min_id=Int64.of_int 0) ?(limit=Int64.of_int 10) () = + let%lwt l = Os_db.OAuth2_server.list_clients ~min_id ~limit () in + Lwt.return + (List.map + (fun (id, application_name, description, + redirect_uri, client_id, client_secret) -> + let info = + client_of_string + ~application_name + ~description + ~redirect_uri + in + let credentials = + Os_oauth2_shared.client_credentials_of_string + ~client_id + ~client_secret + in + to_registered_client id info credentials + ) + l + ) + +let registered_client_exists_by_client_id client_id = + Os_db.OAuth2_server.registered_client_exists_by_client_id client_id + + +module type SCOPE = sig + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + val check_scope_list : + scope list -> + bool +end + +module type TOKEN = sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + val cycle_duration : int + + val number_of_cycle : int + + val id_client_of_saved_token : + saved_token -> + int64 + + val userid_of_saved_token : + saved_token -> + int64 + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val scope_of_saved_token : + saved_token -> + scope list + + + val counter_of_saved_token : + saved_token -> + int ref + + val token_exists : + saved_token -> + bool + + val generate_token_value : + unit -> + string + + val generate_token : + id_client:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t + + val save_token : + saved_token -> + unit + + val remove_saved_token : + saved_token -> + unit + + val saved_token_of_id_client_and_value : + int64 -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val saved_token_to_json : + saved_token -> + Yojson.Safe.json +end + +module type SERVER = sig + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + val scope_list_of_str_list : + string list -> + scope list + + val scope_list_to_str_list : + scope list -> + string list + + type saved_token + + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id + + val userid_of_saved_token : + saved_token -> + Os_types.User.id + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val scope_of_saved_token : + saved_token -> + scope list + + val token_exists : + saved_token -> + bool + + val save_token : + saved_token -> + unit + + val remove_saved_token : + saved_token -> + unit + + val saved_token_of_id_client_and_value : + Os_types.OAuth2.Client.id -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val set_userid_of_request_info_code : + string -> + string -> + Os_types.User.id -> + unit + + val send_authorization_code : + string -> + Os_types.OAuth2.client_id -> + Eliom_registration.Html.page Lwt.t + + val send_authorization_code_error : + ?error_description:string option -> + ?error_uri:string option -> + Os_oauth2_shared.error_authorization_code_type -> + string -> + Ocsigen_lib.Url.t -> + Eliom_registration.Html.page Lwt.t + + val rpc_resource_owner_authorize : + ( + string * Os_types.OAuth2.client_id, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + val rpc_resource_owner_decline : + ( + string * Ocsigen_lib.Url.t, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + type authorization_service = + (string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string)) + ), + unit, + Eliom_service.get, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, [ `WithoutSuffix ], + [ `One of string ] + Eliom_parameter.param_name * + ([ `One of Os_types.OAuth2.client_id ] + Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] + Eliom_parameter.param_name * + ([ `One of string ] + Eliom_parameter.param_name * + [ `One of string ] + Eliom_parameter.param_name))), + unit, Eliom_service.non_ocaml) + Eliom_service.t + + val authorization_service : + Eliom_lib.Url.path -> + authorization_service + + type authorization_handler = + state:string -> + client_id:Os_types.OAuth2.client_id -> + redirect_uri:Ocsigen_lib.Url.t -> + scope:scope list -> + Eliom_registration.Html.page Lwt.t (* Returned value of the handler *) + + val authorization_handler : + authorization_handler -> + ( + (string * (Os_types.OAuth2.client_id * + (Ocsigen_lib.Url.t * (string * string))) + ) -> + unit -> + Eliom_registration.Html.page Lwt.t + ) + + type token_service = + (unit, + string * (string * (Ocsigen_lib.Url.t * (string * + Os_types.OAuth2.client_id))), + Eliom_service.post, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, + [ `WithoutSuffix ], + unit, + [ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), + Eliom_registration.String.return) + Eliom_service.t + + val token_service : + Eliom_lib.Url.path -> + token_service + + val token_handler : + ( + unit -> + (string * (string * + (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id)))) -> + Eliom_registration.String.result Lwt.t + ) +end + +module MakeServer + (Scope : SCOPE) + (Token : (TOKEN with type scope = Scope.scope)) : (SERVER with + type scope = Scope.scope and + type saved_token = Token.saved_token) = + struct + type scope = Scope.scope + + let scope_of_str = Scope.scope_of_str + + let scope_to_str = Scope.scope_to_str + + let scope_list_of_str_list l = List.map scope_of_str l + + let scope_list_to_str_list l = List.map scope_to_str l + + let check_scope_list = Scope.check_scope_list + + (* ----------------------------------------- *) + (* ---------- request information ---------- *) + + let cycle_duration_request_info = 10 + let number_of_cycle_request_info = 60 + + type request_info = + { + userid : int64 ; + redirect_uri : Ocsigen_lib.Url.t ; + client_id : Os_types.OAuth2.client_id ; + code : string ; + state : string ; + scope : scope list ; + counter : int ref ; + } + + let userid_of_request_info c = c.userid + let redirect_uri_of_request_info c = c.redirect_uri + let client_id_of_request_info c = c.client_id + let code_of_request_info c = c.code + let state_of_request_info c = c.state + let scope_of_request_info c = c.scope + + let request_info : request_info list ref = ref [] + + let _ = + Os_oauth2_shared.update_list_timer + cycle_duration_request_info + (fun x -> let c = x.counter in !c >= number_of_cycle_request_info) + (fun x -> incr x.counter) + request_info + + let add_request_info userid redirect_uri client_id code state scope = + let new_state = + { + userid ; redirect_uri ; client_id ; + code ; state ; scope ; counter = ref 0 + } + in + request_info := (new_state :: (! request_info)) + + (** [remove_request_info state] removes the request_info with [state] *) + let remove_request_info_by_state_and_client_id state client_id = + List.filter + (fun x -> x.state = state && x.client_id = client_id) + (! request_info) + + (** Get the request info type with [state]. Raise [State_not_found] if no + request has been done with [state]. + *) + let request_info_of_state state = + let rec request_info_of_state_intern l = match l with + | [] -> raise State_not_found + | head::tail -> + if head.state = state then head + else request_info_of_state_intern tail + in + request_info_of_state_intern (! request_info) + + (** Debug function to print the request information list *) + let print_request_info_state_list () = + let states = ! request_info in + if List.length states = 0 then + print_endline "No registered states" + else + List.iter + (fun r -> + print_endline ("State: " ^ (state_of_request_info r)) ; + print_endline + ("userid: " ^ (Int64.to_string (userid_of_request_info r))); + print_endline ("redirect_uri: " ^ (redirect_uri_of_request_info r)); + print_endline ("code: " ^ (code_of_request_info r)); + print_endline + ("client_id: " ^ (client_id_of_request_info r)) + ) + states + + (** Returns [true] if the state [state] is already used for the client + [client_id]. Else returns [false]. + As the state is used to get the request information between + authorization and token endpoint, we need to be sure it's unique. + *) + + let check_state_already_used client_id state = + let rec check_state_already_used_intern l = + match l with + | [] -> false + | head::tail -> + if (head.state = state && head.client_id = client_id) then true + else check_state_already_used_intern tail + in + check_state_already_used_intern (! request_info) + + (* ---------- request information ---------- *) + (* ------------------------------------------ *) + + (* --------------------------------------------- *) + (* ---------- request code information --------- *) + + type request_info_code = + { + state : string ; + client_id : string ; + userid : int64 option ref ; (* use option because need a way to + distinct if it is set or not. Negative value is not the best way *) + redirect_uri : Ocsigen_lib.Url.t ; + scope : scope list + } + + let new_request_info_code ?(userid=None) state client_id redirect_uri scope + = + { state ; client_id ; userid = ref userid ; redirect_uri ; scope } + + let request_info_code : request_info_code list ref = ref [] + + let add_request_info_code request = + request_info_code := (request :: (!request_info_code)) + + let request_info_code_of_state_and_client_id state client_id = + try + List.find + (fun x -> x.state = state && x.client_id = client_id) + (!request_info_code) + with Not_found -> raise No_such_request_info_code + + let set_userid_of_request_info_code client_id state userid = + let request = request_info_code_of_state_and_client_id state client_id in + request.userid := Some userid + + let remove_request_info_code_by_client_id_and_state client_id state = + List.filter + (fun x -> x.client_id = client_id && x.state = state) + (! request_info_code) + + (* ---------- request code information --------- *) + (* --------------------------------------------- *) + + (** + NOTE: The example in the RFC is a redirection but it is not mentionned + if is mandatory. So we use change_page. + + FIXME: They don't return a page normally. We need to change it for an + action. + *) + let send_authorization_code state client_id = + let request_info_code_tmp = + request_info_code_of_state_and_client_id state client_id + in + let (prefix, path) = + Os_oauth2_shared.prefix_and_path_of_url request_info_code_tmp.redirect_uri + in + let () = match !(request_info_code_tmp.userid) with + | None -> raise No_such_userid_registered + | Some userid -> + ( + let code = generate_authorization_code () in + let service_url = Eliom_service.extern + ~prefix + ~path + ~meth:Os_oauth2_shared.param_authorization_code_response + () + in + add_request_info + userid + request_info_code_tmp.redirect_uri + client_id + code + state + request_info_code_tmp.scope; + ignore(remove_request_info_code_by_client_id_and_state client_id state); + ignore([%client ( + let service_url = ~%service_url in + ignore (Eliom_client.change_page + ~service:service_url + (~%code, ~%state) + ()) + : unit + )]) + ) + in + Lwt.return ( + Eliom_tools.D.html + ~title:"Authorization code: temporarily page" + Eliom_content.Html.D.(body []); + ) + + (* Send an error code and redirect the user-agent to [redirect_uri] *) + let send_authorization_code_error + ?(error_description=None) + ?(error_uri=None) + error + state + redirect_uri + = + let (prefix, path) = + Os_oauth2_shared.prefix_and_path_of_url redirect_uri + in + let service_url = Eliom_service.extern + ~prefix + ~path + ~meth:Os_oauth2_shared.param_authorization_code_response_error + () + in + let error_str = + Os_oauth2_shared.error_authorization_code_type_to_str error + in + (* It is not mentionned in the RFC if we need to send an error code in the + * redirection. So a simple change_page does the job. + *) + ignore ([%client ( + let service_url = ~%service_url in + Eliom_client.change_page + ~service:service_url + (~%error_str, (~%error_description, (~%error_uri, ~%state))) + () + : unit Lwt.t + )]); + Lwt.return ( + Eliom_tools.D.html + ~title:"Authorization code error: temporarily page" + Eliom_content.Html.D.(body []); + ) + + (* When resource owner authorizes the client. Normally, you don't need to + * use this function: {!rpc_resource_owner_authorize} is enough *) + let resource_owner_authorize (state, client_id) = + send_authorization_code state client_id + + (* RPC to use. Must be used client side when the resource owner authorizes. + *) + let rpc_resource_owner_authorize = + Eliom_client.server_function + [%derive.json: (string * string)] + resource_owner_authorize + + (* When resource owner declines the client. Normally, you don't need to use + * this function: {!rpc_resource_owner_decline} is enough. + * + * State and redirect_uri are visible in the URL because they are sent as + * GET parameters. There's no lack of security if they are changed + * client-side + *) + let resource_owner_decline (state, redirect_uri) = + send_authorization_code_error + ~error_description:(Some ("The resource owner doesn't authorize you to + access its data")) + Os_oauth2_shared.Auth_access_denied + state + redirect_uri + + (* RPC to use. Must be used client side when the resource owner declines. *) + let rpc_resource_owner_decline = + Eliom_client.server_function + [%derive.json: string * string] + resource_owner_decline + + type authorization_service = + (string * (string * (string * (string * string))), + unit, + Eliom_service.get, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, [ `WithoutSuffix ], + [ `One of string ] + Eliom_parameter.param_name * + ([ `One of string ] + Eliom_parameter.param_name * + ([ `One of string ] + Eliom_parameter.param_name * + ([ `One of string ] + Eliom_parameter.param_name * + [ `One of string ] + Eliom_parameter.param_name))), + unit, Eliom_service.non_ocaml) + Eliom_service.t + + let authorization_service path = + Eliom_service.create + ~path:(Eliom_service.Path path) + ~meth:Os_oauth2_shared.param_authorization_code + ~https:true + () + + type authorization_handler = + state:string -> + client_id:string -> + redirect_uri:string -> + scope:scope list -> + Eliom_registration.Html.page Lwt.t (* Returned value of the handler *) + + (* Performs check on client_id, scope and response_type before sent state, + * client_id, redirect_uri and scope to the handler + *) + let authorization_handler handler = + fun (response_type, (client_id, (redirect_uri, (scope, state)))) () -> + try%lwt + let scope_list = (scope_list_of_str_list (split_scope_list scope)) in + (* IMPROVEME: authenticates the client. http_header must be used. For + * the moment, we only check if the client exists because we don't how + * to send HTTP headers value when calling a service. + * NOTE: it's OK for the moment because it is checked in the token + * request. + *) + let%lwt authorized = + registered_client_exists_by_client_id client_id + in + let%lwt registered_client = + registered_client_of_client_id client_id + in + let redirect_uri_bdd = + redirect_uri_of_client + (client_of_registered_client registered_client) + in + let state_already_used = + check_state_already_used client_id state + in + (* + let http_header = Eliom_request_info.get_http_header () in + let%lwt authorized = + check_authorization_header client_id http_header + in + *) + if (response_type <> "code") then + send_authorization_code_error + ~error_description:(Some (response_type ^ " is not supported.")) + Os_oauth2_shared.Auth_invalid_request + state + redirect_uri + else if state_already_used then + send_authorization_code_error + ~error_description: + (Some ("State already used. It is recommended to generate \ + random state with minimum 30 characters")) + Os_oauth2_shared.Auth_invalid_request + state + redirect_uri + else if not authorized then + send_authorization_code_error + ~error_description: + (Some ("You are an unauthorized client. Please register before \ + or check your credentials.")) + Os_oauth2_shared.Auth_unauthorized_client + state + redirect_uri + else if not (check_scope_list scope_list) then + send_authorization_code_error + ~error_description: + (Some ("Some values in scope list are not available or you \ + forgot some mandatory scope value.")) + Os_oauth2_shared.Auth_invalid_scope + state + redirect_uri + else if redirect_uri <> redirect_uri_bdd then + ( + send_authorization_code_error + ~error_description: + (Some ("Check the value of redirect_uri.")) + Os_oauth2_shared.Auth_invalid_request + state + redirect_uri + ) + else + ( + add_request_info_code + (new_request_info_code + state + client_id + redirect_uri + scope_list + ); + handler + ~state + ~client_id + ~redirect_uri + ~scope:scope_list + ) + with + (* Comes from registered_client_of_client_id. It means the client + * doesn't exist because the function can't get any information about + * the client. *) + | No_such_client -> + send_authorization_code_error + ~error_description: + (Some ("You are an unauthorized client. Please register before \ + or check your credentials.")) + Os_oauth2_shared.Auth_unauthorized_client + state + redirect_uri + (* Comes from send_authorization_code while trying to get the + * request code information. It means the state or the client_id has + * been changed client-side ==> Maybe someone try to redirect the code + * to another URI. + *) + | No_such_request_info_code -> + send_authorization_code_error + ~error_description: + (Some ("Error while sending the code. Please check if you \ + changed the client_id or the state.")) + Os_oauth2_shared.Auth_invalid_request + state + redirect_uri + (* Comes from send_authorization_code while trying to get the userid of + * the user who authorized the OAuth2.0 client. It means no userid has + * been set. + *) + | No_such_userid_registered -> + send_authorization_code_error + ~error_description: + (Some ("Error while sending the code. No user has authorized.")) + Os_oauth2_shared.Auth_invalid_request + state + redirect_uri + + type saved_token = Token.saved_token + + let id_client_of_saved_token = Token.id_client_of_saved_token + + let userid_of_saved_token = Token.userid_of_saved_token + + let value_of_saved_token = Token.value_of_saved_token + + let token_type_of_saved_token = Token.token_type_of_saved_token + + let scope_of_saved_token = Token.scope_of_saved_token + + let generate_token = Token.generate_token + + let save_token = Token.save_token + + let remove_saved_token = Token.remove_saved_token + + let saved_token_of_id_client_and_value = + Token.saved_token_of_id_client_and_value + + let list_tokens = Token.list_tokens + + let token_exists = Token.token_exists + + let saved_token_to_json = Token.saved_token_to_json + + let send_token_error + ?(error_description=None) ?(error_uri=None) error = + let json_error = match (error_description, error_uri) with + | (None, None) -> + `Assoc [( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + )] + | (None, Some x) -> + `Assoc [ + ( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + ) ; + ("error_uri", `String x) + ] + | (Some x, None) -> + `Assoc [ + ( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + ) ; + ("error_description", `String x) + ] + | (Some x, Some y) -> + `Assoc + [ + ("error", `String (Os_oauth2_shared.error_token_type_to_str error)); + ("error_description", `String x) ; + ("error_uri", `String y) + ] + in + let headers = + Http_headers.add + Http_headers.cache_control + "no-store" + (Http_headers.add + Http_headers.pragma + "no-cache" + Http_headers.empty + ) + in + (* NOTE: RFC page 45 *) + let code = match error with + | Os_oauth2_shared.Token_invalid_client -> 401 + | _ -> 400 + in + + Eliom_registration.String.send + ~code + ~content_type:"application/json;charset=UTF-8" + ~headers + ( + Yojson.Safe.to_string json_error, + "application/json;charset=UTF-8" + ) + + type token_service = + (unit, + string * (string * (string * (string * string))), + Eliom_service.post, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, + [ `WithoutSuffix ], + unit, + [ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + [ `One of string ] Eliom_parameter.param_name))), + Eliom_registration.String.return) + Eliom_service.t + + let token_service path = + Os_oauth2_shared.update_list_timer + Token.cycle_duration + (fun x -> let c = Token.counter_of_saved_token x in !c >= + Token.number_of_cycle) + (fun x -> let c = Token.counter_of_saved_token x in incr c) + Token.saved_tokens + (); + Eliom_service.create + ~path:(Eliom_service.Path path) + ~meth:Os_oauth2_shared.param_access_token + ~https:true + () + + (* NOTE: the state is not mandatory but it is used to get information about + * the request. Not in RFC!! + *) + let token_handler = + fun () (grant_type, (code, (redirect_uri, (state, client_id)))) -> + try%lwt + let http_header = Eliom_request_info.get_http_header () in + (* Fetch information about the request *) + let request_info = request_info_of_state state in + let redirect_uri_state = redirect_uri_of_request_info request_info in + let code_state = code_of_request_info request_info in + let userid = userid_of_request_info request_info in + let scope = scope_of_request_info request_info in + (* Check if the client is well authenticated *) + let%lwt authorized = + check_authorization_header client_id http_header + in + if not authorized then + (* Need to add HTTP 401 (Unauthorized) response, see page 45 *) + send_token_error + ~error_description: + (Some "Client authentication failed. Please check your client \ + credentials and if you mentionned it in the request header.") + Os_oauth2_shared.Token_invalid_client + else if grant_type <> "authorization_code" then + send_token_error + ~error_description: + (Some "This authorization grant type is not supported.") + Os_oauth2_shared.Token_unsupported_grant_type + else if code <> code_state then + send_token_error + ~error_description: + (Some "Wrong code") + Os_oauth2_shared.Token_invalid_grant + else if redirect_uri <> redirect_uri_state then + send_token_error + ~error_description: + (Some "Wrong redirect_uri") + Os_oauth2_shared.Token_invalid_grant + else + ( + let%lwt id_client = + Os_db.OAuth2_server.id_of_client_id client_id + in + let%lwt token = + generate_token + ~id_client + ~userid + ~scope + in + let json = saved_token_to_json token in + let headers = + Http_headers.add + Http_headers.cache_control + "no-store" + (Http_headers.add + Http_headers.pragma + "no-cache" + Http_headers.empty + ) + in + ignore (remove_request_info_by_state_and_client_id state client_id); + save_token token; + Eliom_registration.String.send + ~code:200 + ~content_type:"application/json;charset=UTF-8" + ~headers + (Yojson.Safe.to_string json, + "application/json;charset=UTF-8") + ) + with + (* comes from request_info_of_state if no state found *) + | State_not_found -> + send_token_error + ~error_description: + (Some "Wrong state") + Os_oauth2_shared.Token_invalid_request + | Os_db.No_such_resource -> + send_token_error + ~error_description: + (Some "Client authentication failed.") + Os_oauth2_shared.Token_invalid_client + + end + +module Basic_scope = struct + type scope = OAuth | Firstname | Lastname | Email | Unknown + + let scope_to_str = function + | OAuth -> "oauth" + | Firstname -> "firstname" + | Lastname -> "lastname" + | Email -> "email" + | Unknown -> "" + + let scope_of_str = function + | "oauth" -> OAuth + | "firstname" -> Firstname + | "lastname" -> Lastname + | "email" -> Email + | _ -> Unknown + + let check_scope_list scope_list = + if List.length scope_list = 0 + then false + else if List.length scope_list = 1 && List.hd scope_list = OAuth + then false + else if not (List.mem OAuth scope_list) + then false + else + List.for_all + (fun x -> match x with + | Unknown -> false + | _ -> true + ) + scope_list +end + +module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = + struct + type scope = Scope.scope + + let cycle_duration = 60 + + let number_of_cycle = 10 + + type saved_token = + { + id_client : int64 ; + userid : int64 ; + value : string ; + token_type : string ; + counter : int ref ; + scope : scope list + } + + let saved_tokens : saved_token list ref = ref [] + + let id_client_of_saved_token t = t.id_client + + let userid_of_saved_token t = t.userid + + let value_of_saved_token t = t.value + + let token_type_of_saved_token t = t.token_type + + let scope_of_saved_token t = t.scope + + let counter_of_saved_token t = t.counter + + let token_exists_by_id_client_and_value id_client value = + List.exists + (fun x -> x.id_client = id_client && x.value = value) + (! saved_tokens) + + let token_exists saved_token = + let id_client = id_client_of_saved_token saved_token in + let value = value_of_saved_token saved_token in + token_exists_by_id_client_and_value id_client value + + let generate_token_value () = + Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_token + + let generate_token ~id_client ~userid ~scope = + let rec generate_token_if_doesnt_exists id_client = + let value = generate_token_value () in + if token_exists_by_id_client_and_value id_client value + then generate_token_if_doesnt_exists id_client + else value + in + let value = generate_token_if_doesnt_exists id_client in + Lwt.return + { + id_client ; userid ; value ; token_type = "bearer" ; + scope ; counter = ref 0 + } + + let save_token token = + saved_tokens := (token :: (! saved_tokens)) + + let remove_saved_token saved_token = + let value = value_of_saved_token saved_token in + let id_client = id_client_of_saved_token saved_token in + saved_tokens := + ( + List.filter + (fun x -> x.value = value && x.id_client = id_client) + (! saved_tokens) + ) + + let saved_token_of_id_client_and_value id_client value = + let tokens = (! saved_tokens) in + let rec locale = function + | [] -> raise No_such_saved_token + | head::tail -> + if head.id_client = id_client && head.value = value + then head + else locale tail + in + locale tokens + + (* IMPROVEME: list tokens by client OAuth2 id *) + let list_tokens () = + (! saved_tokens) + + let saved_token_to_json saved_token = + `Assoc + [ + ("token_type", `String "bearer") ; + ("token", `String (value_of_saved_token saved_token)) ; + ("expires_in", `Int (cycle_duration * number_of_cycle)) ; + (* ("refresh_token", `String refresh_token) ;*) + ] + end + +module Basic_token = MakeBasicToken (Basic_scope) + +module Basic = MakeServer (Basic_scope) (Basic_token) diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi new file mode 100644 index 000000000..320bc5bb0 --- /dev/null +++ b/src/os_oauth2_server.eliomi @@ -0,0 +1,595 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** OAuth2.0 server with default scopes ({!Basic_scope}), Tokens + ({!Basic_token}) and server implementation ({!Basic}). + *) + +(** Raised when a state is not found. *) +exception State_not_found + +(** Raised when the given client doesn't exist. *) +exception No_such_client + +(** Raised when the given saved token doesn't exist. *) +exception No_such_saved_token + +(** {1 Clients. } *) + +(** + A basic OAuth2.0 client is represented by an application name, a description + and redirect_uri. When a client is registered, credentials and an ID is + assigned and becomes a {registered_client}. + + IMPROVEME: + For the moment, the client type is the same for all OAuth2 server. However, + it can be interesting to register several OAuth2 servers (for different + purpose) and in this case, we are interested to list client by OAuth2 server. + *) + +type client + +(** Get a type {!client} *) +val client_of_string : + application_name:string -> + description:string -> + redirect_uri:Ocsigen_lib.Url.t -> + client + +(** Get the application name of the client. *) +val application_name_of_client : + client -> + string + +(** Get the redirect URI of the client. *) +val redirect_uri_of_client : + client -> + Ocsigen_lib.Url.t + +(** Get the client description. *) +val description_of_client : + client -> + string + +(** [client_of_id id] returns the client with id [id] as a {!client} type. Data + are retrieved from the database. + *) +val client_of_id : + Os_types.OAuth2.Client.id -> + client Lwt.t + +(** Create a new client by generating credentials (client ID and client secret). + The return value is the ID in the database. + *) +val new_client : + application_name:string -> + description:string -> + redirect_uri:Ocsigen_lib.Url.t -> + Os_types.OAuth2.Client.id Lwt.t + +(** [remove_client_by_id id] removes the client with id [id] from the + database. + *) +val remove_client_by_id : + Os_types.OAuth2.Client.id -> + unit Lwt.t + +(** [remove_client_by_client_id client_id] removes the client with the client_id + [client_id] from the database. + The client ID can be used because it must be unique. + *) +val remove_client_by_client_id : + string -> + unit Lwt.t + +(** A registered client contains basic information about the client, its ID + in the database and its credentials. It represents a client which is + registered in the database. + *) +type registered_client + +(** Get the ID of a registered client. It's the ID from the database. *) +val id_of_registered_client : + registered_client -> + Os_types.OAuth2.Client.id + +(** Get the client information as {!client} type of a registered client. *) +val client_of_registered_client : + registered_client -> + client + +(** Get the credentials of a registered clients. *) +val credentials_of_registered_client : + registered_client -> + Os_oauth2_shared.client_credentials + +(** Build a value of type {!registered_client}. *) +val to_registered_client : + Os_types.OAuth2.Client.id -> + client -> + Os_oauth2_shared.client_credentials -> + registered_client + +(** Return the registered client which has [client_id] as client id. Data are + retrieved from database. + *) +val registered_client_of_client_id : + Os_types.OAuth2.client_id -> + registered_client Lwt.t + +(** List all registered clients from [min_id] (default [0]) with a limit of + [limit] (default [10]). + *) +val list_clients : + ?min_id:Os_types.OAuth2.Client.id -> + ?limit:Int64.t -> + unit -> + registered_client list Lwt.t + +(** {2 Scopes, tokens and basic implementations of them. } *) + +(** Interface for scopes. *) +module type SCOPE = sig + (** Scope is a list of permissions. *) + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + (** Return [true] if the scope asked by the client is + allowed, else [false]. + + You can implement simple check functions by only checking if all + elements of the scopes list are defined but you can also have the case + where two scopes can't be asked at the same time. + *) + val check_scope_list : + scope list -> + bool +end + +(** Interface for tokens. *) + +module type TOKEN = sig + (** List of permissions. Used to type the [scope] field in {!saved_token} *) + type scope + + (** Saved token representation. The type is abstract to let the choice of + the implementation. + A token must contain at least: + - the userid to know which user authorized. + - the OAuth2.0 client ID to know the client to which the token is + assigned. The ID is related to the database. + - a value (the token value). + - the token type (for example ["bearer"]). + - the scopes list (of type {!scope}). Used to know which data the data + service must send. + - a counter which represents the number of times the token has been + checked by the timer. + *) + type saved_token + + (** The list of all saved tokens. *) + val saved_tokens : saved_token list ref + + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!cycle_duration} + seconds if the token has been generated after {!cycle_duration} * + {!number_of_cycle} seconds. If it's the case, the token is removed. + *) + + (** The duration of a cycle. *) + val cycle_duration : int + + (** The number of cycle. *) + val number_of_cycle : int + + (** Return the client ID. *) + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id + + (** Return the userid of the user who authorized. *) + val userid_of_saved_token : + saved_token -> + Os_types.User.id + + (** Return the token value. *) + val value_of_saved_token : + saved_token -> + string + + (** Return the token type. *) + val token_type_of_saved_token : + saved_token -> + string + + (** Return the scope asked by the client. *) + val scope_of_saved_token : + saved_token -> + scope list + + (** Return the number of passed cycle. *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Return [true] if the token already exists. *) + val token_exists : + saved_token -> + bool + + (** Generate a token value. *) + val generate_token_value : + unit -> + string + + (** Generate a new token. *) + val generate_token : + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> + saved_token Lwt.t + + (** Save a token. *) + val save_token : + saved_token -> + unit + + (** Remove a saved token. *) + val remove_saved_token : + saved_token -> + unit + + (** Return the saved token assigned to the client with given ID and + value. + *) + val saved_token_of_id_client_and_value : + Os_types.OAuth2.Client.id -> + string -> + saved_token + + (** List all saved tokens *) + val list_tokens : + unit -> + saved_token list + + (** Return the saved token as a JSON. Used to send to the client. *) + val saved_token_to_json : + saved_token -> + Yojson.Safe.json +end + +(** Interface for OAuth2.0 servers. + See also {!MakeServer}. + *) +module type SERVER = + sig + (** The following types and functions related to tokens and scopes are + aliases to the same types and functions from the modules types given in + the functor {!MakeServer}. These aliases avoid to know the modules used + to build the client. + + See {!SCOPE} and {!TOKEN} modules for documentations about these types + and functions. + *) + + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + val scope_list_of_str_list : + string list -> + scope list + + val scope_list_to_str_list : + scope list -> + string list + + type saved_token + + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id + + val userid_of_saved_token : + saved_token -> + Os_types.User.id + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + val scope_of_saved_token : + saved_token -> + scope list + + val token_exists : + saved_token -> + bool + + val save_token : + saved_token -> + unit + + val remove_saved_token : + saved_token -> + unit + + val saved_token_of_id_client_and_value : + Os_types.OAuth2.Client.id -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + (** [set_userid_of_request_info_code client_id state userid] TODO *) + val set_userid_of_request_info_code : + string -> + string -> + Os_types.User.id -> + unit + + (** {3 Send authorization code functions. } *) + + (** + These functions can be called by the authorization handler + {!authorization_handler}. + + Using this function avoids to know how OAuth2.0 works and to implement + the redirection manually. + *) + + (** [send_authorization_code state client_id] sends + an authorization code to the [redirect_uri] of the client with client ID + [client_id]. [redirect_uri] is retrieved from the state [state]. + + *) + val send_authorization_code : + string -> + Os_types.OAuth2.client_id -> + Eliom_registration.Html.page Lwt.t + + (** [send_authorization_code_error ?error_description ?error_uri error state + redirect_uri] does a change page to [redirect_uri] with the + corresponding error description ([error_description]) and URI + ([error_uri]). + *) + val send_authorization_code_error : + ?error_description:string option -> + ?error_uri:string option -> + Os_oauth2_shared.error_authorization_code_type -> + string -> + Ocsigen_lib.Url.t -> + Eliom_registration.Html.page Lwt.t + + (** {4 RPC to use when the resource owner authorize or decline. } *) + + (** [rpc_resource_owner_authorize state client_id] is the RPC to use + client-side when the resource owner has authorized. + *) + val rpc_resource_owner_authorize : + ( + string * Os_types.OAuth2.client_id, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + (** [rpc_resource_owner_decline state redirect_uri] is the RPC to use + client-side when the resource owner has declined. + *) + val rpc_resource_owner_decline : + ( + string * Ocsigen_lib.Url.t, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + (** {5 Authorization and token services/handlers } *) + + (** When registering, some GET parameters are mandatory in the RFC. + Functions ({!authorization_service} and {!token_service}) are defined to + create the services for authorization and token. + + There are not abstract because it's known due to RFC. + *) + + (** Type of the pre-defined service for authorization. It's a GET + service. + *) + type authorization_service = + (string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string)) + ), + unit, + Eliom_service.get, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, [ `WithoutSuffix ], + [ `One of string ] + Eliom_parameter.param_name * + ([ `One of Os_types.OAuth2.client_id ] + Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] + Eliom_parameter.param_name * + ([ `One of string ] + Eliom_parameter.param_name * + [ `One of string ] + Eliom_parameter.param_name))), + unit, Eliom_service.non_ocaml) + Eliom_service.t + + (** [authorization_service path] returns a service for the authorization. + You can use the handler {!authorization_handler}. + *) + val authorization_service : + Eliom_lib.Url.path -> + authorization_service + + (** The function type for the authorization handler. This type is defined to + have a clearer interface in {!authorization_handler}. + *) + type authorization_handler = + state:string -> + client_id:Os_types.OAuth2.client_id -> + redirect_uri:Ocsigen_lib.Url.t -> + scope:scope list -> + Eliom_registration.Html.page Lwt.t (* Return value of the handler *) + + (** [authorize_handler handler] returns a handler for the authorization URL. + You can use the service {!authorization_service}. + *) + val authorization_handler : + authorization_handler -> + ( + (string * (Os_types.OAuth2.client_id * + (Ocsigen_lib.Url.t * (string * string))) + ) -> + unit -> + Eliom_registration.Html.page Lwt.t + ) + + (** Type of the pre-defined service for token. It's a POST service. *) + type token_service = + (unit, + string * (string * (Ocsigen_lib.Url.t * (string * + Os_types.OAuth2.client_id))), + Eliom_service.post, + Eliom_service.att, + Eliom_service.non_co, + Eliom_service.non_ext, + Eliom_service.reg, + [ `WithoutSuffix ], + unit, + [ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), + Eliom_registration.String.return) + Eliom_service.t + + (** [token_service path] returns a service for the access token URL. + You can use the handler {!token_handler}. + *) + val token_service : + Ocsigen_lib.Url.path -> + token_service + + (** Handler for the access token URL. + You can use the service {!token_service}. + *) + val token_handler : + ( + unit -> + (string * (string * + (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id)))) -> + Eliom_registration.String.result Lwt.t + ) + end + +(** [MakeBasicToken (Scope)] returns a module of type {!TOKEN} with scope + dependency from the module [Scope]. + *) +module MakeBasicToken : functor + (Scope : SCOPE) -> (TOKEN with type scope = Scope.scope) + +(** [MakeServer (Scope) (Token)] returns a module of type {!SERVER} with scope + dependency from the module [Scope] and token dependency from [Token]. + + {!SCOPE.scope} and {!TOKEN.scope} must have the same type. + *) +module MakeServer : functor + (Scope : SCOPE) -> functor + (Token : (TOKEN with type scope = Scope.scope)) -> + (SERVER with + type scope = Scope.scope and + type saved_token = Token.saved_token + ) + +(** Basic scope. *) +module Basic_scope : + sig + (** Available scopes. When doing a request, [OAuth] is automatically + set. + *) + type scope = + | OAuth (** Mandatory in each requests (due to RFC).*) + | Firstname (** Get access to the first name *) + | Lastname (** Get access to the last name *) + | Email (** Get access to the email *) + | Unknown (** Used when an unknown scope is given. *) + + (** Get a string representation of the scope. {{!scope}Unknown} string + representation is the empty string. + *) + val scope_to_str : scope -> string + + (** Convert a string scope to {!scope} type. *) + val scope_of_str : string -> scope + + (** [check_scope_list scope_list] returns [true] if every element in + [scope_list] is an available scope value. + If the list contains only [OAuth] or if the list doesn't contain + [OAuth] (mandatory scope in RFC), returns [false]. + If an unknown scope value is in list (represented by [Unknown]), + it returns [false]. + *) + val check_scope_list : scope list -> bool + end + +(** Basic token, based on {!Basic_scope}. + + A token value is a random string of length {!Os_oauth2_shared.size_token}. + The expiration time is set to [10] minutes with [10] cycles of [60] seconds. + + Tokens are represented as records and have exactly the fields available by + the interface. + + The token type is ["bearer"]. + + The related JSON contains the fields: + - ["token_type"] with value ["bearer"]. + - ["token"] with the token value. + - ["expires_in"] with the value [cycle_duration * number_of_cycle] i.e. 600 + seconds. + *) +module Basic_token : TOKEN + +(** Basic server, based on {!Basic_scope} and {!Basic_token}. *) +module Basic : (SERVER with type scope = Basic_scope.scope) diff --git a/src/os_oauth2_shared.eliom b/src/os_oauth2_shared.eliom new file mode 100644 index 000000000..3aaadc585 --- /dev/null +++ b/src/os_oauth2_shared.eliom @@ -0,0 +1,163 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +open Eliom_parameter +open Lwt.Infix + +exception No_such_client +exception Server_id_exists +exception Empty_content + +let size_authorization_code = 42 +let size_client_id = 42 +let size_client_secret = 42 +let size_token = 42 +let size_state = 42 + +let expiration_time_authorization_code = 10 * 60 + +type client_credentials = + { + client_id : Os_types.OAuth2.client_id ; + client_secret : Os_types.OAuth2.client_secret + } + +let client_credentials_of_string ~client_id ~client_secret = + { + client_id; + client_secret + } + +let client_id_of_client_credentials c = c.client_id +let client_secret_of_client_credentials c = c.client_secret + +type error_authorization_code_type = + | Auth_invalid_request + | Auth_unauthorized_client + | Auth_access_denied + | Auth_unsupported_response_type + | Auth_invalid_scope + | Auth_server_error + | Auth_temporarily_unavailable + +let error_authorization_code_type_to_str e = match e with + | Auth_invalid_request -> "invalid_request" + | Auth_unauthorized_client -> "unauthorized_client" + | Auth_access_denied -> "access_denied" + | Auth_unsupported_response_type -> "unsupported_response_type" + | Auth_invalid_scope -> "invalid_scope" + | Auth_server_error -> "server_error" + | Auth_temporarily_unavailable -> "temporarily_unavailable" + +type error_token_type = + | Token_invalid_request + | Token_unauthorized_client + | Token_invalid_client + | Token_invalid_grant + | Token_unsupported_grant_type + | Token_invalid_scope + +let error_token_type_to_str e = match e with + | Token_invalid_request -> "invalid_request" + | Token_unauthorized_client -> "unauthorized_client" + | Token_unsupported_grant_type -> "unsupported_grant_type" + | Token_invalid_client -> "invalid_client" + | Token_invalid_grant -> "invalid_grant" + | Token_invalid_scope -> "invalid_scope" + +let param_authorization_code = Eliom_service.Get + ( + (Eliom_parameter.string "response_type") ** + ((Eliom_parameter.string "client_id") ** + ((Eliom_parameter.string "redirect_uri") ** + ((Eliom_parameter.string "scope") ** + (Eliom_parameter.string "state") + ) + ) + ) + ) + +let param_authorization_code_response = Eliom_service.Get + ( + (Eliom_parameter.string "code") ** + (Eliom_parameter.string "state") + ) + +let param_authorization_code_response_error = Eliom_service.Get + ( + (Eliom_parameter.string "error") ** + ((Eliom_parameter.opt (Eliom_parameter.string "error_description")) ** + ((Eliom_parameter.opt (Eliom_parameter.string "error_uri")) ** + ((Eliom_parameter.string "state")) + ) + ) + ) + +let param_access_token = Eliom_service.Post + (Eliom_parameter.unit, + ((Eliom_parameter.string "grant_type") ** + ((Eliom_parameter.string "code") ** + ((Eliom_parameter.string "redirect_uri") ** + ((Eliom_parameter.string "state") ** + (Eliom_parameter.string "client_id") + ) + ) + ) + ) + ) + +let rec update_list_timer timer fn_remove fn_incr l () = + let rec locale l = match l with + | [] -> [] + | head :: tail -> + (* if the token is expired we remove it by going to the next *) + if fn_remove head + then (locale tail) + (* else, all next one aren't expired (FIFO) so we return the tail *) + else tail + in + l := locale !l; + List.iter fn_incr (!l); + Lwt_timeout.start + (Lwt_timeout.create timer (update_list_timer timer fn_remove fn_incr l)) + +let generate_random_string length = + let random_character () = match Random.int (26 + 26 + 10) with + n when n < 26 -> int_of_char 'a' + n + | n when n < 26 + 26 -> int_of_char 'A' + n - 26 + | n -> int_of_char '0' + n - 26 - 26 in + let random_character _ = String.make 1 (char_of_int (random_character ())) in + String.concat "" (Array.to_list (Array.init length random_character)) + +let prefix_and_path_of_url url = + let (https, host, port, _, path, _, _) = Ocsigen_lib.Url.parse url in + let https_str = match https with + | None -> "" + | Some x -> if x then "https://" else "http://" + in + let host_str = match host with + | None -> "" + | Some x -> x + in + let port_str = match port with + | None -> "" + | Some x -> string_of_int x + in + (https_str ^ host_str ^ ":" ^ port_str, path) diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi new file mode 100644 index 000000000..d2af4f653 --- /dev/null +++ b/src/os_oauth2_shared.eliomi @@ -0,0 +1,225 @@ +(* Ocsigen-start + * http://www.ocsigen.org/ocsigen-start + * + * Copyright (C) Université Paris Diderot, CNRS, INRIA, Be Sport. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(** Shared types, functions and values between the OAuth2.0/OpenID Connect + client and server. + *) + +(** {1 Constants} *) + +(** Length of state. *) +val size_state : int + +(** Length of client ID. *) +val size_client_id : int + +(** Length of client secret. *) +val size_client_secret : int + +(** Length of token. *) +val size_token : int + +(** Length of authorization code. *) +val size_authorization_code : int + +(** {2 About client credentials} *) + +(** Client credentials type. *) +type client_credentials + +val client_credentials_of_string : + client_id:Os_types.OAuth2.client_id -> + client_secret:Os_types.OAuth2.client_secret -> + client_credentials + +val client_id_of_client_credentials : + client_credentials -> + Os_types.OAuth2.client_id + +val client_secret_of_client_credentials : + client_credentials -> + Os_types.OAuth2.client_secret + +(** {3 Error types for authorization code. } *) + +type error_authorization_code_type = + | Auth_invalid_request + | Auth_unauthorized_client + | Auth_access_denied + | Auth_unsupported_response_type + | Auth_invalid_scope + | Auth_server_error + | Auth_temporarily_unavailable + +val error_authorization_code_type_to_str : + error_authorization_code_type -> + string + +(** {4 Error types for token. } *) + +type error_token_type = + | Token_invalid_request + | Token_unauthorized_client + | Token_invalid_client + | Token_invalid_grant + | Token_unsupported_grant_type + | Token_invalid_scope + +val error_token_type_to_str : + error_token_type -> + string + +(** {5 Parameters types for the different services. } *) + +(** Parameters for the authorization service. This service must be registered on + the server. + + The parameters are (in order): + - the response type. For the moment, only the value ["code"] is + supported. + - the client ID. + - the redirect URI. + - the scope as a space separated list. + - the state. + *) +val param_authorization_code : + ( + Eliom_service.get, + string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string))), + [ `One of string ] Eliom_parameter.param_name * + ([ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + [ `One of string ] Eliom_parameter.param_name))), + unit, + unit, + [ `WithoutSuffix ], + unit + ) + Eliom_service.meth + +(** Parameters for the authorization code response service. This service must be + registered on the client and use by the server to send the code in case + of success. + + The parameters are (in order): + - the code. + - the state. + *) +val param_authorization_code_response : + ( + Eliom_service.get, + string * string, + [ `One of string ] Eliom_parameter.param_name * + [ `One of string ] Eliom_parameter.param_name, + unit, + unit, + [ `WithoutSuffix ], + unit + ) + Eliom_service.meth + +(** Parameters for the authorization code response service. This service must be + registered on the client and use by the server to send the response in case + of error. + + The parameters are (in order): + - the error. + - an (optional) error description + - an (optional) error URI to describe the error. + - the state. + *) +val param_authorization_code_response_error : + ( + Eliom_service.get, + string * (string option * (Ocsigen_lib.Url.t option * string)), + [ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * + [ `One of string ] Eliom_parameter.param_name)), + unit, + unit, + [ `WithoutSuffix ], + unit + ) + Eliom_service.meth + +(** Parameters for the token service. This service must be registered on the + server. + + The parameters are (in order): + - the grant type. For the moment, only the value ["authorization_code"] is + supported. + - the code. + - the redirect URI. + - the state. + - the client ID. + *) +val param_access_token : + ( + Eliom_service.post, + unit, + unit, + string * + (string * (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id))), + [ `One of string ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + ([ `One of string ] Eliom_parameter.param_name * + [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), + [ `WithoutSuffix ], + unit + ) + Eliom_service.meth + +(** {6 MISC functions. } *) + +(** [update_list_timer seconds fn_check fn_timeout list] creates a Lwt timeout + each [seconds] (see <> and <>). After this timeout, [fn_timeout] is + executed on each element of [list] for which [fn_check] is [true]. + + This function is used to remove saved tokens when they are expired. + *) +val update_list_timer : + int -> + ('a -> bool) -> + ('a -> unit) -> + 'a list ref -> + unit -> + unit + +(** [generate_random_string length] generates an alphanumeric string of length + [length]. + *) +val generate_random_string : + int -> + string + +(** [prefix_and_path_of_t url] splits [url] in a couple [(prefix, path)] where + [prefix] is ["http(s)://host:port"] and [path] is the path as [string list] + + Example: [prefix_and_path_of_t "http://ocsigen.org:80/tuto/manual"] + returns [("http://ocsigen.org:80", ["tuto", "manual"])]. + *) +val prefix_and_path_of_url : + Ocsigen_lib.Url.t -> + string * string list diff --git a/src/os_types.eliom b/src/os_types.eliom index 678ace900..25c41413d 100644 --- a/src/os_types.eliom +++ b/src/os_types.eliom @@ -65,3 +65,17 @@ module Group = struct desc : string option; } end + +module OAuth2 = struct + type client_id = string + type client_secret = string + + module Client = struct + type id = int64 + type server_id = string + end + + module Server = struct + type id = int64 + end +end diff --git a/src/os_types.eliomi b/src/os_types.eliomi index 1582c6801..c1a5869e6 100644 --- a/src/os_types.eliomi +++ b/src/os_types.eliomi @@ -69,3 +69,17 @@ module Group : sig desc : string option; } end + +module OAuth2 : sig + type client_id = string + type client_secret = string + + module Client : sig + type id = int64 + type server_id = string + end + + module Server : sig + type id = int64 + end +end diff --git a/template.distillery/PROJECT_NAME.sql b/template.distillery/PROJECT_NAME.sql index 304d38892..ff145d9da 100644 --- a/template.distillery/PROJECT_NAME.sql +++ b/template.distillery/PROJECT_NAME.sql @@ -47,4 +47,31 @@ CREATE SCHEMA ocsigen_start CREATE TABLE preregister ( email citext NOT NULL + ) + -- Table for OAuth2.0 server. An Eliom application can be an OAuth2.0 server. + -- Its client can be an Eliom application, but not always. + + ---- Table to represent and register clients + CREATE TABLE oauth2_server_client ( + id bigserial primary key, + application_name text not NULL, + description text not NULL, + redirect_uri text not NULL, + client_id text not NULL, + client_secret text not NULL + ) + + -- Table for OAuth2.0 client. An Eliom application can be a OAuth2.0 client of a + -- OAuth2.0 server which can be also an Eliom application, but not always. + CREATE TABLE oauth2_client_credentials ( + -- Is it very useful ? Remove it implies an application can be a OAuth + -- client of a OAuth server only one time. For the moment, algorithms works + -- with the server_id which are the name and so id is useless. + id bigserial primary key, + server_id text not NULL, -- to remember which OAuth2.0 server is. The server name can be used. + server_authorization_url text not NULL, + server_token_url text not NULL, + server_data_url text not NULL, + client_id text not NULL, + client_secret text not NULL );