Allow custom headers in web requests; fetching list of NetSuite tables

urweb · Jul 19, 2022 · 5793c56 · 5793c56
1 parent 048ebdd
commit 5793c56
Show file tree

Hide file tree

Showing 24 changed files with 712 additions and 61 deletions.
diff --git a/examples/netSuiteDemo.ur b/examples/netSuiteDemo.ur
@@ -0,0 +1,9 @@
+(* For this demo, it's necessary to create netSuiteSecrets.ur,
+ * defining [account_id], [consumer_key], [consumer_secret], [token_id], and [token_secret]. *)
+structure N = NetSuite.Make(NetSuite.TwoLegged(NetSuiteSecrets))
+
+fun main () =
+    md <- N.metadata;
+    return <xml><body>
+      <pre>{[md]}</pre>
+    </body></xml>
diff --git a/examples/netSuiteDemo.urp b/examples/netSuiteDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all NetSuiteDemo/*
+database dbname=netSuiteDemo
+sql netSuiteDemo.sql
+safeGetDefault
+allow url https://*
+prefix http://localhost:8080/
+
+netSuiteSecrets
+netSuiteDemo
diff --git a/examples/netSuiteDemo.urs b/examples/netSuiteDemo.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/include/world.h b/include/world.h
@@ -1,5 +1,10 @@
 #include <urweb.h>
 
+typedef struct uw_WorldFfi_headers *uw_WorldFfi_headers;
+
+const uw_WorldFfi_headers uw_WorldFfi_emptyHeaders;
+uw_WorldFfi_headers uw_WorldFfi_addHeader(uw_context, uw_WorldFfi_headers, uw_Basis_string header, uw_Basis_string value);
+
 typedef struct {
   int len;
   char *bytes;
@@ -12,11 +17,11 @@ uw_WorldFfi_signatur uw_WorldFfi_sign_hs256(uw_context, uw_Basis_string key, uw_
 uw_WorldFfi_signatur uw_WorldFfi_scrypt(uw_context, uw_Basis_string passwd, uw_Basis_string salt);
 
 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);
-uw_Basis_string uw_WorldFfi_getOpt(uw_context, uw_Basis_string url, uw_Basis_string auth, uw_Basis_bool encode_errors);
-uw_Basis_string uw_WorldFfi_post(uw_context, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body);
-uw_Basis_string uw_WorldFfi_put(uw_context, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body);
-uw_Basis_string uw_WorldFfi_delete(uw_context, uw_Basis_string url, uw_Basis_string auth);
-uw_Basis_string uw_WorldFfi_patch(uw_context, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body);
+uw_Basis_string uw_WorldFfi_get(uw_context, uw_Basis_string url, uw_WorldFfi_headers, uw_Basis_bool encode_errors);
+uw_Basis_string uw_WorldFfi_getOpt(uw_context, uw_Basis_string url, uw_WorldFfi_headers, uw_Basis_bool encode_errors);
+uw_Basis_string uw_WorldFfi_post(uw_context, uw_Basis_string url, uw_WorldFfi_headers, uw_Basis_string bodyContentType, uw_Basis_string body);
+uw_Basis_string uw_WorldFfi_put(uw_context, uw_Basis_string url, uw_WorldFfi_headers, uw_Basis_string bodyContentType, uw_Basis_string body);
+uw_Basis_string uw_WorldFfi_delete(uw_context, uw_Basis_string url, uw_WorldFfi_headers);
+uw_Basis_string uw_WorldFfi_patch(uw_context, uw_Basis_string url, uw_WorldFfi_headers, uw_Basis_string bodyContentType, uw_Basis_string body);
 
 uw_Basis_unit uw_WorldFfi_allowHttp(uw_context);
diff --git a/src/c/world.c b/src/c/world.c
@@ -60,6 +60,20 @@ uw_Basis_unit uw_WorldFfi_allowHttp(uw_context ctx) {
   return uw_unit_v;
 }
 
+typedef struct uw_WorldFfi_headers {
+  uw_Basis_string header, value;
+  struct uw_WorldFfi_headers *next;
+} *uw_WorldFfiHeaders;
+
+const uw_WorldFfi_headers emptyHeaders = NULL;
+uw_WorldFfi_headers uw_WorldFfi_addHeader(uw_context ctx, uw_WorldFfi_headers hs, uw_Basis_string header, uw_Basis_string value) {
+  uw_WorldFfiHeaders r = uw_malloc(ctx, sizeof(struct uw_WorldFfi_headers));
+  r->header = header;
+  r->value = value;
+  r->next = hs;
+  return r;
+}
+
 // Returns 1 on "not found".
 static int doweb(uw_context ctx, uw_buffer *buf, CURL *c, uw_Basis_string url, int encode_errors, int special_case_404) {
   if (strncmp(url, "https://", 8) && (!allow_http || strncmp(url, "http://", 7)))
@@ -114,7 +128,7 @@ static int doweb(uw_context ctx, uw_buffer *buf, CURL *c, uw_Basis_string url, i
   } 
 }
 
-static uw_Basis_string nonget(const char *verb, uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body) {
+static uw_Basis_string nonget(const char *verb, uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_string bodyContentType, uw_Basis_string body) {
   uw_buffer buf;
 
   uw_Basis_string lastUrl = uw_get_global(ctx, "world.lastUrl");
@@ -142,8 +156,8 @@ static uw_Basis_string nonget(const char *verb, uw_context ctx, uw_Basis_string
   struct curl_slist *slist = NULL;
   slist = curl_slist_append(slist, "User-Agent: Ur/Web World library");
 
-  if (auth) {
-    uw_Basis_string header = uw_Basis_strcat(ctx, "Authorization: ", auth);
+  for (; hs; hs = hs->next) {
+    uw_Basis_string header = uw_Basis_mstrcat(ctx, hs->header, ": ", hs->value, NULL);
     slist = curl_slist_append(slist, header);
   }
 
@@ -169,23 +183,23 @@ static uw_Basis_string nonget(const char *verb, uw_context ctx, uw_Basis_string
   return ret;
 }
 
-uw_Basis_string uw_WorldFfi_post(uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body) {
-  return nonget(NULL, ctx, url, auth, bodyContentType, body);
+uw_Basis_string uw_WorldFfi_post(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_string bodyContentType, uw_Basis_string body) {
+  return nonget(NULL, ctx, url, hs, bodyContentType, body);
 }
 
-uw_Basis_string uw_WorldFfi_put(uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body) {
-  return nonget("PUT", ctx, url, auth, bodyContentType, body);
+uw_Basis_string uw_WorldFfi_put(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_string bodyContentType, uw_Basis_string body) {
+  return nonget("PUT", ctx, url, hs, bodyContentType, body);
 }
 
-uw_Basis_string uw_WorldFfi_delete(uw_context ctx, uw_Basis_string url, uw_Basis_string auth) {
-  return nonget("DELETE", ctx, url, auth, NULL, NULL);
+uw_Basis_string uw_WorldFfi_delete(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs) {
+  return nonget("DELETE", ctx, url, hs, NULL, NULL);
 }
 
-uw_Basis_string uw_WorldFfi_patch(uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_string bodyContentType, uw_Basis_string body) {
-  return nonget("PATCH", ctx, url, auth, bodyContentType, body);
+uw_Basis_string uw_WorldFfi_patch(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_string bodyContentType, uw_Basis_string body) {
+  return nonget("PATCH", ctx, url, hs, bodyContentType, body);
 }
 
-uw_Basis_string uw_WorldFfi_get(uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_bool encode_errors) {
+uw_Basis_string uw_WorldFfi_get(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_bool encode_errors) {
   uw_buffer buf;
   CURL *c = curl(ctx);
 
@@ -194,8 +208,8 @@ uw_Basis_string uw_WorldFfi_get(uw_context ctx, uw_Basis_string url, uw_Basis_st
   struct curl_slist *slist = NULL;
   slist = curl_slist_append(slist, "User-Agent: Ur/Web World library");
 
-  if (auth) {
-    uw_Basis_string header = uw_Basis_strcat(ctx, "Authorization: ", auth);
+  for (; hs; hs = hs->next) {
+    uw_Basis_string header = uw_Basis_mstrcat(ctx, hs->header, ": ", hs->value, NULL);
     slist = curl_slist_append(slist, header);
   }
 
@@ -213,7 +227,7 @@ uw_Basis_string uw_WorldFfi_get(uw_context ctx, uw_Basis_string url, uw_Basis_st
   return ret;
 }
 
-uw_Basis_string uw_WorldFfi_getOpt(uw_context ctx, uw_Basis_string url, uw_Basis_string auth, uw_Basis_bool encode_errors) {
+uw_Basis_string uw_WorldFfi_getOpt(uw_context ctx, uw_Basis_string url, uw_WorldFfi_headers hs, uw_Basis_bool encode_errors) {
   uw_buffer buf;
   CURL *c = curl(ctx);
   uw_Basis_string ret;
@@ -223,8 +237,8 @@ uw_Basis_string uw_WorldFfi_getOpt(uw_context ctx, uw_Basis_string url, uw_Basis
   struct curl_slist *slist = NULL;
   slist = curl_slist_append(slist, "User-Agent: Ur/Web World library");
 
-  if (auth) {
-    uw_Basis_string header = uw_Basis_strcat(ctx, "Authorization: ", auth);
+  for (; hs; hs = hs->next) {
+    uw_Basis_string header = uw_Basis_mstrcat(ctx, hs->header, ": ", hs->value, NULL);
     slist = curl_slist_append(slist, header);
   }
 

diff --git a/src/ur/clearbit.ur b/src/ur/clearbit.ur
@@ -357,16 +357,16 @@ functor Make(M : sig
         case tok of
             Some tok => return tok
           | None => error <xml>How odd: no Clearbit token!</xml>
-         
+
     fun api url =
         tok <- token;
-        WorldFfi.get url (Some ("Bearer " ^ tok)) True
+        WorldFfi.get url (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) True
 
     fun addPart url key value =
         return (case value of
                     None => url
                   | Some value => url ^ "&" ^ key ^ "=" ^ urlencode value)
-        
+
     structure Person = struct
         fun lookup r =
             url <- return ("https://person.clearbit.com/v2/people/find?email=" ^ urlencode r.Email);

diff --git a/src/ur/dropbox.ur b/src/ur/dropbox.ur
@@ -276,7 +276,7 @@ functor Make(M : AUTH) = struct
 
     fun api url body =
         tok <- token;
-        logged (WorldFfi.post (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) (Some "application/json") body)
+        logged (WorldFfi.post (bless (prefix ^ url)) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) (Some "application/json") body)
 
     structure FileRequests = struct
         val list =

diff --git a/src/ur/github.ur b/src/ur/github.ur
@@ -58,7 +58,10 @@ functor Make(M : S) = struct
     open M
 
     fun updateProfile url tokOpt =
-        profile <- WorldFfi.get url (Option.mp (fn s => "token " ^ s) tokOpt) False;
+        profile <- WorldFfi.get url (case tokOpt of
+                                         None => WorldFfi.emptyHeaders
+                                       | Some tok =>
+                                         WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("token " ^ tok)) False;
         (profile : profile) <- return (Json.fromJson profile);
         exists <- oneRowE1 (SELECT COUNT( * ) > 0
                             FROM users

diff --git a/src/ur/google.ur b/src/ur/google.ur
@@ -100,7 +100,8 @@ functor TwoLegged(M : sig
             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
+            resp <- WorldFfi.post (bless "https://oauth2.googleapis.com/token")
+                                  WorldFfi.emptyHeaders
                                   (Some "application/x-www-form-urlencoded")
                                   ("grant_type=urn%3Aietf%3Aparams%3Aoauth%3Agrant-type%3Ajwt-bearer&assertion=" ^ assertion);
             resp <- return (fromJson resp : jwt_response);
@@ -152,7 +153,7 @@ functor ThreeLegged(M : sig
         (case hosted_domain of
              None => return ()
            | Some dom =>
-             s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses") (Some ("Bearer " ^ tok)) False;
+             s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses") (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) False;
              case (fromJson s : profile).EmailAddresses of
                  [] => error <xml>No e-mail addresses in Google profile.</xml>
                | {Value = addr} :: _ =>
@@ -571,7 +572,7 @@ functor Make(M : AUTH) = struct
             case addro of
                 Some addr => return (Some addr)
               | None =>
-                s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses") (Some ("Bearer " ^ tok)) False;
+                s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses") (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) False;
                 case (fromJson s : profile).EmailAddresses of
                     [] => error <xml>No e-mail addresses in Google profile.</xml>
                   | {Value = addr} :: _ =>
@@ -591,7 +592,7 @@ functor Make(M : AUTH) = struct
             case ro of
                 Some r => return (Some {EmailAddress = r.Email, DisplayName = r.DisplayName})
               | None =>
-                s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses,names") (Some ("Bearer " ^ tok)) False;
+                s <- WorldFfi.get (bless "https://people.googleapis.com/v1/people/me?personFields=emailAddresses,names") (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) False;
                 p <- return (fromJson s : profile);
                 case p.EmailAddresses of
                     [] => error <xml>No e-mail addresses in Google profile.</xml>
@@ -608,7 +609,7 @@ functor Make(M : AUTH) = struct
     fun api svc url =
         tok <- token;
         debug ("Google GET: " ^ show (api_url svc url));
-        s <- WorldFfi.get (api_url svc url) (Some ("Bearer " ^ tok)) False;
+        s <- WorldFfi.get (api_url svc url) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) False;
         debug ("Google response: " ^ s);
         return s
 
@@ -640,22 +641,22 @@ functor Make(M : AUTH) = struct
         tok <- token;
         debug ("Google POST: " ^ show (api_url svc url));
         debug ("Google request: " ^ body);
-        s <- WorldFfi.post (api_url svc url) (Some ("Bearer " ^ tok)) (Some "application/json") body;
+        s <- WorldFfi.post (api_url svc url) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) (Some "application/json") body;
         debug ("Google response: " ^ s);
         return s
 
     fun apiPut svc url body =
         tok <- token;
         debug ("Google PUT: " ^ show (api_url svc url));
         debug ("Google request: " ^ body);
-        s <- WorldFfi.put (api_url svc url) (Some ("Bearer " ^ tok)) (Some "application/json") body;
+        s <- WorldFfi.put (api_url svc url) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok)) (Some "application/json") body;
         debug ("Google response: " ^ s);
         return s
 
     fun apiDelete svc url =
         tok <- token;
         debug ("Google DELETE: " ^ show (api_url svc url));
-        s <- WorldFfi.delete (api_url svc url) (Some ("Bearer " ^ tok));
+        s <- WorldFfi.delete (api_url svc url) (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Bearer " ^ tok));
         debug ("Google response: " ^ s);
         return s
 

diff --git a/src/ur/influxdb.ur b/src/ur/influxdb.ur
@@ -83,7 +83,7 @@ functor Make(M : sig
         debug ("  InfluxDB request to: " ^ show url);
         debug ("InfluxDB request body: " ^ body);
         Monad.ignore (WorldFfi.post url
-                                    (Some ("Token " ^ params.ApiToken))
+                                    (WorldFfi.addHeader WorldFfi.emptyHeaders "Authorization" ("Token " ^ params.ApiToken))
                                     (Some "text/plain; charset=utf-8")
                                     body)
 

diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -15,6 +15,7 @@ api
 urls
 oauth
 scopes
+openAPI
 clearbit
 dropbox
 github
@@ -27,3 +28,4 @@ slack
 zoom
 openIdConnect
 zenefits
+netSuite