diff --git a/README.md b/README.md index fbab112..d70704e 100644 --- a/README.md +++ b/README.md @@ -77,3 +77,64 @@ match state_query with | None -> Server.respond_string ~status:`Bad_request ~body:"No code parameter provided" () ``` +### GitHub OAuth (built-in provider module) + +```ocaml +(* Example routes from bin/main.ml *) +module GitHubInMemoryStorage = Storage.MakeInMemoryStorage(GitHubInMemoryStorage) +module GitHub = GitHubClient(GitHubInMemoryStorage) + +(* /github *) +let config = Github.GithubOauthConfig { + client_id = "your-client-id"; + client_secret = "your-client-secret"; + redirect_uri = Json_uri.of_string "http://localhost:8080/github-callback"; + scope = ["user" ; "repo"]; + login = Some "my-user"; + allow_signup = Some true; + prompt = No_Prompt; +} in +match GitHub.get_authorization_url ~config with +| Ok (url, _state) -> (* redirect/link to url *) +| Error message -> (* handle error *) +``` + +### Facebook OAuth (new built-in provider module) + +By default, Savvy uses an in-memory storage implementation for the Authorization Code state/config handoff. For production, implement your own storage that matches `Storage.STORAGE_UNIT` and pass it to `Facebook.FacebookClient`. + +```ocaml +open Savvy + +(* Choose storage: in-memory for dev, custom for prod *) +module FacebookInMemoryStorage = Storage.MakeInMemoryStorage(FacebookInMemoryStorage) +module Facebook = FacebookClient(FacebookInMemoryStorage) + +(* /facebook *) +let config = Facebook.FacebookOauthConfig { + client_id = Sys.getenv_opt "FACEBOOK_CLIENT_ID" |> Option.value ~default:"your-client-id"; + client_secret = Sys.getenv_opt "FACEBOOK_CLIENT_SECRET" |> Option.value ~default:"your-client-secret"; + redirect_uri = Json_uri.of_string "http://localhost:8080/facebook-callback"; + scope = ["public_profile"; "email"]; +} in +match Facebook.get_authorization_url ~config with +| Ok (auth_url, state) -> (* redirect/link to auth_url; persist state if needed *) +| Error e -> (* handle error *) + +(* /facebook-callback *) +match (state_param, code_param) with +| (Some state, Some code) -> begin + Facebook.exchange_code_for_token state code + >>= function + | Ok token -> Facebook.get_user_info token + | Error e -> Lwt.return (Error e) + end +| _ -> Lwt.return (Error "Missing params") +``` + +Notes: +- The Facebook authorization URL is `https://www.facebook.com/v20.0/dialog/oauth`. +- The token exchange endpoint is `https://graph.facebook.com/v20.0/oauth/access_token`. +- `Facebook.get_user_info` calls `https://graph.facebook.com/me?fields=id,name,email` with the access token. + + diff --git a/bin/main.ml b/bin/main.ml index 06de968..6847c1e 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -11,6 +11,10 @@ module Client = OAuth2Client(GenericInMemoryStorage) module GitHubInMemoryStorage = Storage.MakeInMemoryStorage(GitHubInMemoryStorage) module GitHub = GitHubClient(GitHubInMemoryStorage) +(* leverage the basic in-memory storage for demo purposes (Facebook edition) *) +module FacebookInMemoryStorage = Storage.MakeInMemoryStorage(FacebookInMemoryStorage) +module Facebook = FacebookClient(FacebookInMemoryStorage) + (* A custom module might look something like this: *) (* module CustomStorage : STORAGE_UNIT = struct @@ -160,6 +164,41 @@ let callback _conn req _body = (*Server.respond_string ~status:`OK ~body:("You did it!") ()*) (* Something needs to happen here *) end + | "/facebook" -> begin + let config = Facebook.FacebookOauthConfig { + client_id = "your-client-id"; + client_secret = "your-client-secret"; + redirect_uri = Json_uri.of_string "http://localhost:8080/facebook-callback"; + scope = ["public_profile"; "email"]; + } in + match Facebook.get_authorization_url ~config with + | Ok (url, _state) -> Server.respond_string ~status:`OK ~body:("Authenticate with Facebook") () + | Error message -> Server.respond_string ~status:`OK ~body:("You've got problems: " ^ message) () + end + | "/facebook-callback" -> begin + let uri = Request.uri req in + let code_query = Uri.get_query_param uri "code" in + let state_query = Uri.get_query_param uri "state" in + match state_query with + | Some state -> begin + match code_query with + | Some code -> begin + Facebook.exchange_code_for_token state code + >>= fun token_result -> + match token_result with + | Ok token -> begin + let token_info = + "

