extra/visionect/visionect.factor

   1 ! Copyright (C) 2020 John Benediktsson
   2 ! See http://factorcode.org/license.txt for BSD license
   3
   4 USING: accessors assocs base64 calendar calendar.format
   5 checksums.hmac checksums.sha combinators.smart formatting http
   6 http.client json.reader json.writer kernel make math.parser
   7 namespaces random sequences splitting ;
   8
   9 IN: visionect
  10
  11 SYMBOL: visionect-base-url
  12 visionect-base-url [ "http://localhost:8081" ] initialize
  13
  14 SYMBOL: visionect-api-key
  15
  16 SYMBOL: visionect-api-secret
  17
  18 <PRIVATE
  19
  20 : visionect-authorization ( request -- auth )
  21     {
  22         [ method>> ]
  23         [ "content-sha256" header ]
  24         [ "content-type" header ]
  25         [ "date" header ]
  26         [ url>> path>> ]
  27     } cleave>array join-lines
  28     visionect-api-secret get sha-256 hmac-bytes >base64
  29     visionect-api-key get ":" rot 3append ;
  30
  31 : set-visionect-headers ( request -- request )
  32     now timestamp>http-string "Date" set-header
  33     dup visionect-authorization "Authorization" set-header ;
  34
  35 : visionect-request ( request -- data )
  36     set-visionect-headers http-request nip ;
  37
  38 : visionect-url ( path -- url )
  39     visionect-base-url get prepend ;
  40
  41 : visionect-get ( path -- data )
  42     visionect-url <get-request> visionect-request ;
  43
  44 : visionect-put ( post-data path -- data )
  45     visionect-url <put-request> visionect-request ;
  46
  47 : visionect-delete ( path -- data )
  48     visionect-url <delete-request> visionect-request ;
  49
  50 : visionect-post ( post-data path -- data )
  51     visionect-url <post-request>
  52     dup post-data>> dup post-data?
  53     [ content-type>> "Content-Type" set-header ] [ drop ] if
  54     visionect-request ;
  55
  56 PRIVATE>
  57
  58 ! ## DEVICES
  59
  60 : get-device ( uuid -- device )
  61     "/api/device/" prepend visionect-get "" like json> ;
  62
  63 : update-device ( device -- )
  64     dup "Uuid" of "/api/device/" prepend visionect-put drop ;
  65
  66 : remove-device ( uuid -- )
  67     "/api/device/" prepend visionect-delete drop ;
  68
  69 : all-devices ( -- devices )
  70     "/api/device/" visionect-get "" like json> ;
  71
  72 : update-devices ( devices -- )
  73     json> "/api/device/" visionect-put drop ;
  74
  75 : tclv-list ( uuid -- tclv )
  76     "/api/devicetclv/" prepend visionect-get "" like json> ;
  77
  78 : get-tclv ( type uuid -- config )
  79     [
  80         "{\"Data\": [{\"Type\": %d, \"Control\": 0, \"Value\": \"\"}]}"
  81         sprintf B{ } like "application/json" <post-data> swap >>data
  82     ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
  83
  84 : set-tclv ( type value uuid -- config )
  85     [
  86         "{\"Data\": [{\"Type\": %d, \"Control\": 1, \"Value\": \"%s\"}]}"
  87         sprintf B{ } like "application/json" <post-data> swap >>data
  88     ] dip "/api/cmd/Param/" prepend visionect-post "" like json> ;
  89
  90 : reboot-device ( uuid -- )
  91     f swap "/api/device/" "/reboot" surround visionect-post drop ;
  92
  93 : reboot-devices ( uuids -- )
  94     >json "/api/device/reboot" visionect-post drop ;
  95
  96 ! ## SESSIONS
  97
  98 : get-session ( uuid -- session )
  99     "/api/session/" prepend visionect-get "" like json> ;
 100
 101 : update-session ( session -- )
 102     dup "Uuid" of "/api/session/" prepend visionect-put drop ;
 103
 104 : remove-session ( uuid -- )
 105     "/api/session/" prepend visionect-delete drop ;
 106
 107 : all-sessions ( -- sessions )
 108     "/api/session/" visionect-get "" like json> ;
 109
 110 : create-session ( session -- )
 111     "/api/session/" visionect-post drop ;
 112
 113 : update-sessions ( sessions -- )
 114     >json "/api/session/" visionect-put drop ;
 115
 116 : restart-session ( uuid -- )
 117     "/api/session/" "/restart" surround visionect-get drop ;
 118
 119 : restart-sessions ( uuids -- )
 120     >json "/api/session/restart" visionect-post drop ;
 121
 122 ! ## USERS
 123
 124 : get-user ( username -- user )
 125     "/api/user/" prepend visionect-get "" like json> ;
 126
 127 : update-user ( user -- )
 128     dup "Username" of "/api/user/" prepend visionect-put drop ;
 129
 130 : remove-user ( username -- )
 131     "/api/user/" prepend visionect-delete drop ;
 132
 133 : all-users ( -- users )
 134     "/api/user/" visionect-get "" like json> ;
 135
 136 : create-user ( user -- )
 137     >json "/api/user/" visionect-post drop ;
 138
 139 : update-users ( users -- )
 140     >json "/api/user/" visionect-put drop ;
 141
 142 ! ## CONFIG
 143
 144 : get-config ( -- config )
 145     "/api/config/" visionect-get "" like json> ;
 146
 147 : update-config ( config -- )
 148     >json "/api/config/" visionect-put drop ;
 149
 150 ! ## LIVE VIEW
 151
 152 : live-view ( uuid cached? -- png )
 153     [ "/api/live/device/" ] 2dip
 154     "/cached.png" "/image.png" ? 3append
 155     visionect-get ;
 156
 157 ! ## DEVICE STATUS
 158
 159 : device-status ( uuid -- status )
 160     "/api/devicestatus/" prepend visionect-get "" like json> ;
 161
 162 : device-status-range ( uuid from to group? -- status )
 163     [ [ timestamp>unix-time ] bi@ ] [ "true" "false" ? ] bi*
 164     "%s?%s,%s,%s" sprintf device-status ;
 165
 166 ! ## BACKENDS
 167
 168 <PRIVATE
 169
 170 : choose-boundary ( data -- boundary )
 171     f swap '[
 172         drop 16 random-bytes bytes>hex-string
 173         dup _ subseq?
 174     ] loop ;
 175
 176 PRIVATE>
 177
 178 :: http-backend ( png-data uuid -- )
 179     png-data choose-boundary :> boundary
 180     "multipart/form-data; boundary=\"" boundary "\"" 3append :> content-type
 181     content-type <post-data>
 182     [
 183         "--" % boundary % "\r\n" %
 184         "Content-Disposition: form-data; name=\"image\"; filename=\"image.png\"\r\n" %
 185         "Content-Type: image/png\r\n" %
 186         "\r\n" %
 187         png-data % "\r\n" %
 188         "--" % boundary % "--\r\n" %
 189     ] B{ } make >>data
 190     "/backend/" uuid append visionect-post drop ;