urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-11-29 14:57:12 +03:00
Code Issues Packages Projects Releases Wiki Activity

Move the http client functionality to %http-client.

Browse Source
This commit is contained in:
Elliot Glaysher 2019-02-08 13:16:42 -08:00
parent 8075a43380
commit 019cb0f8e7
7 changed files with 968 additions and 826 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lib/pill.hoon
View File

@ -14,6 +14,12 @@
:~ :: sys/zuse: standard library
::
[%$ /zuse]
:: sys/vane/http-client: http client
::
[%http-client /vane/http-client]
:: sys/vane/light: new web
::
[%l /vane/light]
:: sys/vane/ames: network
::
[%a /vane/ames]
@ -38,9 +44,6 @@
:: sys/vane/jael: security
::
[%j /vane/jael]
:: sys/vane/light: new web
::
[%l /vane/light]
==
|= [=term =path]
=/ pax (weld sys path)

4
sys/vane/gall.hoon
View File

@ -1,5 +1,6 @@
:: :: %gall, agent execution
!? 163
!:
::::
|= pit/vase
=, gall
@ -842,6 +843,7 @@
=^ tel vel (~(slot wa vel) 3 pec)
:_(+>.$ [%& sto %give %diff `cage`[-.q.pec tel]])
::
++ ap-move-connect
|= {sto/bone vax/vase}
^- {(each cove tang) _+>}
@ -863,7 +865,7 @@
:: TODO: Magic vase validation. I have no idea how malformed checking works.
::
:_ +>.$
[%& sto %give %http-response ((hard raw-http-response:light) q.vax)]
[%& sto %give %http-response ((hard http-event:http) q.vax)]
::
++ ap-move-hiss :: pass %hiss
~/ %hiss

316
sys/vane/http-client.hoon Normal file
View File

@ -0,0 +1,316 @@
!:
:: http-client
::
|= pit=vase
=, http-client
::
::
:: internal data structures
::
=> =~
::
:: internal data structures that won't go in zuse
::
|%
+$ move
::
$: :: duct: request identifier
::
=duct
::
::
card=(wind note gift:able)
==
:: +note: private request from light to another vane
::
+$ note _~
::
::
--
:: more structures
::
|%
+$ axle
$: :: date: date at which light's state was updated to this data structure
::
date=%~2019.2.8
::
::
=state
==
:: +state:client: state relating to open outbound HTTP connections
::
+$ state
$: :: next-id: monotonically increasing id number for the next connection
::
next-id=@ud
:: connection-by-id: open connections to the
::
connection-by-id=(map @ud [=duct =in-progress-http-request])
:: outbound-duct: the duct to send outbound requests on
::
outbound-duct=duct
==
:: +in-progress-http-request: state around an outbound http
::
+$ in-progress-http-request
$: :: remaining-redirects: http limit of number of redirects before error
::
remaining-redirects=@ud
:: remaining-retries: number of times to retry the request
::
remaining-retries=@ud
:: response-header: the response headers from the %start packet
::
:: We send the response headers with each %http-progress, so we must
:: save them.
::
response-header=(unit response-header:http)
:: chunks: a list of partial results returned from unix
::
:: This list of octs must be flopped before it is composed as the
:: final response, as we want to be able to quickly insert.
::
chunks=(list octs)
:: bytes-read: the sum of the size of the :chunks
::
bytes-read=@ud
:: expected-size: the expected content-length of the http request
::
expected-size=(unit @ud)
==
--
::
|%
:: +combine-octs: combine multiple octs into one
::
++ combine-octs
|= a=(list octs)
^- octs
:- %+ roll a
|= [=octs sum=@ud]
(add sum p.octs)
(can 3 a)
:: +per-client-event: per-event client core
::
++ per-client-event
|= [[our=@p eny=@ =duct now=@da scry=sley] =state]
|%
:: +request: makes an external web request
::
++ request
|= [=request:http =outbound-config]
^- [(list move) ^state]
:: get the next id for this request
::
=^ id next-id.state [next-id.state +(next-id.state)]
:: add a new open session
::
=. connection-by-id.state
%+ ~(put by connection-by-id.state) id
=, outbound-config
[duct [redirects retries ~ ~ 0 ~]]
:: start the download
::
:: the original eyre keeps track of the duct on %born and then sends a
:: %give on that duct. this seems like a weird inversion of
:: responsibility, where we should instead be doing a pass to unix. the
:: reason we need to manually build ids is because we aren't using the
:: built in duct system.
::
:: email discussions make it sound like fixing that might be hard, so
:: maybe i should just live with the way it is now?
::
:- [outbound-duct.state %give %request id request]~
state
:: +receive: receives a response to an http-request we made
::
:: TODO: Right now, we are not following redirect and not handling retries
:: correctly. We need to do this.
::
++ receive
|= [id=@ud =http-event:http]
^- [(list move) ^state]
:: ensure that this is a valid receive
::
?~ connection=(~(get by connection-by-id.state) id)
~& [%eyre-unknown-receive id]
[~ state]
::
?- -.http-event
%start
:: TODO: Handle redirects and retries here, before we start dispatching
:: back to the application.
::
:: record data from the http response that only comes from %start
::
=. connection-by-id.state
%+ ~(jab by connection-by-id.state) id
|= [duct=^duct =in-progress-http-request]
::
=. expected-size.in-progress-http-request
?~ str=(get-header:http 'content-length' headers.response-header.http-event)
~
::
(rush u.str dum:ag)
::
=. response-header.in-progress-http-request
`response-header:http-event
::
[duct in-progress-http-request]
::
?: complete.http-event
(send-finished id data.http-event)
::
(record-and-send-progress id data.http-event)
::
%continue
?: complete.http-event
(send-finished id data.http-event)
::
(record-and-send-progress id data.http-event)
::
%cancel
~& [%eyre-received-cancel id]
[~ state]
==
:: +record-and-send-progress: save incoming data and send progress report
::
++ record-and-send-progress
|= [id=@ud data=(unit octs)]
^- [(list move) ^state]
::
=. connection-by-id.state
%+ ~(jab by connection-by-id.state) id
|= [duct=^duct =in-progress-http-request]
:: record the data chunk and size, if it exists
::
=? chunks.in-progress-http-request
?=(^ data)
[u.data chunks.in-progress-http-request]
=? bytes-read.in-progress-http-request
?=(^ data)
(add bytes-read.in-progress-http-request p.u.data)
::
[duct in-progress-http-request]
::
=/ connection (~(got by connection-by-id.state) id)
:_ state
^- (list move)
:_ ~
:* duct.connection
%give
%progress
(need response-header.in-progress-http-request.connection)
bytes-read.in-progress-http-request.connection
expected-size.in-progress-http-request.connection
data
==
:: +send-finished: sends the %finished, cleans up the session state
::
++ send-finished
|= [id=@ud data=(unit octs)]
^- [(list move) ^state]
::
=/ connection (~(got by connection-by-id.state) id)
:: reassemble the octs that we've received into their final form
::
=/ data=octs
%- combine-octs
%- flop
::
?~ data
chunks.in-progress-http-request.connection
[u.data chunks.in-progress-http-request.connection]
::
=/ response-header=response-header:http
(need response-header.in-progress-http-request.connection)
::
=/ mime=@t
?~ mime-type=(get-header:http 'content-type' headers.response-header)
'application/octet-stream'
u.mime-type
:- :~ :* duct.connection
%give
%finished
response-header
?:(=(0 p.data) ~ `[mime data])
== ==
state(connection-by-id (~(del by connection-by-id.state) id))
--
--
:: end the =~
::
. ==
:: begin with a default +axle as a blank slate
::
=| ax=axle
:: a vane is activated with current date, entropy, and a namespace function
::
|= [our=ship now=@da eny=@uvJ scry-gate=sley]
:: allow jets to be registered within this core
::
~% %http-client ..is ~
|%
++ call
|= [=duct type=* wrapped-task=(hobo task:able)]
^- [(list move) _light-gate]
::
=/ task=task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
~| [%p-wrapped-task p.wrapped-task]
((hard task:able) p.wrapped-task)
::
=/ event-args [[our eny duct now scry-gate] state.ax]
=/ client (per-client-event event-args)
?- -.task
::
%born
~& %todo-http-client-born
:: TODO: reset the next-id for client state here.
::
:: send requests on the duct passed in with born.
::
=. outbound-duct.state.ax duct
[~ light-gate]
::
%request
=^ moves state.ax (request:client +.task)
[moves light-gate]
::
%cancel-request
~& %todo-cancel-request
[~ light-gate]
::
%receive
=^ moves state.ax (receive:client +.task)
[moves light-gate]
==
:: http-client issues no requests to other vanes
::
++ take
|= [=wire =duct wrapped-sign=*]
^- [(list move) _light-gate]
!!
::
++ light-gate ..$
:: +load: migrate old state to new state (called on vane reload)
::
++ load
|= old=axle
^+ ..^$
::
~! %loading
..^$(ax old)
:: +stay: produce current state
::
++ stay `axle`ax
:: +scry: request a path in the urbit namespace
::
++ scry
|= *
[~ ~]
--

