From 2db42b96e6dffa07dce272cf5882628a58f6e84e Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Mon, 31 Oct 2016 17:59:29 +0100 Subject: [PATCH 01/19] OAuth2/OpenID Connect implementation --- Makefile.options | 2 +- opam/opam | 1 + src/os_connect_client.eliom | 204 +++++ src/os_connect_client.eliomi | 98 +++ src/os_connect_server.eliom | 337 ++++++++ src/os_connect_server.eliomi | 115 +++ src/os_db.ml | 515 ++++++++++++ src/os_db.mli | 153 +++- src/os_oauth2_client.eliom | 778 ++++++++++++++++++ src/os_oauth2_client.eliomi | 369 +++++++++ src/os_oauth2_server.eliom | 1445 ++++++++++++++++++++++++++++++++++ src/os_oauth2_server.eliomi | 507 ++++++++++++ src/os_oauth2_shared.eliom | 191 +++++ src/os_oauth2_shared.eliomi | 152 ++++ src/os_types.eliom | 16 + src/os_types.eliomi | 16 + 16 files changed, 4895 insertions(+), 4 deletions(-) create mode 100644 src/os_connect_client.eliom create mode 100644 src/os_connect_client.eliomi create mode 100644 src/os_connect_server.eliom create mode 100644 src/os_connect_server.eliomi create mode 100644 src/os_oauth2_client.eliom create mode 100644 src/os_oauth2_client.eliomi create mode 100644 src/os_oauth2_server.eliom create mode 100644 src/os_oauth2_server.eliomi create mode 100644 src/os_oauth2_shared.eliom create mode 100644 src/os_oauth2_shared.eliomi 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..23cfe69e2 --- /dev/null +++ b/src/os_connect_client.eliom @@ -0,0 +1,204 @@ +open Os_oauth2_shared + +exception Bad_JSON_response + +exception No_such_saved_token + +module type IDTOKEN = + sig + (** Represents a saved token. Tokens are registered in the volatile memory with + * scope default_global_scope. + *) + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : + saved_token -> + int64 + + 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 + + (** Representing the number of times the token has been checked by the timeout. + * Must be of type int ref. + *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + (** Parse the JSON file returned by the token server and returns the + * corresponding save_token OCaml type. + * Must raise Bad_JSON_response if all needed information are not given. + * NOTE: Must ignore unrecognized JSON attributes. + *) + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + int64 -> + 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 + (* --------------------------- *) + (* ---------- Scope ---------- *) + + type scope = OpenID | Firstname | Lastname | Email | Unknown + + let default_scope = [ 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 + + (* ---------- Scope ---------- *) + (* --------------------------- *) + end + +module Basic_ID_token : IDTOKEN = + struct + type saved_token = + { + id_server : int64 ; + value : string ; + token_type : string ; + counter : int ref ; + id_token : Jwt.t + } + + let saved_tokens : saved_token list ref = ref [] + + let timeout = 10 + + let number_of_timeout = 1 + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (** Parse the JSON file returned by the token server and returns the + * corresponding save_token OCaml type. + * In this way, it's easier to work with the token response. + * NOTE: Ignore unrecognized JSON attributes. + *) + 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 := + ( + remove_from_list + (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..0b7d43134 --- /dev/null +++ b/src/os_connect_client.eliomi @@ -0,0 +1,98 @@ +exception Bad_JSON_response + +exception No_such_saved_token + +module type IDTOKEN = + sig + (** Represents a saved token. Tokens are registered in the volatile memory with + * scope default_global_scope. + *) + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : + saved_token -> + int64 + + 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 + + (** Representing the number of times the token has been checked by the timeout. + * Must be of type int ref. + *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + (** Parse the JSON file returned by the token server and returns the + * corresponding save_token OCaml type. + * Must raise Bad_JSON_response if all needed information are not given. + * NOTE: Must ignore unrecognized JSON attributes. + *) + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + int64 -> + 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 : + sig + type scope = OpenID | Firstname | Lastname | Email | Unknown + + val default_scope : scope list + + val scope_to_str : scope -> string + + val scope_of_str : string -> scope + end + +module Basic_ID_token : IDTOKEN + +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..62c9c6d0d --- /dev/null +++ b/src/os_connect_server.eliom @@ -0,0 +1,337 @@ +exception No_such_saved_token + +module type IDTOKEN = + sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (* ------- *) + (* getters *) + + val id_client_of_saved_token : + saved_token -> + int64 + + val userid_of_saved_token : + saved_token -> + int64 + + 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 + + (* getters *) + (* ------- *) + + (* Returns 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:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t + + (* Save a token *) + 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 + + (* List all saved tokens *) + 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 timeout = 10 + + let number_of_timeout = 1 + + type saved_token = + { + id_client : int64 ; + userid : int64 ; + token_type : string ; + value : string ; + id_token : Jwt.t ; + scope : scope list ; + counter : int ref ; + secret_key : string (* Needed to be able to check if the client sent the + right id_token. This is the key used by HS256 to sign the token. *) + } + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (** ------------------------------------------ *) + (** ---------- Function about token ---------- *) + + (* FIXME: We need to set an expiration time to 10 minutes for each token in + * the list. So the type will be saved_token Eliom_reference.Volatile.eref + * list and not saved_token list Eliom_reference.Volatile.eref. + *) + let saved_tokens : saved_token list ref = ref [] + + (** token_exists_by_id_client_and_value [id_client] [value] 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) + + (** token_exists [saved_token] returns true if [saved_token] exists + *) + 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 = 10. *. 60. in (* NOTE: expiration in 10 minutes *) + 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 + } + + (* Save a token *) + let save_token token = + saved_tokens := (token :: (! saved_tokens)) + + (* remove a saved token of type saved_token *) + 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 := + ( + Os_oauth2_shared.remove_from_list + (fun x -> x.value = value && x.id_client = id_client) + (! saved_tokens) + ) + + (* Search a saved token by id_client and value *) + 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 + + (* List all saved 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)) + ) + (* FIXME: See fixme for saved_token value. *) + (* ("expires_in", `Int 3600) ; *) + (* What about a refresh_token ? *) + (* ("refresh_token", `String refresh_token) ;*) + ] + + (** ---------- Function about token ---------- *) + (** ------------------------------------------ *) + end + +module Basic_scope : Os_oauth2_server.SCOPE = + struct + (* --------------------------- *) + (* ---------- Scope ---------- *) + + 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 + + (** check_scope_list scope_list returns true if every element in + * [scope_list] is a available scope value. + * If the list contains only OpenID or if the list doesn't contain OpenID + * (mandatory scope in RFC), returns false. + * If an unknown scope value is in list (represented by Unknown value), returns + * false. + *) + 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 + + (* ---------- Scope ---------- *) + (* --------------------------- *) + 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..a8ddbeaec --- /dev/null +++ b/src/os_connect_server.eliomi @@ -0,0 +1,115 @@ +exception No_such_saved_token + +module type IDTOKEN = + sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (* ------- *) + (* getters *) + + val id_client_of_saved_token : + saved_token -> + int64 + + val userid_of_saved_token : + saved_token -> + int64 + + 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 + + (* getters *) + (* ------- *) + + (* Returns 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:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t + + (* Save a token *) + 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 + + (* List all saved tokens *) + val list_tokens : + unit -> + saved_token list + + val saved_token_to_json : + saved_token -> + Yojson.Safe.json + end + +module Basic_scope : Os_oauth2_server.SCOPE + +module MakeIDToken : functor + (Scope : Os_oauth2_server.SCOPE) -> + (IDTOKEN with type scope = Scope.scope) + +module Basic_ID_token + : (IDTOKEN with + type scope = Basic_scope.scope) + +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..40a329caa 100644 --- a/src/os_db.ml +++ b/src/os_db.ml @@ -169,7 +169,63 @@ 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 "oauth2_server_client_id_seq" >> + +let oauth2_server_client_table = + <:table< 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 "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< 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 +624,462 @@ 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$ + >> + ) + (* --------- 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..e270ae4e9 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,152 @@ 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 +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..0ffbc4a97 --- /dev/null +++ b/src/os_oauth2_client.eliom @@ -0,0 +1,778 @@ +open Os_oauth2_shared +open Eliom_parameter +open Lwt.Infix + +(* -------------------------------- *) +(* ---------- Exceptions ---------- *) + +(* About state *) +exception State_not_found + +(* About client *) +exception No_such_client + +(* About server *) +exception Server_id_exists +exception No_such_server + +(* About saved token *) +exception No_such_saved_token +exception Bad_JSON_respoonse + +(* ---------- Exceptions ---------- *) +(* -------------------------------- *) + +(* ----------------------------------- *) +(* Type of registered OAuth2.0 server. *) + +type registered_server = + { + id : int64 ; + server_id : string ; + authorization_url : string ; + token_url : string ; + data_url : string ; + client_credentials : 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: + (client_credentials_of_str client_id client_secret) + ) servers + ) + +(** Type of registered OAuth2.0 server. Only used client side. *) +(** ---------------------------------------------------------- *) + +(** --------------------------------------------- *) +(** Get client credentials and server information *) + +let get_client_credentials ~server_id = + try%lwt + (Os_db.OAuth2_client.get_client_credentials ~server_id) + >>= + (fun (id, secret) -> + Lwt.return (client_credentials_of_str ~client_id:id ~client_secret: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 + +(** Get client credentials and server information *) +(** --------------------------------------------- *) + +(** ------------------------------- *) +(** Save and remove a OAuth2 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 + +(** Save and remove a OAuth2 server *) +(** ------------------------------- *) + +(** ----------------------------------------------------------- *) +(** Scope module type. See the eliomi file for more information *) + +module type SCOPE = sig + type scope + + val default_scope : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string +end + +(** Scope module type. See the eliomi file for more information *) +(** ----------------------------------------------------------- *) + +(** ----------------------------------------------------------- *) +(** Token module type. See the eliomi file for more information *) + +module type TOKEN = sig + (** Represents a saved token *) + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : + saved_token -> + int64 + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + (** Representing the number of times the token has been checked by the timeout. + * Must be of type int ref. + *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + int64 -> + string -> + saved_token + + val save_token : + saved_token -> + unit + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + end + +(** Token module type. See the eliomi file for more information *) +(** ----------------------------------------------------------- *) + +(** ------------------------------------------------------------ *) +(** Client module type. See the eliomi file for more information *) + +module type CLIENT = sig + (* -------------------------- *) + (* --------- Scope ---------- *) + + type scope + + val default_scope : 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 + + (* --------- Scope ---------- *) + (* -------------------------- *) + + (** ---------------------------- *) + (** Initialize a OAuth2.0 client *) + + (** When register, clients must specify a redirect uri 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 [link] : + * - for successfull authorization code response. + * - for error authorization code response. + * 1. 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 in the database and a + * redirection is done to the service [success_redirection]. + * 2. 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:string -> + success_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + error_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + unit Lwt.t + + (** Initialize a OAuth2.0 client *) + (** ---------------------------- *) + + (** ---------------------------------------- *) + (** ---------- Authorization code ---------- *) + + (** + * 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 + * server side saved until expiration in the HTTP parameter. + * 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 optional default scope is to be compatible with OAuth2.0 which + * doesn't respect "oauth" (mandatory in the RFC) in scope. + * IMPROVEME: Use string list to add multiple default scope? + *) + val request_authorization_code : + redirect_uri:string -> + server_id:string -> + scope:scope list -> + unit Lwt.t + + (** ---------- Authorization code ---------- *) + (** ---------------------------------------- *) + + (* ---------------------------------- *) + (* ----------- Saved token ---------- *) + + (** Represents a saved token. Tokens are registered in the volatile memory with + * scope default_global_scope. + *) + type saved_token + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : saved_token -> int64 + val value_of_saved_token : saved_token -> string + val token_type_of_saved_token : saved_token -> string + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + val saved_token_of_id_server_and_value : + int64 -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + val remove_saved_token : + saved_token -> + unit + + (* ----------- Saved token ---------- *) + (* ---------------------------------- *) +end + +(** Client module type. See the eliomi file for more information *) +(** ------------------------------------------------------------ *) + +(** -------------------------------------------------------- *) +(** Functor to create a Client from a Scope and Token module *) + +module MakeClient + (Scope : SCOPE) + (Token : TOKEN) : + (CLIENT with + type scope = Scope.scope and + type saved_token = Token.saved_token + ) = struct + + (* -------------------------- *) + (* --------- Scope ---------- *) + + type scope = Scope.scope + + let default_scope = Scope.default_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 + + (* --------- Scope ---------- *) + (* -------------------------- *) + + (* ---------------------------------------- *) + (* --------- 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 + + (** add_request_info [state] [server_id] [scope] 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)) + + (** remove_request_info [state] removes the + * request_info which has [state] as state. + *) + let remove_request_info_by_state state = + request_info := + (remove_from_list (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_scope @ 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 = client_credentials_id client_credentials in + let state = generate_state () in + + let service_url = Eliom_service.extern + ~prefix + ~path + ~meth: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 () + (** ------------------ *) + + (** ---------- Authorization code ---------- *) + (** ---------------------------------------- *) + + (* ---------------------------------- *) + (* ----------- Saved token ---------- *) + + type saved_token = Token.saved_token + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + 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 + + (* ----------- Saved token ---------- *) + (* ---------------------------------- *) + + (** OCaml representation of a token. This is the OCaml equivalent + * representation of the JSON returned by the token server + *) + type token_json = + { + token_type : string ; + value : string ; + } + + (** Create a token with the type and the corresponding value *) + let token_json_of_str token_type value = {token_type ; value} + + (** ------- *) + (** Getters *) + + let token_type_of_token_json t = t.token_type + let value_of_token_json t = t.value + + (** Getters *) + (** ------- *) + + (** Request a token to the server represented as ~server_id in the + * database. Saving it in the database allows to keep it a long time. + * 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 = + client_credentials_id client_credentials + in + let client_secret = + client_credentials_secret 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 + + (** ---------- Token ---------- *) + (** --------------------------- *) + + (** ---------------------------- *) + (** Initialize a OAuth2.0 client *) + + (** 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:param_authorization_code_response + () + in + let error = + Eliom_service.create + ~path:(Eliom_service.Path path) + ~meth:param_authorization_code_response_error + () + in + + update_list_timer + Token.timeout + (fun x -> let c = Token.counter_of_saved_token x in !c >= Token.number_of_timeout) + (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 a 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 () + + (** Initialize a OAuth2.0 client *) + (** ---------------------------- *) + + (** --------------------------------- *) + (** Tokens *) + + (** Tokens *) + (** --------------------------------- *) +end + +(** Functor to create a Client from a Scope and Token module *) +(** -------------------------------------------------------- *) + +(* -------------------------------------------------------------------------- *) +(* ------------------------------ Basic modules ----------------------------- *) + +module Basic_scope = + struct + type scope = OAuth | Firstname | Lastname | Email | Unknown + + let default_scope = [ 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 + +(** 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 need to + * use this module if the OAuth2 server is a 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 = struct + type saved_token = + { + id_server : int64 ; + value : string ; + token_type : string ; + counter : int ref + } + + let timeout = 10 + let number_of_timeout = 1 + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (** Parse the JSON file returned by the token server and returns the + * corresponding save_token OCaml type. + * In this way, it's easier to work with the token response. + * NOTE: Ignore unrecognized JSON attributes. + *) + 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 := + ( + remove_from_list + (fun (x : saved_token) -> + x.value = value && x.id_server = id_server + ) + (!saved_tokens) + ) +end + +(** Basic OAuth2 client, compatible with OAuth2.0 server + * Os_oauth2_server.Basic. + *) +module Basic = MakeClient (Basic_scope) (Basic_token) + +(* ------------------------------ Basic modules ----------------------------- *) +(* -------------------------------------------------------------------------- *) diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi new file mode 100644 index 000000000..1f8f6d294 --- /dev/null +++ b/src/os_oauth2_client.eliomi @@ -0,0 +1,369 @@ +open Os_oauth2_shared + +(* -------------------------------- *) +(* ---------- Exceptions ---------- *) + +(* About state *) +exception State_not_found + +(* About client *) +exception No_such_client + +(* About server *) +exception Server_id_exists +exception No_such_server + +(* About saved token *) +exception No_such_saved_token +exception Bad_JSON_respoonse + +(* ---------- Exceptions ---------- *) +(* -------------------------------- *) + +(* ----------------------------------- *) +(* Type of registered OAuth2.0 server. *) + +type registered_server + +val id_of_registered_server : + registered_server -> + int64 + +val server_id_of_registered_server : + registered_server -> + string + +val authorization_url_of_registered_server : + registered_server -> + string + +val token_url_of_registered_server : + registered_server -> + string + +val data_url_of_registered_server : + registered_server -> + string + +val client_credentials_of_registered_server : + registered_server -> + client_credentials + +val to_registered_server : + id:int64 -> + server_id:string -> + authorization_url:string -> + token_url:string -> + data_url:string -> + client_credentials:client_credentials -> + registered_server + +val list_servers : + unit -> + registered_server list Lwt.t + +(** Type of registered OAuth2.0 server. Only used client side. *) +(** ---------------------------------------------------------- *) + +(** ------------------------------- *) +(** Save and remove a OAuth2 server *) +(** If a OAuth2 server is already registerd with server_id, raise an error + * Server_id_exists. + * OK + *) + +val save_server : + server_id:string -> + server_authorization_url:string -> + server_token_url:string -> + server_data_url:string -> + client_id:string -> + client_secret:string -> + unit Lwt.t + +val remove_server_by_id : + int64 -> + unit Lwt.t + +(** Save and remove a OAuth2 server *) +(** ------------------------------- *) + +(** ------------------ *) +(** Client credentials *) + +(** Get the client credientials for a given OAuth2.0 server. OK *) +val get_client_credentials : server_id:string -> client_credentials Lwt.t + +(** Client credentials *) +(** ------------------ *) + +module type SCOPE = sig + type scope + + val default_scope : scope list + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string +end + +module type TOKEN = sig + (** Represents a saved token. Tokens are registered in the volatile memory with + * scope default_global_scope. + *) + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : + saved_token -> + int64 + + val value_of_saved_token : + saved_token -> + string + + val token_type_of_saved_token : + saved_token -> + string + + (** Representing the number of times the token has been checked by the timeout. + * Must be of type int ref. + *) + val counter_of_saved_token : + saved_token -> + int ref + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + (** Parse the JSON file returned by the token server and returns the + * corresponding save_token OCaml type. + * Must raise Bad_JSON_response if all needed information are not given. + * NOTE: Must ignore unrecognized JSON attributes. + *) + val parse_json_token : + int64 -> + Yojson.Basic.json -> + saved_token + + val saved_token_of_id_server_and_value : + int64 -> + 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 + (* -------------------------- *) + (* --------- Scope ---------- *) + + type scope + + val default_scope : 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 + + (* --------- Scope ---------- *) + (* -------------------------- *) + + (** ---------------------------- *) + (** Initialize a OAuth2.0 client *) + + (** When register, clients must specify a redirect uri 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 [link] : + * - for successfull authorization code response. + * - for error authorization code response. + * 1. 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 in the database and a + * redirection is done to the service [success_redirection]. + * 2. 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:string -> + success_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + error_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + unit Lwt.t + + (** Initialize a OAuth2.0 client *) + (** ---------------------------- *) + + (** ---------------------------------------- *) + (** ---------- Authorization code ---------- *) + + (** + * 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 + * server side saved until expiration in the HTTP parameter. + * 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 optional default scope is to be compatible with OAuth2.0 which + * doesn't respect "oauth" (mandatory in the RFC) in scope. + * IMPROVEME: Use string list to add multiple default scope? + *) + val request_authorization_code : + redirect_uri:string -> + server_id:string -> + scope:scope list -> + unit Lwt.t + + (** ---------- Authorization code ---------- *) + (** ---------------------------------------- *) + + (* ---------------------------------- *) + (* ----------- Saved token ---------- *) + + (** Represents a saved token. Tokens are registered in the volatile memory with + * scope default_global_scope. + *) + type saved_token + + (** ---------------------------- *) + (** Getters for the saved tokens *) + + val id_server_of_saved_token : saved_token -> int64 + val value_of_saved_token : saved_token -> string + val token_type_of_saved_token : saved_token -> string + + (** Getters for the saved tokens *) + (** ---------------------------- *) + + (** Token.saved_token_of_id_server_and_value. In this way, it can be used + * outside independently of the Token module given in the functor MakeClient + *) + val saved_token_of_id_server_and_value : + int64 -> + string -> + saved_token + + (** Token.list_tokens. In this way, it can be used outside independently of + * the Token module given in the functor MakeClient + *) + val list_tokens : + unit -> + saved_token list + + (** Token.remove_saved_token. In this way, it can be used outside + * independently of the Token module given in the functor MakeClient + *) + val remove_saved_token : + saved_token -> + unit + + (* ----------- Saved token ---------- *) + (* ---------------------------------- *) +end + +(* -------------------------------------------------------------------------- *) +(* ------------------------------ Basic modules ----------------------------- *) + +(** 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 to + * 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) + +(* ------------------------------ Basic modules ----------------------------- *) +(* -------------------------------------------------------------------------- *) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom new file mode 100644 index 000000000..429874374 --- /dev/null +++ b/src/os_oauth2_server.eliom @@ -0,0 +1,1445 @@ +(* GENERAL FIXME: always use HTTPS !!!! *) + +open Os_oauth2_shared + +(* -------------------------------- *) +(* ---------- Exceptions ---------- *) + +exception State_not_found + +exception No_such_client + +exception No_such_saved_token + +(* ------------------------ *) +(* Request code information *) + +exception No_such_request_info_code +exception No_such_userid_registered + +(* Request code information *) +(* ------------------------ *) + +(* ---------- Exceptions ---------- *) +(* -------------------------------- *) + +(* -------------------------- *) +(* ---------- MISC ---------- *) + +(* 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 + +(* ---------- MISC ---------- *) +(* -------------------------- *) + +(* ---------------------------------------- *) +(* ---------- Client credentials ---------- *) + +let generate_client_credentials () = + let client_id = Os_oauth2_shared.generate_random_string size_client_id in + let client_secret = Os_oauth2_shared.generate_random_string size_client_id in + client_credentials_of_str ~client_id ~client_secret + +(* ---------- Client credentials ---------- *) +(* ---------------------------------------- *) + +(* ---------------------------- *) +(* ---------- Header ---------- *) + +(* 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 + +(* ---------- Header ---------- *) +(* ---------------------------- *) + +(** ------------------------------------------------------------ *) +(** ---------- Functions about the authorization code ---------- *) + +(** generate_authorization_code () generates an authorization code. + * NOTE: Improve the generation by using the userid of the OAuth2 server + * user, the client_id of OAuth2 client and the scope? *) +let generate_authorization_code () = + Os_oauth2_shared.generate_random_string size_authorization_code + +(** ---------- Functions about the authorization code ---------- *) +(** ------------------------------------------------------------ *) + +(* ---------------------------- *) +(* ---------- Client ---------- *) + +(* 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}. + *) +type client = +{ + application_name: string; + description: string; + redirect_uri: string +} + +let client_of_str ~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 + +(* Create a new client by generating credentials. The return value is the ID in + * the database. + *) +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 + (client_credentials_id credentials) + (client_credentials_secret credentials) + +let remove_client_by_id id = + Os_db.OAuth2_server.remove_client id + +let remove_client_by_client_id client_id = + let%lwt id = Os_db.OAuth2_server.id_of_client_id client_id in + remove_client_by_id id + +(* ---------- Client ---------- *) +(* ---------------------------- *) + +(* --------------------------------------- *) +(* ---------- Registered client ---------- *) + +type registered_client = +{ + id : int64 ; + client : client ; + credentials : 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_str ~application_name ~description ~redirect_uri + in + let credentials = + client_credentials_of_str ~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_str + ~application_name + ~description + ~redirect_uri + in + let credentials = + client_credentials_of_str + ~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 + + +(* ---------- Registered client ---------- *) +(* --------------------------------------- *) + +module type SCOPE = + sig + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (** Scope is a list of permissions *) + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + (** check_scope_list is used to check if the scope asked by the client is + * allowed. You can implement simple check_scope_list by only check is all + * element of the scope list is 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 + + (* --------------------------- *) + (* ---------- Scope ---------- *) + end + +module type TOKEN = + sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (* Returns 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:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t + + (* Save a token *) + 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 + + (* List all saved tokens *) + val list_tokens : + unit -> + saved_token list + + val saved_token_to_json : + saved_token -> + Yojson.Safe.json + end + +module type SERVER = + sig + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (** Scope is a list of permissions *) + 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 + + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (* --------------------------------------------- *) + (* ---------- request code information --------- *) + + val set_userid_of_request_info_code : + string -> + string -> + int64 -> + unit + + (* ---------- request code information --------- *) + (* --------------------------------------------- *) + + (** ------------------------------------------------------------ *) + (** ---------- Functions about the authorization code ---------- *) + + (** send_authorization_code [state] [redirect_uri] [client_id] [scope] sends + * an authorization code to redirect_uri + * including the state [state]. This function can be called by + * the authorization handler. It uses Eliom_lib.change_page. + * It avoids to know how OAuth2 works and to implement the redirection + * manually. + * 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 for a Any. + *) + + val send_authorization_code : + string -> + string -> + Eliom_registration.Html.page Lwt.t + + val send_authorization_code_error : + ?error_description:string option -> + ?error_uri:string option -> + error_authorization_code_type -> + string -> + Ocsigen_lib.Url.t -> + Eliom_registration.Html.page Lwt.t + + val rpc_resource_owner_authorize : + ( + Deriving_Json.Json_string.a * + Deriving_Json.Json_string.a, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + val rpc_resource_owner_decline : + ( + Deriving_Json.Json_string.a * Deriving_Json.Json_string.a, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + (** ---------- Functions about the authorization code ---------- *) + (** ------------------------------------------------------------ *) + + (** ------------------------------------------ *) + (** ---------- Function about token ---------- *) + + type saved_token + + 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 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 : + int64 -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + (** ---------- Function about token ---------- *) + (** ------------------------------------------ *) + + + (** ---------- URL registration ---------- *) + (** -------------------------------------- *) + + (** When registering, we need to have several get parameters so we need to + * force the developer to have these GET parameter. We define a type for the + * token handler and the authorization handler. + * because they have different GET parameters. + * + * There are not abstract because we need to know the type. And it's also + * known due to RFC. + **) + + (** ------------------------------------------------ *) + (** ---------- Authorization registration ---------- *) + + (* --------------------- *) + (* authorization service *) + + (** Type of pre-defined service for authorization service. It's a GET + * service + *) + (* NOTE: need to improve this type! It's so ugly *) + 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 + + (** authorization_service [path] returns a service for the authorization URL. + * You can use it with Your_app_name.App.register with + * {!authorization_handler} *) + val authorization_service : + Eliom_lib.Url.path -> + authorization_service + + (* authorization service *) + (* --------------------- *) + + (* --------------------- *) + (* authorization handler *) + + type authorization_handler = + state:string -> + client_id:string -> + redirect_uri:string -> + 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 it with Your_app_name.App.register with + * {!authorization_service} + *) + val authorization_handler : + authorization_handler -> + ( + (string * (string * (string * (string * string)))) -> + unit -> + Eliom_registration.Html.page Lwt.t + ) + + (* authorization handler *) + (* --------------------- *) + + (** ---------- Authorization registration ---------- *) + (** ------------------------------------------------ *) + + (** ---------------------------------------- *) + (** ---------- Token registration ---------- *) + + (* ------------- *) + (* token service *) + + (** Type of pre-defined service for token service. It's a POST service. *) + (* NOTE: need to improve this type! It's so ugly *) + 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 + + (** token_service [path] returns a service for the access token URL. + * You can use it with Your_app_name.App.register with + * {!token_handler} + *) + val token_service : + Eliom_lib.Url.path -> + token_service + + (* token service *) + (* ------------- *) + + (* ------------- *) + (* token handler *) + + (** token_handler returns a handler for the access token URL. + * You can use it with Your_app_name.App.register with + * {!token_service} + *) + val token_handler : + ( + unit -> + (string * (string * (string * (string * string)))) -> + Eliom_registration.String.result Lwt.t + ) + + (* token handler *) + (* ------------- *) + + (** ---------- Token registration ---------- *) + (** ---------------------------------------- *) + + (** ---------- URL registration ---------- *) + (** -------------------------------------- *) + + 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 + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (** Scope is a list of permissions *) + 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 + + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (* ------------------------------------------------ *) + (* --------------- Not in signature --------------- *) + + (* ----------------------------------------- *) + (* ---------- request information ---------- *) + + let number_of_timeout_request_info = 10 + let timeout_request_info = 60 + + type request_info = + { + userid : int64 ; + redirect_uri : Ocsigen_lib.Url.t ; + client_id : string ; + 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 _ = + update_list_timer + timeout_request_info + (fun x -> let c = x.counter in !c >= number_of_timeout_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 which has [state] + * as state. + *) + let remove_request_info_by_state_and_client_id state client_id = + remove_from_list + (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 + + (** check_state_already_used [client_id] [state] returns true if the state + * [state] is already used for the client [client_id]. Else returns false. + * As we use state 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 = + remove_from_list + (fun x -> x.client_id = client_id && x.state = state) + (! request_info_code) + + (* ---------- request code information --------- *) + (* --------------------------------------------- *) + + (* --------------- Not in signature --------------- *) + (* ------------------------------------------------ *) + + + (** ------------------------------------------------------------ *) + (** ---------- Functions about the authorization code ---------- *) + + (* Send the authorization code and redirect the user-agent to + * [redirect_uri] + * TODO: Use redirection and not change_page. + * TODO: if there's already a token for this client_id and this userid, send + * the token and not the code. + * NOTE: As the client_id and state are sent as GET parameters (so visible + * by the user agent), we can use it client-side without lack of security. + * If these informations are changed client-side, it will raise an error + * No_such_request_info_code and it will be caught in + * [authorization_handler] which will call send_authorization_code_error. + *) + 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: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:param_authorization_code_response_error + () + in + let error_str = 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")) + 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 + + (** ---------- Functions about the authorization code ---------- *) + (** ------------------------------------------------------------ *) + + (** -------------------------------------- *) + (** ---------- URL registration ---------- *) + + (** ------------------------------------------------ *) + (** ---------- Authorization registration ---------- *) + + (* --------------------- *) + (* Authorization service *) + + (** Type of pre-defined service for authorization service. It's a GET + * service + *) + 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:param_authorization_code + ~https:true + () + + (* Authorization service *) + (* --------------------- *) + + (* --------------------- *) + (* Authorization handler *) + + type authorization_handler = + state:string -> + client_id:string -> + redirect_uri:string -> + scope:scope list -> + Eliom_registration.Html.page Lwt.t (* Return value of the handler *) + + (** ---------- Authorization registration ---------- *) + (** ------------------------------------------------ *) + + (* 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.")) + 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")) + 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.")) + 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.")) + 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.")) + 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.")) + 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.")) + 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.")) + Auth_invalid_request + state + redirect_uri + + (* Authorization handler *) + (* --------------------- *) + + (** ---------- Authorization registration ---------- *) + (** ------------------------------------------------ *) + + (** ---------- URL registration ---------- *) + (** -------------------------------------- *) + + (** ------------------------------------------ *) + (** ---------- Function about token ---------- *) + + 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 (error_token_type_to_str error)) ] + | (None, Some x) -> + `Assoc + [ + ("error", `String (error_token_type_to_str error)) ; + ("error_uri", `String x) + ] + | (Some x, None) -> + `Assoc + [ + ("error", `String (error_token_type_to_str error)) ; + ("error_description", `String x) + ] + | (Some x, Some y) -> + `Assoc + [ + ("error", `String (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 + | 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" + ) + + (** ---------- Function about token ---------- *) + (** ------------------------------------------ *) + + (** ---------------------------------------- *) + (** ---------- Token registration ---------- *) + + (* ------------- *) + (* token service *) + + 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 = + update_list_timer + Token.timeout + (fun x -> let c = Token.counter_of_saved_token x in !c >= Token.number_of_timeout) + (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:param_access_token + ~https:true + () + + (* token service *) + (* ------------- *) + + (* ------------- *) + (* token handler *) + + (* 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.") + Token_invalid_client + else if grant_type <> "authorization_code" then + send_token_error + ~error_description: + (Some "This authorization grant type is not supported.") + Token_unsupported_grant_type + else if code <> code_state then + send_token_error + ~error_description: + (Some "Wrong code") + Token_invalid_grant + else if redirect_uri <> redirect_uri_state then + send_token_error + ~error_description: + (Some "Wrong redirect_uri") + 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") + Token_invalid_request + | Os_db.No_such_resource -> + send_token_error + ~error_description: + (Some "Client authentication failed.") + Token_invalid_client + + (* token handler *) + (* ------------- *) + + (** ---------- Token registration ---------- *) + (** ---------------------------------------- *) + end + +module Basic_scope = struct + (* --------------------------- *) + (* ---------- Scope ---------- *) + + 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 + + (** check_scope_list scope_list returns true if every element in + * [scope_list] is a 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 value), returns + * false. + *) + 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 + + (* ---------- Scope ---------- *) + (* --------------------------- *) +end + +module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = + struct + (** ------------------------------------------ *) + (** ---------- Function about token ---------- *) + type scope = Scope.scope + + let timeout = 10 + + let number_of_timeout = 1 + + 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 [] + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (** token_exists_by_id_client_and_value [id_client] [value] 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) + + (** token_exists [saved_token] returns true if [saved_token] exists + *) + 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 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 := + ( + remove_from_list + (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 + + (* List all saved 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)) ; + (* FIXME: See fixme for saved_token value. *) + (* ("expires_in", `Int 3600) ; *) + (* ("refresh_token", `String refresh_token) ;*) + ] + + (** ---------- Function about 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..1c02877c2 --- /dev/null +++ b/src/os_oauth2_server.eliomi @@ -0,0 +1,507 @@ +open Os_oauth2_shared + +exception State_not_found +exception No_such_client +exception No_such_saved_token + +(* ---------------------------- *) +(* ---------- Client ---------- *) + +(* 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, + * we can be interested to register several OAuth2 server (for different + * purpose) and in this case, we are interested to list client by OAuth2 server. + *) + +type client + +val client_of_str : + application_name:string -> + description:string -> + redirect_uri:string -> + client + +val application_name_of_client : + client -> + string + +val redirect_uri_of_client : + client -> + string + +val description_of_client : + client -> + string + +val client_of_id : + int64 -> + client Lwt.t + +(* Create a new client by generating credentials. The return value is the ID in + * the database. + *) +val new_client : + application_name:string -> + description:string -> + redirect_uri:string -> + int64 Lwt.t + +(** Remove the client with the id [id] from the database. *) +val remove_client_by_id : + int64 -> + unit Lwt.t + +(** Remove the client with the client_id [client_id] from the database. + * Client_id can be used because it must be unique. It calls + * remove_client_by_id after getting the id *) +val remove_client_by_client_id : + string -> + unit Lwt.t + +(* ---------- Client ---------- *) +(* ---------------------------- *) + +(* --------------------------------------- *) +(* ---------- Registered client ---------- *) + +(** 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 + +val id_of_registered_client : + registered_client -> + int64 + +val client_of_registered_client : + registered_client -> + client + +val credentials_of_registered_client : + registered_client -> + client_credentials + +val to_registered_client : + int64 -> + client -> + client_credentials -> + registered_client + +(** Return the registered client having [client_id] as client id *) +val registered_client_of_client_id : + string -> + registered_client Lwt.t + +val list_clients : + ?min_id:Int64.t -> + ?limit:Int64.t -> + unit -> + registered_client list Lwt.t + +(* ---------- Registered client ---------- *) +(* --------------------------------------- *) + +module type SCOPE = + sig + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (** Scope is a list of permissions *) + type scope + + val scope_of_str : + string -> + scope + + val scope_to_str : + scope -> + string + + (** check_scope_list is used to check if the scope asked by the client is + * allowed. You can implement simple check_scope_list by only check is all + * element of the scope list is 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 + + (* --------------------------- *) + (* ---------- Scope ---------- *) + end + +module type TOKEN = + sig + type scope + + type saved_token + + val saved_tokens : saved_token list ref + + (* Tokens must expire after a certain amount of time. For this, a timer checks + * all [timeout] seconds and if the token has been generated after [timeout] * + * [number_of_timeout] seconds, we remove it. + *) + (** [timeout] is the number of seconds after how many we need to check if + * saved tokens are expired. + *) + val timeout : int + + (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + val number_of_timeout : int + + (* ------- *) + (* getters *) + + 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 + + (* getters *) + (* ------- *) + + (* Returns 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:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t + + (* Save a token *) + 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 + + (* List all saved tokens *) + val list_tokens : + unit -> + saved_token list + + val saved_token_to_json : + saved_token -> + Yojson.Safe.json + end + +module type SERVER = + sig + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (** Scope is a list of permissions *) + 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 + + (* --------------------------- *) + (* ---------- Scope ---------- *) + + (* --------------------------------------------- *) + (* ---------- request code information --------- *) + + val set_userid_of_request_info_code : + string -> + string -> + int64 -> + unit + + (* ---------- request code information --------- *) + (* --------------------------------------------- *) + + (** ------------------------------------------------------------ *) + (** ---------- Functions about the authorization code ---------- *) + + (** send_authorization_code [state] [redirect_uri] [client_id] [scope] sends + * an authorization code to redirect_uri + * including the state [state]. This function can be called by + * the authorization handler. It uses Eliom_lib.change_page. + * It avoids to know how OAuth2 works and to implement the redirection + * manually. + * 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 for a Any. + *) + + val send_authorization_code : + string -> + string -> + Eliom_registration.Html.page Lwt.t + + val send_authorization_code_error : + ?error_description:string option -> + ?error_uri:string option -> + error_authorization_code_type -> + string -> + Ocsigen_lib.Url.t -> + Eliom_registration.Html.page Lwt.t + + val rpc_resource_owner_authorize : + ( + Deriving_Json.Json_string.a * + Deriving_Json.Json_string.a, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + val rpc_resource_owner_decline : + ( + Deriving_Json.Json_string.a * Deriving_Json.Json_string.a, + Eliom_registration.Html.page + ) + Eliom_client.server_function + + (** ---------- Functions about the authorization code ---------- *) + (** ------------------------------------------------------------ *) + + (** ------------------------------------------ *) + (** ---------- Function about token ---------- *) + + type saved_token + + 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 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 : + int64 -> + string -> + saved_token + + val list_tokens : + unit -> + saved_token list + + (** ---------- Function about token ---------- *) + (** ------------------------------------------ *) + + + (** ---------- URL registration ---------- *) + (** -------------------------------------- *) + + (** When registering, we need to have several get parameters so we need to + * force the developer to have these GET parameter. We define a type for the + * token handler and the authorization handler. + * because they have different GET parameters. + * + * There are not abstract because we need to know the type. And it's also + * known due to RFC. + **) + + (** ------------------------------------------------ *) + (** ---------- Authorization registration ---------- *) + + (* --------------------- *) + (* authorization service *) + + (** Type of pre-defined service for authorization service. It's a GET + * service + *) + (* NOTE: need to improve this type! It's so ugly *) + 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 + + (** authorization_service [path] returns a service for the authorization URL. + * You can use it with Your_app_name.App.register with + * {!authorization_handler} *) + val authorization_service : + Eliom_lib.Url.path -> + authorization_service + + (* authorization service *) + (* --------------------- *) + + (* --------------------- *) + (* authorization handler *) + + type authorization_handler = + state:string -> + client_id:string -> + redirect_uri:string -> + 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 it with Your_app_name.App.register with + * {!authorization_service} + *) + val authorization_handler : + authorization_handler -> + ( + (string * (string * (string * (string * string)))) -> + unit -> + Eliom_registration.Html.page Lwt.t + ) + + (* authorization handler *) + (* --------------------- *) + + (** ---------- Authorization registration ---------- *) + (** ------------------------------------------------ *) + + (** ---------------------------------------- *) + (** ---------- Token registration ---------- *) + + (* ------------- *) + (* token service *) + + (** Type of pre-defined service for token service. It's a POST service. *) + (* NOTE: need to improve this type! It's so ugly *) + 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 + + (** token_service [path] returns a service for the access token URL. + * You can use it with Your_app_name.App.register with + * {!token_handler} + *) + val token_service : + Eliom_lib.Url.path -> + token_service + + (* token service *) + (* ------------- *) + + (* ------------- *) + (* token handler *) + + (** token_handler returns a handler for the access token URL. + * You can use it with Your_app_name.App.register with + * {!token_service} + *) + val token_handler : + ( + unit -> + (string * (string * (string * (string * string)))) -> + Eliom_registration.String.result Lwt.t + ) + + (* token handler *) + (* ------------- *) + + (** ---------- Token registration ---------- *) + (** ---------------------------------------- *) + + (** ---------- URL registration ---------- *) + (** -------------------------------------- *) + + end + +module MakeBasicToken : functor + (Scope : SCOPE) -> (TOKEN with type scope = Scope.scope) + +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 + ) + +module Basic_scope : SCOPE + +module Basic_token : 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..8ba6e1ef9 --- /dev/null +++ b/src/os_oauth2_shared.eliom @@ -0,0 +1,191 @@ +open Eliom_parameter +open Lwt.Infix + +exception No_such_client +exception Server_id_exists +exception Empty_content + +(* Put these variable in Makefile? *) +let size_authorization_code = 42 +let size_client_id = 42 +let size_client_secret = 42 +let size_token = 42 +let size_state = 42 + +(* Expiration time for the authorization code: default 10 minutes *) +let expiration_time_authorization_code = 10 * 60 + +(* -------------------------------------------------------------------------- *) +(** Shared types definitions between the OAuth2.0 client and server *) + +(** -------------------------- *) +(** Type of client credentials *) + +type client_credentials = + { + client_id : string ; + client_secret : string + } + +let client_credentials_of_str ~client_id ~client_secret = + { + client_id; + client_secret + } + +let client_credentials_id c = c.client_id +let client_credentials_secret c = c.client_secret + +(** -------------------------- *) + +(** ---------------------------------- *) +(** 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 + +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" + +(** Error types for authorization code *) +(** ---------------------------------- *) + +(** --------------------- *) +(** 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 + +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" + +(** Error types for token *) +(** --------------------- *) + + +(** ------------------------------------------- *) +(** Parameters types for the different services *) + +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") + ) + ) + ) + ) + ) +(** Parameters types for the different services *) +(** ------------------------------------------- *) + +(* -------------------------------------------------------------------------- *) + +let remove_from_list f l = + let rec local l buf = + match l with + | [] -> List.rev buf + | head::tail -> + if f head + then (List.rev buf) @ tail + else local tail (head::buf) + in + local l [] + +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)) + +(** Generate a random string with alphanumerical values (capitals or not) with a + given [length]. + *) +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)) + +(** [base_and_path_of_url "http://ocsigen.org:80/tuto/manual"] returns + (base, path) where base is "http://ocsigen.org:80" and path is + ["tuto", "manual"] + *) +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..055b9323e --- /dev/null +++ b/src/os_oauth2_shared.eliomi @@ -0,0 +1,152 @@ +(* -------------------------------------------------------------------------- *) +(** Shared types definitions between the OAuth2.0 client and server *) + +val size_state : int +val size_client_id : int +val size_token : int +val size_client_secret : int +val size_authorization_code : int + +(** -------------------------- *) +(** A type representing a client. It's not mandatory that the OAuth2.0 client + * knows his data so this type is only declared server-side *) + +(** -------------------------- *) +(** Type of client credentials *) + +type client_credentials + +val client_credentials_of_str : + client_id:string -> + client_secret:string -> + client_credentials + +val client_credentials_id : client_credentials -> string +val client_credentials_secret : client_credentials -> string + +(** Type of client credentials *) +(** -------------------------- *) + +(** ---------------------------------- *) +(** 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 + +(** Error types for authorization code *) +(** ---------------------------------- *) + +(** --------------------- *) +(** 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 + +(** Error types for token *) +(** --------------------- *) + +val param_authorization_code : + ( + Eliom_service.get, + string * (string * (string * (string * string))), + [ `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, + unit, + [ `WithoutSuffix ], + (*Eliom_service.get,*) + unit + ) + Eliom_service.meth + +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 ], + (*Eliom_service.get,*) + unit + ) + Eliom_service.meth + +val param_authorization_code_response_error : + ( + Eliom_service.get, + string * (string option * (string option * string)), + [ `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, + unit, + [ `WithoutSuffix ], + (*Eliom_service.get,*) + unit + ) + Eliom_service.meth + +val param_access_token : + ( + Eliom_service.post, + unit, + unit, + string * (string * (string * (string * string))), + [ `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))), + [ `WithoutSuffix ], + (*Eliom_service.get,*) + unit + ) + Eliom_service.meth + +(* -------------------------------------------------------------------------- *) + +val remove_from_list : + ('a -> bool) -> + 'a list -> + 'a list + +val update_list_timer : + int -> + ('a -> bool) -> + ('a -> unit) -> + 'a list ref -> + unit -> + unit + +val generate_random_string : + int -> + string + +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..4285925a9 100644 --- a/src/os_types.eliom +++ b/src/os_types.eliom @@ -65,3 +65,19 @@ module Group = struct desc : string option; } end + +[%%server.start] + +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..dad99a7a5 100644 --- a/src/os_types.eliomi +++ b/src/os_types.eliomi @@ -69,3 +69,19 @@ module Group : sig desc : string option; } end + +[%%server.start] + +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 From 538149fc9b3b462dc410fc8a829f256dc2446b05 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 14:52:29 +0100 Subject: [PATCH 02/19] Add jwt for documentation. --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) 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 \ From c60a03f1dc29ad1c57fbf5f83522bafc8136e9ff Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 14:52:40 +0100 Subject: [PATCH 03/19] Improve documentation for client side --- src/os_connect_client.eliom | 69 +++---- src/os_connect_client.eliomi | 123 +++++++++--- src/os_connect_server.eliom | 66 +++---- src/os_connect_server.eliomi | 45 +++-- src/os_oauth2_client.eliom | 276 ++++++--------------------- src/os_oauth2_client.eliomi | 357 +++++++++++++++++++---------------- src/os_oauth2_server.eliom | 20 ++ src/os_oauth2_server.eliomi | 20 ++ src/os_oauth2_shared.eliom | 20 ++ src/os_oauth2_shared.eliomi | 20 ++ 10 files changed, 515 insertions(+), 501 deletions(-) diff --git a/src/os_connect_client.eliom b/src/os_connect_client.eliom index 23cfe69e2..4900ea66f 100644 --- a/src/os_connect_client.eliom +++ b/src/os_connect_client.eliom @@ -1,3 +1,23 @@ +(* 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 @@ -6,28 +26,14 @@ exception No_such_saved_token module type IDTOKEN = sig - (** Represents a saved token. Tokens are registered in the volatile memory with - * scope default_global_scope. - *) type saved_token val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) val number_of_timeout : int - (** ---------------------------- *) - (** Getters for the saved tokens *) - val id_server_of_saved_token : saved_token -> int64 @@ -44,21 +50,10 @@ module type IDTOKEN = saved_token -> Jwt.t - (** Representing the number of times the token has been checked by the timeout. - * Must be of type int ref. - *) val counter_of_saved_token : saved_token -> int ref - (** Getters for the saved tokens *) - (** ---------------------------- *) - - (** Parse the JSON file returned by the token server and returns the - * corresponding save_token OCaml type. - * Must raise Bad_JSON_response if all needed information are not given. - * NOTE: Must ignore unrecognized JSON attributes. - *) val parse_json_token : int64 -> Yojson.Basic.json -> @@ -84,12 +79,9 @@ module type IDTOKEN = module Basic_scope = struct - (* --------------------------- *) - (* ---------- Scope ---------- *) - type scope = OpenID | Firstname | Lastname | Email | Unknown - let default_scope = [ OpenID ] + let default_scopes = [ OpenID ] let scope_to_str = function | OpenID -> "openid" @@ -104,9 +96,6 @@ module Basic_scope = | "lastname" -> Lastname | "email" -> Email | _ -> Unknown - - (* ---------- Scope ---------- *) - (* --------------------------- *) end module Basic_ID_token : IDTOKEN = @@ -122,12 +111,9 @@ module Basic_ID_token : IDTOKEN = let saved_tokens : saved_token list ref = ref [] - let timeout = 10 - - let number_of_timeout = 1 + let timeout = 10 - (* ------- *) - (* getters *) + let number_of_timeout = 1 let id_server_of_saved_token t = t.id_server @@ -139,14 +125,6 @@ module Basic_ID_token : IDTOKEN = let counter_of_saved_token t = t.counter - (* getters *) - (* ------- *) - - (** Parse the JSON file returned by the token server and returns the - * corresponding save_token OCaml type. - * In this way, it's easier to work with the token response. - * NOTE: Ignore unrecognized JSON attributes. - *) let parse_json_token id_server t = try let value = @@ -165,7 +143,6 @@ module Basic_ID_token : IDTOKEN = { id_server ; value ; token_type ; id_token ; counter = ref 0 } with _ -> raise Bad_JSON_response - let save_token token = saved_tokens := (token :: (! saved_tokens)) diff --git a/src/os_connect_client.eliomi b/src/os_connect_client.eliomi index 0b7d43134..315a78b76 100644 --- a/src/os_connect_client.eliomi +++ b/src/os_connect_client.eliomi @@ -1,98 +1,169 @@ +(* 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. } *) + +(** Represents tokens used by the OpenID Connect server. *) + module type IDTOKEN = sig - (** Represents a saved token. Tokens are registered in the volatile memory with - * scope default_global_scope. + + (** Represents 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 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, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!timeout} seconds + and if the token has been generated after {!timeout} * + {!number_of_timeout} seconds, the token is removed. *) + (** [timeout] represents a check cycle (in seconds). *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + (** [timeout] the number of cycle. *) val number_of_timeout : int - (** ---------------------------- *) - (** Getters for the saved tokens *) - + (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> int64 + (** Returns the token value. *) val value_of_saved_token : saved_token -> string + (** Returns the token type (for example ["bearer"]. *) val token_type_of_saved_token : saved_token -> string + (** Returns the ID token as a JWT. *) val id_token_of_saved_token : saved_token -> Jwt.t - (** Representing the number of times the token has been checked by the timeout. - * Must be of type int ref. - *) + (** Returns the number of remaining cycles. *) val counter_of_saved_token : saved_token -> int ref - (** Getters for the saved tokens *) - (** ---------------------------- *) - - (** Parse the JSON file returned by the token server and returns the - * corresponding save_token OCaml type. - * Must raise Bad_JSON_response if all needed information are not given. - * NOTE: Must ignore unrecognized JSON attributes. + (** [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 : int64 -> 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 : int64 -> string -> saved_token + (** [save_token token] saves a new token. *) val save_token : saved_token -> unit + (** Returns 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 Basic_scope : - sig - type scope = OpenID | Firstname | Lastname | Email | Unknown +(** {3 Basic modules for scopes, tokens and client. } *) - val default_scope : scope list +(** 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 index 62c9c6d0d..a63e46bd6 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -1,3 +1,23 @@ +(* 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 = @@ -8,21 +28,10 @@ module type IDTOKEN = val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) val number_of_timeout : int - (* ------- *) - (* getters *) - val id_client_of_saved_token : saved_token -> int64 @@ -55,27 +64,20 @@ module type IDTOKEN = saved_token -> int ref - (* getters *) - (* ------- *) - - (* Returns 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:int64 -> userid:int64 -> scope:scope list -> saved_token Lwt.t - (* Save a token *) val save_token : saved_token -> unit @@ -89,7 +91,6 @@ module type IDTOKEN = string -> saved_token - (* List all saved tokens *) val list_tokens : unit -> saved_token list @@ -121,9 +122,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) right id_token. This is the key used by HS256 to sign the token. *) } - (* ------- *) - (* getters *) - let id_client_of_saved_token s = s.id_client let userid_of_saved_token s = s.userid @@ -142,12 +140,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) let counter_of_saved_token s = s.counter - (* getters *) - (* ------- *) - - (** ------------------------------------------ *) - (** ---------- Function about token ---------- *) - (* FIXME: We need to set an expiration time to 10 minutes for each token in * the list. So the type will be saved_token Eliom_reference.Volatile.eref * list and not saved_token list Eliom_reference.Volatile.eref. @@ -276,9 +268,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) module Basic_scope : Os_oauth2_server.SCOPE = struct - (* --------------------------- *) - (* ---------- Scope ---------- *) - type scope = OpenID | Firstname | Lastname | Email | Unknown let scope_to_str = function @@ -295,12 +284,12 @@ module Basic_scope : Os_oauth2_server.SCOPE = | "email" -> Email | _ -> Unknown - (** check_scope_list scope_list returns true if every element in - * [scope_list] is a available scope value. - * If the list contains only OpenID or if the list doesn't contain OpenID - * (mandatory scope in RFC), returns false. - * If an unknown scope value is in list (represented by Unknown value), returns - * false. + (** Returns true if every element in + [scope_list] is a available scope value. + If the list contains only OpenID or if the list doesn't contain OpenID + (mandatory scope in RFC), returns false. + If an unknown scope value is in list (represented by Unknown value), + returns false. *) let check_scope_list scope_list = if List.length scope_list = 0 @@ -316,9 +305,6 @@ module Basic_scope : Os_oauth2_server.SCOPE = | _ -> true ) scope_list - - (* ---------- Scope ---------- *) - (* --------------------------- *) end module Basic_ID_token diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi index a8ddbeaec..b32f031ba 100644 --- a/src/os_connect_server.eliomi +++ b/src/os_connect_server.eliomi @@ -1,3 +1,28 @@ +(* 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 client implementation ({!Basic}). + *) + +(** Exception raised when the given token doesn't exist. *) exception No_such_saved_token module type IDTOKEN = @@ -8,21 +33,10 @@ module type IDTOKEN = val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) val number_of_timeout : int - (* ------- *) - (* getters *) - val id_client_of_saved_token : saved_token -> int64 @@ -99,6 +113,15 @@ module type IDTOKEN = Yojson.Safe.json end +(** Basic module for scopes. + [check_scope_list scope_list] returns [true] if every element in + [scope_list] is a available scope value. + If the list contains only [OpenID] or if the list doesn't contain [OpenID] + (mandatory scope in RFC), returns [false]. + If an unknown scope value is in list (represented by [Unknown] value), + returns [false]. + *) + module Basic_scope : Os_oauth2_server.SCOPE module MakeIDToken : functor diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index 0ffbc4a97..2d761ee2d 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -1,4 +1,23 @@ -open Os_oauth2_shared +(* 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 @@ -32,7 +51,7 @@ type registered_server = authorization_url : string ; token_url : string ; data_url : string ; - client_credentials : client_credentials + client_credentials : Os_oauth2_shared.client_credentials } let id_of_registered_server s = s.id @@ -59,7 +78,7 @@ let list_servers () = to_registered_server ~id ~server_id ~authorization_url ~token_url ~data_url ~client_credentials: - (client_credentials_of_str client_id client_secret) + (Os_oauth2_shared.client_credentials_of_str client_id client_secret) ) servers ) @@ -73,8 +92,10 @@ let get_client_credentials ~server_id = try%lwt (Os_db.OAuth2_client.get_client_credentials ~server_id) >>= - (fun (id, secret) -> - Lwt.return (client_credentials_of_str ~client_id:id ~client_secret:secret) + (fun (client_id, client_secret) -> + Lwt.return (Os_oauth2_shared.client_credentials_of_str + ~client_id ~client_secret + ) ) with Os_db.No_such_resource -> Lwt.fail No_such_server @@ -126,7 +147,7 @@ let remove_server_by_id id = module type SCOPE = sig type scope - val default_scope : scope list + val default_scopes : scope list val scope_of_str : string -> @@ -137,33 +158,15 @@ module type SCOPE = sig string end -(** Scope module type. See the eliomi file for more information *) -(** ----------------------------------------------------------- *) - -(** ----------------------------------------------------------- *) -(** Token module type. See the eliomi file for more information *) - module type TOKEN = sig - (** Represents a saved token *) type saved_token val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) val number_of_timeout : int - (** ---------------------------- *) - (** Getters for the saved tokens *) - val id_server_of_saved_token : saved_token -> int64 @@ -176,16 +179,10 @@ module type TOKEN = sig saved_token -> string - (** Representing the number of times the token has been checked by the timeout. - * Must be of type int ref. - *) val counter_of_saved_token : saved_token -> int ref - (** Getters for the saved tokens *) - (** ---------------------------- *) - val parse_json_token : int64 -> Yojson.Basic.json -> @@ -209,19 +206,10 @@ module type TOKEN = sig unit end -(** Token module type. See the eliomi file for more information *) -(** ----------------------------------------------------------- *) - -(** ------------------------------------------------------------ *) -(** Client module type. See the eliomi file for more information *) - module type CLIENT = sig - (* -------------------------- *) - (* --------- Scope ---------- *) - type scope - val default_scope : scope list + val default_scopes : scope list val scope_of_str : string -> @@ -239,85 +227,12 @@ module type CLIENT = sig scope list -> string list - (* --------- Scope ---------- *) - (* -------------------------- *) - - (** ---------------------------- *) - (** Initialize a OAuth2.0 client *) - - (** When register, clients must specify a redirect uri 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 [link] : - * - for successfull authorization code response. - * - for error authorization code response. - * 1. 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 in the database and a - * redirection is done to the service [success_redirection]. - * 2. 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:string -> - success_redirection: - Eliom_service.non_ocaml Eliom_registration.Redirection.page -> - error_redirection: - Eliom_service.non_ocaml Eliom_registration.Redirection.page -> - unit Lwt.t - - (** Initialize a OAuth2.0 client *) - (** ---------------------------- *) - - (** ---------------------------------------- *) - (** ---------- Authorization code ---------- *) - - (** - * 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 - * server side saved until expiration in the HTTP parameter. - * 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 optional default scope is to be compatible with OAuth2.0 which - * doesn't respect "oauth" (mandatory in the RFC) in scope. - * IMPROVEME: Use string list to add multiple default scope? - *) - val request_authorization_code : - redirect_uri:string -> - server_id:string -> - scope:scope list -> - unit Lwt.t - - (** ---------- Authorization code ---------- *) - (** ---------------------------------------- *) - - (* ---------------------------------- *) - (* ----------- Saved token ---------- *) - - (** Represents a saved token. Tokens are registered in the volatile memory with - * scope default_global_scope. - *) type saved_token - (** ---------------------------- *) - (** Getters for the saved tokens *) - val id_server_of_saved_token : saved_token -> int64 val value_of_saved_token : saved_token -> string val token_type_of_saved_token : saved_token -> string - (** Getters for the saved tokens *) - (** ---------------------------- *) - val saved_token_of_id_server_and_value : int64 -> string -> @@ -331,15 +246,20 @@ module type CLIENT = sig saved_token -> unit - (* ----------- Saved token ---------- *) - (* ---------------------------------- *) -end - -(** Client module type. See the eliomi file for more information *) -(** ------------------------------------------------------------ *) + val register_redirect_uri : + redirect_uri:string -> + success_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + error_redirection: + Eliom_service.non_ocaml Eliom_registration.Redirection.page -> + unit Lwt.t -(** -------------------------------------------------------- *) -(** Functor to create a Client from a Scope and Token module *) + val request_authorization_code : + redirect_uri:string -> + server_id:string -> + scope:scope list -> + unit Lwt.t +end module MakeClient (Scope : SCOPE) @@ -349,12 +269,9 @@ module MakeClient type saved_token = Token.saved_token ) = struct - (* -------------------------- *) - (* --------- Scope ---------- *) - type scope = Scope.scope - let default_scope = Scope.default_scope + let default_scopes = Scope.default_scopes let scope_of_str = Scope.scope_of_str @@ -364,9 +281,6 @@ module MakeClient let scope_list_to_str_list l = List.map scope_to_str l - (* --------- Scope ---------- *) - (* -------------------------- *) - (* ---------------------------------------- *) (* --------- Request information ---------- *) @@ -403,19 +317,18 @@ module MakeClient ) states - (** add_request_info [state] [server_id] [scope] creates a new - * request_info value and add it in the volatile reference. - *) + (** 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)) - (** remove_request_info [state] removes the - * request_info which has [state] as state. - *) + (** Removes the request info which has [state] as state. *) let remove_request_info_by_state state = request_info := - (remove_from_list (fun x -> x.state = state) (!request_info)) + (Os_oauth2_shared.remove_from_list + (fun x -> x.state = state) + (!request_info) + ) (** Get the request_info value which has state [state] *) let request_info_of_state state = @@ -447,20 +360,22 @@ module MakeClient = let%lwt (prefix, path) = get_server_url_authorization ~server_id in let scope_str_list = - scope_list_to_str_list (default_scope @ scope) + 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 = client_credentials_id client_credentials in + let client_id = + Os_oauth2_shared.client_credentials_id client_credentials + in let state = generate_state () in let service_url = Eliom_service.extern ~prefix ~path - ~meth:param_authorization_code + ~meth:Os_oauth2_shared.param_authorization_code () in let scope_str = String.concat " " scope_str_list in @@ -475,28 +390,15 @@ module MakeClient ]); Lwt.return () - (** ------------------ *) - - (** ---------- Authorization code ---------- *) - (** ---------------------------------------- *) - - (* ---------------------------------- *) - (* ----------- Saved token ---------- *) type saved_token = Token.saved_token - (* ------- *) - (* getters *) - 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 - (* getters *) - (* ------- *) - let saved_token_of_id_server_and_value = Token.saved_token_of_id_server_and_value @@ -504,9 +406,6 @@ module MakeClient let remove_saved_token = Token.remove_saved_token - (* ----------- Saved token ---------- *) - (* ---------------------------------- *) - (** OCaml representation of a token. This is the OCaml equivalent * representation of the JSON returned by the token server *) @@ -519,15 +418,9 @@ module MakeClient (** Create a token with the type and the corresponding value *) let token_json_of_str token_type value = {token_type ; value} - (** ------- *) - (** Getters *) - let token_type_of_token_json t = t.token_type let value_of_token_json t = t.value - (** Getters *) - (** ------- *) - (** Request a token to the server represented as ~server_id in the * database. Saving it in the database allows to keep it a long time. * TODO: add an optional parameter for other parameters to send. @@ -541,10 +434,10 @@ module MakeClient let grant_type = "authorization_code" in (* ----------------------------- *) let client_id = - client_credentials_id client_credentials + Os_oauth2_shared.client_credentials_id client_credentials in let client_secret = - client_credentials_secret client_credentials + Os_oauth2_shared.client_credentials_secret client_credentials in let base64_credentials = @@ -569,12 +462,6 @@ module MakeClient ~content_type:("application", "x-www-form-urlencoded") server_url - (** ---------- Token ---------- *) - (** --------------------------- *) - - (** ---------------------------- *) - (** Initialize a OAuth2.0 client *) - (** Use a default handler for the moment *) let register_redirect_uri ~redirect_uri ~success_redirection ~error_redirection @@ -583,24 +470,24 @@ module MakeClient let success = Eliom_service.create ~path:(Eliom_service.Path path) - ~meth:param_authorization_code_response + ~meth:Os_oauth2_shared.param_authorization_code_response () in let error = Eliom_service.create ~path:(Eliom_service.Path path) - ~meth:param_authorization_code_response_error + ~meth:Os_oauth2_shared.param_authorization_code_response_error () in - update_list_timer + Os_oauth2_shared.update_list_timer Token.timeout (fun x -> let c = Token.counter_of_saved_token x in !c >= Token.number_of_timeout) (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 a authorization code. + (* 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 @@ -651,28 +538,13 @@ module MakeClient ); Lwt.return () - - (** Initialize a OAuth2.0 client *) - (** ---------------------------- *) - - (** --------------------------------- *) - (** Tokens *) - - (** Tokens *) - (** --------------------------------- *) end -(** Functor to create a Client from a Scope and Token module *) -(** -------------------------------------------------------- *) - -(* -------------------------------------------------------------------------- *) -(* ------------------------------ Basic modules ----------------------------- *) - module Basic_scope = struct type scope = OAuth | Firstname | Lastname | Email | Unknown - let default_scope = [ OAuth ] + let default_scopes = [ OAuth ] let scope_to_str = function | OAuth -> "oauth" @@ -689,15 +561,6 @@ module Basic_scope = | _ -> Unknown 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 need to - * use this module if the OAuth2 server is a 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 = struct type saved_token = { @@ -710,22 +573,11 @@ module Basic_token : TOKEN = struct let timeout = 10 let number_of_timeout = 1 - (* ------- *) - (* getters *) - 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 - (* getters *) - (* ------- *) - - (** Parse the JSON file returned by the token server and returns the - * corresponding save_token OCaml type. - * In this way, it's easier to work with the token response. - * NOTE: Ignore unrecognized JSON attributes. - *) let parse_json_token id_server t = try let value = @@ -761,7 +613,7 @@ module Basic_token : TOKEN = struct let id_server = id_server_of_saved_token token in saved_tokens := ( - remove_from_list + Os_oauth2_shared.remove_from_list (fun (x : saved_token) -> x.value = value && x.id_server = id_server ) @@ -769,10 +621,4 @@ module Basic_token : TOKEN = struct ) end -(** Basic OAuth2 client, compatible with OAuth2.0 server - * Os_oauth2_server.Basic. - *) module Basic = MakeClient (Basic_scope) (Basic_token) - -(* ------------------------------ Basic modules ----------------------------- *) -(* -------------------------------------------------------------------------- *) diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index 1f8f6d294..96c452f2f 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -1,54 +1,103 @@ +(* 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}). + *) + open Os_oauth2_shared -(* -------------------------------- *) (* ---------- Exceptions ---------- *) +(** {1 Exceptions } *) -(* About state *) +(** Raised if a state is not found. *) exception State_not_found -(* About client *) +(** Raised if no such client has been found. *) exception No_such_client -(* About server *) +(** 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 -(* About saved token *) +(** Exception raised when the given token doesn't exist. *) exception No_such_saved_token -exception Bad_JSON_respoonse - -(* ---------- Exceptions ---------- *) -(* -------------------------------- *) -(* ----------------------------------- *) -(* Type of registered OAuth2.0 server. *) +(** 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 -> int64 +(** 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 -> string +(** 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 -> string +(** Get the data URL which must be used to get the data. *) val data_url_of_registered_server : registered_server -> string +(** Get the client credentials. *) val client_credentials_of_registered_server : registered_server -> client_credentials +(** Build a type {!registered_server}. *) val to_registered_server : id:int64 -> server_id:string -> @@ -58,20 +107,15 @@ val to_registered_server : client_credentials:client_credentials -> registered_server +(** List all registered servers. Data are retrieved from the database. *) val list_servers : unit -> registered_server list Lwt.t -(** Type of registered OAuth2.0 server. Only used client side. *) -(** ---------------------------------------------------------- *) - -(** ------------------------------- *) -(** Save and remove a OAuth2 server *) -(** If a OAuth2 server is already registerd with server_id, raise an error - * Server_id_exists. - * OK +(** 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:string -> @@ -81,26 +125,26 @@ val save_server : client_secret:string -> unit Lwt.t +(** [remove_server_by_id id] removes from the database the registered server + with ID [id]. + *) val remove_server_by_id : int64 -> unit Lwt.t -(** Save and remove a OAuth2 server *) -(** ------------------------------- *) - -(** ------------------ *) -(** Client credentials *) - -(** Get the client credientials for a given OAuth2.0 server. OK *) +(** Get the client credientials for a given OAuth2.0 server. *) val get_client_credentials : server_id:string -> client_credentials Lwt.t -(** Client credentials *) -(** ------------------ *) +(** {3 About scopes, tokens and basic client. } *) + +(** Module type for scopes. *) module type SCOPE = sig + (** Available scopes. *) type scope - val default_scope : scope list + (** Default scopes set in all requests where scope is needed. *) + val default_scopes : scope list val scope_of_str : string -> @@ -111,86 +155,112 @@ module type SCOPE = sig string end +(** Module type for tokens. Represents tokens used by the OAuth2.0 server. *) + module type TOKEN = sig - (** Represents a saved token. Tokens are registered in the volatile memory with - * scope default_global_scope. + + (** 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, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. + (** Tokens must expire after a certain amount of time. For this reason, a + timer {!Os_oauth2_shared.update_list_timer} checks all {!timeout} seconds + and if the token has been generated after {!timeout} * + {!number_of_timeout} seconds, the token is removed. *) + (** [timeout] represents a check cycle (in seconds). *) val timeout : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) + (** [timeout] the number of cycle. *) val number_of_timeout : int - (** ---------------------------- *) - (** Getters for the saved tokens *) - + (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> int64 + (** Returns the token value. *) val value_of_saved_token : saved_token -> string + (** Returns the token type (for example ["bearer"]. *) val token_type_of_saved_token : saved_token -> string - (** Representing the number of times the token has been checked by the timeout. - * Must be of type int ref. - *) + (** Returns the number of remaining cycles. *) val counter_of_saved_token : saved_token -> int ref - (** Getters for the saved tokens *) - (** ---------------------------- *) - - (** Parse the JSON file returned by the token server and returns the - * corresponding save_token OCaml type. - * Must raise Bad_JSON_response if all needed information are not given. - * NOTE: Must ignore unrecognized JSON attributes. + (** [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 : int64 -> 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 : int64 -> string -> saved_token + (** [save_token token] saves a new token. *) val save_token : saved_token -> unit + (** Returns 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 - (* -------------------------- *) - (* --------- Scope ---------- *) + (** The following types and functions related to tokens and scopes are + aliases to the same types and functions from the module type given in the + functor {!MakeClient}. These aliases avoid to know the modules used to + build the client. + *) type scope - val default_scope : scope list + val default_scopes : scope list val scope_of_str : string -> @@ -208,122 +278,86 @@ module type CLIENT = sig scope list -> string list - (* --------- Scope ---------- *) - (* -------------------------- *) - - (** ---------------------------- *) - (** Initialize a OAuth2.0 client *) - - (** When register, clients must specify a redirect uri 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 [link] : - * - for successfull authorization code response. - * - for error authorization code response. - * 1. 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 in the database and a - * redirection is done to the service [success_redirection]. - * 2. 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:string -> - success_redirection: - Eliom_service.non_ocaml Eliom_registration.Redirection.page -> - error_redirection: - Eliom_service.non_ocaml Eliom_registration.Redirection.page -> - unit Lwt.t - - (** Initialize a OAuth2.0 client *) - (** ---------------------------- *) - - (** ---------------------------------------- *) - (** ---------- Authorization code ---------- *) - - (** - * 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 - * server side saved until expiration in the HTTP parameter. - * 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 optional default scope is to be compatible with OAuth2.0 which - * doesn't respect "oauth" (mandatory in the RFC) in scope. - * IMPROVEME: Use string list to add multiple default scope? - *) - val request_authorization_code : - redirect_uri:string -> - server_id:string -> - scope:scope list -> - unit Lwt.t - - (** ---------- Authorization code ---------- *) - (** ---------------------------------------- *) - - (* ---------------------------------- *) - (* ----------- Saved token ---------- *) - - (** Represents a saved token. Tokens are registered in the volatile memory with - * scope default_global_scope. - *) type saved_token - (** ---------------------------- *) - (** Getters for the saved tokens *) - val id_server_of_saved_token : saved_token -> int64 val value_of_saved_token : saved_token -> string val token_type_of_saved_token : saved_token -> string - (** Getters for the saved tokens *) - (** ---------------------------- *) - - (** Token.saved_token_of_id_server_and_value. In this way, it can be used - * outside independently of the Token module given in the functor MakeClient - *) val saved_token_of_id_server_and_value : int64 -> string -> saved_token - (** Token.list_tokens. In this way, it can be used outside independently of - * the Token module given in the functor MakeClient - *) val list_tokens : unit -> saved_token list - (** Token.remove_saved_token. In this way, it can be used outside - * independently of the Token module given in the functor MakeClient - *) val remove_saved_token : saved_token -> unit - (* ----------- Saved token ---------- *) - (* ---------------------------------- *) + (** When registering, clients must specify a redirect uri 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 in the database 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:string -> + 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 in the HTTP parameter. + 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:string -> + server_id:string -> + scope:scope list -> + unit Lwt.t + end -(* -------------------------------------------------------------------------- *) -(* ------------------------------ Basic modules ----------------------------- *) +(** 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 to + use this module if the OAuth2.0 server is an instance of + {!Os_oauth2_server.Basic}. -(** 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 to - * 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. + 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 @@ -337,19 +371,19 @@ module Basic_scope : sig 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. +(** 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. +(** 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 @@ -360,10 +394,7 @@ module MakeClient : functor ) (** Basic OAuth2 client, compatible with OAuth2.0 server - * Os_oauth2_server.Basic. + {!Os_oauth2_server.Basic}. *) module Basic : (CLIENT with type scope = Basic_scope.scope and type saved_token = Basic_token.saved_token) - -(* ------------------------------ Basic modules ----------------------------- *) -(* -------------------------------------------------------------------------- *) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index 429874374..64b1884e9 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -1,3 +1,23 @@ +(* 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 !!!! *) open Os_oauth2_shared diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index 1c02877c2..a6a78b94d 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -1,3 +1,23 @@ +(* 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 State_not_found diff --git a/src/os_oauth2_shared.eliom b/src/os_oauth2_shared.eliom index 8ba6e1ef9..9e47f3fd2 100644 --- a/src/os_oauth2_shared.eliom +++ b/src/os_oauth2_shared.eliom @@ -1,3 +1,23 @@ +(* 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 diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index 055b9323e..ae3a8e70f 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -1,3 +1,23 @@ +(* 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 definitions between the OAuth2.0 client and server *) From 3da51cbb1ac2f3f67864d52dc342bde035c4f6f0 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 15:43:26 +0100 Subject: [PATCH 04/19] Timeout --> cycle_duration, number_of_timeout --> number_of_cycle. Remove some useless comments. --- src/os_connect_client.eliom | 8 +- src/os_connect_client.eliomi | 14 +-- src/os_connect_server.eliom | 27 ++--- src/os_connect_server.eliomi | 4 +- src/os_oauth2_client.eliom | 15 +-- src/os_oauth2_client.eliomi | 14 +-- src/os_oauth2_server.eliom | 196 ++--------------------------------- src/os_oauth2_server.eliomi | 23 ++-- 8 files changed, 55 insertions(+), 246 deletions(-) diff --git a/src/os_connect_client.eliom b/src/os_connect_client.eliom index 4900ea66f..9d9b0375c 100644 --- a/src/os_connect_client.eliom +++ b/src/os_connect_client.eliom @@ -30,9 +30,9 @@ module type IDTOKEN = val saved_tokens : saved_token list ref - val timeout : int + val cycle_duration : int - val number_of_timeout : int + val number_of_cycle : int val id_server_of_saved_token : saved_token -> @@ -111,9 +111,9 @@ module Basic_ID_token : IDTOKEN = let saved_tokens : saved_token list ref = ref [] - let timeout = 10 + let cycle_duration = 10 - let number_of_timeout = 1 + let number_of_cycle = 1 let id_server_of_saved_token t = t.id_server diff --git a/src/os_connect_client.eliomi b/src/os_connect_client.eliomi index 315a78b76..801f750be 100644 --- a/src/os_connect_client.eliomi +++ b/src/os_connect_client.eliomi @@ -51,15 +51,15 @@ module type IDTOKEN = 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 {!timeout} seconds - and if the token has been generated after {!timeout} * - {!number_of_timeout} seconds, the token is removed. + 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. *) - (** [timeout] represents a check cycle (in seconds). *) - val timeout : int + (** The duration of a cycle. *) + val cycle_duration : int - (** [timeout] the number of cycle. *) - val number_of_timeout : int + (** [number_of_cycle] the number of cycle. *) + val number_of_cycle : int (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom index a63e46bd6..e9e78c974 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -28,9 +28,9 @@ module type IDTOKEN = val saved_tokens : saved_token list ref - val timeout : int + val cycle_duration : int - val number_of_timeout : int + val number_of_cycle : int val id_client_of_saved_token : saved_token -> @@ -105,9 +105,9 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) struct type scope = Scope.scope - let timeout = 10 + let cycle_duration = 10 - let number_of_timeout = 1 + let number_of_cycle = 1 type saved_token = { @@ -140,10 +140,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) let counter_of_saved_token s = s.counter - (* FIXME: We need to set an expiration time to 10 minutes for each token in - * the list. So the type will be saved_token Eliom_reference.Volatile.eref - * list and not saved_token list Eliom_reference.Volatile.eref. - *) let saved_tokens : saved_token list ref = ref [] (** token_exists_by_id_client_and_value [id_client] [value] returns true if @@ -186,7 +182,7 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) "JWT" in let current_time = Unix.time () in - let exp_time = 10. *. 60. in (* NOTE: expiration in 10 minutes *) + let exp_time = float_of_int (number_of_cycle * cycle_duration) in let payload_token = let open Jwt in empty_payload @@ -247,6 +243,7 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) (* List all saved tokens *) (* IMPROVEME: list tokens by client OAuth2 id *) let list_tokens () = (! saved_tokens) + let saved_token_to_json saved_token = `Assoc [ @@ -255,9 +252,8 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) ( "id_token", `String (Jwt.token_of_t (id_token_of_saved_token saved_token)) - ) - (* FIXME: See fixme for saved_token value. *) - (* ("expires_in", `Int 3600) ; *) + ) ; + ("expires_in", `Int (cycle_duration * number_of_cycle)) (* What about a refresh_token ? *) (* ("refresh_token", `String refresh_token) ;*) ] @@ -284,13 +280,6 @@ module Basic_scope : Os_oauth2_server.SCOPE = | "email" -> Email | _ -> Unknown - (** Returns true if every element in - [scope_list] is a available scope value. - If the list contains only OpenID or if the list doesn't contain OpenID - (mandatory scope in RFC), returns false. - If an unknown scope value is in list (represented by Unknown value), - returns false. - *) let check_scope_list scope_list = if List.length scope_list = 0 then false diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi index b32f031ba..ecde11cc0 100644 --- a/src/os_connect_server.eliomi +++ b/src/os_connect_server.eliomi @@ -33,9 +33,9 @@ module type IDTOKEN = val saved_tokens : saved_token list ref - val timeout : int + val cycle_duration : int - val number_of_timeout : int + val number_of_cycle : int val id_client_of_saved_token : saved_token -> diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index 2d761ee2d..a0d2fdea2 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -163,9 +163,9 @@ module type TOKEN = sig val saved_tokens : saved_token list ref - val timeout : int + val cycle_duration : int - val number_of_timeout : int + val number_of_cycle : int val id_server_of_saved_token : saved_token -> @@ -422,7 +422,7 @@ module MakeClient let value_of_token_json t = t.value (** Request a token to the server represented as ~server_id in the - * database. Saving it in the database allows to keep it a long time. + * 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. *) @@ -481,8 +481,9 @@ module MakeClient in Os_oauth2_shared.update_list_timer - Token.timeout - (fun x -> let c = Token.counter_of_saved_token x in !c >= Token.number_of_timeout) + 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 (); @@ -570,8 +571,8 @@ module Basic_token : TOKEN = struct counter : int ref } - let timeout = 10 - let number_of_timeout = 1 + 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 diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index 96c452f2f..1a0ce465f 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -176,15 +176,15 @@ module type TOKEN = sig 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 {!timeout} seconds - and if the token has been generated after {!timeout} * - {!number_of_timeout} seconds, the token is removed. + 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. *) - (** [timeout] represents a check cycle (in seconds). *) - val timeout : int + (** The duration of a cycle. *) + val cycle_duration : int - (** [timeout] the number of cycle. *) - val number_of_timeout : int + (** [number_of_cycle] the number of cycle. *) + val number_of_cycle : int (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index 64b1884e9..cc1bad220 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -22,27 +22,15 @@ open Os_oauth2_shared -(* -------------------------------- *) -(* ---------- Exceptions ---------- *) - exception State_not_found exception No_such_client exception No_such_saved_token -(* ------------------------ *) -(* Request code information *) - exception No_such_request_info_code exception No_such_userid_registered -(* Request code information *) -(* ------------------------ *) - -(* ---------- Exceptions ---------- *) -(* -------------------------------- *) - (* -------------------------- *) (* ---------- MISC ---------- *) @@ -253,20 +241,9 @@ module type TOKEN = val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. - *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) - val timeout : int + val cycle_duration : int - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) - val number_of_timeout : int - - (* ------- *) - (* getters *) + val number_of_cycle : int val id_client_of_saved_token : saved_token -> @@ -293,27 +270,20 @@ module type TOKEN = saved_token -> int ref - (* getters *) - (* ------- *) - - (* Returns 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:int64 -> userid:int64 -> scope:scope list -> saved_token Lwt.t - (* Save a token *) val save_token : saved_token -> unit @@ -327,7 +297,6 @@ module type TOKEN = string -> saved_token - (* List all saved tokens *) val list_tokens : unit -> saved_token list @@ -339,10 +308,6 @@ module type TOKEN = module type SERVER = sig - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (** Scope is a list of permissions *) type scope val scope_of_str : @@ -361,35 +326,12 @@ module type SERVER = scope list -> string list - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (* --------------------------------------------- *) - (* ---------- request code information --------- *) - val set_userid_of_request_info_code : string -> string -> int64 -> unit - (* ---------- request code information --------- *) - (* --------------------------------------------- *) - - (** ------------------------------------------------------------ *) - (** ---------- Functions about the authorization code ---------- *) - - (** send_authorization_code [state] [redirect_uri] [client_id] [scope] sends - * an authorization code to redirect_uri - * including the state [state]. This function can be called by - * the authorization handler. It uses Eliom_lib.change_page. - * It avoids to know how OAuth2 works and to implement the redirection - * manually. - * 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 for a Any. - *) - val send_authorization_code : string -> string -> @@ -418,12 +360,6 @@ module type SERVER = ) Eliom_client.server_function - (** ---------- Functions about the authorization code ---------- *) - (** ------------------------------------------------------------ *) - - (** ------------------------------------------ *) - (** ---------- Function about token ---------- *) - type saved_token val id_client_of_saved_token : saved_token -> int64 @@ -453,32 +389,6 @@ module type SERVER = unit -> saved_token list - (** ---------- Function about token ---------- *) - (** ------------------------------------------ *) - - - (** ---------- URL registration ---------- *) - (** -------------------------------------- *) - - (** When registering, we need to have several get parameters so we need to - * force the developer to have these GET parameter. We define a type for the - * token handler and the authorization handler. - * because they have different GET parameters. - * - * There are not abstract because we need to know the type. And it's also - * known due to RFC. - **) - - (** ------------------------------------------------ *) - (** ---------- Authorization registration ---------- *) - - (* --------------------- *) - (* authorization service *) - - (** Type of pre-defined service for authorization service. It's a GET - * service - *) - (* NOTE: need to improve this type! It's so ugly *) type authorization_service = (string * (string * (string * (string * string))), unit, @@ -500,19 +410,10 @@ module type SERVER = unit, Eliom_service.non_ocaml) Eliom_service.t - (** authorization_service [path] returns a service for the authorization URL. - * You can use it with Your_app_name.App.register with - * {!authorization_handler} *) val authorization_service : Eliom_lib.Url.path -> authorization_service - (* authorization service *) - (* --------------------- *) - - (* --------------------- *) - (* authorization handler *) - type authorization_handler = state:string -> client_id:string -> @@ -520,10 +421,6 @@ module type SERVER = 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 it with Your_app_name.App.register with - * {!authorization_service} - *) val authorization_handler : authorization_handler -> ( @@ -532,20 +429,6 @@ module type SERVER = Eliom_registration.Html.page Lwt.t ) - (* authorization handler *) - (* --------------------- *) - - (** ---------- Authorization registration ---------- *) - (** ------------------------------------------------ *) - - (** ---------------------------------------- *) - (** ---------- Token registration ---------- *) - - (* ------------- *) - (* token service *) - - (** Type of pre-defined service for token service. It's a POST service. *) - (* NOTE: need to improve this type! It's so ugly *) type token_service = (unit, string * (string * (string * (string * string))), @@ -564,40 +447,16 @@ module type SERVER = Eliom_registration.String.return) Eliom_service.t - (** token_service [path] returns a service for the access token URL. - * You can use it with Your_app_name.App.register with - * {!token_handler} - *) val token_service : Eliom_lib.Url.path -> token_service - (* token service *) - (* ------------- *) - - (* ------------- *) - (* token handler *) - - (** token_handler returns a handler for the access token URL. - * You can use it with Your_app_name.App.register with - * {!token_service} - *) val token_handler : ( unit -> (string * (string * (string * (string * string)))) -> Eliom_registration.String.result Lwt.t ) - - (* token handler *) - (* ------------- *) - - (** ---------- Token registration ---------- *) - (** ---------------------------------------- *) - - (** ---------- URL registration ---------- *) - (** -------------------------------------- *) - end module MakeServer @@ -606,10 +465,6 @@ module MakeServer type scope = Scope.scope and type saved_token = Token.saved_token) = struct - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (** Scope is a list of permissions *) type scope = Scope.scope let scope_of_str = Scope.scope_of_str @@ -622,17 +477,11 @@ module MakeServer let check_scope_list = Scope.check_scope_list - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (* ------------------------------------------------ *) - (* --------------- Not in signature --------------- *) - (* ----------------------------------------- *) (* ---------- request information ---------- *) - let number_of_timeout_request_info = 10 - let timeout_request_info = 60 + let cycle_duration_request_info = 10 + let number_of_cycle_request_info = 60 type request_info = { @@ -656,8 +505,8 @@ module MakeServer let _ = update_list_timer - timeout_request_info - (fun x -> let c = x.counter in !c >= number_of_timeout_request_info) + cycle_duration_request_info + (fun x -> let c = x.counter in !c >= number_of_cycle_request_info) (fun x -> incr x.counter) request_info @@ -896,21 +745,6 @@ module MakeServer [%derive.json: string * string] resource_owner_decline - (** ---------- Functions about the authorization code ---------- *) - (** ------------------------------------------------------------ *) - - (** -------------------------------------- *) - (** ---------- URL registration ---------- *) - - (** ------------------------------------------------ *) - (** ---------- Authorization registration ---------- *) - - (* --------------------- *) - (* Authorization service *) - - (** Type of pre-defined service for authorization service. It's a GET - * service - *) type authorization_service = (string * (string * (string * (string * string))), unit, @@ -939,12 +773,6 @@ module MakeServer ~https:true () - (* Authorization service *) - (* --------------------- *) - - (* --------------------- *) - (* Authorization handler *) - type authorization_handler = state:string -> client_id:string -> @@ -952,9 +780,6 @@ module MakeServer scope:scope list -> Eliom_registration.Html.page Lwt.t (* Return value of the handler *) - (** ---------- Authorization registration ---------- *) - (** ------------------------------------------------ *) - (* Performs check on client_id, scope and response_type before sent state, * client_id, redirect_uri and scope to the handler *) @@ -1192,8 +1017,9 @@ module MakeServer let token_service path = update_list_timer - Token.timeout - (fun x -> let c = Token.counter_of_saved_token x in !c >= Token.number_of_timeout) + 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 (); @@ -1351,9 +1177,9 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = (** ---------- Function about token ---------- *) type scope = Scope.scope - let timeout = 10 + let cycle_duration = 10 - let number_of_timeout = 1 + let number_of_cycle = 1 type saved_token = { diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index a6a78b94d..ed0e2cd6c 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -163,20 +163,16 @@ module type TOKEN = val saved_tokens : saved_token list ref - (* Tokens must expire after a certain amount of time. For this, a timer checks - * all [timeout] seconds and if the token has been generated after [timeout] * - * [number_of_timeout] seconds, we remove it. + (** 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. *) - (** [timeout] is the number of seconds after how many we need to check if - * saved tokens are expired. - *) - val timeout : int - - (** [number_of_timeout] IMPROVEME DOCUMENTATION *) - val number_of_timeout : int + (** The duration of a cycle. *) + val cycle_duration : int - (* ------- *) - (* getters *) + (** [number_of_cycle] the number of cycle. *) + val number_of_cycle : int val id_client_of_saved_token : saved_token -> @@ -202,9 +198,6 @@ module type TOKEN = saved_token -> int ref - (* getters *) - (* ------- *) - (* Returns true if the token already exists *) val token_exists : saved_token -> From 1498bfeeb9719c4e39b36e896dffa6f74bdbf3ca Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 15:43:44 +0100 Subject: [PATCH 05/19] Use ocsigen_start schema for OAuth2.0 tables. --- src/os_db.ml | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/src/os_db.ml b/src/os_db.ml index 40a329caa..646c28486 100644 --- a/src/os_db.ml +++ b/src/os_db.ml @@ -171,17 +171,18 @@ let os_preregister_table = (** ------------------------ *) (** 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. + 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 "oauth2_server_client_id_seq" >> + <:sequence< bigserial "ocsigen_start.oauth2_server_client_id_seq" >> let oauth2_server_client_table = - <:table< oauth2_server_client ( + <: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, @@ -196,20 +197,20 @@ let oauth2_server_client_table = (** 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. + be also an Eliom application, but not always. *) let oauth2_client_credentials_id_seq = - <:sequence< bigserial "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. + 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< oauth2_client_credentials ( + <: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 *) From bc3db31de7ef4daedd8296243c58f7e84a836671 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 15:52:08 +0100 Subject: [PATCH 06/19] Use List.filter instead of remove_from_list. Add documentation in Os_oauth2_shared --- src/os_connect_client.eliom | 2 +- src/os_connect_server.eliom | 2 +- src/os_oauth2_client.eliom | 4 ++-- src/os_oauth2_server.eliom | 6 ++--- src/os_oauth2_shared.eliom | 48 ------------------------------------- src/os_oauth2_shared.eliomi | 39 +++++++----------------------- 6 files changed, 16 insertions(+), 85 deletions(-) diff --git a/src/os_connect_client.eliom b/src/os_connect_client.eliom index 9d9b0375c..c4dd611fe 100644 --- a/src/os_connect_client.eliom +++ b/src/os_connect_client.eliom @@ -165,7 +165,7 @@ module Basic_ID_token : IDTOKEN = let id_server = id_server_of_saved_token token in saved_tokens := ( - remove_from_list + List.filter (fun (x : saved_token) -> x.value = value && x.id_server = id_server ) diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom index e9e78c974..ae249d67c 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -223,7 +223,7 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) let id_client = id_client_of_saved_token saved_token in saved_tokens := ( - Os_oauth2_shared.remove_from_list + List.filter (fun x -> x.value = value && x.id_client = id_client) (! saved_tokens) ) diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index a0d2fdea2..2845a3c9d 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -325,7 +325,7 @@ module MakeClient (** Removes the request info which has [state] as state. *) let remove_request_info_by_state state = request_info := - (Os_oauth2_shared.remove_from_list + (List.filter (fun x -> x.state = state) (!request_info) ) @@ -614,7 +614,7 @@ module Basic_token : TOKEN = struct let id_server = id_server_of_saved_token token in saved_tokens := ( - Os_oauth2_shared.remove_from_list + List.filter (fun (x : saved_token) -> x.value = value && x.id_server = id_server ) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index cc1bad220..f973cadab 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -523,7 +523,7 @@ module MakeServer * as state. *) let remove_request_info_by_state_and_client_id state client_id = - remove_from_list + List.filter (fun x -> x.state = state && x.client_id = client_id) (! request_info) @@ -610,7 +610,7 @@ module MakeServer request.userid := Some userid let remove_request_info_code_by_client_id_and_state client_id state = - remove_from_list + List.filter (fun x -> x.client_id = client_id && x.state = state) (! request_info_code) @@ -1251,7 +1251,7 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = let id_client = id_client_of_saved_token saved_token in saved_tokens := ( - remove_from_list + List.filter (fun x -> x.value = value && x.id_client = id_client) (! saved_tokens) ) diff --git a/src/os_oauth2_shared.eliom b/src/os_oauth2_shared.eliom index 9e47f3fd2..ec8544ade 100644 --- a/src/os_oauth2_shared.eliom +++ b/src/os_oauth2_shared.eliom @@ -25,22 +25,14 @@ exception No_such_client exception Server_id_exists exception Empty_content -(* Put these variable in Makefile? *) let size_authorization_code = 42 let size_client_id = 42 let size_client_secret = 42 let size_token = 42 let size_state = 42 -(* Expiration time for the authorization code: default 10 minutes *) let expiration_time_authorization_code = 10 * 60 -(* -------------------------------------------------------------------------- *) -(** Shared types definitions between the OAuth2.0 client and server *) - -(** -------------------------- *) -(** Type of client credentials *) - type client_credentials = { client_id : string ; @@ -56,11 +48,6 @@ let client_credentials_of_str ~client_id ~client_secret = let client_credentials_id c = c.client_id let client_credentials_secret c = c.client_secret -(** -------------------------- *) - -(** ---------------------------------- *) -(** Error types for authorization code *) - type error_authorization_code_type = | Auth_invalid_request | Auth_unauthorized_client @@ -79,12 +66,6 @@ let error_authorization_code_type_to_str e = match e with | Auth_server_error -> "server_error" | Auth_temporarily_unavailable -> "temporarily_unavailable" -(** Error types for authorization code *) -(** ---------------------------------- *) - -(** --------------------- *) -(** Error types for token *) - type error_token_type = | Token_invalid_request | Token_unauthorized_client @@ -101,13 +82,6 @@ let error_token_type_to_str e = match e with | Token_invalid_grant -> "invalid_grant" | Token_invalid_scope -> "invalid_scope" -(** Error types for token *) -(** --------------------- *) - - -(** ------------------------------------------- *) -(** Parameters types for the different services *) - let param_authorization_code = Eliom_service.Get ( (Eliom_parameter.string "response_type") ** @@ -148,21 +122,6 @@ let param_access_token = Eliom_service.Post ) ) ) -(** Parameters types for the different services *) -(** ------------------------------------------- *) - -(* -------------------------------------------------------------------------- *) - -let remove_from_list f l = - let rec local l buf = - match l with - | [] -> List.rev buf - | head::tail -> - if f head - then (List.rev buf) @ tail - else local tail (head::buf) - in - local l [] let rec update_list_timer timer fn_remove fn_incr l () = let rec locale l = match l with @@ -179,9 +138,6 @@ let rec update_list_timer timer fn_remove fn_incr l () = Lwt_timeout.start (Lwt_timeout.create timer (update_list_timer timer fn_remove fn_incr l)) -(** Generate a random string with alphanumerical values (capitals or not) with a - given [length]. - *) let generate_random_string length = let random_character () = match Random.int (26 + 26 + 10) with n when n < 26 -> int_of_char 'a' + n @@ -190,10 +146,6 @@ let generate_random_string length = let random_character _ = String.make 1 (char_of_int (random_character ())) in String.concat "" (Array.to_list (Array.init length random_character)) -(** [base_and_path_of_url "http://ocsigen.org:80/tuto/manual"] returns - (base, path) where base is "http://ocsigen.org:80" and path is - ["tuto", "manual"] - *) let prefix_and_path_of_url url = let (https, host, port, _, path, _, _) = Ocsigen_lib.Url.parse url in let https_str = match https with diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index ae3a8e70f..e285c0ac7 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -18,22 +18,18 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* -------------------------------------------------------------------------- *) -(** Shared types definitions between the OAuth2.0 client and server *) +(** Shared types, functions and values between the OAuth2.0/OpenID Connect + client and server. + *) +(** {1 Constants} *) val size_state : int val size_client_id : int val size_token : int val size_client_secret : int val size_authorization_code : int -(** -------------------------- *) -(** A type representing a client. It's not mandatory that the OAuth2.0 client - * knows his data so this type is only declared server-side *) - -(** -------------------------- *) -(** Type of client credentials *) - +(** {2 About client credentials} *) type client_credentials val client_credentials_of_str : @@ -44,11 +40,7 @@ val client_credentials_of_str : val client_credentials_id : client_credentials -> string val client_credentials_secret : client_credentials -> string -(** Type of client credentials *) -(** -------------------------- *) - -(** ---------------------------------- *) -(** Error types for authorization code *) +(** {3 Error types for authorization code. } *) type error_authorization_code_type = | Auth_invalid_request @@ -63,11 +55,7 @@ val error_authorization_code_type_to_str : error_authorization_code_type -> string -(** Error types for authorization code *) -(** ---------------------------------- *) - -(** --------------------- *) -(** Error types for token *) +(** {4 Error types for token. } *) type error_token_type = | Token_invalid_request @@ -81,8 +69,7 @@ val error_token_type_to_str : error_token_type -> string -(** Error types for token *) -(** --------------------- *) +(** {5 Parameters types for the different services. } *) val param_authorization_code : ( @@ -96,7 +83,6 @@ val param_authorization_code : unit, unit, [ `WithoutSuffix ], - (*Eliom_service.get,*) unit ) Eliom_service.meth @@ -110,7 +96,6 @@ val param_authorization_code_response : unit, unit, [ `WithoutSuffix ], - (*Eliom_service.get,*) unit ) Eliom_service.meth @@ -126,7 +111,6 @@ val param_authorization_code_response_error : unit, unit, [ `WithoutSuffix ], - (*Eliom_service.get,*) unit ) Eliom_service.meth @@ -148,12 +132,7 @@ val param_access_token : ) Eliom_service.meth -(* -------------------------------------------------------------------------- *) - -val remove_from_list : - ('a -> bool) -> - 'a list -> - 'a list +(** {6 MISC functions. } *) val update_list_timer : int -> From 397bfd452cc9b2f8861bbd211c87b86e2bc6145f Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 16:30:09 +0100 Subject: [PATCH 07/19] Use Os_types. --- src/os_connect_client.eliom | 14 ++++---- src/os_connect_client.eliomi | 10 +++--- src/os_connect_server.eliom | 18 +++++----- src/os_connect_server.eliomi | 14 ++++---- src/os_oauth2_client.eliom | 38 ++++++++++----------- src/os_oauth2_client.eliomi | 60 ++++++++++++++++---------------- src/os_oauth2_server.eliomi | 66 ++++++++++++++++-------------------- src/os_oauth2_shared.eliom | 4 +-- src/os_oauth2_shared.eliomi | 31 ++++++++++------- src/os_types.eliom | 2 -- src/os_types.eliomi | 2 -- 11 files changed, 129 insertions(+), 130 deletions(-) diff --git a/src/os_connect_client.eliom b/src/os_connect_client.eliom index c4dd611fe..89b73ea03 100644 --- a/src/os_connect_client.eliom +++ b/src/os_connect_client.eliom @@ -36,7 +36,7 @@ module type IDTOKEN = val id_server_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Server.id val value_of_saved_token : saved_token -> @@ -60,8 +60,8 @@ module type IDTOKEN = saved_token val saved_token_of_id_server_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token val save_token : @@ -102,10 +102,10 @@ module Basic_ID_token : IDTOKEN = struct type saved_token = { - id_server : int64 ; - value : string ; - token_type : string ; - counter : int ref ; + id_server : Os_types.OAuth2.Server.id ; + value : string ; + token_type : string ; + counter : int ref ; id_token : Jwt.t } diff --git a/src/os_connect_client.eliomi b/src/os_connect_client.eliomi index 801f750be..c54bb0232 100644 --- a/src/os_connect_client.eliomi +++ b/src/os_connect_client.eliomi @@ -64,7 +64,7 @@ module type IDTOKEN = (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Server.id (** Returns the token value. *) val value_of_saved_token : @@ -93,8 +93,8 @@ module type IDTOKEN = Unrecognized JSON attributes must be ignored. *) val parse_json_token : - int64 -> - Yojson.Basic.json -> + Os_types.OAuth2.Server.id -> + Yojson.Basic.json -> saved_token (** [saved_token_of_id_server_and_value id_server value] returns the @@ -107,8 +107,8 @@ module type IDTOKEN = logical for security. *) val saved_token_of_id_server_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token (** [save_token token] saves a new token. *) diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom index ae249d67c..a3682c393 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -34,11 +34,11 @@ module type IDTOKEN = val id_client_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Client.id val userid_of_saved_token : saved_token -> - int64 + Os_types.User.id val token_type_of_saved_token : saved_token -> @@ -73,9 +73,9 @@ module type IDTOKEN = string val generate_token : - id_client:int64 -> - userid:int64 -> - scope:scope list -> + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> saved_token Lwt.t val save_token : @@ -87,8 +87,8 @@ module type IDTOKEN = unit val saved_token_of_id_client_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token val list_tokens : @@ -111,8 +111,8 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) type saved_token = { - id_client : int64 ; - userid : int64 ; + id_client : Os_types.OAuth2.Client.id ; + userid : Os_types.User.id ; token_type : string ; value : string ; id_token : Jwt.t ; diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi index ecde11cc0..9850c2464 100644 --- a/src/os_connect_server.eliomi +++ b/src/os_connect_server.eliomi @@ -39,11 +39,11 @@ module type IDTOKEN = val id_client_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Client.id val userid_of_saved_token : saved_token -> - int64 + Os_types.User.id val token_type_of_saved_token : saved_token -> @@ -84,9 +84,9 @@ module type IDTOKEN = (* Generate a new token *) val generate_token : - id_client:int64 -> - userid:int64 -> - scope:scope list -> + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> saved_token Lwt.t (* Save a token *) @@ -99,8 +99,8 @@ module type IDTOKEN = unit val saved_token_of_id_client_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token (* List all saved tokens *) diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index 2845a3c9d..9ff442512 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -46,12 +46,12 @@ exception Bad_JSON_respoonse type registered_server = { - id : int64 ; - server_id : string ; - authorization_url : string ; - token_url : string ; - data_url : string ; - client_credentials : Os_oauth2_shared.client_credentials + 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 @@ -169,7 +169,7 @@ module type TOKEN = sig val id_server_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Server.id val value_of_saved_token : saved_token -> @@ -189,8 +189,8 @@ module type TOKEN = sig saved_token val saved_token_of_id_server_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token val save_token : @@ -229,13 +229,13 @@ module type CLIENT = sig type saved_token - val id_server_of_saved_token : saved_token -> int64 + 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 : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token val list_tokens : @@ -247,7 +247,7 @@ module type CLIENT = sig unit val register_redirect_uri : - redirect_uri:string -> + redirect_uri:Ocsigen_lib.Url.t -> success_redirection: Eliom_service.non_ocaml Eliom_registration.Redirection.page -> error_redirection: @@ -255,9 +255,9 @@ module type CLIENT = sig unit Lwt.t val request_authorization_code : - redirect_uri:string -> - server_id:string -> - scope:scope list -> + redirect_uri:Ocsigen_lib.Url.t -> + server_id:string -> + scope:scope list -> unit Lwt.t end @@ -565,9 +565,9 @@ module Basic_scope = module Basic_token : TOKEN = struct type saved_token = { - id_server : int64 ; - value : string ; - token_type : string ; + id_server : Os_types.OAuth2.Server.id ; + value : string ; + token_type : string ; counter : int ref } diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index 1a0ce465f..d1de2648a 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -66,7 +66,7 @@ type registered_server (** Get the ID database. *) val id_of_registered_server : registered_server -> - int64 + Os_types.OAuth2.Server.id (** Get the server ID which is a string to recognize it easily. *) val server_id_of_registered_server : @@ -78,19 +78,19 @@ val server_id_of_registered_server : *) val authorization_url_of_registered_server : registered_server -> - string + 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 -> - string + Ocsigen_lib.Url.t (** Get the data URL which must be used to get the data. *) val data_url_of_registered_server : registered_server -> - string + Ocsigen_lib.Url.t (** Get the client credentials. *) val client_credentials_of_registered_server : @@ -99,11 +99,11 @@ val client_credentials_of_registered_server : (** Build a type {!registered_server}. *) val to_registered_server : - id:int64 -> + id:Os_types.OAuth2.Server.id -> server_id:string -> - authorization_url:string -> - token_url:string -> - data_url:string -> + authorization_url:Ocsigen_lib.Url.t -> + token_url:Ocsigen_lib.Url.t -> + data_url:Ocsigen_lib.Url.t -> client_credentials:client_credentials -> registered_server @@ -117,23 +117,25 @@ val list_servers : {!Server_id_exists} is raised. *) val save_server : - server_id:string -> - server_authorization_url:string -> - server_token_url:string -> - server_data_url:string -> - client_id:string -> - client_secret:string -> + 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 : - int64 -> + 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 -> client_credentials Lwt.t +val get_client_credentials : + server_id:string -> + client_credentials Lwt.t (** {3 About scopes, tokens and basic client. } *) @@ -189,7 +191,7 @@ module type TOKEN = sig (** Returns the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Server.id (** Returns the token value. *) val value_of_saved_token : @@ -201,7 +203,7 @@ module type TOKEN = sig saved_token -> string - (** Returns the number of remaining cycles. *) + (** Returns the number of passed cycles. *) val counter_of_saved_token : saved_token -> int ref @@ -213,8 +215,8 @@ module type TOKEN = sig Unrecognized JSON attributes must be ignored. *) val parse_json_token : - int64 -> - Yojson.Basic.json -> + Os_types.OAuth2.Server.id -> + Yojson.Basic.json -> saved_token (** [saved_token_of_id_server_and_value id_server value] returns the @@ -227,8 +229,8 @@ module type TOKEN = sig logical for security. *) val saved_token_of_id_server_and_value : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token (** [save_token token] saves a new token. *) @@ -280,13 +282,13 @@ module type CLIENT = sig type saved_token - val id_server_of_saved_token : saved_token -> int64 + 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 : - int64 -> - string -> + Os_types.OAuth2.Server.id -> + string -> saved_token val list_tokens : @@ -315,7 +317,7 @@ module type CLIENT = sig *) val register_redirect_uri : - redirect_uri:string -> + redirect_uri:Ocsigen_lib.Url.t -> success_redirection: Eliom_service.non_ocaml Eliom_registration.Redirection.page -> error_redirection: @@ -343,9 +345,9 @@ module type CLIENT = sig [server_id]. *) val request_authorization_code : - redirect_uri:string -> - server_id:string -> - scope:scope list -> + redirect_uri:Ocsigen_lib.Url.t -> + server_id:string -> + scope:scope list -> unit Lwt.t end diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index ed0e2cd6c..390389414 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -42,7 +42,7 @@ type client val client_of_str : application_name:string -> description:string -> - redirect_uri:string -> + redirect_uri:Ocsigen_lib.Url.t -> client val application_name_of_client : @@ -51,28 +51,28 @@ val application_name_of_client : val redirect_uri_of_client : client -> - string + Ocsigen_lib.Url.t val description_of_client : client -> string val client_of_id : - int64 -> + Os_types.OAuth2.Client.id -> client Lwt.t (* Create a new client by generating credentials. The return value is the ID in * the database. *) val new_client : - application_name:string -> - description:string -> - redirect_uri:string -> - int64 Lwt.t + application_name:string -> + description:string -> + redirect_uri:Ocsigen_lib.Url.t -> + Os_types.OAuth2.Client.id Lwt.t (** Remove the client with the id [id] from the database. *) val remove_client_by_id : - int64 -> + Os_types.OAuth2.Client.id -> unit Lwt.t (** Remove the client with the client_id [client_id] from the database. @@ -96,7 +96,7 @@ type registered_client val id_of_registered_client : registered_client -> - int64 + Os_types.OAuth2.Client.id val client_of_registered_client : registered_client -> @@ -107,9 +107,9 @@ val credentials_of_registered_client : client_credentials val to_registered_client : - int64 -> - client -> - client_credentials -> + Os_types.OAuth2.Client.id -> + client -> + client_credentials -> registered_client (** Return the registered client having [client_id] as client id *) @@ -118,9 +118,9 @@ val registered_client_of_client_id : registered_client Lwt.t val list_clients : - ?min_id:Int64.t -> - ?limit:Int64.t -> - unit -> + ?min_id:Os_types.OAuth2.Client.id -> + ?limit:Int64.t -> + unit -> registered_client list Lwt.t (* ---------- Registered client ---------- *) @@ -128,9 +128,6 @@ val list_clients : module type SCOPE = sig - (* --------------------------- *) - (* ---------- Scope ---------- *) - (** Scope is a list of permissions *) type scope @@ -150,9 +147,6 @@ module type SCOPE = val check_scope_list : scope list -> bool - - (* --------------------------- *) - (* ---------- Scope ---------- *) end module type TOKEN = @@ -176,11 +170,11 @@ module type TOKEN = val id_client_of_saved_token : saved_token -> - int64 + Os_types.OAuth2.Client.id val userid_of_saved_token : saved_token -> - int64 + Os_types.User.id val value_of_saved_token : saved_token -> @@ -210,9 +204,9 @@ module type TOKEN = (* Generate a new token *) val generate_token : - id_client:int64 -> - userid:int64 -> - scope:scope list -> + id_client:Os_types.OAuth2.Client.id -> + userid:Os_types.User.id -> + scope:scope list -> saved_token Lwt.t (* Save a token *) @@ -225,7 +219,7 @@ module type TOKEN = unit val saved_token_of_id_client_and_value : - int64 -> + Os_types.OAuth2.Client.id -> string -> saved_token @@ -272,7 +266,7 @@ module type SERVER = val set_userid_of_request_info_code : string -> string -> - int64 -> + Os_types.User.id -> unit (* ---------- request code information --------- *) @@ -328,8 +322,8 @@ module type SERVER = type saved_token - val id_client_of_saved_token : saved_token -> int64 - val userid_of_saved_token : saved_token -> int64 + 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 @@ -347,7 +341,7 @@ module type SERVER = unit val saved_token_of_id_client_and_value : - int64 -> + Os_types.OAuth2.Client.id -> string -> saved_token @@ -416,10 +410,10 @@ module type SERVER = (* authorization handler *) type authorization_handler = - state:string -> - client_id:string -> - redirect_uri:string -> - scope:scope list -> + 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. @@ -471,7 +465,7 @@ module type SERVER = * {!token_handler} *) val token_service : - Eliom_lib.Url.path -> + Ocsigen_lib.Url.path -> token_service (* token service *) diff --git a/src/os_oauth2_shared.eliom b/src/os_oauth2_shared.eliom index ec8544ade..39e74e805 100644 --- a/src/os_oauth2_shared.eliom +++ b/src/os_oauth2_shared.eliom @@ -35,8 +35,8 @@ let expiration_time_authorization_code = 10 * 60 type client_credentials = { - client_id : string ; - client_secret : string + client_id : Os_types.OAuth2.client_id ; + client_secret : Os_types.OAuth2.client_secret } let client_credentials_of_str ~client_id ~client_secret = diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index e285c0ac7..78088b391 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -33,12 +33,17 @@ val size_authorization_code : int type client_credentials val client_credentials_of_str : - client_id:string -> - client_secret:string -> + client_id:Os_types.OAuth2.client_id -> + client_secret:Os_types.OAuth2.client_secret -> client_credentials -val client_credentials_id : client_credentials -> string -val client_credentials_secret : client_credentials -> string +val client_credentials_id : + client_credentials -> + Os_types.OAuth2.client_id + +val client_credentials_secret : + client_credentials -> + Os_types.OAuth2.client_secret (** {3 Error types for authorization code. } *) @@ -74,10 +79,11 @@ val error_token_type_to_str : val param_authorization_code : ( Eliom_service.get, - string * (string * (string * (string * string))), + string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string))), [ `One of string ] 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 * + ([ `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, @@ -103,10 +109,10 @@ val param_authorization_code_response : val param_authorization_code_response_error : ( Eliom_service.get, - string * (string option * (string option * string)), + 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 string ] Eliom_parameter.param_name * + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * [ `One of string ] Eliom_parameter.param_name)), unit, unit, @@ -120,12 +126,13 @@ val param_access_token : Eliom_service.post, unit, unit, - string * (string * (string * (string * string))), + string * + (string * (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id))), [ `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 string ] Eliom_parameter.param_name * - [ `One of string ] Eliom_parameter.param_name))), + [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), [ `WithoutSuffix ], (*Eliom_service.get,*) unit diff --git a/src/os_types.eliom b/src/os_types.eliom index 4285925a9..25c41413d 100644 --- a/src/os_types.eliom +++ b/src/os_types.eliom @@ -66,8 +66,6 @@ module Group = struct } end -[%%server.start] - module OAuth2 = struct type client_id = string type client_secret = string diff --git a/src/os_types.eliomi b/src/os_types.eliomi index dad99a7a5..c1a5869e6 100644 --- a/src/os_types.eliomi +++ b/src/os_types.eliomi @@ -70,8 +70,6 @@ module Group : sig } end -[%%server.start] - module OAuth2 : sig type client_id = string type client_secret = string From f8ad3ee505ca1f412f4c9ee8cca61b0d8f53ca8b Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 16:35:22 +0100 Subject: [PATCH 08/19] Remove token_json which is useless since saved_token. Remove useless comments. --- src/os_connect_server.eliom | 12 ++------ src/os_oauth2_client.eliom | 55 +++---------------------------------- 2 files changed, 7 insertions(+), 60 deletions(-) diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom index a3682c393..2dedfbf6b 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -142,16 +142,14 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) let saved_tokens : saved_token list ref = ref [] - (** token_exists_by_id_client_and_value [id_client] [value] returns true if - * there exists a saved token with [id_client] and [value]. - *) + (** 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) - (** token_exists [saved_token] returns true if [saved_token] exists - *) 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 @@ -213,11 +211,9 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) id_token ; scope ; counter = ref 0 ; secret_key } - (* Save a token *) let save_token token = saved_tokens := (token :: (! saved_tokens)) - (* remove a saved token of type saved_token *) 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 @@ -228,7 +224,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) (! saved_tokens) ) - (* Search a saved token by id_client and value *) let saved_token_of_id_client_and_value id_client value = let tokens = ! saved_tokens in let rec locale = function @@ -240,7 +235,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) in locale tokens - (* List all saved tokens *) (* IMPROVEME: list tokens by client OAuth2 id *) let list_tokens () = (! saved_tokens) diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index 9ff442512..0700c296e 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -21,29 +21,15 @@ open Eliom_parameter open Lwt.Infix -(* -------------------------------- *) -(* ---------- Exceptions ---------- *) - -(* About state *) exception State_not_found - -(* About client *) exception No_such_client -(* About server *) exception Server_id_exists exception No_such_server -(* About saved token *) exception No_such_saved_token exception Bad_JSON_respoonse -(* ---------- Exceptions ---------- *) -(* -------------------------------- *) - -(* ----------------------------------- *) -(* Type of registered OAuth2.0 server. *) - type registered_server = { id : Os_types.OAuth2.Server.id ; @@ -82,12 +68,6 @@ let list_servers () = ) servers ) -(** Type of registered OAuth2.0 server. Only used client side. *) -(** ---------------------------------------------------------- *) - -(** --------------------------------------------- *) -(** Get client credentials and server information *) - let get_client_credentials ~server_id = try%lwt (Os_db.OAuth2_client.get_client_credentials ~server_id) @@ -112,12 +92,6 @@ let get_server_url_token ~server_id = Os_db.OAuth2_client.get_server_token_url ~server_id with Os_db.No_such_resource -> Lwt.fail No_such_server -(** Get client credentials and server information *) -(** --------------------------------------------- *) - -(** ------------------------------- *) -(** Save and remove a OAuth2 server *) - let save_server ~server_id ~server_authorization_url ~server_token_url ~server_data_url ~client_id ~client_secret = @@ -138,12 +112,6 @@ let remove_server_by_id id = Os_db.OAuth2_client.remove_server_by_id id with Os_db.No_such_resource -> Lwt.fail No_such_server -(** Save and remove a OAuth2 server *) -(** ------------------------------- *) - -(** ----------------------------------------------------------- *) -(** Scope module type. See the eliomi file for more information *) - module type SCOPE = sig type scope @@ -358,7 +326,7 @@ module MakeClient (* 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%lwt (prefix, path) = get_server_url_authorization ~server_id in let scope_str_list = scope_list_to_str_list (default_scopes @ scope) in @@ -366,11 +334,11 @@ module MakeClient (* in raw to easily change later. *) let response_type = "code" in (* ------------------------------ *) - let%lwt client_credentials = get_client_credentials ~server_id in + let%lwt client_credentials = get_client_credentials ~server_id in let client_id = Os_oauth2_shared.client_credentials_id client_credentials in - let state = generate_state () in + let state = generate_state () in let service_url = Eliom_service.extern ~prefix @@ -378,7 +346,7 @@ module MakeClient ~meth:Os_oauth2_shared.param_authorization_code () in - let scope_str = String.concat " " scope_str_list in + let scope_str = String.concat " " scope_str_list in add_request_info state server_id scope; ignore ([%client ( Eliom_client.change_page @@ -406,21 +374,6 @@ module MakeClient let remove_saved_token = Token.remove_saved_token - (** OCaml representation of a token. This is the OCaml equivalent - * representation of the JSON returned by the token server - *) - type token_json = - { - token_type : string ; - value : string ; - } - - (** Create a token with the type and the corresponding value *) - let token_json_of_str token_type value = {token_type ; value} - - let token_type_of_token_json t = t.token_type - let value_of_token_json t = t.value - (** Request a token to the server represented as ~server_id in the * database. * TODO: add an optional parameter for other parameters to send. From 279007ee985a91f3f59d94f616fc1d890136e58e Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 16:42:18 +0100 Subject: [PATCH 09/19] Remove useless comments in eliom file. --- src/os_oauth2_server.eliom | 139 ++---------------------------------- src/os_oauth2_shared.eliomi | 1 - 2 files changed, 7 insertions(+), 133 deletions(-) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index f973cadab..3cbb8bf03 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -31,29 +31,14 @@ exception No_such_saved_token exception No_such_request_info_code exception No_such_userid_registered -(* -------------------------- *) -(* ---------- MISC ---------- *) - (* 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 -(* ---------- MISC ---------- *) -(* -------------------------- *) - -(* ---------------------------------------- *) -(* ---------- Client credentials ---------- *) - let generate_client_credentials () = let client_id = Os_oauth2_shared.generate_random_string size_client_id in let client_secret = Os_oauth2_shared.generate_random_string size_client_id in client_credentials_of_str ~client_id ~client_secret -(* ---------- Client credentials ---------- *) -(* ---------------------------------------- *) - -(* ---------------------------- *) -(* ---------- Header ---------- *) - (* Check if the client id and the client secret has been set in the header while * requesting a token and if they are correct. *) @@ -74,24 +59,12 @@ let check_authorization_header client_id header = (* if the authorization value is not defined *) with Not_found -> Lwt.return_false -(* ---------- Header ---------- *) -(* ---------------------------- *) - -(** ------------------------------------------------------------ *) -(** ---------- Functions about the authorization code ---------- *) - (** generate_authorization_code () generates an authorization code. * NOTE: Improve the generation by using the userid of the OAuth2 server * user, the client_id of OAuth2 client and the scope? *) let generate_authorization_code () = Os_oauth2_shared.generate_random_string size_authorization_code -(** ---------- Functions about the authorization code ---------- *) -(** ------------------------------------------------------------ *) - -(* ---------------------------- *) -(* ---------- Client ---------- *) - (* 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}. @@ -139,12 +112,6 @@ let remove_client_by_client_id client_id = let%lwt id = Os_db.OAuth2_server.id_of_client_id client_id in remove_client_by_id id -(* ---------- Client ---------- *) -(* ---------------------------- *) - -(* --------------------------------------- *) -(* ---------- Registered client ---------- *) - type registered_client = { id : int64 ; @@ -201,15 +168,8 @@ let registered_client_exists_by_client_id client_id = Os_db.OAuth2_server.registered_client_exists_by_client_id client_id -(* ---------- Registered client ---------- *) -(* --------------------------------------- *) - module type SCOPE = sig - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (** Scope is a list of permissions *) type scope val scope_of_str : @@ -220,17 +180,9 @@ module type SCOPE = scope -> string - (** check_scope_list is used to check if the scope asked by the client is - * allowed. You can implement simple check_scope_list by only check is all - * element of the scope list is 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 - - (* --------------------------- *) - (* ---------- Scope ---------- *) end module type TOKEN = @@ -419,7 +371,7 @@ module type SERVER = client_id:string -> redirect_uri:string -> scope:scope list -> - Eliom_registration.Html.page Lwt.t (* Return value of the handler *) + Eliom_registration.Html.page Lwt.t (* Returned value of the handler *) val authorization_handler : authorization_handler -> @@ -617,24 +569,6 @@ module MakeServer (* ---------- request code information --------- *) (* --------------------------------------------- *) - (* --------------- Not in signature --------------- *) - (* ------------------------------------------------ *) - - - (** ------------------------------------------------------------ *) - (** ---------- Functions about the authorization code ---------- *) - - (* Send the authorization code and redirect the user-agent to - * [redirect_uri] - * TODO: Use redirection and not change_page. - * TODO: if there's already a token for this client_id and this userid, send - * the token and not the code. - * NOTE: As the client_id and state are sent as GET parameters (so visible - * by the user agent), we can use it client-side without lack of security. - * If these informations are changed client-side, it will raise an error - * No_such_request_info_code and it will be caught in - * [authorization_handler] which will call send_authorization_code_error. - *) let send_authorization_code state client_id = let request_info_code_tmp = request_info_code_of_state_and_client_id state client_id @@ -778,7 +712,7 @@ module MakeServer client_id:string -> redirect_uri:string -> scope:scope list -> - Eliom_registration.Html.page Lwt.t (* Return value of the handler *) + 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 @@ -903,24 +837,16 @@ module MakeServer state redirect_uri - (* Authorization handler *) - (* --------------------- *) - - (** ---------- Authorization registration ---------- *) - (** ------------------------------------------------ *) - - (** ---------- URL registration ---------- *) - (** -------------------------------------- *) - - (** ------------------------------------------ *) - (** ---------- Function about token ---------- *) - 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 @@ -988,15 +914,6 @@ module MakeServer "application/json;charset=UTF-8" ) - (** ---------- Function about token ---------- *) - (** ------------------------------------------ *) - - (** ---------------------------------------- *) - (** ---------- Token registration ---------- *) - - (* ------------- *) - (* token service *) - type token_service = (unit, string * (string * (string * (string * string))), @@ -1029,12 +946,6 @@ module MakeServer ~https:true () - (* token service *) - (* ------------- *) - - (* ------------- *) - (* token handler *) - (* NOTE: the state is not mandatory but it is used to get information about * the request. Not in RFC!! *) @@ -1118,17 +1029,9 @@ module MakeServer (Some "Client authentication failed.") Token_invalid_client - (* token handler *) - (* ------------- *) - - (** ---------- Token registration ---------- *) - (** ---------------------------------------- *) end module Basic_scope = struct - (* --------------------------- *) - (* ---------- Scope ---------- *) - type scope = OAuth | Firstname | Lastname | Email | Unknown let scope_to_str = function @@ -1145,13 +1048,6 @@ module Basic_scope = struct | "email" -> Email | _ -> Unknown - (** check_scope_list scope_list returns true if every element in - * [scope_list] is a 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 value), returns - * false. - *) let check_scope_list scope_list = if List.length scope_list = 0 then false @@ -1166,15 +1062,10 @@ module Basic_scope = struct | _ -> true ) scope_list - - (* ---------- Scope ---------- *) - (* --------------------------- *) end module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = struct - (** ------------------------------------------ *) - (** ---------- Function about token ---------- *) type scope = Scope.scope let cycle_duration = 10 @@ -1193,9 +1084,6 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = let saved_tokens : saved_token list ref = ref [] - (* ------- *) - (* getters *) - let id_client_of_saved_token t = t.id_client let userid_of_saved_token t = t.userid @@ -1208,19 +1096,11 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = let counter_of_saved_token t = t.counter - (* getters *) - (* ------- *) - - (** token_exists_by_id_client_and_value [id_client] [value] 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) - (** token_exists [saved_token] returns true if [saved_token] exists - *) 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 @@ -1267,7 +1147,6 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = in locale tokens - (* List all saved tokens *) (* IMPROVEME: list tokens by client OAuth2 id *) let list_tokens () = (! saved_tokens) @@ -1277,13 +1156,9 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = [ ("token_type", `String "bearer") ; ("token", `String (value_of_saved_token saved_token)) ; - (* FIXME: See fixme for saved_token value. *) - (* ("expires_in", `Int 3600) ; *) + ("expires_in", `Int (cycle_duration * number_of_cycle)) ; (* ("refresh_token", `String refresh_token) ;*) ] - - (** ---------- Function about token ---------- *) - (** ------------------------------------------ *) end module Basic_token = MakeBasicToken (Basic_scope) diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index 78088b391..7a89cd834 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -134,7 +134,6 @@ val param_access_token : ([ `One of string ] Eliom_parameter.param_name * [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), [ `WithoutSuffix ], - (*Eliom_service.get,*) unit ) Eliom_service.meth From fe2fd79a1a15c81347d41ab3daeb07eeaefcdeeb Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 16:53:45 +0100 Subject: [PATCH 10/19] OCaml conventions. --- src/os_oauth2_client.eliom | 11 ++++++----- src/os_oauth2_server.eliom | 10 +++++----- src/os_oauth2_shared.eliom | 6 +++--- src/os_oauth2_shared.eliomi | 20 ++++++++++++++++---- 4 files changed, 30 insertions(+), 17 deletions(-) diff --git a/src/os_oauth2_client.eliom b/src/os_oauth2_client.eliom index 0700c296e..0c244a2fc 100644 --- a/src/os_oauth2_client.eliom +++ b/src/os_oauth2_client.eliom @@ -64,7 +64,8 @@ let list_servers () = to_registered_server ~id ~server_id ~authorization_url ~token_url ~data_url ~client_credentials: - (Os_oauth2_shared.client_credentials_of_str client_id client_secret) + (Os_oauth2_shared.client_credentials_of_string + client_id client_secret) ) servers ) @@ -73,7 +74,7 @@ let get_client_credentials ~server_id = (Os_db.OAuth2_client.get_client_credentials ~server_id) >>= (fun (client_id, client_secret) -> - Lwt.return (Os_oauth2_shared.client_credentials_of_str + Lwt.return (Os_oauth2_shared.client_credentials_of_string ~client_id ~client_secret ) ) @@ -336,7 +337,7 @@ module MakeClient (* ------------------------------ *) let%lwt client_credentials = get_client_credentials ~server_id in let client_id = - Os_oauth2_shared.client_credentials_id client_credentials + Os_oauth2_shared.client_id_of_client_credentials client_credentials in let state = generate_state () in @@ -387,10 +388,10 @@ module MakeClient let grant_type = "authorization_code" in (* ----------------------------- *) let client_id = - Os_oauth2_shared.client_credentials_id client_credentials + Os_oauth2_shared.client_id_of_client_credentials client_credentials in let client_secret = - Os_oauth2_shared.client_credentials_secret client_credentials + Os_oauth2_shared.client_secret_of_client_credentials client_credentials in let base64_credentials = diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index 3cbb8bf03..7c8fba910 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -37,7 +37,7 @@ 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 size_client_id in let client_secret = Os_oauth2_shared.generate_random_string size_client_id in - client_credentials_of_str ~client_id ~client_secret + 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. @@ -102,8 +102,8 @@ let new_client ~application_name ~description ~redirect_uri = application_name description redirect_uri - (client_credentials_id credentials) - (client_credentials_secret credentials) + (client_id_of_client_credentials credentials) + (client_secret_of_client_credentials credentials) let remove_client_by_id id = Os_db.OAuth2_server.remove_client id @@ -137,7 +137,7 @@ let registered_client_of_client_id client_id = client_of_str ~application_name ~description ~redirect_uri in let credentials = - client_credentials_of_str ~client_id ~client_secret + 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 @@ -155,7 +155,7 @@ let list_clients ?(min_id=Int64.of_int 0) ?(limit=Int64.of_int 10) () = ~redirect_uri in let credentials = - client_credentials_of_str + client_credentials_of_string ~client_id ~client_secret in diff --git a/src/os_oauth2_shared.eliom b/src/os_oauth2_shared.eliom index 39e74e805..3aaadc585 100644 --- a/src/os_oauth2_shared.eliom +++ b/src/os_oauth2_shared.eliom @@ -39,14 +39,14 @@ type client_credentials = client_secret : Os_types.OAuth2.client_secret } -let client_credentials_of_str ~client_id ~client_secret = +let client_credentials_of_string ~client_id ~client_secret = { client_id; client_secret } -let client_credentials_id c = c.client_id -let client_credentials_secret c = c.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 diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index 7a89cd834..03e487249 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -23,25 +23,37 @@ *) (** {1 Constants} *) + +(** Length of state. *) val size_state : int + +(** Length of client ID. *) val size_client_id : int -val size_token : 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_str : +val client_credentials_of_string : client_id:Os_types.OAuth2.client_id -> client_secret:Os_types.OAuth2.client_secret -> client_credentials -val client_credentials_id : +val client_id_of_client_credentials : client_credentials -> Os_types.OAuth2.client_id -val client_credentials_secret : +val client_secret_of_client_credentials : client_credentials -> Os_types.OAuth2.client_secret From a06183ca54098db090d2724238fad5f0756ea077 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 17:05:04 +0100 Subject: [PATCH 11/19] Documentation for Os_oauth2_client.eliomi --- src/os_oauth2_client.eliomi | 53 +++++++++++++++++++++---------------- 1 file changed, 30 insertions(+), 23 deletions(-) diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index d1de2648a..7eea0c59b 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -185,7 +185,7 @@ module type TOKEN = sig (** The duration of a cycle. *) val cycle_duration : int - (** [number_of_cycle] the number of cycle. *) + (** [number_of_cycle] is the number of cycle. *) val number_of_cycle : int (** Returns the OpenID Connect server ID which delivered the token. *) @@ -198,7 +198,7 @@ module type TOKEN = sig saved_token -> string - (** Returns the token type (for example ["bearer"]. *) + (** Returns the token type (for example ["bearer"]). *) val token_type_of_saved_token : saved_token -> string @@ -244,7 +244,7 @@ module type TOKEN = sig saved_token list (** [remove_saved_token token] removes [token] (used for example when [token] - is expired. + is expired). *) val remove_saved_token : saved_token -> @@ -255,8 +255,8 @@ module type TOKEN = sig module type CLIENT = sig (** The following types and functions related to tokens and scopes are - aliases to the same types and functions from the module type given in the - functor {!MakeClient}. These aliases avoid to know the modules used to + 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. *) @@ -282,9 +282,17 @@ module type CLIENT = sig 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 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 -> @@ -299,21 +307,20 @@ module type CLIENT = sig saved_token -> unit - (** When registering, clients must specify a redirect uri 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 in the database and a - redirection is done to the service [success_redirection]. + (** 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 an error response (while requesting an authorization code - or a token), we redirect the user to the service [error_redirection]. + 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 : @@ -334,7 +341,7 @@ module type CLIENT = sig 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 in the HTTP parameter. + 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. @@ -354,7 +361,7 @@ 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 to + 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}. From bfee6a3b29918023e305d45adabd8525b26b75c6 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 17:09:48 +0100 Subject: [PATCH 12/19] Remove open --- src/os_oauth2_client.eliomi | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/src/os_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index 7eea0c59b..0efe459f5 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -22,9 +22,6 @@ ({!Basic_token}) and client implementation ({!Basic}). *) -open Os_oauth2_shared - -(* ---------- Exceptions ---------- *) (** {1 Exceptions } *) (** Raised if a state is not found. *) @@ -95,16 +92,16 @@ val data_url_of_registered_server : (** Get the client credentials. *) val client_credentials_of_registered_server : registered_server -> - client_credentials + 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:client_credentials -> + 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. *) @@ -135,7 +132,7 @@ val remove_server_by_id : (** Get the client credientials for a given OAuth2.0 server. *) val get_client_credentials : server_id:string -> - client_credentials Lwt.t + Os_oauth2_shared.client_credentials Lwt.t (** {3 About scopes, tokens and basic client. } *) From a45900b4aaa5467e5afe2cb159f499972327a231 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 17:11:49 +0100 Subject: [PATCH 13/19] Os_oauth2_server: OCaml conventions. --- src/os_oauth2_server.eliom | 6 +++--- src/os_oauth2_server.eliomi | 22 ++++++++++------------ 2 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index 7c8fba910..e3a9c0c7b 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -76,7 +76,7 @@ type client = redirect_uri: string } -let client_of_str ~application_name ~description ~redirect_uri = +let client_of_string ~application_name ~description ~redirect_uri = { application_name; description; redirect_uri } let application_name_of_client c = c.application_name @@ -134,7 +134,7 @@ let registered_client_of_client_id client_id = Os_db.OAuth2_server.registered_client_of_client_id client_id in let info = - client_of_str ~application_name ~description ~redirect_uri + client_of_string ~application_name ~description ~redirect_uri in let credentials = client_credentials_of_string ~client_id ~client_secret @@ -149,7 +149,7 @@ let list_clients ?(min_id=Int64.of_int 0) ?(limit=Int64.of_int 10) () = (fun (id, application_name, description, redirect_uri, client_id, client_secret) -> let info = - client_of_str + client_of_string ~application_name ~description ~redirect_uri diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index 390389414..bc059b38c 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -24,22 +24,20 @@ exception State_not_found exception No_such_client exception No_such_saved_token -(* ---------------------------- *) -(* ---------- Client ---------- *) - -(* 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, - * we can be interested to register several OAuth2 server (for different - * purpose) and in this case, we are interested to list client by OAuth2 server. +(** + 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 -val client_of_str : +val client_of_string : application_name:string -> description:string -> redirect_uri:Ocsigen_lib.Url.t -> From 4e81de0c7a6812ea315704b368e70c6c53fb6c29 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Wed, 2 Nov 2016 17:25:53 +0100 Subject: [PATCH 14/19] Os_db: add remove_client_by_client_id --- src/os_db.ml | 10 ++++++++++ src/os_db.mli | 9 ++++++++- 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/src/os_db.ml b/src/os_db.ml index 646c28486..1c4eccda3 100644 --- a/src/os_db.ml +++ b/src/os_db.ml @@ -912,6 +912,16 @@ module OAuth2_server = | 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 diff --git a/src/os_db.mli b/src/os_db.mli index e270ae4e9..c1b533395 100644 --- a/src/os_db.mli +++ b/src/os_db.mli @@ -347,6 +347,14 @@ module OAuth2_server : sig 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 @@ -359,7 +367,6 @@ module OAuth2_client : sig 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 From d299469853a765434ab7094d55d64c204a890510 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Thu, 3 Nov 2016 13:43:33 +0100 Subject: [PATCH 15/19] Os_oauth2_server doc --- src/os_connect_server.eliomi | 2 +- src/os_oauth2_server.eliom | 262 ++++++++++++--------- src/os_oauth2_server.eliomi | 442 +++++++++++++++++++++-------------- 3 files changed, 414 insertions(+), 292 deletions(-) diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi index 9850c2464..14089ad67 100644 --- a/src/os_connect_server.eliomi +++ b/src/os_connect_server.eliomi @@ -115,7 +115,7 @@ module type IDTOKEN = (** Basic module for scopes. [check_scope_list scope_list] returns [true] if every element in - [scope_list] is a available scope value. + [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), returns [false]. If an unknown scope value is in list (represented by [Unknown] value), diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index e3a9c0c7b..92577a90f 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -20,8 +20,6 @@ (* GENERAL FIXME: always use HTTPS !!!! *) -open Os_oauth2_shared - exception State_not_found exception No_such_client @@ -35,9 +33,13 @@ exception No_such_userid_registered 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 size_client_id in - let client_secret = Os_oauth2_shared.generate_random_string size_client_id in - client_credentials_of_string ~client_id ~client_secret + 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. @@ -63,7 +65,8 @@ let check_authorization_header client_id header = * NOTE: Improve the generation by using the userid of the OAuth2 server * user, the client_id of OAuth2 client and the scope? *) let generate_authorization_code () = - Os_oauth2_shared.generate_random_string size_authorization_code + Os_oauth2_shared.generate_random_string + Os_oauth2_shared.size_authorization_code (* 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 @@ -102,21 +105,20 @@ let new_client ~application_name ~description ~redirect_uri = application_name description redirect_uri - (client_id_of_client_credentials credentials) - (client_secret_of_client_credentials credentials) + (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 = - let%lwt id = Os_db.OAuth2_server.id_of_client_id client_id in - remove_client_by_id id + Os_db.OAuth2_server.remove_client_by_client_id client_id type registered_client = { - id : int64 ; - client : client ; - credentials : client_credentials ; + id : int64 ; + client : client ; + credentials : Os_oauth2_shared.client_credentials ; } let id_of_registered_client t = t.id @@ -137,7 +139,7 @@ let registered_client_of_client_id client_id = client_of_string ~application_name ~description ~redirect_uri in let credentials = - client_credentials_of_string ~client_id ~client_secret + 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 @@ -155,7 +157,7 @@ let list_clients ?(min_id=Int64.of_int 0) ?(limit=Int64.of_int 10) () = ~redirect_uri in let credentials = - client_credentials_of_string + Os_oauth2_shared.client_credentials_of_string ~client_id ~client_secret in @@ -278,47 +280,27 @@ module type SERVER = scope list -> string list - val set_userid_of_request_info_code : - string -> - string -> - int64 -> - unit - - val send_authorization_code : - string -> - string -> - Eliom_registration.Html.page Lwt.t + type saved_token - val send_authorization_code_error : - ?error_description:string option -> - ?error_uri:string option -> - error_authorization_code_type -> - string -> - Ocsigen_lib.Url.t -> - Eliom_registration.Html.page Lwt.t + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id - val rpc_resource_owner_authorize : - ( - Deriving_Json.Json_string.a * - Deriving_Json.Json_string.a, - Eliom_registration.Html.page - ) - Eliom_client.server_function + val userid_of_saved_token : + saved_token -> + Os_types.User.id - val rpc_resource_owner_decline : - ( - Deriving_Json.Json_string.a * Deriving_Json.Json_string.a, - Eliom_registration.Html.page - ) - Eliom_client.server_function + val value_of_saved_token : + saved_token -> + string - type saved_token + val token_type_of_saved_token : + saved_token -> + string - 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 scope_of_saved_token : + saved_token -> + scope list val token_exists : saved_token -> @@ -333,7 +315,7 @@ module type SERVER = unit val saved_token_of_id_client_and_value : - int64 -> + Os_types.OAuth2.Client.id -> string -> saved_token @@ -341,8 +323,43 @@ module type SERVER = 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 * (string * (string * (string * string))), + (string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string)) + ), unit, Eliom_service.get, Eliom_service.att, @@ -351,9 +368,9 @@ module type SERVER = Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name * - ([ `One of string ] + ([ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name * - ([ `One of string ] + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * @@ -367,23 +384,26 @@ module type SERVER = authorization_service type authorization_handler = - state:string -> - client_id:string -> - redirect_uri:string -> - scope:scope list -> + 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 * (string * (string * (string * string)))) -> + (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 * (string * (string * string))), + string * (string * (Ocsigen_lib.Url.t * (string * + Os_types.OAuth2.client_id))), Eliom_service.post, Eliom_service.att, Eliom_service.non_co, @@ -393,9 +413,9 @@ module type SERVER = unit, [ `One of string ] Eliom_parameter.param_name * ([ `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 string ] Eliom_parameter.param_name))), + [ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name))), Eliom_registration.String.return) Eliom_service.t @@ -405,8 +425,9 @@ module type SERVER = val token_handler : ( - unit -> - (string * (string * (string * (string * string)))) -> + unit -> + (string * (string * + (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id)))) -> Eliom_registration.String.result Lwt.t ) end @@ -437,13 +458,13 @@ module MakeServer type request_info = { - userid : int64 ; - redirect_uri : Ocsigen_lib.Url.t ; - client_id : string ; - code : string ; - state : string ; - scope : scope list ; - counter : int ref ; + 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 @@ -456,7 +477,7 @@ module MakeServer let request_info : request_info list ref = ref [] let _ = - update_list_timer + 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) @@ -509,10 +530,11 @@ module MakeServer ) states - (** check_state_already_used [client_id] [state] returns true if the state - * [state] is already used for the client [client_id]. Else returns false. - * As we use state to get the request information between authorization and - * token endpoint, we need to be sure it's unique. + (** 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 = @@ -569,6 +591,13 @@ module MakeServer (* ---------- 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 @@ -584,7 +613,7 @@ module MakeServer let service_url = Eliom_service.extern ~prefix ~path - ~meth:param_authorization_code_response + ~meth:Os_oauth2_shared.param_authorization_code_response () in add_request_info @@ -625,10 +654,12 @@ module MakeServer let service_url = Eliom_service.extern ~prefix ~path - ~meth:param_authorization_code_response_error + ~meth:Os_oauth2_shared.param_authorization_code_response_error () in - let error_str = error_authorization_code_type_to_str 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. *) @@ -646,8 +677,8 @@ module MakeServer 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 *) + (* 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 @@ -669,7 +700,7 @@ module MakeServer send_authorization_code_error ~error_description:(Some ("The resource owner doesn't authorize you to access its data")) - Auth_access_denied + Os_oauth2_shared.Auth_access_denied state redirect_uri @@ -703,7 +734,7 @@ module MakeServer let authorization_service path = Eliom_service.create ~path:(Eliom_service.Path path) - ~meth:param_authorization_code + ~meth:Os_oauth2_shared.param_authorization_code ~https:true () @@ -749,7 +780,7 @@ module MakeServer if (response_type <> "code") then send_authorization_code_error ~error_description:(Some (response_type ^ " is not supported.")) - Auth_invalid_request + Os_oauth2_shared.Auth_invalid_request state redirect_uri else if state_already_used then @@ -757,7 +788,7 @@ module MakeServer ~error_description: (Some ("State already used. It is recommended to generate \ random state with minimum 30 characters")) - Auth_invalid_request + Os_oauth2_shared.Auth_invalid_request state redirect_uri else if not authorized then @@ -765,7 +796,7 @@ module MakeServer ~error_description: (Some ("You are an unauthorized client. Please register before \ or check your credentials.")) - Auth_unauthorized_client + Os_oauth2_shared.Auth_unauthorized_client state redirect_uri else if not (check_scope_list scope_list) then @@ -773,7 +804,7 @@ module MakeServer ~error_description: (Some ("Some values in scope list are not available or you \ forgot some mandatory scope value.")) - Auth_invalid_scope + Os_oauth2_shared.Auth_invalid_scope state redirect_uri else if redirect_uri <> redirect_uri_bdd then @@ -781,7 +812,7 @@ module MakeServer send_authorization_code_error ~error_description: (Some ("Check the value of redirect_uri.")) - Auth_invalid_request + Os_oauth2_shared.Auth_invalid_request state redirect_uri ) @@ -809,7 +840,7 @@ module MakeServer ~error_description: (Some ("You are an unauthorized client. Please register before \ or check your credentials.")) - Auth_unauthorized_client + Os_oauth2_shared.Auth_unauthorized_client state redirect_uri (* Comes from send_authorization_code while trying to get the @@ -822,7 +853,7 @@ module MakeServer ~error_description: (Some ("Error while sending the code. Please check if you \ changed the client_id or the state.")) - Auth_invalid_request + Os_oauth2_shared.Auth_invalid_request state redirect_uri (* Comes from send_authorization_code while trying to get the userid of @@ -833,7 +864,7 @@ module MakeServer send_authorization_code_error ~error_description: (Some ("Error while sending the code. No user has authorized.")) - Auth_invalid_request + Os_oauth2_shared.Auth_invalid_request state redirect_uri @@ -868,23 +899,30 @@ module MakeServer ?(error_description=None) ?(error_uri=None) error = let json_error = match (error_description, error_uri) with | (None, None) -> - `Assoc [ ("error", `String (error_token_type_to_str error)) ] + `Assoc [( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + )] | (None, Some x) -> - `Assoc - [ - ("error", `String (error_token_type_to_str error)) ; + `Assoc [ + ( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + ) ; ("error_uri", `String x) ] | (Some x, None) -> - `Assoc - [ - ("error", `String (error_token_type_to_str error)) ; + `Assoc [ + ( + "error", + `String (Os_oauth2_shared.error_token_type_to_str error) + ) ; ("error_description", `String x) ] | (Some x, Some y) -> `Assoc [ - ("error", `String (error_token_type_to_str error)) ; + ("error", `String (Os_oauth2_shared.error_token_type_to_str error)); ("error_description", `String x) ; ("error_uri", `String y) ] @@ -901,7 +939,7 @@ module MakeServer in (* NOTE: RFC page 45 *) let code = match error with - | Token_invalid_client -> 401 + | Os_oauth2_shared.Token_invalid_client -> 401 | _ -> 400 in @@ -933,7 +971,7 @@ module MakeServer Eliom_service.t let token_service path = - update_list_timer + 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) @@ -942,7 +980,7 @@ module MakeServer (); Eliom_service.create ~path:(Eliom_service.Path path) - ~meth:param_access_token + ~meth:Os_oauth2_shared.param_access_token ~https:true () @@ -969,22 +1007,22 @@ module MakeServer ~error_description: (Some "Client authentication failed. Please check your client \ credentials and if you mentionned it in the request header.") - Token_invalid_client + 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.") - Token_unsupported_grant_type + Os_oauth2_shared.Token_unsupported_grant_type else if code <> code_state then send_token_error ~error_description: (Some "Wrong code") - Token_invalid_grant + Os_oauth2_shared.Token_invalid_grant else if redirect_uri <> redirect_uri_state then send_token_error ~error_description: (Some "Wrong redirect_uri") - Token_invalid_grant + Os_oauth2_shared.Token_invalid_grant else ( let%lwt id_client = @@ -1022,12 +1060,12 @@ module MakeServer send_token_error ~error_description: (Some "Wrong state") - Token_invalid_request + Os_oauth2_shared.Token_invalid_request | Os_db.No_such_resource -> send_token_error ~error_description: (Some "Client authentication failed.") - Token_invalid_client + Os_oauth2_shared.Token_invalid_client end @@ -1068,9 +1106,9 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = struct type scope = Scope.scope - let cycle_duration = 10 + let cycle_duration = 60 - let number_of_cycle = 1 + let number_of_cycle = 10 type saved_token = { @@ -1107,7 +1145,7 @@ module MakeBasicToken (Scope : SCOPE) : (TOKEN with type scope = Scope.scope) = token_exists_by_id_client_and_value id_client value let generate_token_value () = - Os_oauth2_shared.generate_random_string size_token + 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 = diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index bc059b38c..c4d9c7c16 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -18,12 +18,21 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -open Os_oauth2_shared +(** 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 @@ -37,30 +46,37 @@ exception No_such_saved_token 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. The return value is the ID in - * the database. +(** 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 -> @@ -68,65 +84,71 @@ val new_client : redirect_uri:Ocsigen_lib.Url.t -> Os_types.OAuth2.Client.id Lwt.t -(** Remove the client with the id [id] from the database. *) +(** [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 the client with the client_id [client_id] from the database. - * Client_id can be used because it must be unique. It calls - * remove_client_by_id after getting the id *) +(** [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 -(* ---------- Client ---------- *) -(* ---------------------------- *) - -(* --------------------------------------- *) -(* ---------- Registered client ---------- *) - (** 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. + 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 -> - client_credentials + Os_oauth2_shared.client_credentials +(** Build a value of type {!registered_client}. *) val to_registered_client : - Os_types.OAuth2.Client.id -> - client -> - client_credentials -> + Os_types.OAuth2.Client.id -> + client -> + Os_oauth2_shared.client_credentials -> registered_client -(** Return the registered client having [client_id] as client id *) +(** Return the registered client which has [client_id] as client id. Data are + retrieved from database. + *) val registered_client_of_client_id : - string -> + 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 -(* ---------- Registered client ---------- *) -(* --------------------------------------- *) +(** {2 Scopes, tokens and basic implementations of them. } *) +(** Interface for scopes. *) module type SCOPE = sig - (** Scope is a list of permissions *) + (** Scope is a list of permissions. *) type scope val scope_of_str : @@ -137,22 +159,40 @@ module type SCOPE = scope -> string - (** check_scope_list is used to check if the scope asked by the client is - * allowed. You can implement simple check_scope_list by only check is all - * element of the scope list is defined but you can also have the case where - * two scopes can't be asked at the same time. + (** 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 @@ -160,83 +200,103 @@ module type TOKEN = 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. *) + (** 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 - (* Returns true if the token already exists *) + (** Return [true] if the token already exists. *) val token_exists : saved_token -> bool - (* Generate a token value *) + (** Generate a token value. *) val generate_token_value : unit -> string - (* Generate a new token *) + (** 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 *) + (** 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 *) + (** 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 - (* --------------------------- *) - (* ---------- Scope ---------- *) + (** 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. + *) - (** Scope is a list of permissions *) type scope val scope_of_str : @@ -255,76 +315,27 @@ module type SERVER = scope list -> string list - (* --------------------------- *) - (* ---------- Scope ---------- *) - - (* --------------------------------------------- *) - (* ---------- request code information --------- *) - - val set_userid_of_request_info_code : - string -> - string -> - Os_types.User.id -> - unit - - (* ---------- request code information --------- *) - (* --------------------------------------------- *) - - (** ------------------------------------------------------------ *) - (** ---------- Functions about the authorization code ---------- *) - - (** send_authorization_code [state] [redirect_uri] [client_id] [scope] sends - * an authorization code to redirect_uri - * including the state [state]. This function can be called by - * the authorization handler. It uses Eliom_lib.change_page. - * It avoids to know how OAuth2 works and to implement the redirection - * manually. - * 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 for a Any. - *) - - val send_authorization_code : - string -> - string -> - Eliom_registration.Html.page Lwt.t - - val send_authorization_code_error : - ?error_description:string option -> - ?error_uri:string option -> - error_authorization_code_type -> - string -> - Ocsigen_lib.Url.t -> - Eliom_registration.Html.page Lwt.t - - val rpc_resource_owner_authorize : - ( - Deriving_Json.Json_string.a * - Deriving_Json.Json_string.a, - Eliom_registration.Html.page - ) - Eliom_client.server_function + type saved_token - val rpc_resource_owner_decline : - ( - Deriving_Json.Json_string.a * Deriving_Json.Json_string.a, - Eliom_registration.Html.page - ) - Eliom_client.server_function + val id_client_of_saved_token : + saved_token -> + Os_types.OAuth2.Client.id - (** ---------- Functions about the authorization code ---------- *) - (** ------------------------------------------------------------ *) + val userid_of_saved_token : + saved_token -> + Os_types.User.id - (** ------------------------------------------ *) - (** ---------- Function about token ---------- *) + val value_of_saved_token : + saved_token -> + string - type saved_token + val token_type_of_saved_token : + saved_token -> + string - 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 scope_of_saved_token : + saved_token -> + scope list val token_exists : saved_token -> @@ -347,34 +358,84 @@ module type SERVER = unit -> saved_token list - (** ---------- Function about token ---------- *) - (** ------------------------------------------ *) + (** [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. + *) - (** ---------- URL registration ---------- *) - (** -------------------------------------- *) + (** [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]. - (** When registering, we need to have several get parameters so we need to - * force the developer to have these GET parameter. We define a type for the - * token handler and the authorization handler. - * because they have different GET parameters. - * - * There are not abstract because we need to know the type. And it's also - * known due to RFC. - **) + *) + val send_authorization_code : + string -> + Os_types.OAuth2.client_id -> + Eliom_registration.Html.page Lwt.t - (** ------------------------------------------------ *) - (** ---------- Authorization registration ---------- *) + (** [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 - (* --------------------- *) - (* authorization service *) + (** {4 RPC to use when the resource owner authorize or decline. } *) - (** Type of pre-defined service for authorization service. It's a GET - * service + (** [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. *) - (* NOTE: need to improve this type! It's so ugly *) type authorization_service = - (string * (string * (string * (string * string))), + (string * + (Os_types.OAuth2.client_id * (Ocsigen_lib.Url.t * (string * string)) + ), unit, Eliom_service.get, Eliom_service.att, @@ -383,9 +444,9 @@ module type SERVER = Eliom_service.reg, [ `WithoutSuffix ], [ `One of string ] Eliom_parameter.param_name * - ([ `One of string ] + ([ `One of Os_types.OAuth2.client_id ] Eliom_parameter.param_name * - ([ `One of string ] + ([ `One of Ocsigen_lib.Url.t ] Eliom_parameter.param_name * ([ `One of string ] Eliom_parameter.param_name * @@ -394,19 +455,16 @@ module type SERVER = unit, Eliom_service.non_ocaml) Eliom_service.t - (** authorization_service [path] returns a service for the authorization URL. - * You can use it with Your_app_name.App.register with - * {!authorization_handler} *) + (** [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 - (* authorization service *) - (* --------------------- *) - - (* --------------------- *) - (* authorization handler *) - + (** 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 -> @@ -414,35 +472,24 @@ module type SERVER = 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 it with Your_app_name.App.register with - * {!authorization_service} + (** [authorize_handler handler] returns a handler for the authorization URL. + You can use the service {!authorization_service}. *) val authorization_handler : authorization_handler -> ( - (string * (string * (string * (string * string)))) -> + (string * (Os_types.OAuth2.client_id * + (Ocsigen_lib.Url.t * (string * string))) + ) -> unit -> Eliom_registration.Html.page Lwt.t ) - (* authorization handler *) - (* --------------------- *) - - (** ---------- Authorization registration ---------- *) - (** ------------------------------------------------ *) - - (** ---------------------------------------- *) - (** ---------- Token registration ---------- *) - - (* ------------- *) - (* token service *) - - (** Type of pre-defined service for token service. It's a POST service. *) - (* NOTE: need to improve this type! It's so ugly *) + (** Type of the pre-defined service for token. It's a POST service. *) type token_service = (unit, - string * (string * (string * (string * string))), + string * (string * (Ocsigen_lib.Url.t * (string * + Os_types.OAuth2.client_id))), Eliom_service.post, Eliom_service.att, Eliom_service.non_co, @@ -452,51 +499,42 @@ module type SERVER = unit, [ `One of string ] Eliom_parameter.param_name * ([ `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 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 it with Your_app_name.App.register with - * {!token_handler} + (** [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 - (* token service *) - (* ------------- *) - - (* ------------- *) - (* token handler *) - - (** token_handler returns a handler for the access token URL. - * You can use it with Your_app_name.App.register with - * {!token_service} + (** Handler for the access token URL. + You can use the service {!token_service}. *) val token_handler : ( - unit -> - (string * (string * (string * (string * string)))) -> + unit -> + (string * (string * + (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id)))) -> Eliom_registration.String.result Lwt.t ) - - (* token handler *) - (* ------------- *) - - (** ---------- Token registration ---------- *) - (** ---------------------------------------- *) - - (** ---------- URL registration ---------- *) - (** -------------------------------------- *) - 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)) -> @@ -505,8 +543,54 @@ module MakeServer : functor type saved_token = Token.saved_token ) -module Basic_scope : SCOPE +(** 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) From d5a913154eb435f4ea72e47dae383ea432691706 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Thu, 3 Nov 2016 14:21:00 +0100 Subject: [PATCH 16/19] Os_oauth2_shared documentation. --- src/os_oauth2_shared.eliomi | 56 +++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/src/os_oauth2_shared.eliomi b/src/os_oauth2_shared.eliomi index 03e487249..d2af4f653 100644 --- a/src/os_oauth2_shared.eliomi +++ b/src/os_oauth2_shared.eliomi @@ -88,6 +88,17 @@ val error_token_type_to_str : (** {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, @@ -105,6 +116,14 @@ val param_authorization_code : ) 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, @@ -118,6 +137,16 @@ val param_authorization_code_response : ) 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, @@ -133,6 +162,17 @@ val param_authorization_code_response_error : ) 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, @@ -152,6 +192,13 @@ val param_access_token : (** {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) -> @@ -160,10 +207,19 @@ val update_list_timer : 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 From 72112f2b657ea0b273af03226828e87068ad3897 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Thu, 3 Nov 2016 17:13:13 +0100 Subject: [PATCH 17/19] Update documentation. --- src/os_connect_client.eliomi | 69 ++++----- src/os_connect_server.eliomi | 253 +++++++++++++++++++++------------ src/os_oauth2_client.eliomi | 12 +- src/os_oauth2_server.eliomi | 265 +++++++++++++++++------------------ 4 files changed, 336 insertions(+), 263 deletions(-) diff --git a/src/os_connect_client.eliomi b/src/os_connect_client.eliomi index c54bb0232..d12b232da 100644 --- a/src/os_connect_client.eliomi +++ b/src/os_connect_client.eliomi @@ -34,15 +34,17 @@ exception No_such_saved_token (** {2 Token representation. } *) -(** Represents tokens used by the OpenID Connect server. *) +(** Interface for ID Token used by the OpenID Connect server. *) -module type IDTOKEN = - sig - - (** Represents a saved token. The type is abstract to let the choice of the +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 @@ -61,27 +63,27 @@ module type IDTOKEN = (** [number_of_cycle] the number of cycle. *) val number_of_cycle : int - (** Returns the OpenID Connect server ID which delivered the token. *) + (** Return the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> Os_types.OAuth2.Server.id - (** Returns the token value. *) + (** Return the token value. *) val value_of_saved_token : saved_token -> string - (** Returns the token type (for example ["bearer"]. *) + (** Return the token type (for example ["bearer"]. *) val token_type_of_saved_token : saved_token -> string - (** Returns the ID token as a JWT. *) + (** Return the ID token as a JWT. *) val id_token_of_saved_token : saved_token -> Jwt.t - (** Returns the number of remaining cycles. *) + (** Return the number of remaining cycles. *) val counter_of_saved_token : saved_token -> int ref @@ -116,7 +118,7 @@ module type IDTOKEN = saved_token -> unit - (** Returns all saved tokens as a list. *) + (** Return all saved tokens as a list. *) val list_tokens : unit -> saved_token list @@ -133,29 +135,28 @@ module type IDTOKEN = (** 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 +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. *) diff --git a/src/os_connect_server.eliomi b/src/os_connect_server.eliomi index 14089ad67..a39a93c22 100644 --- a/src/os_connect_server.eliomi +++ b/src/os_connect_server.eliomi @@ -19,119 +19,192 @@ *) (** OpenID Connect server with default scopes ({!Basic_scope}), ID Tokens - ({!Basic_ID_Token}) and client implementation ({!Basic}). + ({!Basic_ID_Token}) and server implementation ({!Basic}). *) +(** {1 Exceptions. } *) + (** Exception raised when the given token doesn't exist. *) 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 - - (* getters *) - (* ------- *) - - (* Returns 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 - - val remove_saved_token : - saved_token -> - unit - - 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 - - val saved_token_to_json : - saved_token -> - Yojson.Safe.json - end +(** {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), returns [false]. + (mandatory scope in RFC), it returns [false]. If an unknown scope value is in list (represented by [Unknown] value), - returns [false]. + 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_oauth2_client.eliomi b/src/os_oauth2_client.eliomi index 0efe459f5..fb553292a 100644 --- a/src/os_oauth2_client.eliomi +++ b/src/os_oauth2_client.eliomi @@ -185,22 +185,22 @@ module type TOKEN = sig (** [number_of_cycle] is the number of cycle. *) val number_of_cycle : int - (** Returns the OpenID Connect server ID which delivered the token. *) + (** Return the OpenID Connect server ID which delivered the token. *) val id_server_of_saved_token : saved_token -> Os_types.OAuth2.Server.id - (** Returns the token value. *) + (** Return the token value. *) val value_of_saved_token : saved_token -> string - (** Returns the token type (for example ["bearer"]). *) + (** Return the token type (for example ["bearer"]). *) val token_type_of_saved_token : saved_token -> string - (** Returns the number of passed cycles. *) + (** Return the number of passed cycles. *) val counter_of_saved_token : saved_token -> int ref @@ -235,7 +235,7 @@ module type TOKEN = sig saved_token -> unit - (** Returns all saved tokens as a list. *) + (** Return all saved tokens as a list. *) val list_tokens : unit -> saved_token list @@ -378,7 +378,7 @@ module Basic_scope : sig end (** Basic_token is a {!TOKEN} module representing a basic token (id_server, - value and token_type. + 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}. diff --git a/src/os_oauth2_server.eliomi b/src/os_oauth2_server.eliomi index c4d9c7c16..320bc5bb0 100644 --- a/src/os_oauth2_server.eliomi +++ b/src/os_oauth2_server.eliomi @@ -146,142 +146,141 @@ val list_clients : (** {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 +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 +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}. From c8e745ead8833e097f1ad9275a996bc25c0d0723 Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Thu, 3 Nov 2016 17:15:24 +0100 Subject: [PATCH 18/19] Update SQL file in the template. --- template.distillery/PROJECT_NAME.sql | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) 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 ); From 8713013c852699f18beacc420efbb18c3b6760be Mon Sep 17 00:00:00 2001 From: Danny Willems Date: Thu, 3 Nov 2016 17:36:57 +0100 Subject: [PATCH 19/19] Remove some comments and convention for module type indentation. --- src/os_connect_server.eliom | 6 +- src/os_oauth2_server.eliom | 487 +++++++++++++++++------------------- 2 files changed, 237 insertions(+), 256 deletions(-) diff --git a/src/os_connect_server.eliom b/src/os_connect_server.eliom index 2dedfbf6b..19f1d02c0 100644 --- a/src/os_connect_server.eliom +++ b/src/os_connect_server.eliom @@ -118,8 +118,7 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) id_token : Jwt.t ; scope : scope list ; counter : int ref ; - secret_key : string (* Needed to be able to check if the client sent the - right id_token. This is the key used by HS256 to sign the token. *) + secret_key : string } let id_client_of_saved_token s = s.id_client @@ -251,9 +250,6 @@ module MakeIDToken (Scope : Os_oauth2_server.SCOPE) (* What about a refresh_token ? *) (* ("refresh_token", `String refresh_token) ;*) ] - - (** ---------- Function about token ---------- *) - (** ------------------------------------------ *) end module Basic_scope : Os_oauth2_server.SCOPE = diff --git a/src/os_oauth2_server.eliom b/src/os_oauth2_server.eliom index 92577a90f..7a668626c 100644 --- a/src/os_oauth2_server.eliom +++ b/src/os_oauth2_server.eliom @@ -61,17 +61,11 @@ let check_authorization_header client_id header = (* if the authorization value is not defined *) with Not_found -> Lwt.return_false -(** generate_authorization_code () generates an authorization code. - * NOTE: Improve the generation by using the userid of the OAuth2 server - * user, the client_id of OAuth2 client and the scope? *) +(** Generates an authorization code. *) let generate_authorization_code () = Os_oauth2_shared.generate_random_string Os_oauth2_shared.size_authorization_code -(* 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}. - *) type client = { application_name: string; @@ -96,9 +90,6 @@ let client_of_id id = Lwt.return { application_name ; description ; redirect_uri } with Os_db.No_such_resource -> Lwt.fail No_such_client -(* Create a new client by generating credentials. The return value is the ID in - * the database. - *) let new_client ~application_name ~description ~redirect_uri = let credentials = generate_client_credentials () in Os_db.OAuth2_server.new_client @@ -170,267 +161,264 @@ 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 +module type SCOPE = sig + type scope - val save_token : - saved_token -> - unit + val scope_of_str : + string -> + scope - val remove_saved_token : - saved_token -> - unit + val scope_to_str : + scope -> + string - 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 + val check_scope_list : + scope list -> + bool +end -module type SERVER = - sig - type scope +module type TOKEN = sig + type scope - val scope_of_str : - string -> - scope + type saved_token - val scope_to_str : - scope -> - string + val saved_tokens : saved_token list ref - val scope_list_of_str_list : - string list -> - scope list + val cycle_duration : int - val scope_list_to_str_list : - scope list -> - string list + val number_of_cycle : int - type saved_token + val id_client_of_saved_token : + saved_token -> + int64 - val id_client_of_saved_token : - saved_token -> - Os_types.OAuth2.Client.id + val userid_of_saved_token : + saved_token -> + int64 - val userid_of_saved_token : - saved_token -> - Os_types.User.id + val value_of_saved_token : + saved_token -> + string - val value_of_saved_token : - saved_token -> - string + val token_type_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 scope_of_saved_token : - saved_token -> - scope list - val token_exists : - saved_token -> - bool + val counter_of_saved_token : + saved_token -> + int ref - val save_token : - saved_token -> - unit + val token_exists : + saved_token -> + bool - val remove_saved_token : - saved_token -> - unit + val generate_token_value : + unit -> + string - val saved_token_of_id_client_and_value : - Os_types.OAuth2.Client.id -> - string -> - saved_token + val generate_token : + id_client:int64 -> + userid:int64 -> + scope:scope list -> + saved_token Lwt.t - val list_tokens : - unit -> - saved_token list + val save_token : + saved_token -> + unit - val set_userid_of_request_info_code : - string -> - string -> - Os_types.User.id -> - unit + val remove_saved_token : + saved_token -> + unit - val send_authorization_code : - string -> - Os_types.OAuth2.client_id -> - Eliom_registration.Html.page Lwt.t + val saved_token_of_id_client_and_value : + int64 -> + string -> + saved_token - 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 list_tokens : + unit -> + saved_token list - val rpc_resource_owner_authorize : - ( - string * Os_types.OAuth2.client_id, - Eliom_registration.Html.page - ) - Eliom_client.server_function + val saved_token_to_json : + saved_token -> + Yojson.Safe.json +end - val rpc_resource_owner_decline : - ( - string * Ocsigen_lib.Url.t, - Eliom_registration.Html.page - ) - Eliom_client.server_function +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 - 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 ] + 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 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))), - 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 + [ `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 + ) - val token_handler : - ( - unit -> - (string * (string * - (Ocsigen_lib.Url.t * (string * Os_types.OAuth2.client_id)))) -> - Eliom_registration.String.result Lwt.t - ) - end + 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) @@ -492,16 +480,14 @@ module MakeServer in request_info := (new_state :: (! request_info)) - (** remove_request_info [state] removes the request_info which has [state] - * as state. - *) + (** [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] + (** 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 @@ -530,9 +516,8 @@ module MakeServer ) states - (** Returns [true] if the state - [state] is already used for the client [client_id]. Else returns - [false]. + (** 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. *)