mirror of
https://github.com/urbit/shrub.git
synced 2024-12-02 08:55:07 +03:00
158 lines
3.7 KiB
Plaintext
158 lines
3.7 KiB
Plaintext
:: Pass-through Eyre driver
|
|
::
|
|
/- aquarium
|
|
=, aquarium
|
|
=> |%
|
|
+$ move (pair bone card)
|
|
+$ card
|
|
$% [%poke wire dock %aqua-events (list aqua-event)]
|
|
[%peer wire dock path]
|
|
[%pull wire dock ~]
|
|
[%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)]
|
|
==
|
|
::
|
|
+$ state
|
|
$: %0
|
|
subscribed=_|
|
|
piers=(map ship pier)
|
|
==
|
|
::
|
|
+$ pier http-requests=(set @ud)
|
|
--
|
|
=, gall
|
|
=| moves=(list move)
|
|
|_ $: bowl
|
|
state
|
|
==
|
|
++ this .
|
|
++ apex %_(this moves ~)
|
|
++ abet [(flop moves) this]
|
|
++ emit-moves
|
|
|= ms=(list move)
|
|
%_(this moves (weld ms moves))
|
|
::
|
|
++ emit-aqua-events
|
|
|= aes=(list aqua-event)
|
|
%- emit-moves
|
|
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
|
|
::
|
|
++ poke-aqua-vane-control
|
|
|= command=?(%subscribe %unsubscribe)
|
|
:_ this(subscribed =(command %subscribe))
|
|
(aqua-vane-control-handler our ost subscribed command)
|
|
::
|
|
++ diff-aqua-effects
|
|
|= [way=wire afs=aqua-effects]
|
|
^- (quip move _this)
|
|
=. this apex =< abet
|
|
|- ^+ this
|
|
?~ ufs.afs
|
|
this
|
|
=. this
|
|
?+ -.q.i.ufs.afs this
|
|
%sleep abet-pe:handle-sleep:(pe who.afs)
|
|
%restore abet-pe:handle-restore:(pe who.afs)
|
|
%thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs)
|
|
==
|
|
$(ufs.afs t.ufs.afs)
|
|
::
|
|
:: Received inbound HTTP response
|
|
::
|
|
++ sigh-httr
|
|
|= [way=wire res=httr:eyre]
|
|
^- (quip move _this)
|
|
=. this apex =< abet
|
|
?> ?=([@ *] way)
|
|
=/ who (,@p (slav %p i.way))
|
|
~& [%received-httr who]
|
|
abet-pe:(take-sigh-httr:(pe who) t.way res)
|
|
::
|
|
:: Received inbound HTTP response error
|
|
::
|
|
++ sigh-tang
|
|
|= [way=wire tan=tang]
|
|
^- (quip move _this)
|
|
=. this apex =< abet
|
|
?> ?=([@ *] way)
|
|
=/ who (,@p (slav %p i.way))
|
|
~& [%received-httr who]
|
|
abet-pe:(take-sigh-tang:(pe who) t.way tan)
|
|
::
|
|
++ pe
|
|
|= who=ship
|
|
=+ (~(gut by piers) who *pier)
|
|
=* pier-data -
|
|
|%
|
|
++ abet-pe
|
|
^+ this
|
|
=. piers (~(put by piers) who pier-data)
|
|
this
|
|
::
|
|
++ handle-sleep
|
|
^+ ..abet-pe
|
|
..abet-pe(pier-data *pier)
|
|
::
|
|
++ handle-restore
|
|
^+ ..abet-pe
|
|
=. this
|
|
%- emit-aqua-events
|
|
[%event who [//http/0v1n.2m9vh %born ~]]~
|
|
..abet-pe
|
|
::
|
|
++ handle-thus
|
|
|= [way=wire %thus num=@ud req=(unit hiss:eyre)]
|
|
^+ ..abet-pe
|
|
?~ req
|
|
?. (~(has in http-requests) num)
|
|
..abet-pe
|
|
:: Eyre doesn't support cancelling HTTP requests from userspace,
|
|
:: so we remove it from our state so we won't pass along the
|
|
:: response.
|
|
::
|
|
~& [who=who %aqua-eyre-cant-cancel-thus num=num]
|
|
=. http-requests (~(del in http-requests) num)
|
|
..abet-pe
|
|
~& [who=who %aqua-eyre-requesting u.req]
|
|
=. http-requests (~(put in http-requests) num)
|
|
=. this
|
|
%- emit-moves :_ ~
|
|
:* ost
|
|
%hiss
|
|
/(scot %p who)/(scot %ud num)
|
|
~
|
|
%httr
|
|
[%hiss u.req]
|
|
==
|
|
..abet-pe
|
|
::
|
|
:: Pass HTTP response back to virtual ship
|
|
::
|
|
++ take-sigh-httr
|
|
|= [way=wire res=httr:eyre]
|
|
^+ ..abet-pe
|
|
?> ?=([@ ~] way)
|
|
=/ num (slav %ud i.way)
|
|
?. (~(has in http-requests) num)
|
|
~& [who=who %ignoring-httr num=num]
|
|
..abet-pe
|
|
=. http-requests (~(del in http-requests) num)
|
|
=. this
|
|
(emit-aqua-events [%event who [//http/0v1n.2m9vh %receive num [%start [p.res q.res] r.res &]]]~)
|
|
..abet-pe
|
|
::
|
|
:: Got error in HTTP response
|
|
::
|
|
++ take-sigh-tang
|
|
|= [way=wire tan=tang]
|
|
^+ ..abet-pe
|
|
?> ?=([@ ~] way)
|
|
=/ num (slav %ud i.way)
|
|
?. (~(has in http-requests) num)
|
|
~& [who=who %ignoring-httr num=num]
|
|
..abet-pe
|
|
=. http-requests (~(del in http-requests) num)
|
|
%- (slog tan)
|
|
..abet-pe
|
|
--
|
|
--
|