Auth was successful!

" ^ + "

Access Token: " ^ token.access_token ^ "

" in + Server.respond_string ~status:`OK ~body:(token_info ^ "Back to Login") () + end + | Error message -> Server.respond_string ~status:`OK ~body:("Authorization failed: " ^ message) () + end + | None -> + Server.respond_string ~status:`Bad_request ~body:"No code parameter provided" () + end + | None -> Server.respond_string ~status:`Bad_request ~body:"No code parameter provided" () + end | _ -> begin (* Handle unknown paths *) Server.respond_string ~status:`Not_found ~body:"Not Found" () diff --git a/src/dune b/src/dune index 804509d..802f522 100644 --- a/src/dune +++ b/src/dune @@ -2,6 +2,7 @@ (name savvy) (public_name savvy) (libraries + facebook github lwt oauth2_client diff --git a/src/facebook/dune b/src/facebook/dune new file mode 100644 index 0000000..6a3b5e7 --- /dev/null +++ b/src/facebook/dune @@ -0,0 +1,13 @@ +(library + (name facebook) + (public_name savvy.facebook) + (libraries + cohttp-lwt-unix + json_uri + lwt + oauth2_client + storage + utils + yojson + ) + (preprocess (pps ppx_deriving_yojson))) diff --git a/src/facebook/facebook.ml b/src/facebook/facebook.ml new file mode 100644 index 0000000..e3ab934 --- /dev/null +++ b/src/facebook/facebook.ml @@ -0,0 +1,115 @@ +(* + - A Facebook config struct + - Create URL for the developer to put in a button + - Create a token exchange method +*) +open Lwt.Infix +open Cohttp_lwt_unix + +let ( let* ) = Lwt.bind + +type facebook_oauth_config = { + client_id: string; + client_secret: string; + redirect_uri: Json_uri.t; + scope: string list; +} [@@deriving yojson] + +type user_response = { + id: string; + name: string; + email: string option; +} [@@deriving yojson] + +type token_response = { + access_token: string; + token_type: (string option [@default None]); + expires_in: (int option [@default None]); +} [@@deriving yojson] + +type config = + | FacebookOauthConfig of facebook_oauth_config +[@@deriving yojson] + +module DefaultInMemoryStorage = struct + type value = config + let ttl = 3600.0 +end + +module type FACEBOOK_CLIENT = +sig + val get_authorization_url : config:config -> ((Uri.t * string), string) result + val exchange_code_for_token : string -> string -> (token_response, string) result Lwt.t + val get_user_info : token_response -> (user_response, string) result Lwt.t +end + +module FacebookClient (Storage : Storage.STORAGE_UNIT with type value = config) : FACEBOOK_CLIENT = struct + let get_authorization_url ~config = + match config with + | FacebookOauthConfig fb_config -> begin + let state = Utils.generate_state () in + let params = [ + ("client_id", fb_config.client_id); + ("redirect_uri", Json_uri.to_string fb_config.redirect_uri); + ("state", state); + ] @ ( + match fb_config.scope with + | [] -> [] + | scopes -> [ ("scope", String.concat "," scopes) ] + ) in + Storage.update state config; + let url = Uri.add_query_params' (Uri.of_string "https://www.facebook.com/v20.0/dialog/oauth") params in + Ok (url, state) + end + + let exchange_code_for_token state code = + match Storage.get state with + | Some ((stored_config), _expires) -> begin + Storage.remove state; + match stored_config with + | FacebookOauthConfig config -> begin + let params = [ + ("client_id", config.client_id); + ("client_secret", config.client_secret); + ("code", code); + ("redirect_uri", Json_uri.to_string config.redirect_uri); + ] in + let uri = Uri.add_query_params' (Uri.of_string "https://graph.facebook.com/v20.0/oauth/access_token") params in + Client.get uri + >>= fun (_resp, body) -> Cohttp_lwt.Body.to_string body + >>= fun body_str -> + let json = Yojson.Safe.from_string body_str in + match token_response_of_yojson json with + | Ok token -> Lwt.return (Ok token) + | Error _ -> begin + let open Yojson.Safe.Util in + let err = member "error" json in + if err <> `Null then + let message = err |> member "message" |> to_string_option |> Option.value ~default:"Unknown error" in + Lwt.return (Error message) + else + Lwt.return (Error "Failed to decode token response") + end + end + end + | None -> Lwt.return (Error "State value did not match a known session") + + let get_user_info token = + let uri = Uri.add_query_params' (Uri.of_string "https://graph.facebook.com/me") [ + ("fields", "id,name,email"); + ("access_token", token.access_token); + ] in + let* (resp, body) = Cohttp_lwt_unix.Client.get uri in + let code = resp + |> Cohttp.Response.status + |> Cohttp.Code.code_of_status in + if Cohttp.Code.is_success code + then + let* body_str = Cohttp_lwt.Body.to_string body in + let json = Yojson.Safe.from_string body_str in + match user_response_of_yojson json with + | Ok user -> Lwt.return (Ok user) + | Error _ -> Lwt.return (Error "Failed to unwrap user object") + else + Lwt.return (Error "Failed to successfully retrieve user") +end diff --git a/src/facebook/facebook.mli b/src/facebook/facebook.mli new file mode 100644 index 0000000..d68b360 --- /dev/null +++ b/src/facebook/facebook.mli @@ -0,0 +1,42 @@ +(* Expose the necessary things to use Facebook *) + +type facebook_oauth_config = { + client_id: string; + client_secret: string; + redirect_uri: Json_uri.t; + scope: string list; +} [@@deriving yojson] + +(** A minimal user response; extend as needed *) +type user_response = { + id: string; + name: string; + email: string option; +} [@@deriving yojson] + +(** Token response per Facebook Graph API *) +type token_response = { + access_token: string; + token_type: string option; + expires_in: int option; +} [@@deriving yojson] + +(** Config wrapper type for storage *) +type config = + | FacebookOauthConfig of facebook_oauth_config +[@@deriving yojson] + +module DefaultInMemoryStorage : sig + type value = config + val ttl : float +end + +module type FACEBOOK_CLIENT = +sig + val get_authorization_url : config:config -> ((Uri.t * string), string) result + val exchange_code_for_token : string -> string -> (token_response, string) result Lwt.t + (** Retrieves the currently authenticated user's information *) + val get_user_info : token_response -> (user_response, string) result Lwt.t +end + +module FacebookClient (_ : Storage.STORAGE_UNIT with type value = config) : FACEBOOK_CLIENT diff --git a/src/savvy.ml b/src/savvy.ml index 9d0aa55..486e294 100644 --- a/src/savvy.ml +++ b/src/savvy.ml @@ -3,8 +3,11 @@ module type STORAGE_UNIT = Storage.STORAGE_UNIT module type OAUTH2_CLIENT = Oauth2_client.OAUTH2_CLIENT module type GITHUB_CLIENT = Github.GITHUB_CLIENT +module type FACEBOOK_CLIENT = Facebook.FACEBOOK_CLIENT module DefaultInMemoryStorage = Oauth2_client.DefaultInMemoryStorage module GitHubInMemoryStorage = Github.DefaultInMemoryStorage +module FacebookInMemoryStorage = Facebook.DefaultInMemoryStorage module OAuth2Client = Oauth2_client.OAuth2Client module GitHubClient = Github.GitHubClient +module FacebookClient = Facebook.FacebookClient