InfluxDB (writing lines)

urweb · Aug 22, 2021 · ec34d5d · ec34d5d
1 parent eed7daa
commit ec34d5d
Show file tree

Hide file tree

Showing 10 changed files with 173 additions and 2 deletions.
diff --git a/examples/influxdbDemo.ur b/examples/influxdbDemo.ur
@@ -0,0 +1,26 @@
+(* For this demo, it's necessary to create influxdbSecrets.ur. *)
+structure I = Influxdb.Make(Influxdb.TwoLegged(InfluxdbSecrets))
+
+fun addRows () =
+    WorldFfi.allowHttp;
+    I.write {Precision = None}
+    ({Measurement = "test1",
+      Tags = ("tag1", "t1") :: ("tag2", "t2") :: [],
+      Fields = ("field1", "value1") :: ("field2", "uh\\oh\"!") :: [],
+      Timestamp = None}
+  :: {Measurement = "test1",
+      Tags = [],
+      Fields = ("field3", "value3") :: [],
+      Timestamp = Some 12345678}
+  :: {Measurement = "test1",
+      Tags = ("tag4", "t4") :: [],
+      Fields = ("field4", "yikes\nyowza") :: [],
+      Timestamp = None}
+  :: []);
+    return <xml><body>Done.</body></xml>
+
+fun main () = return <xml><body>
+  <form>
+    <submit action={addRows}/>
+  </form>
+</body></xml>
diff --git a/examples/influxdbDemo.urp b/examples/influxdbDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all InfluxdbDemo/*
+database dbname=influxdbDemo
+sql influxdbDemo.sql
+safeGetDefault
+allow url http://*
+allow url https://*
+
+influxdbSecrets
+influxdbDemo
diff --git a/examples/influxdbDemo.urs b/examples/influxdbDemo.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
diff --git a/examples/zenefitsDemo.ur b/examples/zenefitsDemo.ur
@@ -1,4 +1,4 @@
-(* For this demo, it's necessary to create zenefitsScrets.ur,
+(* For this demo, it's necessary to create zenefitsSecrets.ur,
  * defining [api_token]. *)
 structure Z = Zenefits.Make(Zenefits.TwoLegged(ZenefitsSecrets))
 

diff --git a/include/world.h b/include/world.h
@@ -17,3 +17,5 @@ uw_Basis_string uw_WorldFfi_post(uw_context, uw_Basis_string url, uw_Basis_strin
 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_unit uw_WorldFfi_allowHttp(uw_context);
diff --git a/src/c/world.c b/src/c/world.c
@@ -51,9 +51,16 @@ uw_Basis_int uw_WorldFfi_lastErrorCode(uw_context ctx) {
   else return 200;
 }
 
+static int allow_http = 0;
+
+uw_Basis_unit uw_WorldFfi_allowHttp(uw_context ctx) {
+  allow_http = 1;
+  return uw_unit_v;
+}
+
 // 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))
+  if (strncmp(url, "https://", 8) && (!allow_http || strncmp(url, "http://", 7)))
     uw_error(ctx, FATAL, "World: URL is not HTTPS");
 
   ctx_buffer cb = {ctx, buf};

diff --git a/src/ur/influxdb.ur b/src/ur/influxdb.ur
@@ -0,0 +1,97 @@
+open Json
+
+type params = {InfluxdbUrl : string,
+               Org : string,
+               Bucket : string,
+               ApiToken : string}
+val _ : json params = json_record {InfluxdbUrl = "InfluxdbUrl",
+                                   Org = "Org",
+                                   Bucket = "Bucket",
+                                   ApiToken = "ApiToken"}
+
+functor TwoLegged(M : sig
+                      val influxdb_url : string
+                      val org : string
+                      val bucket : string
+                      val api_token : string
+                    end) = struct
+    val token = return (Some (toJson {InfluxdbUrl = M.influxdb_url,
+                                      Org = M.org,
+                                      Bucket = M.bucket,
+                                      ApiToken = M.api_token}))
+end
+
+type line = {Measurement : string,
+             Tags : list (string * string),
+             Fields : list (string * string),
+             Timestamp : option int}
+type lines = list line
+
+datatype precision = S | Ms | Us | Ns
+val _ : show precision = mkShow (fn v =>
+                                    case v of
+                                        S => "s"
+                                      | Ms => "ms"
+                                      | Us => "us"
+                                      | Ns => "ns")
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) = struct
+    fun showId id =
+        if String.all (fn ch => Char.isAlnum ch || ch = #"_" || ch = #"-") id then
+            id
+        else
+            error <xml>Invalid InfluxDB identifier "{[id]}"</xml>
+
+    fun showLine line =
+        let
+            val s = showId line.Measurement
+            val s = List.foldl (fn (k, v) s =>
+                                   s ^ "," ^ showId k ^ "=" ^ toJson v)
+                               s line.Tags
+            val s = case line.Fields of
+                        [] => error <xml>InfluxDB line contains no fields.</xml>
+                      | (k, v) :: fs => List.foldl (fn (k, v) s =>
+                                                       s ^ "," ^ showId k ^ "=" ^ toJson v)
+                                                   (s ^ " " ^ showId k ^ "=" ^ toJson v) fs
+        in
+            case line.Timestamp of
+                None => s
+              | Some ts => s ^ " " ^ show ts
+        end
+
+    val showLines =
+        List.foldl (fn line s => s ^ showLine line ^ "\n") ""
+
+    fun url make =
+        params <- M.token;
+        case params of
+            None => error <xml>No InfluxDB token</xml>
+          | Some params =>
+            params <- return (fromJson params : params);
+            prefix <- return (if params.InfluxdbUrl <> ""
+                                 && String.sub params.InfluxdbUrl (String.length params.InfluxdbUrl - 1) = #"/" then
+                                  params.InfluxdbUrl ^ "api/v2/"
+                              else
+                                  params.InfluxdbUrl ^ "/api/v2/");
+            s <- return (make params);
+            return (params, bless (prefix ^ s))
+
+    fun post make body =
+        (params, url) <- url make;
+        debug ("  InfluxDB request to: " ^ show url);
+        debug ("InfluxDB request body: " ^ body);
+        Monad.ignore (WorldFfi.post url
+                                    (Some ("Token " ^ params.ApiToken))
+                                    (Some "text/plain; charset=utf-8")
+                                    body)
+
+    fun write settings lines =
+        post (fn params => "write?org=" ^ Urls.urlencode params.Org
+                           ^ "&bucket=" ^ Urls.urlencode params.Bucket
+                           ^ (case settings.Precision of
+                                  None => ""
+                                | Some prec => "&precision=" ^ show prec))
+             (showLines lines)
+end
diff --git a/src/ur/influxdb.urs b/src/ur/influxdb.urs
@@ -0,0 +1,25 @@
+functor TwoLegged(M : sig
+                      val influxdb_url : string (* Base URL you use to access this database on the web *)
+                      val org : string          (* Organization name *)
+                      val bucket : string       (* Bucket name *)
+                      val api_token : string
+                    end) : sig
+    val token : transaction (option string)
+end
+
+type line = {Measurement : string,
+             Tags : list (string * string),
+             Fields : list (string * string),
+             Timestamp : option int}
+type lines = list line
+(* Lists of string pairs are key-value associations.
+ * Keys (including measurement names) should only be alphanumeric, perhaps with "-" and "_". *)
+
+(* Unit of measure for timestamps *)
+datatype precision = S | Ms | Us | Ns
+
+functor Make(M : sig
+                 val token : transaction (option string)
+             end) : sig
+    val write : {Precision : option precision} -> lines -> transaction unit
+end
diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -19,6 +19,7 @@ dropbox
 github
 google
 hotcrp
+influxdb
 salesforce
 slack
 zoom

diff --git a/src/ur/worldFfi.urs b/src/ur/worldFfi.urs
@@ -17,3 +17,5 @@ val sign_rs256 : string (* key, in PEM format *)
 val sign_hs256 : string (* key, in PEM format *)
                  -> string (* message to sign *)
                  -> signatur
+
+val allowHttp : transaction unit
-Original file line number
+Diff line change
@@ Expand Up / @@ -19,6 +19,7 @@ dropbox @@
     github
     google
     hotcrp
+    influxdb
     salesforce
     slack
     zoom
@@ Expand Down @@