gistfile1.ml

open Spotlib.Spot
open GapiUtils.Infix
open GapiLens.Infix
open GapiLens.StateInfix
open GapiMonad.SessionM

module OAuth2 = GapiOAuth2
module Conv = GapiConversation
module Service = GapiService

(*** How to configure your client and authenticate using OAuth 2.0 for native
   * applications. ***)

let application_name = "picasatest"

(* The clientId and clientSecret are copied from the API Access tab on
 * the Google APIs Console *)
let client_id     = Priv.Client.id
let client_secret = Priv.Client.secret

let configuration = 
  let module C = GapiConfig in
  C.default
  |> C.application_name ^= application_name
  |> C.auth ^= C.OAuth2 { C.client_id; client_secret }

module Xml = struct
  include Xml

  let parse_string str =
    let xmlp = XmlParser.make () in
    XmlParser.prove xmlp false;
    XmlParser.parse xmlp (XmlParser.SString str)

  let parse_string s = 
     try parse_string s with
    | (Xml.Error error as e) -> 
        Format.eprintf "ERROR: Xml: %s (saved as error.xml)@." (Xml.error error);
        let oc = open_out "error.xml" in
        output_string oc s;
        close_out oc;
        raise e

  let parse_string ?(robust=false) s = 
    Xml_lexer.robust := robust;
    XmlParser.robust := robust;
    parse_string s

  let parse_string s =
    try parse_string ~robust:false s with _ ->
      parse_string ~robust:true s

  (* HaXml style quickly built combinator *)

  let visit f xml = match xml with
    | Element _ -> iter f xml
    | PCData _ -> ()

  let children = List.concat_map & function
    | PCData _ -> []
    | Element (_, _, xs) -> xs

  let tag s = List.concat_map & function
    | PCData _ -> []
    | (Element (s', _, _) as e) when s = s' -> [e]
    | Element _ -> []

  let pcdata = List.concat_map & function
    | PCData s -> [s]
    | Element _ -> []
end

module Picasa = struct
  let scope = "http://picasaweb.google.com/data/"

  (* https://picasaweb.google.com/data/feed/api/user/liz?kind=album&access=private    *)
  let albums_url userid = !% "https://picasaweb.google.com/data/feed/api/user/%s?kind=album&access=private" userid

  let parse pipe = 
    Conv.read_all pipe
      |> Xml.parse_string

  let albums userid session = Service.get (albums_url userid) parse session

  let album_ids xml =
    let open Xml in
    [xml]
    |> children
    |> tag "entry"
    |> (children *> tag "id" *> children *> pcdata)

  let delete_album url session = 
    Service.delete url (fun pipe ->
      prerr_endline & Conv.read_all pipe )
      session
end

module Authorize(A : sig end) = struct
  let redirect_uri = "urn:ietf:wg:oauth:2.0:oob"

  (* Step 1: Authorize --> *)
  let authorization_url =
    OAuth2.authorization_code_url
      ~redirect_uri
      ~scope: [Picasa.scope]
      ~response_type:"code"
      client_id
  
  (* Point or redirect your user to the authorization_url. *)
  let () = print_endline "Go to the following link in your browser:";
           print_endline authorization_url
  
  (* Read the authorization code from the standard input stream. *)
  let () = print_endline "What is the authorization code?: "

  let code = input_line stdin

  let () = !!% "code =%S@." code

  let batch = perform
    response <-- OAuth2.get_access_token
      ~client_id
      ~client_secret
      ~code
      ~redirect_uri;
    
    let (access_token, refresh_token) =  match response with
      | GapiAuthResponse.OAuth2AccessToken token ->
          (token.GapiAuthResponse.OAuth2.access_token,
           token.GapiAuthResponse.OAuth2.refresh_token)
      | _ -> failwith "Not supported OAuth2 response" in
  
    \ !!% "acc=%s@.ref=%s@." access_token refresh_token;
    return ()

  let (), _ = Conv.with_curl configuration batch

end

(* module M = Authorize(struct end) *)

let access_token = Priv.Token.access
let refresh_token = Priv.Token.refresh

let batch = perform

  \ !!% "acc=%s ref=%s@." access_token refresh_token;

  (* Update session with OAuth2 tokens *)
  Conv.Session.auth ^=!
        Conv.Session.OAuth2 {
          Conv.Session.oauth2_token = access_token;
          refresh_token
        };

  xml <-- Picasa.albums Priv.userid;

  let album_urls = Picasa.album_ids xml in

  \ List.iter prerr_endline album_urls;

(* THIS DELETES ALL THE ALBUMS!
  mapM_ Picasa.delete_album album_urls;
*)

  return ()

(* Start a new session *)
let (), _ =
  Conv.with_curl configuration batch