429
sys/vane/light.hoon
View File

@ -115,7 +115,7 @@
:: We send the response headers with each %http-progress, so we must
:: save them.
::
response-headers=(unit http-response-header)
response-headers=(unit response-header:http)
:: chunks: a list of partial results returned from unix
::
:: This list of octs must be flopped before it is composed as the
@ -166,12 +166,9 @@
:: inbound-request: the original request which caused this connection
::
=inbound-request
:: code: the status code, if sent
:: response-header: set when we get our first %start
::
code=(unit @ud)
:: headers: the headers, if sent
::
headers=(unit header-list)
response-header=(unit response-header:http)
:: bytes-sent: the total bytes sent in response
::
bytes-sent=@ud
@ -657,19 +654,6 @@
?. =(i.prefix i.full)
%.n
$(prefix t.prefix, full t.full)
:: +get-header: returns the value for :header, if it exists in :header-list
::
++ get-header
|= [header=@t =header-list]
^- (unit @t)
::
?~ header-list
~
::
?: =(key.i.header-list header)
`value.i.header-list
::
$(header-list t.header-list)
:: +simplified-url-parser: returns [(each @if @t) (unit port=@ud)]
::
++ simplified-url-parser
@ -687,155 +671,6 @@
(easy ~)
==
==
:: +per-client-event: per-event client core
::
++ per-client-event
|= [[our=@p eny=@ =duct now=@da scry=sley] state=state:client]
|%
:: +request: makes an external web request
::
++ request
|= [=http-request =outbound-config]
^- [(list move) state:client]
:: get the next id for this request
::
=^ id next-id.state [next-id.state +(next-id.state)]
:: add a new open session
::
=. connection-by-id.state
%+ ~(put by connection-by-id.state) id
=, outbound-config
[duct [redirects retries ~ ~ 0 ~]]
:: start the download
::
:: the original eyre keeps track of the duct on %born and then sends a
:: %give on that duct. this seems like a weird inversion of
:: responsibility, where we should instead be doing a pass to unix. the
:: reason we need to manually build ids is because we aren't using the
:: built in duct system.
::
:: email discussions make it sound like fixing that might be hard, so
:: maybe i should just live with the way it is now?
::
:- [outbound-duct.state %give %http-client %request id http-request]~
state
:: +receive: receives a response to an http-request we made
::
:: TODO: Right now, we are not following redirect and not handling retries
:: correctly. We need to do this.
::
++ receive
|= [id=@ud =raw-http-response]
^- [(list move) state:client]
:: ensure that this is a valid receive
::
?~ connection=(~(get by connection-by-id.state) id)
~& [%eyre-unknown-receive id]
[~ state]
::
?- -.raw-http-response
%start
:: TODO: Handle redirects and retries here, before we start dispatching
:: back to the application.
::
:: record data from the http response that only comes from %start
::
=. connection-by-id.state
%+ ~(jab by connection-by-id.state) id
|= [duct=^duct =in-progress-http-request:client]
::
=. expected-size.in-progress-http-request
?~ str=(get-header 'content-length' headers.raw-http-response)
~
::
(rush u.str dum:ag)
::
=. response-headers.in-progress-http-request
`[status-code headers]:raw-http-response
::
[duct in-progress-http-request]
::
?: complete.raw-http-response
(send-finished id data.raw-http-response)
::
(record-and-send-progress id data.raw-http-response)
::
%continue
?: complete.raw-http-response
(send-finished id data.raw-http-response)
::
(record-and-send-progress id data.raw-http-response)
::
%cancel
~& [%eyre-received-cancel id]
[~ state]
==
:: +record-and-send-progress: save incoming data and send progress report
::
++ record-and-send-progress
|= [id=@ud data=(unit octs)]
^- [(list move) state:client]
::
=. connection-by-id.state
%+ ~(jab by connection-by-id.state) id
|= [duct=^duct =in-progress-http-request:client]
:: record the data chunk and size, if it exists
::
=? chunks.in-progress-http-request
?=(^ data)
[u.data chunks.in-progress-http-request]
=? bytes-read.in-progress-http-request
?=(^ data)
(add bytes-read.in-progress-http-request p.u.data)
::
[duct in-progress-http-request]
::
=/ connection (~(got by connection-by-id.state) id)
:_ state
^- (list move)
:_ ~
:* duct.connection
%give
%http-client
%progress
(need response-headers.in-progress-http-request.connection)
bytes-read.in-progress-http-request.connection
expected-size.in-progress-http-request.connection
data
==
:: +send-finished: sends the %finished, cleans up the session state
::
++ send-finished
|= [id=@ud data=(unit octs)]
^- [(list move) state:client]
::
=/ connection (~(got by connection-by-id.state) id)
:: reassemble the octs that we've received into their final form
::
=/ data=octs
%- combine-octs
%- flop
::
?~ data
chunks.in-progress-http-request.connection
[u.data chunks.in-progress-http-request.connection]
::
=/ response-headers=http-response-header
(need response-headers.in-progress-http-request.connection)
::
=/ mime=@t
?~ mime-type=(get-header 'content-type' headers.response-headers)
'application/octet-stream'
u.mime-type
:- :~ :* duct.connection
%give
%http-client
%finished
response-headers
?:(=(0 p.data) ~ `[mime data])
== ==
state(connection-by-id (~(del by connection-by-id.state) id))
--
:: +per-server-event: per-event server core
::
++ per-server-event
@ -846,17 +681,17 @@
:: +request: starts handling an inbound http request
::
++ request
|= [secure=? =address =http-request]
|= [secure=? =address =request:http]
^- [(list move) server-state]
::
=+ host=(get-header 'host' header-list.http-request)
=+ action=(get-action-for-binding host url.http-request)
=+ host=(get-header:http 'host' header-list.request)
=+ action=(get-action-for-binding host url.request)
::
=/ authenticated (request-is-logged-in:authentication http-request)
=/ authenticated (request-is-logged-in:authentication request)
:: record that we started an asynchronous response
::
=/ connection=outstanding-connection
[action [authenticated secure address http-request] ~ ~ 0]
[action [authenticated secure address request] ~ 0]
=. connections.state
(~(put by connections.state) duct connection)
::
@ -875,7 +710,7 @@
:: prelude with the arguments passed in.
::
[%$ %noun !>([[now=now eny=eny bek=[our desk.generator.action [%da now]]] ~ ~])]
[%$ %noun !>([authenticated http-request])]
[%$ %noun !>([authenticated request])]
::
%app
:_ state
@ -895,14 +730,14 @@
==
::
%authentication
(handle-request:authentication secure address http-request)
(handle-request:authentication secure address request)
::
%channel
(handle-request:by-channel secure authenticated address http-request)
(handle-request:by-channel secure authenticated address request)
::
%four-oh-four
%^ return-static-data-on-duct 404 'text/html'
(file-not-found-page url.http-request)
(file-not-found-page url.request)
==
:: +cancel-request: handles a request being externally aborted
::
@ -958,7 +793,7 @@
::
%- handle-response
:* %start
status-code=code
:- status-code=code
^= headers
:~ ['content-type' content-type]
['content-length' (crip (format-ud-as-integer p.data))]
@ -977,32 +812,32 @@
:: +handle-request: handles an http request for the
::
++ handle-request
|= [secure=? =address =http-request]
|= [secure=? =address =request:http]
^- [(list move) server-state]
::
:: if we received a simple get, just return the page
::
?: =('GET' method.http-request)
?: =('GET' method.request)
:: parse the arguments out of request uri
::
=+ request-line=(parse-request-line url.http-request)
=+ request-line=(parse-request-line url.request)
%^ return-static-data-on-duct 200 'text/html'
(login-page (get-header 'redirect' args.request-line))
(login-page (get-header:http 'redirect' args.request-line))
:: if we are not a post, return an error
::
?. =('POST' method.http-request)
?. =('POST' method.request)
(return-static-data-on-duct 400 'text/html' (login-page ~))
:: we are a post, and must process the body type as form data
::
?~ body.http-request
?~ body.request
(return-static-data-on-duct 400 'text/html' (login-page ~))
::
=/ parsed=(unit (list [key=@t value=@t]))
(rush q.u.body.http-request yquy:de-purl:html)
(rush q.u.body.request yquy:de-purl:html)
?~ parsed
(return-static-data-on-duct 400 'text/html' (login-page ~))
::
?~ password=(get-header 'password' u.parsed)
?~ password=(get-header:http 'password' u.parsed)
(return-static-data-on-duct 400 'text/html' (login-page ~))
:: check that the password is correct
::
@ -1026,13 +861,13 @@
"urbauth={<session>}; Path=/; Max-Age=86400"
::
=/ new-location=@t
?~ redirect=(get-header 'redirect' u.parsed)
?~ redirect=(get-header:http 'redirect' u.parsed)
'/'
u.redirect
::
%- handle-response
:* %start
status-code=307
:- status-code=307
^= headers
:~ ['location' new-location]
['set-cookie' cookie-line]
@ -1042,18 +877,18 @@
==
:: +request-is-logged-in: checks to see if the request is authenticated
::
:: We are considered logged in if this http-request has an urbauth
:: We are considered logged in if this request has an urbauth
:: Cookie which is not expired.
::
++ request-is-logged-in
|= =http-request
|= =request:http
^- ?
:: are there cookies passed with this request?
::
:: TODO: In HTTP2, the client is allowed to put multiple 'Cookie'
:: headers.
::
?~ cookie-header=(get-header 'cookie' header-list.http-request)
?~ cookie-header=(get-header:http 'cookie' header-list.request)
%.n
:: is the cookie line is valid?
::
@ -1061,7 +896,7 @@
%.n
:: is there an urbauth cookie?
::
?~ urbauth=(get-header 'urbauth' u.cookies)
?~ urbauth=(get-header:http 'urbauth' u.cookies)
%.n
:: is this formatted like a valid session cookie?
::
@ -1098,7 +933,7 @@
:: +handle-request: handles an http request for the subscription system
::
++ handle-request
|= [secure=? authenticated=? =address =http-request]
|= [secure=? authenticated=? =address =request:http]
^- [(list move) server-state]
:: if we're not authenticated error, but don't redirect.
::
@ -1110,16 +945,16 @@
:: TODO: Real 400 page.
::
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error authenticated url.http-request ~)
(internal-server-error authenticated url.request ~)
:: parse out the path key the subscription is on
::
=+ request-line=(parse-request-line url.http-request)
=+ request-line=(parse-request-line url.request)
?. ?=([@t @t @t ~] site.request-line)
~& %bad-request-line
:: url is not of the form '/~/channel/'
::
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error authenticated url.http-request ~)
(internal-server-error authenticated url.request ~)
:: channel-id: unique channel id parsed out of url
::
=+ channel-id=i.t.t.site.request-line
@ -1131,13 +966,13 @@
::
(return-static-data-on-duct 200 'application/javascript' channel-js)
::
?: =('PUT' method.http-request)
?: =('PUT' method.request)
:: PUT methods starts/modifies a channel, and returns a result immediately
::
(on-put-request channel-id http-request)
(on-put-request channel-id request)
::
?: =('GET' method.http-request)
(on-get-request channel-id http-request)
?: =('GET' method.request)
(on-get-request channel-id request)
::
~& %session-not-a-put
[~ state]
@ -1231,26 +1066,26 @@
:: client in text/event-stream format.
::
++ on-get-request
|= [channel-id=@t =http-request]
|= [channel-id=@t =request:http]
^- [(list move) server-state]
:: if there's no channel-id, we must 404
::
?~ maybe-channel=(~(get by session.channel-state.state) channel-id)
%^ return-static-data-on-duct 404 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: if there's already a duct listening to this channel, we must 400
::
?: ?=([%| *] state.u.maybe-channel)
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: when opening an event-stream, we must cancel our timeout timer
::
=. moves
[(cancel-timeout-move channel-id p.state.u.maybe-channel) moves]
:: the http-request may include a 'Last-Event-Id' header
:: the request may include a 'Last-Event-Id' header
::
=/ maybe-last-event-id=(unit @ud)
?~ maybe-raw-header=(get-header 'Last-Event-ID' header-list.http-request)
?~ maybe-raw-header=(get-header:http 'Last-Event-ID' header-list.request)
~
(rush u.maybe-raw-header dum:ag)
:: flush events older than the passed in 'Last-Event-ID'
@ -1274,7 +1109,8 @@
::
=^ http-moves state
%- handle-response
:* %start 200
:* %start
:- 200
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
@ -1312,32 +1148,32 @@
:: a set of commands in JSON format in the body of the message.
::
++ on-put-request
|= [channel-id=@t =http-request]
|= [channel-id=@t =request:http]
^- [(list move) server-state]
:: error when there's no body
::
?~ body.http-request
?~ body.request
~& %no-body
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: if the incoming body isn't json, this is a bad request, 400.
::
?~ maybe-json=(de-json:html q.u.body.http-request)
?~ maybe-json=(de-json:html q.u.body.request)
~& %no-json
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: parse the json into an array of +channel-request items
::
?~ maybe-requests=(parse-channel-request u.maybe-json)
~& [%no-parse u.maybe-json]
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: while weird, the request list could be empty
::
?: =(~ u.maybe-requests)
~& %empty-list
%^ return-static-data-on-duct 400 'text/html'
(internal-server-error %.y url.http-request ~)
(internal-server-error %.y url.request ~)
:: check for the existence of the channel-id
::
:: if we have no session, create a new one set to expire in
@ -1362,8 +1198,7 @@
=^ http-moves state
%- handle-response
:* %start
status-code=200
headers=~
[status-code=200 headers=~]
data=~
complete=%.y
==
@ -1499,8 +1334,10 @@
:: if a client is connected, send this event to them.
::
=? moves ?=([%| *] state.channel)
^- (list move)
:_ moves
:^ p.state.channel %give %http-server
:+ p.state.channel %give
^- gift:able:light
:* %response %continue
::
^= data
@ -1569,10 +1406,10 @@
%- handle-response
=/ result=mime ((hard mime) q.q.cage)
::
^- raw-http-response
^- http-event:http
:* %start
200
^- header-list
:- 200
^- header-list:http
:~ ['content-type' (en-mite:mimes:html p.result)]
['content-length' (crip (format-ud-as-integer p.q.result))]
==
@ -1587,7 +1424,7 @@
:: done with.
::
++ handle-response
|= =raw-http-response
|= =http-event:http
^- [(list move) server-state]
:: verify that this is a valid response on the duct
::
@ -1597,10 +1434,10 @@
::
|^ ^- [(list move) server-state]
::
?- -.raw-http-response
?- -.http-event
::
%start
?^ code.u.connection-state
?^ response-header.u.connection-state
~& [%http-multiple-start duct]
error-connection
::
@ -1608,28 +1445,27 @@
%+ ~(jab by connections.state) duct
|= connection=outstanding-connection
%_ connection
code `status-code.raw-http-response
headers `headers.raw-http-response
bytes-sent ?~(data.raw-http-response 0 p.u.data.raw-http-response)
response-header `response-header.http-event
bytes-sent ?~(data.http-event 0 p.u.data.http-event)
==
::
=? state complete.raw-http-response
=? state complete.http-event
log-complete-request
::
pass-response
::
%continue
?~ code.u.connection-state
?~ response-header.u.connection-state
~& [%http-continue-without-start duct]
error-connection
::
=. connections.state
%+ ~(jab by connections.state) duct
|= connection=outstanding-connection
=+ size=?~(data.raw-http-response 0 p.u.data.raw-http-response)
=+ size=?~(data.http-event 0 p.u.data.http-event)
connection(bytes-sent (add bytes-sent.connection size))
::
=? state complete.raw-http-response
=? state complete.http-event
log-complete-request
::
pass-response
@ -1642,7 +1478,7 @@
::
++ pass-response
^- [(list move) server-state]
[[duct %give %http-server %response raw-http-response]~ state]
[[duct %give %response http-event]~ state]
::
++ log-complete-request
:: todo: log the complete request
@ -1663,7 +1499,7 @@
:: respond to outside with %error
::
^- [(list move) server-state]
[[duct %give %http-server %response %cancel ~]~ state]
[[duct %give %response %cancel ~]~ state]
--
:: +add-binding: conditionally add a pairing between binding and action
::
@ -1676,7 +1512,7 @@
|-
^- [(list move) server-state]
?~ to-search
:- [duct %give %http-server %bound %.y binding]~
:- [duct %give %bound %.y binding]~
=. bindings.state
:: store in reverse alphabetical order so that longer paths are first
::
@ -1692,7 +1528,7 @@
state
::
?: =(binding binding.i.to-search)
:- [duct %give %http-server %bound %.n binding]~
:- [duct %give %bound %.n binding]~
state
::
$(to-search t.to-search)
@ -1796,11 +1632,9 @@
wrapped-task
~| [%p-wrapped-task p.wrapped-task]
((hard task:able) p.wrapped-task)
:: %init: tells us what our ship name is
::
?- -.task
:: %init: tells us what our ship name is
::
%init
?: ?=(%init -.task)
:: initial value for the login handler
::
=. bindings.server-state.ax
@ -1808,9 +1642,8 @@
[[~ /~/channel] duct [%channel ~]]
==
[~ light-gate]
:: %born: new unix process
::
%born
:: %born: new unix process
?: ?=(%born -.task)
::
~& [%todo-handle-born p.task]
:: TODO: reset the next-id for client state here.
@ -1843,72 +1676,72 @@
;: weld
:: hand back default configuration for now
::
[duct %give %http-server %set-config *http-config]~
[duct %give %set-config *http-config]~
::
closed-connections
==
:: all other commands operate on a per-server-event
::
::
::
%http-server
=/ event-args [[our eny duct now scry-gate] server-state.ax]
=/ server (per-server-event event-args)
?- -.server-task.task
::
:: %live: no idea what this is for
::
%live
::
~! task
~& [%todo-live server-task.task]
::
[~ light-gate]
::
%request
=^ moves server-state.ax (request:server +.server-task.task)
[moves light-gate]
::
%cancel-request
=^ moves server-state.ax cancel-request:server
[moves light-gate]
::
%connect
=^ moves server-state.ax
%+ add-binding:server binding.server-task.task
[%app app.server-task.task]
[moves light-gate]
::
%serve
=^ moves server-state.ax
%+ add-binding:server binding.server-task.task
[%gen generator.server-task.task]
[moves light-gate]
::
%disconnect
=. server-state.ax (remove-binding:server binding.server-task.task)
[~ light-gate]
==
=/ event-args [[our eny duct now scry-gate] server-state.ax]
=/ server (per-server-event event-args)
?- -.task
::
:: %live: no idea what this is for
::
::
%http-client
=/ event-args [[our eny duct now scry-gate] client-state.ax]
=/ client (per-client-event event-args)
?- -.client-task.task
%live
::
%request
=^ moves client-state.ax (request:client +.client-task.task)
[moves light-gate]
~& [%todo-live task]
::
%cancel-request
~& %todo-cancel-request
[~ light-gate]
::
%receive
=^ moves client-state.ax (receive:client +.client-task.task)
[moves light-gate]
==
[~ light-gate]
::
%request
=^ moves server-state.ax (request:server +.task)
[moves light-gate]
::
%cancel-request
=^ moves server-state.ax cancel-request:server
[moves light-gate]
::
%connect
=^ moves server-state.ax
%+ add-binding:server binding.task
[%app app.task]
[moves light-gate]
::
%serve
=^ moves server-state.ax
%+ add-binding:server binding.task
[%gen generator.task]
[moves light-gate]
::
%disconnect
=. server-state.ax (remove-binding:server binding.task)
[~ light-gate]
==
:: ::
:: ::
:: ::
:: %http-client
:: :: TODO: Move me.
:: ::
:: =/ event-args [[our eny duct now scry-gate] client-state.ax]
:: [~ light-gate]
:: =/ client (per-client-event event-args)
:: ?- -.client-task.task
:: ::
:: %request
:: =^ moves client-state.ax (request:client +.client-task.task)
:: [moves light-gate]
:: ::
:: %cancel-request
:: ~& %todo-cancel-request
:: [~ light-gate]
:: ::
:: %receive
:: =^ moves client-state.ax (receive:client +.client-task.task)
:: [moves light-gate]
:: ==
::==
::
++ take
|= [=wire =duct wrapped-sign=(hypo sign)]
@ -1940,7 +1773,7 @@
::
=/ event-args [[our eny duct now scry-gate] server-state.ax]
=/ handle-response handle-response:(per-server-event event-args)
=^ moves server-state.ax (handle-response raw-http-response.p.sign)
=^ moves server-state.ax (handle-response http-event.p.sign)
[moves light-gate]
::
++ run-build

354
sys/zuse.hoon
View File

@ -75,8 +75,6 @@
::
:: TODO: Rename to +mime once the current +mime and +mite are gone. The
::
+$ mime-data
[type=@t data=octs]
++ octs {p/@ud q/@t} :: octet-stream
++ sock {p/ship q/ship} :: outgoing [our his]
::+|
@ -183,6 +181,113 @@
==
--
:: ::::
:::: ++http ::
:: ::::
:: http: shared representations of http concepts
::
++ http ^?
|%
:: +header-list: an ordered list of http headers
::
+$ header-list
(list [key=@t value=@t])
:: +method: exhaustive list of http verbs
::
+$ method
$? %'CONNECT'
%'DELETE'
%'GET'
%'HEAD'
%'OPTIONS'
%'POST'
%'PUT'
%'TRACE'
==
:: +request: a single http request
::
+$ request
$: :: method: http method
::
method=method
:: url: the url requested
::
:: The url is not escaped. There is no escape.
::
url=@t
:: header-list: headers to pass with this request
::
=header-list
:: body: optionally, data to send with this request
::
body=(unit octs)
==
:: +response-header: the status code and header list on an http request
::
:: We separate these away from the body data because we may not wait for
:: the entire body before we send a %progress to the caller.
::
+$ response-header
$: :: status: http status code
::
status-code=@ud
:: headers: http headers
::
headers=header-list
==
:: +http-event: packetized http
::
:: Urbit treats Earth's HTTP servers as pipes, where Urbit sends or
:: receives one or more %http-events. The first of these will always be a
:: %start or an %error, and the last will always be %cancel or will have
:: :complete set to %.y to finish the connection.
::
:: Calculation of control headers such as 'Content-Length' or
:: 'Transfer-Encoding' should be performed at a higher level; this structure
:: is merely for what gets sent to or received from Earth.
::
+$ http-event
$% :: %start: the first packet in a response
::
$: %start
:: response-header: first event information
::
=response-header
:: data: data to pass to the pipe
::
data=(unit octs)
:: whether this completes the request
::
complete=?
==
:: %continue: every subsequent packet
::
$: %continue
:: data: data to pass to the pipe
::
data=(unit octs)
:: complete: whether this completes the request
::
complete=?
==
:: %cancel: represents unsuccessful termination
::
[%cancel ~]
==
:: +get-header: returns the value for :header, if it exists in :header-list
::
++ get-header
|= [header=@t =header-list]
^- (unit @t)
::
?~ header-list
~
::
?: =(key.i.header-list header)
`value.i.header-list
::
$(header-list t.header-list)
--
:: ::::
:::: ++ames :: (1a) network
:: ::::
++ ames ^?
@ -1711,7 +1816,7 @@
{$diff p/cage} :: subscription output
{$quit ~} :: close subscription
{$reap p/(unit tang)} :: peer result
[%http-response =raw-http-response:light] :: serve http result
[%http-response =http-event:http] :: serve http result
== ::
++ culm :: config action
$% {$load p/scup} :: load+reload
@ -1987,47 +2092,19 @@
-- :: rights
-- :: jael
::
::::
::
++ light ^?
++ http-client ^?
|%
+| %vane-interface
++ able
|%
:: +gift: %light responses
:: +gift: effects the client can emit
::
++ gift
$% [%http-server server-gift]
[%http-client client-gift]
==
:: +server-gift: effects the server can emit
::
++ server-gift
$% :: set-config: configures the external http server
::
:: TODO: We need to actually return a (map (unit @t) http-config)
:: so we can apply configurations on a per-site basis
::
[%set-config =http-config]
:: response: response to an event from earth
::
[%response =raw-http-response]
:: response to a %connect or %serve
::
:: :accepted is whether :binding was valid. Duplicate bindings are
:: not allowed.
::
[%bound accepted=? =binding]
==
:: +client-gift: effects the client can emit
::
++ client-gift
$% :: %request: outbound http-request to earth
::
:: TODO: id is sort of wrong for this interface; the duct should
:: be enough to identify which request we're talking about?
::
[%request id=@ud request=http-request]
[%request id=@ud request=request:http]
:: %cancel-request: tell earth to cancel a previous %request
::
[%cancel-request id=@ud]
@ -2039,7 +2116,7 @@
:: In case of a redirect chain, this is the target of the
:: final redirect.
::
=http-response-header
=response-header:http
:: bytes-read: bytes fetched so far
::
bytes-read=@ud
@ -2052,7 +2129,70 @@
==
:: final response of a download, parsed as mime-data if successful
::
[%finished =http-response-header full-file=(unit mime-data)]
[%finished =response-header:http full-file=(unit mime-data)]
==
::
++ task
$% :: system started up; reset open connections
::
[%born ~]
:: fetches a remote resource
::
[%request =request:http =outbound-config]
:: cancels a previous fetch
::
[%cancel-request ~]
:: receives http data from outside
::
[%receive id=@ud =http-event:http]
==
--
:: mime-data: externally received but unvalidated mimed data
::
+$ mime-data
[type=@t data=octs]
:: +outbound-config: configuration for outbound http requests
::
+$ outbound-config
$: :: number of times to follow a 300 redirect before erroring
::
:: Common values for this will be 3 (the limit most browsers use), 5
:: (the limit recommended by the http standard), or 0 (let the
:: requester deal with 300 redirects).
::
redirects=_5
:: number of times to retry before failing
::
:: When we retry, we'll automatically try to use the 'Range' header
:: to resume the download where we left off if we have the
:: 'Accept-Range: bytes' in the original response.
::
retries=_3
==
--
::
::::
::
++ light ^?
|%
++ able
|%
++ gift
$% :: set-config: configures the external http server
::
:: TODO: We need to actually return a (map (unit @t) http-config)
:: so we can apply configurations on a per-site basis
::
[%set-config =http-config]
:: response: response to an event from earth
::
[%response =http-event:http]
:: response to a %connect or %serve
::
:: :accepted is whether :binding was valid. Duplicate bindings are
:: not allowed.
::
[%bound accepted=? =binding]
==
::
++ task
@ -2064,21 +2204,12 @@
:: new unix process
::
[%born p=(list host)]
:: task for the http server
::
[%http-server =server-task]
:: task for the http client
::
[%http-client =client-task]
==
::
++ server-task
$% :: set http ports (?)
:: set http ports (?)
::
[%live p=@ud q=(unit @ud)]
:: starts handling an inbound http request
::
[%request secure=? =address =http-request]
[%request secure=? =address =request:http]
:: cancels a previous request
::
[%cancel-request ~]
@ -2096,20 +2227,7 @@
[%disconnect =binding]
==
::
++ client-task
$% :: fetches a remote resource
::
[%request =http-request =outbound-config]
:: cancels a previous fetch
::
[%cancel-request ~]
:: receives http data from outside
::
[%receive id=@ud =raw-http-response]
==
--
::
+| %bindings
:: +binding: A rule to match a path.
::
:: A +binding is a system unique mapping for a path to match. A +binding
@ -2146,9 +2264,6 @@
::
args=*
==
:: %config: http configuration
::
+| %config
:: +host: http host
::
+$ host
@ -2171,115 +2286,6 @@
::
redirect=?
==
:: +outbound-config: configuration for outbound http requests
::
+$ outbound-config
$: :: number of times to follow a 300 redirect before erroring
::
:: Common values for this will be 3 (the limit most browsers use), 5
:: (the limit recommended by the http standard), or 0 (let the
:: requester deal with 300 redirects).
::
redirects=_5
:: number of times to retry before failing
::
:: When we retry, we'll automatically try to use the 'Range' header
:: to resume the download where we left off if we have the
:: 'Accept-Range: bytes' in the original response.
::
retries=_3
==
::
+| %http
:: +header-list: an ordered list of http headers
::
+$ header-list
(list [key=@t value=@t])
:: +http-method: exhaustive list of http verbs
::
+$ http-method
$? %'CONNECT'
%'DELETE'
%'GET'
%'HEAD'
%'OPTIONS'
%'POST'
%'PUT'
%'TRACE'
==
:: +http-request: a single http-request
::
+$ http-request
$: :: http-method:
::
method=http-method
:: url: the url requested
::
:: The url is not escaped. There is no escape.
::
url=@t
:: header-list: headers to pass with this request
::
=header-list
:: body: optionally, data to send with this request
::
body=(unit octs)
==
:: +http-response: the status code and header list on an http request
::
:: We separate these away from the body data because we may not wait for
:: the entire body before we send a %progress to the caller.
::
+$ http-response-header
$: :: status: http status code
::
status-code=@ud
:: headers: http headers
::
headers=header-list
==
:: +raw-http-response: http-response to sent to earth
::
:: Urbit treats Earth's HTTP servers as pipes, where Urbit sends one or
:: more %http-response replies on the wire. The first of these will
:: always be a %start or an %error, and the last will always be %error
:: or will have :complete set to %.y to finish the connection.
::
:: Calculation of control headers such as 'Content-Length' or
:: 'Transfer-Encoding' should be performed at a higher level; this structure
:: is merely for what gets sent to Earth.
::
+$ raw-http-response
$% :: %start: the first packet in a response
::
$: %start
:: status: http status code
::
status-code=@ud
:: headers: http headers
::
headers=header-list
:: data: data to pass to the pipe
::
data=(unit octs)
:: whether this completes the request
::
complete=?
==
:: %continue: every subsequent packet
::
$: %continue
:: data: data to pass to the pipe
::
data=(unit octs)
:: complete: whether this completes the request
::
complete=?
==
:: %cancel: whether the connection should terminate unsuccessfully
::
[%cancel ~]
==
:: +address: client IP address
::
+$ address
@ -2299,9 +2305,9 @@
:: address: the source address of this request
::
=address
:: http-request: the http-request itself
:: request: the http-request itself
::
=http-request
=request:http
==
--
:: ::::

283
tests/sys/vane/http-client.hoon Normal file
View File

@ -0,0 +1,283 @@
/+ *test
::
/= http-client-raw /: /===/sys/vane/http-client /!noun/
::
!:
::
=/ test-pit=vase !>(..zuse)
=/ http-client-gate (http-client-raw test-pit)
::
|%
:: +test-client-request-basic: tests a single request, single reply style http request
::
++ test-client-request-basic
:: send a %born event to use /initial-born-duct for requests
::
=^ results1 http-client-gate
%- http-client-call :*
http-client-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
expected-moves=~
==
::
=/ request=request:http
:* %'GET'
'http://www.example.com'
~
~
==
:: opens the http channel
::
=^ results2 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s1)
scry=*sley
^= call-args
:* duct=~[/http-get-request] ~
%request
request
*outbound-config:http-client
==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/initial-born-duct]
%give
%request
id=0
method=%'GET'
url='http://www.example.com'
~
~
== == ==
:: returns the entire payload in one response
::
=^ results3 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s2)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:http-client
:* %receive
id=0
^- http-event:http
:* %start
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
::
complete=%.y
== ==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/http-get-request]
%give
%finished
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
:- 'text/html'
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
== == ==
::
;: weld
results1
results2
results3
==
:: +test-client-request-multiple-cards: tests when complete=%.n
::
++ test-client-request-multiple-cards
:: send a %born event to use /initial-born-duct for requests
::
=^ results1 http-client-gate
%- http-client-call :*
http-client-gate
now=~1111.1.1
scry=*sley
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
expected-moves=~
==
::
=/ request=request:http
:* %'GET'
'http://www.example.com'
~
~
==
:: opens the http channel
::
=^ results2 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s1)
scry=*sley
^= call-args
:* duct=~[/http-get-request] ~
%request
request
*outbound-config:http-client
==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/initial-born-duct]
%give
%request
id=0
method=%'GET'
url='http://www.example.com'
~
~
== == ==
:: returns the first 1/3 of the payload in the first response
::
=^ results3 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s2)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:http-client
:* %receive
id=0
^- http-event:http
:* %start
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
[~ (as-octs:mimes:html '<html><body>')]
complete=%.n
== ==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/http-get-request]
%give
%progress
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
bytes-read=12
expected-size=`34
[~ (as-octs:mimes:html '<html><body>')]
== == ==
:: returns the second 1/3 of the payload
::
=^ results4 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s3)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:http-client
:* %receive
id=0
^- http-event:http
:* %continue
[~ (as-octs:mimes:html 'Response')]
complete=%.n
== ==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/http-get-request]
%give
%progress
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
bytes-read=20
expected-size=`34
[~ (as-octs:mimes:html 'Response')]
== == ==
:: returns the last part
::
=^ results5 http-client-gate
%- http-client-call :*
http-client-gate
now=(add ~1111.1.1 ~s4)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:http-client
:* %receive
id=0
^- http-event:http
:* %continue
[~ (as-octs:mimes:html '</body></html>')]
complete=%.y
== ==
^= expected-moves
^- (list move:http-client-gate)
:~ :* duct=~[/http-get-request]
%give
%finished
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
:- 'text/html'
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
== == ==
::
;: weld
results1
results2
results3
results4
results5
==
::
++ http-client-call
|= $: http-client-gate=_http-client-gate
now=@da
scry=sley
call-args=[=duct type=* wrapped-task=(hobo task:able:http-client)]
expected-moves=(list move:http-client-gate)
==
^- [tang _http-client-gate]
::
=/ http-client-core
(http-client-gate our=~nul now=now eny=`@uvJ`0xdead.beef scry=scry)
::
=^ moves http-client-gate (call:http-client-core call-args)
::
=/ output=tang
%+ expect-eq
!> expected-moves
!> moves
::
[output http-client-gate]
--

399
tests/sys/vane/light.hoon
View File

@ -37,8 +37,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app2 tries to bind to the same path and fails
::
@ -47,8 +47,8 @@
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app2] ~ [%http-server %connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %http-server %bound %.n [~ /]]~
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.n [~ /]]~
==
::
;: weld
@ -74,8 +74,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app1 unbinds
::
@ -84,7 +84,7 @@
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %disconnect [~ /]]]
call-args=[duct=~[/app1] ~ [%disconnect [~ /]]]
expected-moves=~
==
:: app2 binds successfully
@ -94,8 +94,8 @@
light-gate
now=~1111.1.4
scry=*sley
call-args=[duct=~[/app2] ~ [%http-server %connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.y [~ /]]~
==
::
;: weld
@ -122,8 +122,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: app2 tries to steal the binding by disconnecting the path
::
@ -132,7 +132,7 @@
light-gate
now=~1111.1.3
scry=*sley
call-args=[duct=~[/app2] ~ [%http-server %disconnect [~ /]]]
call-args=[duct=~[/app2] ~ [%disconnect [~ /]]]
expected-moves=~
==
:: app2 doesn't bind successfully because it couldn't remove app1's binding
@ -142,8 +142,8 @@
light-gate
now=~1111.1.4
scry=*sley
call-args=[duct=~[/app2] ~ [%http-server %connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %http-server %bound %.n [~ /]]~
call-args=[duct=~[/app2] ~ [%connect [~ /] %app2]]
expected-moves=[duct=~[/app2] %give %bound %.n [~ /]]~
==
::
;: weld
@ -173,7 +173,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -183,10 +182,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-blah]
%give
%http-server
%response
%start
404
:- 404
:~ ['content-type' 'text/html']
['content-length' '153']
==
@ -217,8 +215,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: outside requests a path that app1 has bound to
::
@ -229,7 +227,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -270,15 +267,15 @@
^- (hypo sign:light-gate)
:- *type
:* %g %unto %http-response
%start 200
['content-type' 'text/html']~
%start
[200 ['content-type' 'text/html']~]
[~ (as-octs:mimes:html 'Hiya!')]
%.y
==
==
^= expected-move
:~ :* duct=~[/http-blah] %give %http-server %response
[%start 200 ['content-type' 'text/html']~ `[5 'Hiya!'] %.y]
:~ :* duct=~[/http-blah] %give %response
[%start [200 ['content-type' 'text/html']~] `[5 'Hiya!'] %.y]
== == ==
::
;: weld
@ -305,8 +302,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/app1] ~ [%connect [~ /] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /]]~
==
:: outside requests a path that app1 has bound to
::
@ -317,7 +314,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -357,14 +353,15 @@
:* wire=/run-app/app1 duct=~[/http-blah]
^- (hypo sign:light-gate) :- *type
:* %g %unto %http-response
%start 200 ['content-type' 'text/html']~
%start
[200 ['content-type' 'text/html']~]
[~ (as-octs:mimes:html 'Hi')]
%.n
==
==
^= expected-move
:~ :* duct=~[/http-blah] %give %http-server %response
[%start 200 ['content-type' 'text/html']~ `[2 'Hi'] %.n]
:~ :* duct=~[/http-blah] %give %response
[%start [200 ['content-type' 'text/html']~] `[2 'Hi'] %.n]
== == ==
:: theoretical outside response
::
@ -381,7 +378,7 @@
==
==
^= expected-move
:~ :* duct=~[/http-blah] %give %http-server %response
:~ :* duct=~[/http-blah] %give %response
[%continue `[3 'ya!'] %.y]
== == ==
::
@ -412,8 +409,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/app1] ~ [%http-server %connect [~ /'~landscape'] %app1]]
expected-moves=[duct=~[/app1] %give %http-server %bound %.y [~ /'~landscape']]~
call-args=[duct=~[/app1] ~ [%connect [~ /'~landscape'] %app1]]
expected-moves=[duct=~[/app1] %give %bound %.y [~ /'~landscape']]~
==
:: outside requests a path that app1 has bound to
::
@ -424,7 +421,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -464,12 +460,12 @@
:* wire=/run-app/app1 duct=~[/http-blah]
^- (hypo sign:light-gate) :- *type
:* %g %unto %http-response
[%start 307 ['location' '/~/login?redirect=/~landscape/inner-path']~ ~ %.y]
[%start [307 ['location' '/~/login?redirect=/~landscape/inner-path']~] ~ %.y]
==
==
^= expected-move
:~ :* duct=~[/http-blah] %give %http-server %response
[%start 307 ['location' '/~/login?redirect=/~landscape/inner-path']~ ~ %.y]
:~ :* duct=~[/http-blah] %give %response
[%start [307 ['location' '/~/login?redirect=/~landscape/inner-path']~] ~ %.y]
== == ==
:: the browser then fetches the login page
::
@ -489,7 +485,6 @@
^= call-args
^- [=duct type=* wrapped-task=(hobo task:able:light-gate)]
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -557,8 +552,8 @@
light-gate
now=~1111.1.2
scry=*sley
call-args=[duct=~[/gen1] ~ [%http-server %serve [~ /] [%home /gen/handler/hoon ~]]]
expected-moves=[duct=~[/gen1] %give %http-server %bound %.y [~ /]]~
call-args=[duct=~[/gen1] ~ [%serve [~ /] [%home /gen/handler/hoon ~]]]
expected-moves=[duct=~[/gen1] %give %bound %.y [~ /]]~
==
:: outside requests a path that app1 has bound to
::
@ -569,7 +564,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -626,9 +620,9 @@
[%cast %mime !>([['text' 'plain' ~] (as-octs:mimes:html 'one two three')])]
==
^= expected-move
:~ :* duct=~[/http-blah] %give %http-server %response
:~ :* duct=~[/http-blah] %give %response
:* %start
200
:- 200
:~ ['content-type' 'text/plain']
['content-length' '13']
==
@ -752,7 +746,7 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server %request
%request
%.n
[%ipv4 .192.168.1.1]
[%'PUT' '/~/channel/1234567890abcdef' ~ ~]
@ -761,10 +755,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-blah]
%give
%http-server
%response
%start
400
:- 400
:~ ['content-type' 'text/html']
['content-length' '206']
==
@ -876,7 +869,6 @@
scry=*sley
^= call-args
:* duct=~[/http-get-open] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -889,10 +881,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-get-open]
%give
%http-server
%response
%start
200
:- 200
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
@ -928,7 +919,7 @@
light-gate
now=(add ~1111.1.2 ~m4)
scry=*sley
call-args=[duct=~[/http-get-open] ~ %http-server %cancel-request ~]
call-args=[duct=~[/http-get-open] ~ %cancel-request ~]
^= expected-moves
^- (list move:light-gate)
:: closing the channel restarts the timeout timer
@ -966,7 +957,6 @@
scry=*sley
^= call-args
:* duct=~[/http-put-request] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1001,7 +991,7 @@
card.i.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %http-server %response %start 200 ~ ~ %.y]
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> i.t.moves
::
%+ expect-eq
@ -1079,7 +1069,6 @@
scry=*sley
^= call-args
:* duct=~[/http-get-open] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1092,10 +1081,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-get-open]
%give
%http-server
%response
%start
200
:- 200
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
@ -1138,7 +1126,6 @@
^- (list move:light-gate)
:~ :* duct=~[/http-get-open]
%give
%http-server
%response
%continue
:- ~
@ -1162,7 +1149,6 @@
scry=*sley
^= call-args
:* duct=~[/http-put-request] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1186,7 +1172,7 @@
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
%+ expect-eq
!> [~[/http-put-request] %give %http-server %response %start 200 ~ ~ %.y]
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> i.moves
==
:: the client connection is detected to be broken
@ -1196,7 +1182,7 @@
light-gate
now=(add ~1111.1.2 ~m6)
scry=*sley
call-args=[duct=~[/http-get-open] ~ %http-server %cancel-request ~]
call-args=[duct=~[/http-get-open] ~ %cancel-request ~]
^= expected-moves
^- (list move:light-gate)
:: closing the channel restarts the timeout timer
@ -1233,7 +1219,6 @@
scry=*sley
^= call-args
:* duct=~[/http-get-open] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1246,10 +1231,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-get-open]
%give
%http-server
%response
%start
200
:- 200
:~ ['content-type' 'text/event-stream']
['cache-control' 'no-cache']
['connection' 'keep-alive']
@ -1289,286 +1273,6 @@
results8
results9
==
:: +test-client-request-basic: tests a single request, single reply style http request
::
++ test-client-request-basic
:: send a %born event to use /initial-born-duct for requests
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
^= call-args
:* duct=~[/initial-born-duct] ~
%born
[[%.n .192.168.1.1] ~]
==
^= expected-moves
:~ :* duct=~[/initial-born-duct]
%give
%http-server
%set-config
*http-config:light
== == ==
::
=/ request=http-request:light
:* %'GET'
'http://www.example.com'
~
~
==
:: opens the http channel
::
=^ results2 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s1)
scry=*sley
^= call-args
:* duct=~[/http-get-request] ~
%http-client
%request
request
*outbound-config:light
==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/initial-born-duct]
%give
%http-client
%request
id=0
method=%'GET'
url='http://www.example.com'
~
~
== == ==
:: returns the entire payload in one response
::
=^ results3 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s2)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:light
:* %http-client
%receive
id=0
^- raw-http-response:light
:* %start
200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
::
complete=%.y
== ==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/http-get-request]
%give
%http-client
%finished
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
:- 'text/html'
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
== == ==
::
;: weld
results1
results2
results3
==
:: +test-client-request-multiple-cards: tests when complete=%.n
::
++ test-client-request-multiple-cards
:: send a %born event to use /initial-born-duct for requests
::
=^ results1 light-gate
%- light-call :*
light-gate
now=~1111.1.1
scry=*sley
^= call-args
:* duct=~[/initial-born-duct] ~
%born
[[%.n .192.168.1.1] ~]
==
^= expected-moves
:~ :* duct=~[/initial-born-duct]
%give
%http-server
%set-config
*http-config:light
== == ==
::
=/ request=http-request:light
:* %'GET'
'http://www.example.com'
~
~
==
:: opens the http channel
::
=^ results2 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s1)
scry=*sley
^= call-args
:* duct=~[/http-get-request] ~
%http-client
%request
request
*outbound-config:light
==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/initial-born-duct]
%give
%http-client
%request
id=0
method=%'GET'
url='http://www.example.com'
~
~
== == ==
:: returns the first 1/3 of the payload in the first response
::
=^ results3 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s2)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:light
:* %http-client
%receive
id=0
^- raw-http-response:light
:* %start
200
:~ ['content-type' 'text/html']
['content-length' '34']
==
[~ (as-octs:mimes:html '<html><body>')]
complete=%.n
== ==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/http-get-request]
%give
%http-client
%progress
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
bytes-read=12
expected-size=`34
[~ (as-octs:mimes:html '<html><body>')]
== == ==
:: returns the second 1/3 of the payload
::
=^ results4 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s3)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:light
:* %http-client
%receive
id=0
^- raw-http-response:light
:* %continue
[~ (as-octs:mimes:html 'Response')]
complete=%.n
== ==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/http-get-request]
%give
%http-client
%progress
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
bytes-read=20
expected-size=`34
[~ (as-octs:mimes:html 'Response')]
== == ==
:: returns the last part
::
=^ results5 light-gate
%- light-call :*
light-gate
now=(add ~1111.1.1 ~s4)
scry=*sley
^= call-args
:+ duct=~[/initial-born-duct] ~
^- task:able:light
:* %http-client
%receive
id=0
^- raw-http-response:light
:* %continue
[~ (as-octs:mimes:html '</body></html>')]
complete=%.y
== ==
^= expected-moves
^- (list move:light-gate)
:~ :* duct=~[/http-get-request]
%give
%http-client
%finished
::
:- 200
:~ ['content-type' 'text/html']
['content-length' '34']
==
::
:- ~
:- 'text/html'
%- as-octs:mimes:html
'''
<html><body>Response</body></html>
'''
== == ==
::
;: weld
results1
results2
results3
results4
results5
==
::
++ light-call
|= $: light-gate=_light-gate
@ -1727,7 +1431,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1737,10 +1440,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-blah]
%give
%http-server
%response
%start
200
:- 200
:~ ['content-type' 'text/html']
['content-length' '348']
==
@ -1757,7 +1459,6 @@
scry=*sley
^= call-args
:* duct=~[/http-blah] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1772,10 +1473,9 @@
^- (list move:light-gate)
:~ :* duct=~[/http-blah]
%give
%http-server
%response
%start
307
:- 307
:~ ['location' '/~landscape']
:- 'set-cookie'
'urbauth=0v3.q0p7t.mlkkq.cqtto.p0nvi.2ieea; Path=/; Max-Age=86400'
@ -1820,7 +1520,6 @@
scry=*sley
^= call-args
:* duct=~[/http-put-request] ~
%http-server
%request
%.n
[%ipv4 .192.168.1.1]
@ -1868,7 +1567,7 @@
card.i.t.moves
::
%+ expect-eq
!> [~[/http-put-request] %give %http-server %response %start 200 ~ ~ %.y]
!> [~[/http-put-request] %give %response %start [200 ~] ~ %.y]
!> i.t.t.moves
::
%+ expect-eq