]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/visionect/visionect.factor
mason: move alignment to mason.css, right align but-last columns in table body
[factor.git] / extra / visionect / visionect.factor
index e245e07c56c108956e6c74ae0483259bd6f9a934..61ba4cee47f4ad3899d6b3ef4ea5e17a18e355e8 100644 (file)
@@ -1,15 +1,15 @@
 ! Copyright (C) 2020 John Benediktsson
-! See http://factorcode.org/license.txt for BSD license
+! See https://factorcode.org/license.txt for BSD license
 
 USING: accessors assocs base64 calendar calendar.format
-checksums.hmac checksums.sha combinators combinators.smart
-formatting fry http http.client json.reader json.writer kernel
-locals make math.parser namespaces random sequences ;
+checksums.hmac checksums.sha combinators.smart formatting
+hex-strings http http.client json kernel make namespaces random
+sequences splitting ;
 
 IN: visionect
 
 SYMBOL: visionect-base-url
-visionect-base-url [ "http://localhost:8081" ] initialize
+visionect-base-url [ "https://localhost:8081" ] initialize
 
 SYMBOL: visionect-api-key
 
@@ -24,13 +24,13 @@ SYMBOL: visionect-api-secret
         [ "content-type" header ]
         [ "date" header ]
         [ url>> path>> ]
-    } cleave>array "\n" join
+    } cleave>array join-lines
     visionect-api-secret get sha-256 hmac-bytes >base64
     visionect-api-key get ":" rot 3append ;
 
 : set-visionect-headers ( request -- request )
-    now timestamp>http-string "date" set-header
-    dup visionect-authorization "authorization" set-header ;
+    now timestamp>http-string "Date" set-header
+    dup visionect-authorization "Authorization" set-header ;
 
 : visionect-request ( request -- data )
     set-visionect-headers http-request nip ;
@@ -48,7 +48,10 @@ SYMBOL: visionect-api-secret
     visionect-url <delete-request> visionect-request ;
 
 : visionect-post ( post-data path -- data )
-    visionect-url <post-request> visionect-request ;
+    visionect-url <post-request>
+    dup post-data>> dup post-data?
+    [ content-type>> "Content-Type" set-header ] [ drop ] if
+    visionect-request ;
 
 PRIVATE>
 
@@ -72,15 +75,17 @@ PRIVATE>
 : tclv-list ( uuid -- tclv )
     "/api/devicetclv/" prepend visionect-get "" like json> ;
 
-: get-tclv ( uuid type -- config )
-    [ "/api/cmd/Param/" prepend ] dip
-    "{\"Data\": [{\"Type\": %d, \"Control\": 0, \"Value\": \"\"}]}"
-    sprintf swap visionect-post "" like json> ;
+: get-tclv ( type uuid -- config )
+    [
+        "{\"Data\": [{\"Type\": %d, \"Control\": 0, \"Value\": \"\"}]}"
+        sprintf B{ } like "application/json" <post-data> swap >>data
+    ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
 
-: set-tclv ( uuid type value -- config )
-    [ "/api/cmd/Param/" prepend ] 2dip
-    "{\"Data\": [{\"Type\": %d, \"Control\": 1, \"Value\": \"%s\"}]}"
-    sprintf swap visionect-post "" like json> ;
+: set-tclv ( type value uuid -- config )
+    [
+        "{\"Data\": [{\"Type\": %d, \"Control\": 1, \"Value\": \"%s\"}]}"
+        sprintf B{ } like "application/json" <post-data> swap >>data
+    ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
 
 : reboot-device ( uuid -- )
     f swap "/api/device/" "/reboot" surround visionect-post drop ;
@@ -175,14 +180,11 @@ PRIVATE>
     "multipart/form-data; boundary=\"" boundary "\"" 3append :> content-type
     content-type <post-data>
     [
-        "--" % boundary % "\n" %
-        "Content-Disposition: form-data; name=\"image\"; filename=\"image.png\"\n" %
-        "Content-Type: image/png\n" %
-        "\n" %
-        png-data % "\n" %
-        "--" % boundary % "--\n" %
+        "--" % boundary % "\r\n" %
+        "Content-Disposition: form-data; name=\"image\"; filename=\"image.png\"\r\n" %
+        "Content-Type: image/png\r\n" %
+        "\r\n" %
+        png-data % "\r\n" %
+        "--" % boundary % "--\r\n" %
     ] B{ } make >>data
-    "/backend/" uuid append visionect-url
-    <post-request>
-    content-type "content-type" set-header
-    set-visionect-headers http-request 2drop ;
+    "/backend/" uuid append visionect-post drop ;