Zoom three-legged auth

urweb · Jun 20, 2020 · b64051c · b64051c
1 parent 87a2df1
commit b64051c
Show file tree

Hide file tree

Showing 4 changed files with 138 additions and 29 deletions.
diff --git a/examples/zoomDemo.ur b/examples/zoomDemo.ur
@@ -1,12 +1,21 @@
 (* For this demo, it's necessary to create zoomSecrets.urs,
  * defining [api_key] and [api_secret]. *)
-structure Z = Zoom.Make(Zoom.TwoLegged(ZoomSecrets))
+(*structure Z = Zoom.Make(Zoom.TwoLegged(ZoomSecrets))*)
+
+(* Here's an alternative authentication flow. *)
+structure A = Zoom.ThreeLegged(struct
+                                   open ZoomSecrets
+                                   val https = False
+                                   val onCompletion = return <xml>Done.</xml>
+                                   val scopes = Zoom.Scope.meetingWrite
+                               end)
+structure Z = Zoom.Make(A)
 
 fun meeting m =
     case m.Id of
         None => error <xml>Meeting has no ID!</xml>
       | Some id =>
-        r <- Z.CloudRecordings.get id;
+        (ro : option Zoom.recording) <- Z.CloudRecordings.get id;
         case (m.StartUrl, m.JoinUrl) of
             (Some start, Some join) =>
             return <xml><body>
@@ -15,10 +24,10 @@ fun meeting m =
               <h4><a href={bless start}>Start</a>, <a href={bless join}>Join</a></h4>
 
               <ul>
-                {case r.ShareUrl of
+                {case (r <- ro; r.ShareUrl) of
                      None => <xml></xml>
                    | Some u => <xml><li><a href={bless u}>[Share]</a></li></xml>}
-                {case r.RecordingFiles of
+                {case (r <- ro; r.RecordingFiles) of
                      None => <xml></xml>
                    | Some rfs =>
                      List.mapX (fn r => <xml><li>Recording of size {[r.FileSize]}
@@ -31,7 +40,7 @@ fun meeting m =
               </ul>
             </body></xml>
           | _ => error <xml>New meeting is missing URL to start or join.</xml>
-    
+
 fun create r =
     m <- Z.Meetings.create ({Topic = r.Topic,
                              Typ = Zoom.Scheduled}
@@ -42,21 +51,27 @@ fun create r =
     meeting m
 
 fun lookup id =
-    m <- Z.Meetings.get id;
-    meeting m
+    mo <- Z.Meetings.get id;
+    case mo of
+        None => error <xml>Missing meeting</xml>
+      | Some m => meeting m
 
 val main =
-    rs <- Z.Meetings.list;
-    return <xml><body>
-      <ul>
-        {List.mapX (fn r => <xml><li><a link={lookup (Option.get 0 r.Id)}>{[r.Topic]}</a> ({[r.StartTime]})</li></xml>) rs}
-      </ul>
-
-      <h3>Create Meeting</h3>
-
-      <form>
-        Topic: <textbox{#Topic}/><br/>
-        Starts: <textbox{#StartTime}/><br/>
-        <submit action={create}/>
-      </form>
-    </body></xml>
+    toko <- A.token;
+    case toko of
+        None => return <xml><body><a link={A.authorize}>Log into Zoom</a></body></xml>
+      | Some _ =>
+        rs <- Z.Meetings.list;
+        return <xml><body>
+          <ul>
+            {List.mapX (fn r => <xml><li><a link={lookup (Option.get 0 r.Id)}>{[r.Topic]}</a> ({[r.StartTime]})</li></xml>) rs}
+          </ul>
+
+          <h3>Create Meeting</h3>
+
+          <form>
+            Topic: <textbox{#Topic}/><br/>
+            Starts: <textbox{#StartTime}/><br/>
+            <submit action={create}/>
+          </form>
+        </body></xml>
diff --git a/examples/zoomDemo.urp b/examples/zoomDemo.urp
@@ -4,6 +4,7 @@ database dbname=zoomDemo
 sql zoomDemo.sql
 safeGetDefault
 allow url https://*
+prefix http://localhost:8080/
 
 zoomSecrets
 zoomDemo
diff --git a/src/ur/zoom.ur b/src/ur/zoom.ur
@@ -1,8 +1,20 @@
 open Json
 
-signature S = sig
-    val api_key : string
-    val api_secret : string
+structure Scope = struct
+    type t = Scopes.t [MeetingRead, MeetingWrite, WebinarRead, WebinarWrite]
+    val empty = Scopes.empty
+    val union = Scopes.union
+    val toString = Scopes.toString {MeetingRead = "meeting:read",
+                                    MeetingWrite = "meeting:write",
+                                    WebinarRead = "webinar:read",
+                                    WebinarWrite = "webinar:write"}
+
+    val meetingRead = Scopes.one [#MeetingRead]
+    val meetingWrite = Scopes.one [#MeetingWrite]
+    val webinarRead = Scopes.one [#WebinarRead]
+    val webinarWrite = Scopes.one [#WebinarWrite]
+
+    val readonly = Scopes.disjoint (union meetingWrite webinarWrite)
 end
 
 signature AUTH = sig
@@ -817,7 +829,10 @@ type jwt_response = {
 val _ : json jwt_response = json_record {AccessToken = "access_token",
                                          ExpiresIn = "expires_in"}
 
-functor TwoLegged(M : S) = struct
+functor TwoLegged(M : sig
+                      val api_key : string
+                      val api_secret : string
+                  end) = struct
     open M
 
     table mytoken : { Token : string,
@@ -849,3 +864,58 @@ functor TwoLegged(M : S) = struct
                  VALUES ({[token]}, {[exp]}));
             return (Some token)
 end
+
+functor ThreeLegged(M : sig
+                        val client_id : string
+                        val client_secret : string
+                        val https : bool
+
+                        val scopes : Scope.t
+                        val onCompletion : transaction page
+                    end) = struct
+    open M
+
+    table secrets : { Secret : int,
+                      Token : string,
+                      Expires : time }
+      PRIMARY KEY Secret
+
+    task periodic 60 = fn () =>
+                          tm <- now;
+                          dml (DELETE FROM secrets
+                               WHERE Expires < {[addSeconds tm (-60)]})
+
+    cookie user : int
+
+    fun withToken {Token = tok, Expiration = seconds, ...} =
+        case seconds of
+            None => error <xml>Missing token expiration in OAuth response</xml>
+          | Some seconds =>
+            secret <- rand;
+            tm <- now;
+            dml (INSERT INTO secrets(Secret, Token, Expires)
+                 VALUES ({[secret]}, {[tok]}, {[addSeconds tm (seconds * 3 / 4)]}));
+            setCookie user {Value = secret,
+                            Expires = None,
+                            Secure = https}
+
+    open Oauth.Make(struct
+                        open M
+
+                        val authorize_url = bless "https://api.zoom.us/oauth/authorize"
+                        val access_token_url = bless "https://api.zoom.us/oauth/token"
+
+                        val withToken = withToken
+                        val scope = Some (Scope.toString scopes)
+                    end)
+
+    val token =
+        c <- getCookie user;
+        case c of
+            None => return None
+          | Some n =>
+            oneOrNoRowsE1 (SELECT (secrets.Token)
+                           FROM secrets
+                           WHERE secrets.Secret = {[n]}
+                             AND secrets.Expires > CURRENT_TIMESTAMP)
+end
diff --git a/src/ur/zoom.urs b/src/ur/zoom.urs
@@ -1,13 +1,36 @@
-signature S = sig
-    val api_key : string
-    val api_secret : string
+structure Scope : sig
+    type t
+    val empty : t
+    val union : t -> t -> t
+    val readonly : t -> bool
+
+    val meetingRead : t
+    val meetingWrite : t
+    val webinarRead : t
+    val webinarWrite : t
 end
 
 signature AUTH = sig
     val token : transaction (option string)
 end
 
-functor TwoLegged(M : S) : AUTH
+functor TwoLegged(M : sig
+                      val api_key : string
+                      val api_secret : string
+                  end) : sig
+    val token : transaction (option string)
+end
+functor ThreeLegged(M : sig
+                        val client_id : string
+                        val client_secret : string
+                        val https : bool
+
+                        val scopes : Scope.t
+                        val onCompletion : transaction page
+                    end) : sig
+    val token : transaction (option string)
+    val authorize : transaction page
+end
 
 datatype meeting_type =
          Instant