urbit/pkg/arvo/sys/vane/behn.hoon
Philip Monk b8903e9a6f
gall: fix ap-kill-down
This broke when %kick was handled by resubscribing on your own ship
because it processed the %kick before the %leave.  For example, `@t`404
at the dojo would put the dojo in an unworkable state.

You want the %leave to be processed first because you can't do a
"resubscribe" in response to that.
2019-11-20 13:24:19 -08:00

306 lines
8.4 KiB
Plaintext

:: %behn, just a timer
!:
!? 164
::
=, behn
|= pit=vase
=> |%
+$ move [p=duct q=(wind note gift:able)]
+$ note :: out request $->
$~ [%b %wait *@da] ::
$% $: %b :: to self
$>(%wait task:able) :: set timer
== ::
$: %d :: to %dill
$>(%flog task:able:dill) :: log output
== == ::
+$ sign
$~ [%b %wake ~]
$% [%b $>(%wake gift:able)]
==
::
+$ behn-state
$: timers=(list timer)
unix-duct=duct
next-wake=(unit @da)
drips=drip-manager
==
::
+$ drip-manager
$: count=@ud
movs=(map @ud vase)
==
::
+$ timer [date=@da =duct]
--
::
=> |%
++ per-event
=| moves=(list move)
|= [[our=ship now=@da =duct] state=behn-state]
::
|%
:: %entry-points
::
:: +born: urbit restarted; refresh :next-wake and store wakeup timer duct
::
++ born set-unix-wake(next-wake.state ~, unix-duct.state duct)
:: +crud: handle failure of previous arvo event
::
++ crud
|= [tag=@tas error=tang]
^+ [moves state]
:: behn must get activated before other vanes in a %wake
::
:: TODO: uncomment this case after switching %crud tags
::
:: We don't know how to handle other errors, so relay them to %dill
:: to be printed and don't treat them as timer failures.
::
:: ?. =(%wake tag)
:: ~& %behn-crud-not-first-activation^tag
:: [[duct %slip %d %flog %crud tag error]~ state]
::
?: =(~ timers.state) ~| %behn-crud-no-timer^tag^error !!
::
(wake `error)
:: +rest: cancel the timer at :date, then adjust unix wakeup
:: +wait: set a new timer at :date, then adjust unix wakeup
::
++ rest |=(date=@da set-unix-wake(timers.state (unset-timer [date duct])))
++ wait |=(date=@da set-unix-wake(timers.state (set-timer [date duct])))
:: +huck: give back immediately
::
:: Useful if you want to continue working after other moves finish.
::
++ huck
|= mov=vase
=< [moves state]
event-core(moves [duct %give %meta mov]~)
:: +drip: XX
::
++ drip
|= mov=vase
=< [moves state]
^+ event-core
=. moves
[duct %pass /drip/(scot %ud count.drips.state) %b %wait +(now)]~
=. movs.drips.state
(~(put by movs.drips.state) count.drips.state mov)
=. count.drips.state +(count.drips.state)
event-core
:: +take-drip: XX
::
++ take-drip
|= [num=@ud error=(unit tang)]
=< [moves state]
^+ event-core
=/ drip (~(got by movs.drips.state) num)
=. movs.drips.state (~(del by movs.drips.state) num)
?^ error
:: if the receiver errored, drop it
::
%. event-core
(slog leaf/"drip failed" (flop u.error))
event-core(moves [duct %give %meta drip]~)
:: +trim: in response to memory pressue
::
++ trim [moves state]
:: +vega: learn of a kernel upgrade
::
++ vega [moves state]
:: +wake: unix says wake up; process the elapsed timer and set :next-wake
::
++ wake
|= error=(unit tang)
^+ [moves state]
:: no-op on spurious but innocuous unix wakeups
::
?~ timers.state
~? ?=(^ error) %behn-wake-no-timer^u.error
[moves state]
:: if we errored, pop the timer and notify the client vane of the error
::
?^ error
=< set-unix-wake
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state error)
:: if unix woke us too early, retry by resetting the unix wakeup timer
::
?: (gth date.i.timers.state now)
set-unix-wake(next-wake.state ~)
:: pop first timer, tell vane it has elapsed, and adjust next unix wakeup
::
=< set-unix-wake
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state ~)
:: +wegh: produce memory usage report for |mass
::
++ wegh
^+ [moves state]
:_ state :_ ~
:^ duct %give %mass
:+ %behn %|
:~ timers+&+timers.state
dot+&+state
==
:: %utilities
::
::+|
::
++ event-core .
:: +emit-vane-wake: produce a move to wake a vane; assumes no prior moves
::
++ emit-vane-wake
|= [=^duct error=(unit tang)]
event-core(moves [duct %give %wake error]~)
:: +emit-doze: set new unix wakeup timer in state and emit move to unix
::
:: We prepend the unix %doze event so that it is handled first. Arvo must
:: handle this first because the moves %behn emits will get handled in
:: depth-first order. If we're handling a %wake which causes a move to a
:: different vane and a %doze event to send to unix, Arvo needs to process
:: the %doze first because otherwise if the move to the other vane calls
:: back into %behn and emits a second %doze, the second %doze would be
:: handled by unix first which is incorrect.
::
++ emit-doze
|= =date=(unit @da)
^+ event-core
:: no-op if .unix-duct has not yet been set
::
?~ unix-duct.state
event-core
:: make sure we don't try to wake up in the past
::
=? date-unit ?=(^ date-unit) `(max now u.date-unit)
::
%_ event-core
next-wake.state date-unit
moves [[unix-duct.state %give %doze date-unit] moves]
==
:: +set-unix-wake: set or unset next unix wakeup timer based on :i.timers
::
++ set-unix-wake
=< [moves state]
^+ event-core
::
=* next-wake next-wake.state
=* timers timers.state
:: if no timers, cancel existing wakeup timer or no-op
::
?~ timers
?~ next-wake
event-core
(emit-doze ~)
:: if :next-wake is in the past or not soon enough, reset it
::
?^ next-wake
?: &((gte date.i.timers u.next-wake) (lte now u.next-wake))
event-core
(emit-doze `date.i.timers)
:: there was no unix wakeup timer; set one
::
(emit-doze `date.i.timers)
:: +set-timer: set a timer, maintaining the sort order of the :timers list
::
++ set-timer
=* timers timers.state
|= t=timer
^+ timers
::
?~ timers
~[t]
:: ignore duplicates
::
?: =(t i.timers)
timers
:: timers at the same date form a fifo queue
::
?: (lth date.t date.i.timers)
[t timers]
::
[i.timers $(timers t.timers)]
:: +unset-timer: cancel a timer; if it already expired, no-op
::
++ unset-timer
=* timers timers.state
|= t=timer
^+ timers
:: if we don't have this timer, no-op
::
?~ timers
~
?: =(i.timers t)
t.timers
::
[i.timers $(timers t.timers)]
--
--
::
=| behn-state
=* state -
|= [our=ship now=@da eny=@uvJ ski=sley]
=* behn-gate .
^?
|%
:: +call: handle a +task:able:behn request
::
++ call
|= $: hen=duct
type=*
wrapped-task=(hobo task:able)
==
^- [(list move) _behn-gate]
::
=/ =task:able
?. ?=(%soft -.wrapped-task)
wrapped-task
;;(task:able p.wrapped-task)
::
=/ event-core (per-event [our now hen] state)
::
=^ moves state
?- -.task
%born born:event-core
%crud (crud:event-core [p q]:task)
%rest (rest:event-core date=p.task)
%drip (drip:event-core move=p.task)
%huck (huck:event-core move=p.task)
%trim trim:event-core
%vega vega:event-core
%wait (wait:event-core date=p.task)
%wake (wake:event-core error=~)
%wegh wegh:event-core
==
[moves behn-gate]
:: +load: migrate an old state to a new behn version
::
++ load
|= old=behn-state
^+ behn-gate
::
behn-gate(state old)
:: +scry: view timer state
::
:: TODO: not referentially transparent w.r.t. elapsed timers,
:: which might or might not show up in the product
::
++ scry
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
^- (unit (unit cage))
::
?. ?=(%& -.why)
~
[~ ~ %tank !>(>timers<)]
::
++ stay state
++ take
|= [tea=wire hen=duct hin=(hypo sign)]
^- [(list move) _behn-gate]
?> ?=([%drip @ ~] tea)
=/ event-core (per-event [our now hen] state)
=^ moves state
(take-drip:event-core (slav %ud i.t.tea) error.q.hin)
[moves behn-gate]
--