1 ! Copyright (C) 2020 John Benediktsson
2 ! See http://factorcode.org/license.txt for BSD license
4 USING: accessors assocs base64 calendar calendar.format
5 checksums.hmac checksums.sha combinators combinators.smart
6 formatting fry http http.client json.reader json.writer kernel
7 locals make math.parser namespaces random sequences ;
11 SYMBOL: visionect-base-url
12 visionect-base-url [ "http://localhost:8081" ] initialize
14 SYMBOL: visionect-api-key
16 SYMBOL: visionect-api-secret
20 : visionect-authorization ( request -- auth )
23 [ "content-sha256" header ]
24 [ "content-type" header ]
27 } cleave>array "\n" join
28 visionect-api-secret get sha-256 hmac-bytes >base64
29 visionect-api-key get ":" rot 3append ;
31 : set-visionect-headers ( request -- request )
32 now timestamp>http-string "date" set-header
33 dup visionect-authorization "authorization" set-header ;
35 : visionect-request ( request -- data )
36 set-visionect-headers http-request nip ;
38 : visionect-url ( path -- url )
39 visionect-base-url get prepend ;
41 : visionect-get ( path -- data )
42 visionect-url <get-request> visionect-request ;
44 : visionect-put ( post-data path -- data )
45 visionect-url <put-request> visionect-request ;
47 : visionect-delete ( path -- data )
48 visionect-url <delete-request> visionect-request ;
50 : visionect-post ( post-data path -- data )
51 visionect-url <post-request>
52 dup post-data>> content-type>> "content-type" set-header
59 : get-device ( uuid -- device )
60 "/api/device/" prepend visionect-get "" like json> ;
62 : update-device ( device -- )
63 dup "Uuid" of "/api/device/" prepend visionect-put drop ;
65 : remove-device ( uuid -- )
66 "/api/device/" prepend visionect-delete drop ;
68 : all-devices ( -- devices )
69 "/api/device/" visionect-get "" like json> ;
71 : update-devices ( devices -- )
72 json> "/api/device/" visionect-put drop ;
74 : tclv-list ( uuid -- tclv )
75 "/api/devicetclv/" prepend visionect-get "" like json> ;
77 : get-tclv ( type uuid -- config )
79 "{\"Data\": [{\"Type\": %d, \"Control\": 0, \"Value\": \"\"}]}"
80 sprintf B{ } like "application/json" <post-data> swap >>data
81 ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
83 : set-tclv ( type value uuid -- config )
85 "{\"Data\": [{\"Type\": %d, \"Control\": 1, \"Value\": \"%s\"}]}"
86 sprintf B{ } like "application/json" <post-data> swap >>data
87 ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
89 : reboot-device ( uuid -- )
90 f swap "/api/device/" "/reboot" surround visionect-post drop ;
92 : reboot-devices ( uuids -- )
93 >json "/api/device/reboot" visionect-post drop ;
97 : get-session ( uuid -- session )
98 "/api/session/" prepend visionect-get "" like json> ;
100 : update-session ( session -- )
101 dup "Uuid" of "/api/session/" prepend visionect-put drop ;
103 : remove-session ( uuid -- )
104 "/api/session/" prepend visionect-delete drop ;
106 : all-sessions ( -- sessions )
107 "/api/session/" visionect-get "" like json> ;
109 : create-session ( session -- )
110 "/api/session/" visionect-post drop ;
112 : update-sessions ( sessions -- )
113 >json "/api/session/" visionect-put drop ;
115 : restart-session ( uuid -- )
116 "/api/session/" "/restart" surround visionect-get drop ;
118 : restart-sessions ( uuids -- )
119 >json "/api/session/restart" visionect-post drop ;
123 : get-user ( username -- user )
124 "/api/user/" prepend visionect-get "" like json> ;
126 : update-user ( user -- )
127 dup "Username" of "/api/user/" prepend visionect-put drop ;
129 : remove-user ( username -- )
130 "/api/user/" prepend visionect-delete drop ;
132 : all-users ( -- users )
133 "/api/user/" visionect-get "" like json> ;
135 : create-user ( user -- )
136 >json "/api/user/" visionect-post drop ;
138 : update-users ( users -- )
139 >json "/api/user/" visionect-put drop ;
143 : get-config ( -- config )
144 "/api/config/" visionect-get "" like json> ;
146 : update-config ( config -- )
147 >json "/api/config/" visionect-put drop ;
151 : live-view ( uuid cached? -- png )
152 [ "/api/live/device/" ] 2dip
153 "/cached.png" "/image.png" ? 3append
158 : device-status ( uuid -- status )
159 "/api/devicestatus/" prepend visionect-get "" like json> ;
161 : device-status-range ( uuid from to group? -- status )
162 [ [ timestamp>unix-time ] bi@ ] [ "true" "false" ? ] bi*
163 "%s?%s,%s,%s" sprintf device-status ;
169 : choose-boundary ( data -- boundary )
171 drop 16 random-bytes bytes>hex-string
177 :: http-backend ( png-data uuid -- )
178 png-data choose-boundary :> boundary
179 "multipart/form-data; boundary=\"" boundary "\"" 3append :> content-type
180 content-type <post-data>
182 "--" % boundary % "\n" %
183 "Content-Disposition: form-data; name=\"image\"; filename=\"image.png\"\n" %
184 "Content-Type: image/png\n" %
187 "--" % boundary % "--\n" %
189 "/backend/" uuid append visionect-post drop ;