Api and Zoom

urweb · Mar 23, 2020 · 3bb38f6 · 3bb38f6
1 parent 00c62bf
commit 3bb38f6
Show file tree

Hide file tree

Showing 15 changed files with 655 additions and 80 deletions.
diff --git a/examples/.gitignore b/examples/.gitignore
@@ -1,3 +1,4 @@
 basic_in.ur
 *.exe
 *.sql
+zoomSecrets.ur
diff --git a/examples/zoomDemo.ur b/examples/zoomDemo.ur
@@ -0,0 +1,29 @@
+(* For this demo, it's necessary to create zoomSecrets.urs,
+ * defining [api_key] and [api_secret]. *)
+structure Z = Zoom.Make(Zoom.TwoLegged(ZoomSecrets))
+
+fun main () =
+    rs <- Z.Meetings.list;
+    return <xml><body>
+      <ul>
+        {List.mapX (fn r => <xml><li>{[r.Topic]} ({[r.StartTime]}, {[case r.Typ of
+                                                                          Zoom.Scheduled => "scheduled"
+                                                                        | _ => "other"]})</li></xml>) rs}
+      </ul>
+
+      <h3>Create Meeting</h3>
+
+      <form>
+        Topic: <textbox{#Topic}/><br/>
+        Starts: <textbox{#StartTime}/><br/>
+        <submit action={create}/>
+      </form>
+    </body></xml>
+
+and create r =
+    Monad.ignore (Z.Meetings.create ({Topic = r.Topic,
+                                      Typ = Zoom.Scheduled}
+                                         ++ Api.optionals {StartTime = readError r.StartTime,
+                                                           Duration = 30,
+                                                           Settings = Api.optionals {Audio = Zoom.Voip}}));
+    redirect (url (main ()))
diff --git a/examples/zoomDemo.urp b/examples/zoomDemo.urp
@@ -0,0 +1,9 @@
+library ../src/ur
+rewrite all ZoomDemo/*
+database dbname=zoomDemo
+sql zoomDemo.sql
+safeGetDefault
+allow url https://api.zoom.us/*
+
+zoomSecrets
+zoomDemo
diff --git a/examples/zoomDemo.urs b/examples/zoomDemo.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/include/world.h b/include/world.h
@@ -7,7 +7,8 @@ typedef struct {
 
 uw_Basis_int uw_WorldFfi_length(uw_context, uw_WorldFfi_signatur);
 uw_Basis_char uw_WorldFfi_byte(uw_context, uw_WorldFfi_signatur, uw_Basis_int);
-uw_WorldFfi_signatur uw_WorldFfi_sign(uw_context, uw_Basis_string key, uw_Basis_string message);
+uw_WorldFfi_signatur uw_WorldFfi_sign_rs256(uw_context, uw_Basis_string key, uw_Basis_string message);
+uw_WorldFfi_signatur uw_WorldFfi_sign_hs256(uw_context, uw_Basis_string key, uw_Basis_string message);
 
 uw_Basis_int uw_WorldFfi_lastErrorCode(uw_context);
 uw_Basis_string uw_WorldFfi_get(uw_context, uw_Basis_string url, uw_Basis_string auth, uw_Basis_bool encode_errors);

diff --git a/src/c/world.c b/src/c/world.c
@@ -8,6 +8,7 @@
 #include <openssl/sha.h>
 #include <openssl/rsa.h>
 #include <openssl/pem.h>
+#include <openssl/hmac.h>
 
 #include <urweb.h>
 #include <world.h>
@@ -201,7 +202,7 @@ uw_Basis_char uw_WorldFfi_byte(uw_context ctx, uw_WorldFfi_signatur sig, uw_Basi
   return sig.bytes[i];
 }
 
-uw_WorldFfi_signatur uw_WorldFfi_sign(uw_context ctx, uw_Basis_string key, uw_Basis_string message) {
+uw_WorldFfi_signatur uw_WorldFfi_sign_rs256(uw_context ctx, uw_Basis_string key, uw_Basis_string message) {
   unsigned char digest[SHA256_DIGEST_LENGTH];
   uw_WorldFfi_signatur sig;
 
@@ -240,3 +241,15 @@ uw_WorldFfi_signatur uw_WorldFfi_sign(uw_context ctx, uw_Basis_string key, uw_Ba
   RSA_free(rsa);
   return sig;
 }
+
+uw_WorldFfi_signatur uw_WorldFfi_sign_hs256(uw_context ctx, uw_Basis_string key, uw_Basis_string message) {
+  uw_WorldFfi_signatur sig;
+
+  const EVP_MD *md = EVP_sha256();
+  sig.bytes = uw_malloc(ctx, EVP_MD_meth_get_result_size(md));
+  if (!HMAC(md, key, strlen(key), (unsigned char *)message, strlen(message),
+            (unsigned char *)sig.bytes, (unsigned int *)&sig.len))
+    uw_error(ctx, FATAL, "World: HMAC failed");
+
+  return sig;
+}
diff --git a/src/ur/api.ur b/src/ur/api.ur
@@ -0,0 +1,5 @@
+fun optionals [yes ::: {Type}] [no ::: {Type}] [yes ~ no]
+              (yfl : folder yes) (nfl : folder no)
+              (r : $yes) =
+    @mp [ident] [option] (fn [t] => Some) yfl r
+     ++ @map0 [option] (fn [t ::_] => None) nfl
diff --git a/src/ur/api.urs b/src/ur/api.urs
@@ -0,0 +1,4 @@
+val optionals : yes ::: {Type} -> no ::: {Type} -> [yes ~ no]
+                => folder yes -> folder no
+                -> $yes
+                -> $(map option (yes ++ no))
diff --git a/src/ur/google.ur b/src/ur/google.ur
@@ -619,78 +619,6 @@ functor CalendarThreeLegged(M : sig
         </xml>
 end
 
-fun base64url_encode' (getChar : int -> char) (len : int) =
-    let
-        fun char n =
-            String.str (Char.fromInt (if n < 0 then
-                                          error <xml>Negative character to base64 encode</xml>
-                                      else if n < 26 then
-                                          Char.toInt #"A" + n
-                                      else if n < 52 then
-                                          Char.toInt #"a" + (n - 26)
-                                      else if n < 62 then
-                                          Char.toInt #"0" + (n - 52)
-                                      else if n = 62 then
-                                          Char.toInt #"-"
-                                      else if n = 63 then
-                                          Char.toInt #"_"
-                                      else
-                                          error <xml>Invalid base64 digit</xml>))
-
-        fun ch j =
-            let
-                val n = Char.toInt (getChar j)
-            in
-                if n < 0 then
-                    n + 256
-                else
-                    n
-            end
-
-        fun bytes i acc =
-            if i >= len then
-                acc
-            else if i = len - 1 then
-                let
-                    val n = ch i * 16
-                in
-                    acc
-                    ^ char (n / 64)
-                    ^ char (n % 64)
-                    ^ "=="
-                end
-            else if i = len - 2 then
-                let
-                    val n1 = ch i
-                    val n2 = ch (i + 1)
-                    val n = n1 * (256 * 4) + n2 * 4
-                in
-                    acc
-                    ^ char (n / (64 * 64))
-                    ^ char (n / 64 % 64)
-                    ^ char (n % 64)
-                    ^ "="
-                end
-            else
-                let
-                    val n1 = ch i
-                    val n2 = ch (i + 1)
-                    val n3 = ch (i + 2)
-                    val n = n1 * (256 * 256) + n2 * 256 + n3
-                in
-                    bytes (i + 3) (acc
-                                   ^ char (n / (64 * 64 * 64))
-                                   ^ char (n / (64 * 64) % 64)
-                                   ^ char (n / 64 % 64)
-                                   ^ char (n % 64))
-                end
-    in
-        bytes 0 ""
-    end
-
-fun base64url_encode s = base64url_encode' (String.sub s) (String.length s)
-fun base64url_encode_signature s = base64url_encode' (WorldFfi.byte s) (WorldFfi.length s)
-
 type jwt_header = {
      Alg : string,
      Typ : string
@@ -752,9 +680,9 @@ functor CalendarTwoLegged(M : sig
                                      Aud = "https://oauth2.googleapis.com/token",
                                      Exp = toSeconds (addSeconds tm (60 * 60)),
                                      Iat = toSeconds tm});
-            header_clset <- return (base64url_encode header ^ "." ^ base64url_encode clset);
-            signed <- return (WorldFfi.sign private_key header_clset);
-            assertion <- return (header_clset ^ "." ^ base64url_encode_signature signed);
+            header_clset <- return (Urls.base64url_encode header ^ "." ^ Urls.base64url_encode clset);
+            signed <- return (WorldFfi.sign_rs256 private_key header_clset);
+            assertion <- return (header_clset ^ "." ^ Urls.base64url_encode_signature signed);
             resp <- WorldFfi.post (bless "https://oauth2.googleapis.com/token") None
                                   (Some "application/x-www-form-urlencoded")
                                   ("grant_type=urn%3Aietf%3Aparams%3Aoauth%3Agrant-type%3Ajwt-bearer&assertion=" ^ assertion);

diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -9,9 +9,12 @@ $/json
 $/monad
 $/option
 $/list
+$/datetime
+api
 urls
 oauth
 clearbit
 github
 google
 salesforce
+zoom
diff --git a/src/ur/urls.ur b/src/ur/urls.ur
@@ -51,3 +51,75 @@ fun urldecode s =
     in
         loop s ""
     end
+
+fun base64url_encode' (getChar : int -> char) (len : int) =
+    let
+        fun char n =
+            String.str (Char.fromInt (if n < 0 then
+                                          error <xml>Negative character to base64 encode</xml>
+                                      else if n < 26 then
+                                          Char.toInt #"A" + n
+                                      else if n < 52 then
+                                          Char.toInt #"a" + (n - 26)
+                                      else if n < 62 then
+                                          Char.toInt #"0" + (n - 52)
+                                      else if n = 62 then
+                                          Char.toInt #"-"
+                                      else if n = 63 then
+                                          Char.toInt #"_"
+                                      else
+                                          error <xml>Invalid base64 digit</xml>))
+
+        fun ch j =
+            let
+                val n = Char.toInt (getChar j)
+            in
+                if n < 0 then
+                    n + 256
+                else
+                    n
+            end
+
+        fun bytes i acc =
+            if i >= len then
+                acc
+            else if i = len - 1 then
+                let
+                    val n = ch i * 16
+                in
+                    acc
+                    ^ char (n / 64)
+                    ^ char (n % 64)
+                    ^ "=="
+                end
+            else if i = len - 2 then
+                let
+                    val n1 = ch i
+                    val n2 = ch (i + 1)
+                    val n = n1 * (256 * 4) + n2 * 4
+                in
+                    acc
+                    ^ char (n / (64 * 64))
+                    ^ char (n / 64 % 64)
+                    ^ char (n % 64)
+                    ^ "="
+                end
+            else
+                let
+                    val n1 = ch i
+                    val n2 = ch (i + 1)
+                    val n3 = ch (i + 2)
+                    val n = n1 * (256 * 256) + n2 * 256 + n3
+                in
+                    bytes (i + 3) (acc
+                                   ^ char (n / (64 * 64 * 64))
+                                   ^ char (n / (64 * 64) % 64)
+                                   ^ char (n / 64 % 64)
+                                   ^ char (n % 64))
+                end
+    in
+        bytes 0 ""
+    end
+
+fun base64url_encode s = base64url_encode' (String.sub s) (String.length s)
+fun base64url_encode_signature s = base64url_encode' (WorldFfi.byte s) (WorldFfi.length s)
diff --git a/src/ur/urls.urs b/src/ur/urls.urs
@@ -1,2 +1,5 @@
 val urlencode : string -> string
 val urldecode : string -> string
+
+val base64url_encode : string -> string
+val base64url_encode_signature : WorldFfi.signatur -> string
diff --git a/src/ur/worldFfi.urs b/src/ur/worldFfi.urs
@@ -9,6 +9,9 @@ type signatur
 val length : signatur -> int
 val byte : signatur -> int -> char
 
-val sign : string (* key, in PEM format *)
-           -> string (* message to sign *)
-           -> signatur
+val sign_rs256 : string (* key, in PEM format *)
+                 -> string (* message to sign *)
+                 -> signatur
+val sign_hs256 : string (* key, in PEM format *)
+                 -> string (* message to sign *)
+                 -> signatur