Implement facebook auth and update docs

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.
+
+

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:("<a styles='padding: 4px; background-color: \"#1877F2\"; color: \"white\" border-radius: 4px;' href='" ^ Uri.to_string url ^ "'>Authenticate with Facebook</a>") ()
+    | 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 = 
+              "<p>Auth was successful!</p>" ^
+              "<p>Access Token: " ^ token.access_token ^ "</p>" in
+            Server.respond_string ~status:`OK ~body:(token_info ^ "<a href='/'>Back to Login</a>") ()
+          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" ()

src/dune

@@ -2,6 +2,7 @@
  (name savvy)
  (public_name savvy)
  (libraries
+   facebook
    github
    lwt
    oauth2_client

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)))

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

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

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