Dropbox: just FileRequests.create so far, with two-legged auth

urweb · Feb 13, 2021 · 0a0341c · 0a0341c
1 parent 948eacb
commit 0a0341c
Show file tree

Hide file tree

Showing 8 changed files with 204 additions and 1 deletion.
diff --git a/examples/dropboxDemo.ur b/examples/dropboxDemo.ur
@@ -0,0 +1,20 @@
+(* For this demo, it's necessary to create dropboxSecrets.ur,
+ * defining [api_key] and [api_secret]. *)
+structure D = Dropbox.Make(Dropbox.TwoLegged(DropboxSecrets))
+
+fun create r =
+    m <- D.FileRequests.create ({Title = r.Title,
+                                 Destination = r.Destination,
+                                 Open = True}
+                                    ++ Api.optionals {});
+    return <xml><body>ID: {[m.Id]}</body></xml>
+
+val main = return <xml><body>
+  <h3>Create Request</h3>
+
+  <form>
+    Title: <textbox{#Title}/><br/>
+    Destination: <textbox{#Destination}/><br/>
+    <submit action={create}/>
+  </form>
+</body></xml>
diff --git a/examples/dropboxDemo.urp b/examples/dropboxDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all DropboxDemo/*
+database dbname=dropboxDemo
+sql dropboxDemo.sql
+safeGetDefault
+allow url https://*
+prefix http://localhost:8080/
+
+dropboxSecrets
+dropboxDemo
diff --git a/examples/dropboxDemo.urs b/examples/dropboxDemo.urs
@@ -0,0 +1 @@
+val main : transaction page
diff --git a/examples/dropboxSecrets.ur b/examples/dropboxSecrets.ur
@@ -0,0 +1 @@
+val token = "sl.ArMQd_xwOsCUogNtfZriKxTOb78tokjfD6hM23YustyImp31vb6hrOOjbCpcFganZGjWvLwlWwo5e9p0A_KljGxRRxsSWNi1N8v62zh2G3gWEfHW2Cu89W2vBLi9EE5Q7dwz6rP7"
diff --git a/examples/zoomDemo.ur b/examples/zoomDemo.ur
@@ -1,4 +1,4 @@
-(* For this demo, it's necessary to create zoomSecrets.urs,
+(* For this demo, it's necessary to create zoomSecrets.ur,
  * defining [api_key] and [api_secret]. *)
 (*structure Z = Zoom.Make(Zoom.TwoLegged(ZoomSecrets))*)
 

diff --git a/src/ur/dropbox.ur b/src/ur/dropbox.ur
@@ -0,0 +1,118 @@
+open Json
+
+signature AUTH = sig
+    val token : transaction (option string)
+end
+
+functor TwoLegged(M : sig
+                      val token : string
+                  end) = struct
+    val token = return (Some M.token)
+end
+
+type file_request_id = string
+val file_request_id_eq = _
+val file_request_id_show = _
+val file_request_id_inj = _
+
+datatype grace_period =
+         OneDay
+       | TwoDays
+       | SevenDays
+       | ThirtyDays
+       | Always
+val _ : json grace_period = json_derived
+                            (fn x =>
+                                case x of
+                                    "one_day" => OneDay
+                                  | "two_days" => TwoDays
+                                  | "seven_days" => SevenDays
+                                  | "thirty_days" => ThirtyDays
+                                  | "always" => Always
+                                  | _ => error <xml>Bad Dropbox grace period {[x]}</xml>)
+                            (fn x =>
+                                case x of
+                                    OneDay => "one_day"
+                                  | TwoDays => "two_days"
+                                  | SevenDays => "seven_days"
+                                  | ThirtyDays => "thirty_days"
+                                  | Always => "always")
+
+type file_request_deadline = {
+     Deadline : time,
+     AllowLateUploads : option grace_period
+}
+val _ : json file_request_deadline = json_record_withOptional
+                                     {Deadline = "deadline"}
+                                     {AllowLateUploads = "allow_late_uploads"}
+
+type file_request_parameters = {
+     Title : string,
+     Destination : string,
+     Deadline : option file_request_deadline,
+     Open : bool,
+     Description : option string
+}
+val _ : json file_request_parameters = json_record_withOptional
+                                       {Title = "title",
+                                        Destination = "destination",
+                                        Open = "open"}
+                                       {Deadline = "deadline",
+                                        Description = "description"}
+
+type file_request = {
+     Id : file_request_id,
+     Url : string,
+     Title : string,
+     Created : time,
+     IsOpen : bool,
+     FileCount : int,
+     Destination : option string,
+     Deadline : option file_request_deadline,
+     Description : option string
+}
+val _ : json file_request = json_record_withOptional
+                            {Id = "id",
+                             Url = "url",
+                             Title = "title",
+                             Created = "created",
+                             IsOpen = "is_open",
+                             FileCount = "file_count"}
+                            {Destination = "destination",
+                             Deadline = "deadline",
+                             Description = "description"}
+
+functor Make(M : AUTH) = struct
+    open M
+
+    val token =
+        toko <- token;
+        case toko of
+            None => error <xml>You must be logged into Dropbox to use this feature.</xml>
+          | Some tok => return tok
+
+    val prefix = "https://api.dropboxapi.com/2/"
+
+    fun logged [a] (_ : show a) (t : transaction a) =
+        v <- t;
+        debug ("Dropbox response: " ^ show v);
+        return v
+
+    fun api url =
+        tok <- token;
+        logged (WorldFfi.get (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) False)
+
+    fun apiOpt url =
+        tok <- token;
+        logged (WorldFfi.getOpt (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) False)
+
+    fun apiPost url body =
+        tok <- token;
+        logged (WorldFfi.post (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) (Some "application/json") body)
+
+    structure FileRequests = struct
+        fun create p =
+            r <- apiPost "file_requests/create" (toJson p);
+            return (fromJson r)
+    end
+end
diff --git a/src/ur/dropbox.urs b/src/ur/dropbox.urs
@@ -0,0 +1,52 @@
+signature AUTH = sig
+    val token : transaction (option string)
+end
+
+functor TwoLegged(M : sig
+                      val token : string
+                  end) : sig
+    val token : transaction (option string)
+end
+
+type file_request_id
+val file_request_id_eq : eq file_request_id
+val file_request_id_show : show file_request_id
+val file_request_id_inj : sql_injectable_prim file_request_id
+
+datatype grace_period =
+         OneDay
+       | TwoDays
+       | SevenDays
+       | ThirtyDays
+       | Always
+
+type file_request_deadline = {
+     Deadline : time,
+     AllowLateUploads : option grace_period
+}
+
+type file_request_parameters = {
+     Title : string,
+     Destination : string,
+     Deadline : option file_request_deadline,
+     Open : bool,
+     Description : option string
+}
+
+type file_request = {
+     Id : file_request_id,
+     Url : string,
+     Title : string,
+     Created : time,
+     IsOpen : bool,
+     FileCount : int,
+     Destination : option string,
+     Deadline : option file_request_deadline,
+     Description : option string
+}
+
+functor Make(M : AUTH) : sig
+    structure FileRequests : sig
+        val create : file_request_parameters -> transaction file_request
+    end
+end
diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -15,6 +15,7 @@ urls
 oauth
 scopes
 clearbit
+dropbox
 github
 google
 hotcrp
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		val token = "sl.ArMQd_xwOsCUogNtfZriKxTOb78tokjfD6hM23YustyImp31vb6hrOOjbCpcFganZGjWvLwlWwo5e9p0A_KljGxRRxsSWNi1N8v62zh2G3gWEfHW2Cu89W2vBLi9EE5Q7dwz6rP7"
-Original file line number
+Diff line change
@@ Expand Up / @@ -15,6 +15,7 @@ urls @@
     oauth
     scopes
     clearbit
+    dropbox
     github
     google
     hotcrp
@@ Expand Down @@