urbit/pkg/arvo/sys/vane/gall.hoon

1927 lines
52 KiB
Plaintext
Raw Normal View History

2019-11-19 07:36:21 +03:00
!: :: %gall, agent execution
2019-08-29 21:44:37 +03:00
!? 163
!:
::::
|= pit=vase
2019-11-19 07:36:21 +03:00
=, gall
=>
2019-08-29 21:44:37 +03:00
|%
:: +move: Arvo-level move
::
+$ move [=duct move=(wind note-arvo gift-arvo)]
:: +state-5: overall gall state, versioned
::
+$ state-5 [%5 state]
:: +state: overall gall state
::
:: system-duct: TODO document
:: outstanding: outstanding request queue
:: contacts: other ships we're in communication with
:: yokes: running agents
:: blocked: moves to agents that haven't been started yet
::
+$ state
$: system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
yokes=(map term yoke)
blocked=(map term (qeu blocked-move))
==
:: +watches: subscribers and publications
::
:: TODO: rename this, to $ties?
:: TODO: rename $boat and $bitt and document
::
+$ watches [inbound=bitt outbound=boat]
:: +routes: new cuff; TODO: document
::
+$ routes
$: disclosing=(unit (set ship))
attributing=ship
==
:: +yoke: agent runner state
::
:: control-duct: TODO document
:: live: is this agent running? TODO document better
:: stats: TODO document
:: watches: incoming and outgoing subscription state
:: agent: agent core
:: beak: compilation source
:: marks: mark conversion requests
::
+$ yoke
$: control-duct=duct
live=?
=stats
=watches
=agent
=beak
marks=(map duct mark)
==
:: +blocked-move: enqueued move to an agent
::
+$ blocked-move [=duct =routes =deal]
:: +stats: statistics
::
:: change: how many moves this agent has processed
:: eny: entropy
:: time: date of current event processing
::
+$ stats [change=@ud eny=@uvJ time=@da]
:: +ames-response: network response message (%boon)
2019-08-29 21:44:37 +03:00
::
:: %d: fact
:: %x: quit
::
+$ ames-response
$% [%d =mark noun=*]
2019-08-29 21:44:37 +03:00
[%x ~]
==
:: +ames-request: network request (%plea)
2019-08-29 21:44:37 +03:00
::
:: %m: poke
:: %l: watch-as
:: %s: watch
:: %u: leave
::
+$ ames-request
$% [%m =mark noun=*]
2019-08-29 21:44:37 +03:00
[%l =mark =path]
[%s =path]
[%u ~]
==
:: +remote-request: kinds of agent actions that can cross the network
2019-08-29 21:44:37 +03:00
::
:: Used in wires to identify the kind of remote request we made.
:: Bijective with the tags of $ames-request.
::
+$ remote-request
2019-11-07 09:19:32 +03:00
$? %watch
%watch-as
2019-08-29 21:44:37 +03:00
%poke
2019-11-07 09:19:32 +03:00
%leave
%missing
2019-08-29 21:44:37 +03:00
==
--
=| state=state-5
|= [our=ship now=@da eny=@uvJ ski=sley]
2019-11-19 07:36:21 +03:00
~% %gall-top ..is ~
2019-08-29 21:44:37 +03:00
|%
2019-11-19 07:36:21 +03:00
:: +gall-payload: gall payload
2019-08-29 21:44:37 +03:00
::
2019-11-19 07:36:21 +03:00
++ gall-payload +
2019-08-29 21:44:37 +03:00
:: +mo: Arvo-level move handling
::
:: An outer core responsible for routing moves to and from Arvo; it calls
:: an inner core, +ap, to route internal moves to and from agents.
::
++ mo
2019-11-19 07:36:21 +03:00
~% %gall-mo +> ~
|_ [hen=duct moves=(list move)]
:: +mo-abed: initialise state with the provided duct
:: +mo-abet: finalize, reversing moves
:: +mo-pass: prepend a standard %pass to the current list of moves
:: +mo-give: prepend a standard %give to the current list of moves
2019-08-29 21:44:37 +03:00
::
++ mo-core .
++ mo-abed |=(hun=duct mo-core(hen hun))
++ mo-abet [(flop moves) gall-payload]
++ mo-pass |=(p=[wire note-arvo] mo-core(moves [[hen pass+p] moves]))
++ mo-give |=(g=gift:able mo-core(moves [[hen give+g] moves]))
2019-08-29 21:44:37 +03:00
:: +mo-boot: ask %ford to build us a core for the specified agent.
::
++ mo-boot
|= [dap=term =ship =desk]
2019-08-29 21:44:37 +03:00
^+ mo-core
=/ =case [%da now]
?~ pax=(get-fit:clay [ship desk case] %app dap)
(mo-give %onto |+[leaf+"gall: no file for agent {<dap>}"]~)
=/ =wire /sys/cor/[dap]/(scot %p ship)/[desk]/(scot case)
(mo-pass wire %c %warp ship desk ~ %sing %a case u.pax)
:: +mo-reboot: ask %ford to rebuild the specified agent
::
++ mo-reboot
|= [dap=term =ship]
^+ mo-core
=/ gent (~(got by yokes.state) dap)
=* desk q.beak.gent
(mo-boot:(mo-abed control-duct.gent) dap ship desk)
:: +mo-goad: rebuild agent(s)
::
++ mo-goad
|= agent=(unit dude)
^+ mo-core
?^ agent
~| goad-gone+u.agent
(mo-reboot u.agent our)
=/ agents=(list term) ~(tap in ~(key by yokes.state))
|- ^+ mo-core
?~ agents mo-core
$(agents t.agents, mo-core (mo-reboot i.agents our))
2019-08-29 21:44:37 +03:00
:: +mo-receive-core: receives an app core built by %ford.
::
:: Presuming we receive a good core, we first check to see if the agent
2019-11-19 07:36:21 +03:00
:: is already running. If so, we update its beak in %gall's state,
2019-08-29 21:44:37 +03:00
:: initialise an +ap core for the agent, install the core we got from
:: %ford, and then resolve any moves associated with it.
::
:: If we're dealing with a new agent, we create one using the result we
2019-11-19 07:36:21 +03:00
:: got from %ford, add it to the collection of agents %gall is keeping
2019-08-29 21:44:37 +03:00
:: track of, and then do more or less the same procedure as we did for the
:: running agent case.
::
++ mo-receive-core
~/ %mo-receive-core
|= [dap=term bek=beak =rant:clay]
2019-08-29 21:44:37 +03:00
^+ mo-core
::
=/ =cage r.rant
?. =(%vase p.cage)
(mo-give %onto |+[leaf+"gall: bizarre mark {<p.cage>} for agent {<dap>}"]~)
2019-08-29 21:44:37 +03:00
::
=/ maybe-new-agent (mule |.(!<(agent !<(vase q.cage))))
?: ?=(%| -.maybe-new-agent)
=/ err [[%leaf "{<dap>}: not valid agent"] p.maybe-new-agent]
(mo-give %onto %.n err)
=/ =agent p.maybe-new-agent
2019-08-29 21:44:37 +03:00
::
?^ existing=(~(get by yokes.state) dap)
=. yokes.state
(~(put by yokes.state) dap u.existing(beak bek))
2019-08-29 21:44:37 +03:00
=/ =routes [disclosing=~ attributing=our]
=/ ap-core (ap-abed:ap dap routes)
=. ap-core (ap-reinstall:ap-core agent)
ap-abet:ap-core
2019-08-29 21:44:37 +03:00
::
=. yokes.state
%+ ~(put by yokes.state) dap
=/ default-yoke *yoke
default-yoke(control-duct hen, beak bek, agent agent)
::
2019-08-29 21:44:37 +03:00
=/ old mo-core
=/ wag
=/ =routes [disclosing=~ attributing=our]
=/ ap-core (ap-abed:ap dap routes)
(ap-upgrade-state:ap-core ~)
2019-08-29 21:44:37 +03:00
::
=/ maybe-tang -.wag
=/ ap-core +.wag
2019-08-29 21:44:37 +03:00
?^ maybe-tang
=. mo-core old
(mo-give %onto %.n u.maybe-tang)
::
=. mo-core ap-abet:ap-core
=. mo-core (mo-clear-queue dap)
=/ =suss [dap %boot now]
2019-08-29 21:44:37 +03:00
(mo-give %onto [%.y suss])
:: +mo-send-foreign-request: handle local request to .ship
2019-08-29 21:44:37 +03:00
::
++ mo-send-foreign-request
~/ %mo-send-foreign-request
|= [=ship foreign-agent=term =deal]
2019-08-29 21:44:37 +03:00
^+ mo-core
::
2019-11-04 04:35:45 +03:00
=. mo-core (mo-track-ship ship)
?< ?=(?(%raw-poke %poke-as) -.deal)
=/ =ames-request
?- -.deal
%poke [%m p.cage.deal q.q.cage.deal]
%leave [%u ~]
%watch-as [%l deal]
%watch [%s path.deal]
2019-08-29 21:44:37 +03:00
==
::
=/ wire
/sys/way/(scot %p ship)/[foreign-agent]
2019-08-29 21:44:37 +03:00
::
=/ =note-arvo
2019-11-01 22:06:09 +03:00
=/ =path /ge/[foreign-agent]
[%a %plea ship %g path ames-request]
2019-08-29 21:44:37 +03:00
::
=. outstanding.state
=/ stand
(~(gut by outstanding.state) [wire hen] *(qeu remote-request))
(~(put by outstanding.state) [wire hen] (~(put to stand) -.deal))
(mo-pass wire note-arvo)
2019-11-04 04:35:45 +03:00
:: +mo-track-ship: subscribe to ames and jael for notices about .ship
2019-08-29 21:44:37 +03:00
::
2019-11-04 04:35:45 +03:00
++ mo-track-ship
|= =ship
2019-08-29 21:44:37 +03:00
^+ mo-core
:: if already contacted, no-op
2019-08-29 21:44:37 +03:00
::
?: (~(has in contacts.state) ship)
2019-11-05 07:19:08 +03:00
mo-core
2019-11-04 04:35:45 +03:00
:: first contact; update state and subscribe to notifications
2019-08-29 21:44:37 +03:00
::
=. contacts.state (~(put in contacts.state) ship)
2019-11-04 04:35:45 +03:00
:: ask ames to track .ship's connectivity
2019-08-29 21:44:37 +03:00
::
=. moves [[system-duct.state %pass /sys/lag %a %heed ship] moves]
2019-11-04 04:35:45 +03:00
:: ask jael to track .ship's breaches
2019-08-29 21:44:37 +03:00
::
=/ =note-arvo [%j %public-keys (silt ship ~)]
=. moves
[[system-duct.state %pass /sys/era note-arvo] moves]
mo-core
2019-11-04 04:35:45 +03:00
:: +mo-untrack-ship: cancel subscriptions to ames and jael for .ship
2019-11-05 07:19:08 +03:00
::
2019-11-04 04:35:45 +03:00
++ mo-untrack-ship
2019-11-05 07:19:08 +03:00
|= =ship
^+ mo-core
:: if already canceled, no-op
::
?. (~(has in contacts.state) ship)
mo-core
2019-11-04 04:35:45 +03:00
:: delete .ship from state and kill subscriptions
::
=. contacts.state (~(del in contacts.state) ship)
2019-11-04 04:35:45 +03:00
::
=. moves [[system-duct.state %pass /sys/lag %a %jilt ship] moves]
2019-11-04 04:35:45 +03:00
::
2019-11-05 07:19:08 +03:00
=/ =note-arvo [%j %nuke (silt ship ~)]
=. moves
[[system-duct.state %pass /sys/era note-arvo] moves]
2019-11-05 07:19:08 +03:00
mo-core
:: +mo-breach: ship breached, so forget about them
::
++ mo-breach
|= =ship
^+ mo-core
2019-11-04 04:35:45 +03:00
=. mo-core (mo-untrack-ship ship)
=. mo-core (mo-filter-queue ship)
=/ agents=(list [name=term =yoke]) ~(tap by yokes.state)
2019-11-05 07:19:08 +03:00
|- ^+ mo-core
?~ agents
mo-core
=. mo-core
=/ =routes [disclosing=~ attributing=ship]
=/ app (ap-abed:ap name.i.agents routes)
ap-abet:(ap-breach:app ship)
$(agents t.agents)
2019-08-29 21:44:37 +03:00
:: +mo-handle-sys: handle a +sign incoming over /sys.
::
:: (Note that /sys implies the +sign should be routed to a vane.)
::
++ mo-handle-sys
~/ %mo-handle-sys
|= [=path =sign-arvo]
^+ mo-core
::
?+ -.path !!
2019-11-04 04:35:45 +03:00
%era (mo-handle-sys-era path sign-arvo)
%cor (mo-handle-sys-cor path sign-arvo)
%lag (mo-handle-sys-lag path sign-arvo)
%pel (mo-handle-sys-pel path sign-arvo)
%rep (mo-handle-sys-rep path sign-arvo)
%req (mo-handle-sys-req path sign-arvo)
%val (mo-handle-sys-val path sign-arvo)
%way (mo-handle-sys-way path sign-arvo)
2019-08-29 21:44:37 +03:00
==
2019-11-04 04:35:45 +03:00
:: +mo-handle-sys-era: receive update about contact
2019-11-05 07:19:08 +03:00
::
2019-11-04 04:35:45 +03:00
++ mo-handle-sys-era
2019-11-05 07:19:08 +03:00
|= [=path =sign-arvo]
^+ mo-core
?> ?=([%j %public-keys *] sign-arvo)
?> ?=([%era ~] path)
2019-11-05 07:19:08 +03:00
?. ?=(%breach -.public-keys-result.sign-arvo)
mo-core
(mo-breach who.public-keys-result.sign-arvo)
:: +mo-handle-sys-cor: receive a cor from %ford.
2019-08-29 21:44:37 +03:00
::
2019-11-04 04:35:45 +03:00
++ mo-handle-sys-cor
2019-08-29 21:44:37 +03:00
|= [=path =sign-arvo]
^+ mo-core
::
2019-11-04 04:35:45 +03:00
?> ?=([%cor @ @ @ @ ~] path)
=/ [dap=term her=@ta desk=@ta dat=@ta ~] t.path
=/ =beak [(slav %p her) desk da+(slav da+dat)]
?> ?=([?(%b %c) %writ *] sign-arvo)
?^ p.sign-arvo
(mo-receive-core dap beak u.p.sign-arvo)
(mo-give %onto |+[leaf+"gall: failed to build agent {<dap>}"]~)
2019-11-04 04:35:45 +03:00
:: +mo-handle-sys-lag: handle an ames %clog notification
2019-08-29 21:44:37 +03:00
::
2019-11-04 04:35:45 +03:00
++ mo-handle-sys-lag
2019-08-29 21:44:37 +03:00
|= [=path =sign-arvo]
^+ mo-core
::
2019-11-04 04:35:45 +03:00
?> ?=([%lag ~] path)
?> ?=([%a %clog *] sign-arvo)
2019-08-29 21:44:37 +03:00
::
=/ agents=(list term) ~(tap in ~(key by yokes.state))
2019-11-04 04:35:45 +03:00
|- ^+ mo-core
?~ agents mo-core
2019-08-29 21:44:37 +03:00
::
2019-11-04 04:35:45 +03:00
=. mo-core
=/ =routes [disclosing=~ attributing=our]
=/ app (ap-abed:ap i.agents routes)
ap-abet:(ap-clog:app ship.sign-arvo)
2019-08-29 21:44:37 +03:00
::
2019-11-04 04:35:45 +03:00
$(agents t.agents)
2019-05-13 10:40:50 +03:00
:: +mo-handle-sys-pel: translated peer.
2019-08-29 21:44:37 +03:00
::
:: Validates a received %ford result and %gives an internal
:: %fact.
2019-08-29 21:44:37 +03:00
::
2019-05-13 10:40:50 +03:00
++ mo-handle-sys-pel
2019-08-29 21:44:37 +03:00
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%pel @ ~] path)
?> ?=([%f %made *] sign-arvo)
2019-08-29 21:44:37 +03:00
::
?- result.sign-arvo
[%incomplete *]
(mo-give %unto %poke-ack `tang.result.sign-arvo)
2019-08-29 21:44:37 +03:00
::
[%complete %error *]
(mo-give %unto %poke-ack `message.build-result.result.sign-arvo)
2019-08-29 21:44:37 +03:00
::
[%complete %success *]
(mo-give %unto %fact (result-to-cage:ford build-result.result.sign-arvo))
==
2019-08-29 21:44:37 +03:00
:: +mo-handle-sys-rep: reverse request.
::
:: On receipt of a valid +sign from %ford, sets state to the
2019-11-07 09:19:32 +03:00
:: appropriate duct and gives an internal %fact
:: containing the +sign payload.
2019-08-29 21:44:37 +03:00
::
++ mo-handle-sys-rep
|= [=path =sign-arvo]
^+ mo-core
::
2019-11-04 04:35:45 +03:00
?> ?=([%rep ~] path)
2019-08-29 21:44:37 +03:00
?> ?=([%f %made *] sign-arvo)
::
?- result.sign-arvo
[%incomplete *]
(mo-give %done `[%gall-fail tang.result.sign-arvo])
2019-08-29 21:44:37 +03:00
::
[%complete %error *]
(mo-give %done `[%gall-fail message.build-result.result.sign-arvo])
::
[%complete %success *]
(mo-give %unto %fact (result-to-cage:ford build-result.result.sign-arvo))
==
:: +mo-handle-sys-req: TODO description
2019-08-29 21:44:37 +03:00
::
:: TODO: what should we do if the remote nacks our %pull?
2019-08-29 21:44:37 +03:00
++ mo-handle-sys-req
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%req @ @ ~] path)
2019-08-29 21:44:37 +03:00
=/ him (slav %p i.t.path)
=/ dap i.t.t.path
::
?> ?=([?(%g %b) %unto *] sign-arvo)
=/ =sign:agent +>.sign-arvo
2019-08-29 21:44:37 +03:00
::
?- -.sign
%poke-ack
=/ err=(unit error:ames)
?~ p.sign ~
`[%poke-ack u.p.sign]
(mo-give %done err)
2019-08-29 21:44:37 +03:00
::
2019-11-07 09:19:32 +03:00
%fact
=+ [mark noun]=[p q.q]:cage.sign
(mo-give %boon %d mark noun)
2019-08-29 21:44:37 +03:00
::
2019-11-07 09:19:32 +03:00
%kick
(mo-give %boon %x ~)
2019-08-29 21:44:37 +03:00
::
2019-11-07 09:19:32 +03:00
%watch-ack
=/ err=(unit error:ames)
?~ p.sign ~
`[%watch-ack u.p.sign]
(mo-give %done err)
2019-08-29 21:44:37 +03:00
==
:: +mo-handle-sys-val: inbound validate.
::
:: Validates an incoming +sign from %ford and applies it to the
:: specified agent.
2019-08-29 21:44:37 +03:00
::
++ mo-handle-sys-val
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%val @ @ ~] path)
2019-08-29 21:44:37 +03:00
?> ?=([%f %made *] sign-arvo)
=/ =ship (slav %p i.t.path)
=/ =term i.t.t.path
?: ?=([%incomplete *] result.sign-arvo)
=/ err (some tang.result.sign-arvo)
(mo-give %unto %poke-ack err)
2019-08-29 21:44:37 +03:00
::
=/ build-result build-result.result.sign-arvo
?: ?=([%error *] build-result)
=/ err (some message.build-result)
(mo-give %unto %poke-ack err)
2019-08-29 21:44:37 +03:00
::
=/ =routes [disclosing=~ attributing=ship]
=/ =cage (result-to-cage:ford build-result)
=/ =deal [%poke cage]
(mo-apply term routes deal)
:: +mo-handle-sys-way: handle response to outgoing remote request
2019-08-29 21:44:37 +03:00
::
++ mo-handle-sys-way
|= [=wire =sign-arvo]
2019-08-29 21:44:37 +03:00
^+ mo-core
?> ?=([%way @ @ $@(~ [@ ~])] wire)
=/ =ship (slav %p i.t.wire)
=/ foreign-agent i.t.t.wire
::
?+ sign-arvo !!
[%a %done *]
=^ remote-request outstanding.state
?~ t.t.t.wire
=/ full-wire sys+wire
=/ stand
%+ ~(gut by outstanding.state) [full-wire hen]
:: default is do nothing; should only hit if cleared queue
:: in +load 3-to-4
::
(~(put to *(qeu remote-request)) %missing)
~| [full-wire=full-wire hen=hen stand=stand outs=outstanding.state]
=^ rr stand ~(get to stand)
[rr (~(put by outstanding.state) [full-wire hen] stand)]
:: non-null case of wire is old, remove on next breach after
:: 2019/12
::
[;;(remote-request i.t.t.t.wire) outstanding.state]
::
=/ err=(unit tang)
?~ error=error.sign-arvo
~
`[[%leaf (trip tag.u.error)] tang.u.error]
2019-06-29 04:13:32 +03:00
::
?- remote-request
%watch-as (mo-give %unto %watch-ack err)
%watch (mo-give %unto %watch-ack err)
%poke (mo-give %unto %poke-ack err)
%leave mo-core
%missing (mo-give:(mo-give %unto %watch-ack err) %unto %poke-ack err)
==
2016-11-24 07:25:07 +03:00
::
[%a %boon *]
?^ t.t.t.wire
:: kill subscriptions which use the old wire format
::
!!
=/ =ames-response ;;(ames-response payload.sign-arvo)
2019-11-04 04:35:45 +03:00
(mo-handle-ames-response ames-response)
2016-11-24 07:25:07 +03:00
::
[%a %lost *]
:: note this should only happen on reverse bones, so only facts
:: and kicks
::
=/ sys-wire [%sys wire]
:: TODO: %drip %kick so app crash can't kill the remote %pull
::
2019-11-04 04:35:45 +03:00
=. mo-core (mo-pass sys-wire %a %plea ship %g /ge/[foreign-agent] %u ~)
2019-12-03 00:35:05 +03:00
=. mo-core (mo-give %unto %kick ~)
mo-core
2016-11-24 07:25:07 +03:00
==
2019-08-29 21:44:37 +03:00
:: +mo-handle-use: handle a typed +sign incoming on /use.
::
:: (Note that /use implies the +sign should be routed to an agent.)
::
:: Initialises the specified agent and then performs an agent-level
:: +take on the supplied +sign.
2019-08-29 21:44:37 +03:00
::
++ mo-handle-use
~/ %mo-handle-use
|= [=path hin=(hypo sign-arvo)]
^+ mo-core
::
2019-09-06 04:18:31 +03:00
?. ?=([@ @ *] path)
2019-08-29 21:44:37 +03:00
~& [%mo-handle-use-bad-path path]
!!
::
=/ =sign-arvo q.hin
?. ?=([?(%g %b) %unto *] sign-arvo)
=/ app
=/ =term i.path
=/ =ship (slav %p i.t.path)
=/ =routes [disclosing=~ attributing=ship]
(ap-abed:ap term routes)
::
=. app (ap-generic-take:app t.t.path sign-arvo)
2019-08-29 21:44:37 +03:00
ap-abet:app
=/ =sign:agent +>.sign-arvo
=/ app
?> ?=([%out @ @ *] t.t.path)
=/ =term i.path
=/ =ship (slav %p i.t.t.t.path)
=/ =routes [disclosing=~ attributing=ship]
(ap-abed:ap term routes)
2019-09-06 04:18:31 +03:00
=. app
(ap-specific-take:app t.t.path sign)
2019-09-06 04:18:31 +03:00
ap-abet:app
2019-08-29 21:44:37 +03:00
:: +mo-clear-queue: clear blocked tasks from the specified running agent.
::
++ mo-clear-queue
|= dap=term
2019-08-29 21:44:37 +03:00
^+ mo-core
?. (~(has by yokes.state) dap)
2019-08-29 21:44:37 +03:00
mo-core
?~ maybe-blocked=(~(get by blocked.state) dap)
2019-08-29 21:44:37 +03:00
mo-core
=/ blocked=(qeu blocked-move) u.maybe-blocked
2019-08-29 21:44:37 +03:00
|- ^+ mo-core
?: =(~ blocked)
=. blocked.state (~(del by blocked.state) dap)
mo-core
=^ [=duct =routes =deal] blocked ~(get to blocked)
2019-08-29 21:44:37 +03:00
=/ move
=/ =sock [attributing.routes our]
=/ card [%slip %g %deal sock dap deal]
2019-08-29 21:44:37 +03:00
[duct card]
$(moves [move moves])
:: +mo-filter-queue: remove all blocked tasks from ship.
::
++ mo-filter-queue
|= =ship
=/ agents=(list [name=term blocked=(qeu blocked-move)])
~(tap by blocked.state)
=| new-agents=(map term (qeu blocked-move))
|- ^+ mo-core
?~ agents
mo-core(blocked.state new-agents)
=| new-blocked=(qeu blocked-move)
|- ^+ mo-core
?: =(~ blocked.i.agents)
?~ new-blocked
^$(agents t.agents)
%= ^$
agents t.agents
new-agents (~(put by new-agents) name.i.agents new-blocked)
==
=^ mov=blocked-move blocked.i.agents ~(get to blocked.i.agents)
=? new-blocked !=(ship attributing.routes.mov)
(~(put to new-blocked) mov)
$
2019-08-29 21:44:37 +03:00
:: +mo-beak: assemble a beak for the specified agent.
::
++ mo-beak
|= dap=term
2019-08-29 21:44:37 +03:00
^- beak
?^ yoke=(~(get by yokes.state) dap)
beak.u.yoke
:: XX this fallback is necessary, as .term could be either the source
:: or the destination app. ie, it might not exist locally ...
2019-08-29 21:44:37 +03:00
::
[our %home %da now]
2019-08-29 21:44:37 +03:00
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
::
++ mo-peek
~/ %mo-peek
|= [dap=term =routes care=term =path]
2019-08-29 21:44:37 +03:00
^- (unit (unit cage))
::
=/ app (ap-abed:ap dap routes)
(ap-peek:app care dap path)
2019-08-29 21:44:37 +03:00
:: +mo-apply: apply the supplied action to the specified agent.
::
++ mo-apply
|= [agent=term =routes =deal]
2019-08-29 21:44:37 +03:00
^+ mo-core
:: TODO: Remove this horrific hack when ford pinto comes!
=> |%
+$ serial @uvH
::
+$ letter
$% [%text text=cord]
[%url url=cord]
[%code expression=cord output=(list tank)]
[%me narrative=cord]
==
::
+$ envelope
$: uid=serial
number=@
author=ship
when=time
=letter
==
::
+$ config
$: length=@
read=@
==
::
+$ mailbox
$: =config
envelopes=(list envelope)
==
::
+$ inbox (map path mailbox)
::
+$ chat-configs (map path config)
::
+$ chat-base
$% [%create =path]
[%delete =path]
[%message =path =envelope]
[%read =path]
==
::
+$ chat-action
$% :: %messages: append a list of messages to mailbox
::
[%messages =path envelopes=(list envelope)]
chat-base
==
::
+$ chat-update
$% [%keys keys=(set path)]
[%config =path =config]
[%messages =path start=@ud end=@ud envelopes=(list envelope)]
chat-base
==
--
2019-08-29 21:44:37 +03:00
::
=/ =path
=/ ship (scot %p attributing.routes)
/sys/val/[ship]/[agent]
2019-08-29 21:44:37 +03:00
::
=/ ship-desk
=/ =beak (mo-beak agent)
2019-08-29 21:44:37 +03:00
[p q]:beak
::
?: ?=(%raw-poke -.deal)
:: TODO: Remove this horrific hack when ford pinto comes!
?+ mark.deal
=/ =schematic:ford [%vale ship-desk +.deal]
=/ =note-arvo [%f %build live=%.n schematic]
(mo-pass path note-arvo)
::
%chat-action
=/ chat-act=(unit chat-action) ((soft chat-action) noun.deal)
?~ chat-act
~& gall-raw-chat-poke-failed+[agent attributing.routes]
mo-core
=/ =cage [%chat-action !>(u.chat-act)]
=/ new-deal=^deal [%poke cage]
=/ app (ap-abed:ap agent routes)
=. app (ap-apply:app new-deal)
ap-abet:app
==
2019-08-29 21:44:37 +03:00
::
?: ?=(%poke-as -.deal)
=/ =schematic:ford [%cast ship-desk mark.deal [%$ cage.deal]]
2019-08-29 21:44:37 +03:00
=/ =note-arvo [%f %build live=%.n schematic]
(mo-pass path note-arvo)
::
=/ app (ap-abed:ap agent routes)
=. app (ap-apply:app deal)
2019-08-29 21:44:37 +03:00
ap-abet:app
:: +mo-handle-local: handle locally.
::
:: If the agent is running or blocked, assign it the supplied +deal.
2019-08-29 21:44:37 +03:00
:: Otherwise simply apply the action to the agent.
::
++ mo-handle-local
|= [=ship agent=term =deal]
2019-08-29 21:44:37 +03:00
^+ mo-core
::
=/ =routes [disclosing=~ attributing=ship]
=/ is-running (~(has by yokes.state) agent)
=/ is-blocked (~(has by blocked.state) agent)
2019-08-29 21:44:37 +03:00
::
?: |(!is-running is-blocked)
=/ blocked=(qeu blocked-move)
=/ waiting (~(get by blocked.state) agent)
=/ deals (fall waiting *(qeu blocked-move))
=/ deal [hen routes deal]
(~(put to deals) deal)
2019-08-29 21:44:37 +03:00
::
2019-12-04 03:41:29 +03:00
%- (slog leaf+"gall: not running {<agent>} yet, got {<-.deal>}" ~)
2019-08-29 21:44:37 +03:00
%_ mo-core
blocked.state (~(put by blocked.state) agent blocked)
2019-08-29 21:44:37 +03:00
==
(mo-apply agent routes deal)
:: +mo-handle-ames-request: handle %ames request message.
2019-08-29 21:44:37 +03:00
::
++ mo-handle-ames-request
|= [=ship agent-name=term =ames-request]
2019-08-29 21:44:37 +03:00
^+ mo-core
:: %u/%leave gets automatically acked
2019-08-29 21:44:37 +03:00
::
2019-11-27 01:56:20 +03:00
=. mo-core (mo-track-ship ship)
=? mo-core ?=(%u -.ames-request) (mo-give %done ~)
2019-08-29 21:44:37 +03:00
::
=/ =wire /sys/req/(scot %p ship)/[agent-name]
2019-08-29 21:44:37 +03:00
::
=/ =deal
?- -.ames-request
%m [%raw-poke [mark noun]:ames-request]
%l [%watch-as [mark path]:ames-request]
%s [%watch path.ames-request]
%u [%leave ~]
2019-08-29 21:44:37 +03:00
==
(mo-pass wire %g %deal [ship our] agent-name deal)
:: +mo-handle-ames-response: handle ames response message.
2019-08-29 21:44:37 +03:00
::
++ mo-handle-ames-response
2019-11-04 04:35:45 +03:00
|= =ames-response
2019-08-29 21:44:37 +03:00
^+ mo-core
?- -.ames-response
:: %d: diff; ask ford to validate .noun as .mark
::
2019-08-29 21:44:37 +03:00
%d
2019-11-04 04:35:45 +03:00
=/ =wire /sys/rep
:: agents load their code from the %home desk, including marks
2019-08-29 21:44:37 +03:00
::
=/ =note-arvo
2019-11-04 04:35:45 +03:00
=/ =disc:ford [our %home]
[%f %build live=%.n %vale disc [mark noun]:ames-response]
(mo-pass wire note-arvo)
2019-08-29 21:44:37 +03:00
::
:: %x: kick; tell agent the publisher canceled the subscription
::
2019-08-29 21:44:37 +03:00
%x
(mo-give %unto %kick ~)
2019-08-29 21:44:37 +03:00
==
:: +ap: agent engine
::
:: An inner, agent-level core. The sample refers to the agent we're
:: currently focused on.
::
++ ap
2019-11-19 07:36:21 +03:00
~% %gall-ap +> ~
2019-08-29 21:44:37 +03:00
|_ $: agent-name=term
agent-routes=routes
agent-duct=duct
2019-11-08 03:30:45 +03:00
agent-moves=(list move)
2019-08-29 21:44:37 +03:00
agent-config=(list (each suss tang))
current-agent=yoke
2019-08-29 21:44:37 +03:00
==
++ ap-core .
:: +ap-abed: initialise state for an agent, with the supplied routes.
::
2019-11-19 07:36:21 +03:00
:: The agent must already be running in +gall -- here we simply update
2019-08-29 21:44:37 +03:00
:: +ap's state to focus on it.
::
++ ap-abed
~/ %ap-abed
|= [=term =routes]
^+ ap-core
::
=/ =yoke
=/ running (~(got by yokes.state) term)
2019-08-29 21:44:37 +03:00
=/ =stats
:+ +(change.stats.running)
(shaz (mix (add term change.stats.running) eny))
now
running(stats stats)
::
=. agent-name term
=. agent-routes routes
=. current-agent yoke
=. agent-duct hen
ap-core
2019-08-29 21:44:37 +03:00
:: +ap-abet: resolve moves.
::
++ ap-abet
^+ mo-core
::
=/ running (~(put by yokes.state) agent-name current-agent)
2019-08-29 21:44:37 +03:00
=/ moves
=/ giver |=(report=(each suss tang) [hen %give %onto report])
=/ from-suss (turn agent-config giver)
2019-11-08 03:30:45 +03:00
:(weld agent-moves from-suss moves)
2019-08-29 21:44:37 +03:00
::
%_ mo-core
yokes.state running
moves moves
2019-08-29 21:44:37 +03:00
==
:: +ap-from-internal: internal move to move.
::
:: We convert from cards to duct-indexed moves when resolving
:: them in Arvo.
2019-08-29 21:44:37 +03:00
::
++ ap-from-internal
~/ %ap-from-internal
|= card=(wind neat gift:agent)
^- (list move)
2019-08-29 21:44:37 +03:00
::
?- -.card
%slip !!
2019-08-29 21:44:37 +03:00
::
%give
=/ =gift:agent p.card
2019-11-08 00:17:13 +03:00
?: ?=(%kick -.gift)
=/ ducts=(list duct) (ap-ducts-from-paths paths.gift ship.gift)
2019-11-08 00:17:13 +03:00
%+ turn ducts
|= =duct
~? &(=(duct system-duct.state) !=(agent-name %hood))
2019-11-08 00:17:13 +03:00
[%agent-giving-on-system-duct agent-name -.gift]
[duct %give %unto %kick ~]
::
2019-11-07 09:19:32 +03:00
?. ?=(%fact -.gift)
[agent-duct %give %unto gift]~
2019-08-29 21:44:37 +03:00
::
=/ ducts=(list duct) (ap-ducts-from-paths paths.gift ~)
=/ =cage cage.gift
%+ turn ducts
|= =duct
~? &(=(duct system-duct.state) !=(agent-name %hood))
[%agent-giving-on-system-duct agent-name -.gift]
^- move
=/ =mark
(~(gut by marks.current-agent) duct p.cage)
2019-08-29 21:44:37 +03:00
::
?: =(mark p.cage)
[duct %give %unto %fact cage.gift]
=/ =path /sys/pel/[agent-name]
=/ =note-arvo
=/ =schematic:ford
=/ =beak (mo-beak agent-name)
[%cast [p q]:beak mark [%$ cage]]
[%f %build live=%.n schematic]
::
[duct %pass path note-arvo]
::
%pass
=/ =duct system-duct.state
2019-09-29 07:44:31 +03:00
=/ =wire p.card
=/ =neat q.card
2019-09-29 07:44:31 +03:00
=. wire
?: ?=(%agent -.neat)
:: remove `our` in next breach after 2019/12 and reflect in
:: +mo-handle-use (non-unto case)
::
:- (scot %p our)
[%out (scot %p ship.neat) name.neat wire]
[(scot %p attributing.agent-routes) wire]
=. wire
[%use agent-name wire]
=/ =note-arvo
?- -.neat
%arvo note-arvo.neat
%agent [%g %deal [our ship.neat] [name deal]:neat]
==
2019-09-29 07:44:31 +03:00
[duct %pass wire note-arvo]~
==
2019-11-05 07:19:08 +03:00
:: +ap-breach: ship breached, so forget about them
::
++ ap-breach
|= =ship
^+ ap-core
=/ in=(list [=duct =^ship =path])
~(tap by inbound.watches.current-agent)
2019-11-05 07:19:08 +03:00
|- ^+ ap-core
?^ in
=? ap-core =(ship ship.i.in)
=/ core ap-load-delete(agent-duct duct.i.in)
core(agent-duct agent-duct)
$(in t.in)
::
=/ out=(list [[=wire =^ship =term] ? =path])
~(tap by outbound.watches.current-agent)
2019-11-05 07:19:08 +03:00
|- ^+ ap-core
?~ out
ap-core
=? ap-core =(ship ship.i.out)
=/ core
=. agent-duct system-duct.state
=/ way [%out (scot %p ship) term.i.out wire.i.out]
(ap-specific-take way %kick ~)
2019-11-05 07:19:08 +03:00
core(agent-duct agent-duct)
$(out t.out)
2019-11-04 04:35:45 +03:00
:: +ap-clog: handle %clog notification from ames
::
:: Kills subscriptions from .ship in both directions:
:: - notifies local app that subscription is dead
:: - gives remote %quit to notify subscriber ship
:: TODO: %drip local app notification for error isolation
::
++ ap-clog
|= =ship
^+ ap-core
::
=/ in=(list [=duct =^ship =path])
~(tap by inbound.watches.current-agent)
2019-11-04 04:35:45 +03:00
|- ^+ ap-core
?~ in ap-core
::
=? ap-core =(ship ship.i.in)
=/ core ap-kill-up(agent-duct duct.i.in)
core(agent-duct agent-duct)
2019-11-04 04:35:45 +03:00
$(in t.in)
2019-08-29 21:44:37 +03:00
:: +ap-agent-core: agent core with current bowl and state
::
++ ap-agent-core
~(. agent.current-agent ap-construct-bowl)
:: +ap-ducts-from-paths: get ducts subscribed to paths
::
++ ap-ducts-from-paths
|= [target-paths=(list path) target-ship=(unit ship)]
^- (list duct)
?: &(?=(~ target-paths) ?=(~ target-ship))
~[agent-duct]
%- zing
%+ turn target-paths
|= =path
(ap-ducts-from-path `path target-ship)
:: +ap-ducts-from-path: get ducts subscribed to path
::
++ ap-ducts-from-path
2019-09-24 06:46:59 +03:00
|= [target-path=(unit path) target-ship=(unit ship)]
^- (list duct)
2019-09-24 06:46:59 +03:00
?: &(?=(~ target-path) ?=(~ target-ship))
~[agent-duct]
%+ murn ~(tap by inbound.watches.current-agent)
|= [=duct =ship =path]
^- (unit ^duct)
2019-09-24 06:46:59 +03:00
?~ target-ship
?: =(target-path `path)
`duct
~
?~ target-path
?: =(target-ship `ship)
`duct
~
?: &(=(target-path `path) =(target-ship `ship))
`duct
~
2019-08-29 21:44:37 +03:00
:: +ap-apply: apply effect.
::
++ ap-apply
|= =deal
2019-08-29 21:44:37 +03:00
^+ ap-core
::
?- -.deal
%watch-as (ap-subscribe-as +.deal)
%poke (ap-poke +.deal)
%watch (ap-subscribe +.deal)
%raw-poke !!
%poke-as !!
%leave ap-load-delete
2019-08-29 21:44:37 +03:00
==
:: +ap-peek: peek.
::
++ ap-peek
~/ %ap-peek
|= [=term tyl=path]
^- (unit (unit cage))
::
2019-09-25 23:19:09 +03:00
=/ marked
?. ?=(%x term)
[mark=%$ tyl=tyl]
::
=/ =path (flop tyl)
?> ?=(^ path)
[mark=i.path tyl=(flop t.path)]
::
=/ =mark mark.marked
=/ tyl tyl.marked
::
2019-08-29 21:44:37 +03:00
=/ peek-result=(each (unit (unit cage)) tang)
(ap-mule-peek |.((on-peek:ap-agent-core [term tyl])))
2019-08-29 21:44:37 +03:00
::
?- -.peek-result
%& p.peek-result
%| ((slog leaf+"peek bad result" p.peek-result) [~ ~])
==
2019-08-29 21:44:37 +03:00
:: +ap-update-subscription: update subscription.
::
++ ap-update-subscription
~/ %ap-update-subscription
2019-09-29 07:44:31 +03:00
|= [is-ok=? =other=ship other-agent=term =wire]
2019-08-29 21:44:37 +03:00
^+ ap-core
::
?: is-ok
ap-core
(ap-kill-down wire [other-ship other-agent])
2019-08-29 21:44:37 +03:00
:: +ap-give: return result.
::
++ ap-give
|= =gift:agent
2019-08-29 21:44:37 +03:00
^+ ap-core
::
2019-11-08 03:30:45 +03:00
=/ internal-moves
(weld (ap-from-internal %give gift) agent-moves)
ap-core(agent-moves internal-moves)
2019-08-29 21:44:37 +03:00
:: +ap-construct-bowl: set up bowl.
::
++ ap-construct-bowl
^- bowl
:* :* our :: host
attributing.agent-routes :: guest
agent-name :: agent
== ::
:* wex=outbound.watches.current-agent :: outgoing
sup=inbound.watches.current-agent :: incoming
2019-08-29 21:44:37 +03:00
== ::
:* act=change.stats.current-agent :: tick
2019-08-29 21:44:37 +03:00
eny=eny.stats.current-agent :: nonce
now=time.stats.current-agent :: time
byk=beak.current-agent :: source
== ==
:: +ap-pass: request action.
::
++ ap-pass
|= [=path =neat]
2019-08-29 21:44:37 +03:00
^+ ap-core
::
2019-11-08 03:30:45 +03:00
=/ internal-moves
(ap-from-internal %pass path neat)
2019-11-08 03:30:45 +03:00
ap-core(agent-moves (weld internal-moves agent-moves))
2019-08-29 21:44:37 +03:00
:: +ap-reinstall: reinstall.
::
++ ap-reinstall
~/ %ap-reinstall
|= =agent
2019-08-29 21:44:37 +03:00
^+ ap-core
::
=/ old-state=vase ~(on-save agent.current-agent ap-construct-bowl)
=^ error ap-core
(ap-install(agent.current-agent agent) `old-state)
?~ error
2019-08-29 21:44:37 +03:00
ap-core
(ap-error %load-failed u.error)
:: +ap-subscribe-as: apply %watch-as.
2019-08-29 21:44:37 +03:00
::
++ ap-subscribe-as
2019-08-29 21:44:37 +03:00
|= [=mark =path]
^+ ap-core
::
=. marks.current-agent (~(put by marks.current-agent) agent-duct mark)
(ap-subscribe path)
2019-11-07 09:19:32 +03:00
:: +ap-subscribe: apply %watch.
2019-08-29 21:44:37 +03:00
::
++ ap-subscribe
~/ %ap-subscribe
2019-08-29 21:44:37 +03:00
|= pax=path
^+ ap-core
::
=/ incoming [attributing.agent-routes pax]
=. inbound.watches.current-agent
(~(put by inbound.watches.current-agent) agent-duct incoming)
2019-08-29 21:44:37 +03:00
::
=^ maybe-tang ap-core
2019-11-07 09:19:32 +03:00
%+ ap-ingest %watch-ack |.
(on-watch:ap-agent-core pax)
2019-08-29 21:44:37 +03:00
?^ maybe-tang
ap-silent-delete
ap-core
:: +ap-poke: apply %poke.
::
++ ap-poke
~/ %ap-poke
|= =cage
^+ ap-core
::
=^ maybe-tang ap-core
%+ ap-ingest %poke-ack |.
2019-11-07 09:19:32 +03:00
(on-poke:ap-agent-core cage)
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-error: pour error.
2019-08-29 21:44:37 +03:00
::
++ ap-error
2019-08-29 21:44:37 +03:00
|= [=term =tang]
^+ ap-core
::
=/ form |=(=tank [%rose [~ "! " ~] tank ~])
2019-08-29 22:57:33 +03:00
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
2019-11-07 09:19:32 +03:00
(on-fail:ap-agent-core term (turn tang form))
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-generic-take: generic take.
::
++ ap-generic-take
~/ %ap-generic-take
|= [=wire =sign-arvo]
2019-08-29 21:44:37 +03:00
^+ ap-core
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
2019-11-07 09:19:32 +03:00
(on-arvo:ap-agent-core wire sign-arvo)
2019-08-29 21:44:37 +03:00
?^ maybe-tang
(ap-error %arvo-response u.maybe-tang)
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-specific-take: specific take.
::
++ ap-specific-take
|= [=wire =sign:agent]
2019-08-29 21:44:37 +03:00
^+ ap-core
::
2019-09-29 07:44:31 +03:00
~| wire=wire
?> ?=([%out @ @ *] wire)
=/ other-ship (slav %p i.t.wire)
=/ other-agent i.t.t.wire
=/ =dock [other-ship other-agent]
2019-09-29 07:44:31 +03:00
=/ agent-wire t.t.t.wire
:: if subscription ack or close, handle before calling user code
::
=? outbound.watches.current-agent ?=(%kick -.sign)
%- ~(del by outbound.watches.current-agent)
2019-11-08 05:25:19 +03:00
[agent-wire dock]
?: ?& ?=(%watch-ack -.sign)
!(~(has by outbound.watches.current-agent) [agent-wire dock])
2019-11-06 06:55:51 +03:00
==
%- %: slog
leaf+"{<agent-name>}: got ack for nonexistent subscription"
leaf+"{<dock>}: {<agent-wire>}"
2019-11-08 05:25:19 +03:00
>wire=wire<
>out=outbound.watches.current-agent<
2019-11-06 06:55:51 +03:00
~
==
ap-core
::
=? outbound.watches.current-agent ?=(%watch-ack -.sign)
?^ p.sign
%- ~(del by outbound.watches.current-agent)
[agent-wire dock]
%+ ~(jab by outbound.watches.current-agent) [agent-wire dock]
|= [acked=? =path]
=. .
?. acked
.
%- =/ =tape
"{<agent-name>}: received 2nd watch-ack on {<wire dock path>}"
(slog leaf+tape ~)
.
[& path]
::
2019-08-29 21:44:37 +03:00
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(on-agent:ap-agent-core agent-wire sign)
:: if failed %fact handling, kill subscription
::
=? ap-core ?=(%fact -.sign)
(ap-update-subscription =(~ maybe-tang) p.dock q.dock agent-wire)
2019-08-29 21:44:37 +03:00
?^ maybe-tang
(ap-error -.sign leaf/"closing subscription" u.maybe-tang)
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-install: install wrapper.
::
++ ap-install
|= old-agent-state=(unit vase)
2019-08-29 21:44:37 +03:00
^- [(unit tang) _ap-core]
::
=^ maybe-tang ap-core (ap-upgrade-state old-agent-state)
2019-08-29 21:44:37 +03:00
::
=. agent-config
=/ =term ?~(old-agent-state %boot %bump)
2019-08-29 21:44:37 +03:00
=/ possibly-suss
?~ maybe-tang
=/ =suss [agent-name term now]
[%.y suss]
[%.n u.maybe-tang]
[possibly-suss agent-config]
::
[maybe-tang ap-core]
:: +ap-upgrade-state: low-level install.
2019-08-29 21:44:37 +03:00
::
++ ap-upgrade-state
~/ %ap-upgrade-state
2019-08-29 21:44:37 +03:00
|= maybe-vase=(unit vase)
^- [(unit tang) _ap-core]
::
=^ maybe-tang ap-core
%+ ap-ingest ~
?~ maybe-vase
2019-11-07 09:19:32 +03:00
|. on-init:ap-agent-core
|. (on-load:ap-agent-core u.maybe-vase)
2019-08-29 21:44:37 +03:00
[maybe-tang ap-core]
:: +ap-silent-delete: silent delete.
::
++ ap-silent-delete
^+ ap-core
::
%= ap-core
inbound.watches.current-agent
(~(del by inbound.watches.current-agent) agent-duct)
2019-08-29 21:44:37 +03:00
==
:: +ap-load-delete: load delete.
::
++ ap-load-delete
^+ ap-core
::
=/ maybe-incoming
(~(get by inbound.watches.current-agent) agent-duct)
2019-08-29 21:44:37 +03:00
?~ maybe-incoming
ap-core
::
=/ incoming u.maybe-incoming
=. inbound.watches.current-agent
(~(del by inbound.watches.current-agent) agent-duct)
2019-08-29 21:44:37 +03:00
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
2019-11-07 09:19:32 +03:00
(on-leave:ap-agent-core q.incoming)
2019-08-29 21:44:37 +03:00
?^ maybe-tang
2019-11-07 09:19:32 +03:00
(ap-error %leave u.maybe-tang)
2019-08-29 21:44:37 +03:00
ap-core
2019-09-29 07:44:31 +03:00
:: +ap-kill-up: 2-sided kill from publisher side
2019-08-29 21:44:37 +03:00
::
2019-09-29 07:44:31 +03:00
++ ap-kill-up
2019-08-29 21:44:37 +03:00
^+ ap-core
::
=> ap-load-delete
2019-11-07 09:19:32 +03:00
(ap-give %kick ~ ~)
2019-09-29 07:44:31 +03:00
:: +ap-kill-down: 2-sided kill from subscriber side
::
:: Must process leave first in case kick handler rewatches.
::
2019-09-29 07:44:31 +03:00
++ ap-kill-down
|= [=wire =dock]
^+ ap-core
::
=. ap-core
(ap-pass wire %agent dock %leave ~)
=/ way [%out (scot %p p.dock) q.dock wire]
(ap-pass way %arvo %b %huck !>([%unto %kick ~]))
:: +ap-mule: run virtualized with intercepted scry, preserving type
::
:: Compare +mute and +mule. Those pass through scry, which
:: doesn't allow us to catch crashes due to blocking scry. If
:: you intercept scry, you can't preserve the type
:: polymorphically. By monomorphizing, we are able to do so
:: safely.
::
++ ap-mule
|= run=_^?(|.(*step:agent))
^- (each step:agent tang)
=/ res (mock [run %9 2 %0 1] (sloy ski))
?- -.res
%0 [%& !<(step:agent [-:!>(*step:agent) p.res])]
%1 [%| (turn p.res |=(a=* (smyt (path a))))]
%2 [%| p.res]
==
:: +ap-mule-peek: same as +ap-mule but for (unit (unit cage))
::
++ ap-mule-peek
|= run=_^?(|.(*(unit (unit cage))))
^- (each (unit (unit cage)) tang)
=/ res (mock [run %9 2 %0 1] (sloy ski))
?- -.res
%0 [%& !<((unit (unit cage)) [-:!>(*(unit (unit cage))) p.res])]
%1 [%| (turn p.res |=(a=* (smyt (path a))))]
%2 [%| p.res]
==
2019-08-29 21:44:37 +03:00
:: +ap-ingest: call agent arm
::
:: Handle acks here because they need to be emitted before the
:: rest of the moves.
::
++ ap-ingest
2019-11-07 09:19:32 +03:00
|= [ack=?(%poke-ack %watch-ack ~) run=_^?(|.(*step:agent))]
2019-08-29 21:44:37 +03:00
^- [(unit tang) _ap-core]
=/ result (ap-mule run)
2019-11-08 03:30:45 +03:00
=^ new-moves ap-core (ap-handle-result result)
2019-08-29 21:44:37 +03:00
=/ maybe-tang=(unit tang)
?: ?=(%& -.result)
2019-08-29 21:44:37 +03:00
~
`p.result
2019-11-08 03:30:45 +03:00
=/ ack-moves=(list move)
%- zing
%- turn :_ ap-from-internal
^- (list card:agent)
2019-08-29 21:44:37 +03:00
?- ack
~ ~
2019-11-08 03:30:45 +03:00
%poke-ack [%give %poke-ack maybe-tang]~
2019-11-07 09:19:32 +03:00
%watch-ack [%give %watch-ack maybe-tang]~
2019-08-29 21:44:37 +03:00
==
::
2019-11-08 03:30:45 +03:00
=. agent-moves
:(weld (flop new-moves) ack-moves agent-moves)
2019-08-29 21:44:37 +03:00
[maybe-tang ap-core]
:: +ap-handle-result: handle result.
::
++ ap-handle-result
~/ %ap-handle-result
|= result=(each step:agent tang)
2019-11-08 03:30:45 +03:00
^- [(list move) _ap-core]
2019-08-29 21:44:37 +03:00
?: ?=(%| -.result)
`ap-core
2019-08-29 21:44:37 +03:00
::
=. agent.current-agent +.p.result
2019-11-08 03:30:45 +03:00
=/ moves (zing (turn -.p.result ap-from-internal))
=. inbound.watches.current-agent
2019-11-08 03:30:45 +03:00
(ap-handle-kicks moves)
(ap-handle-peers moves)
:: +ap-handle-kicks: handle cancels of inbound.watches
2019-08-29 21:44:37 +03:00
::
2019-11-08 03:30:45 +03:00
++ ap-handle-kicks
~/ %ap-handle-kicks
|= moves=(list move)
2019-08-29 21:44:37 +03:00
^- bitt
=/ quits=(list duct)
2019-11-08 03:30:45 +03:00
%+ murn moves
|= =move
^- (unit duct)
?. ?=([* %give %unto %kick *] move)
2019-08-29 21:44:37 +03:00
~
2019-11-08 03:30:45 +03:00
`duct.move
2019-08-29 21:44:37 +03:00
::
=/ quit-map=bitt
(malt (turn quits |=(=duct [duct *[ship path]])))
(~(dif by inbound.watches.current-agent) quit-map)
:: +ap-handle-peers: handle new outbound.watches
2019-08-29 21:44:37 +03:00
::
++ ap-handle-peers
~/ %ap-handle-peers
2019-11-08 03:30:45 +03:00
|= moves=(list move)
^- [(list move) _ap-core]
=| new-moves=(list move)
|- ^- [(list move) _ap-core]
?~ moves
2019-11-08 03:30:45 +03:00
[(flop new-moves) ap-core]
=/ =move i.moves
2019-11-19 07:36:21 +03:00
?: ?=([* %pass * %g %deal * * %leave *] move)
2019-11-08 03:30:45 +03:00
=/ =wire p.move.move
2019-11-08 05:25:19 +03:00
?> ?=([%use @ @ %out @ @ *] wire)
=/ short-wire t.t.t.t.t.t.wire
2019-11-08 03:30:45 +03:00
=/ =dock [q.p q]:q.move.move
=. outbound.watches.current-agent
(~(del by outbound.watches.current-agent) [short-wire dock])
2019-11-08 03:30:45 +03:00
$(moves t.moves, new-moves [move new-moves])
2019-11-19 07:36:21 +03:00
?. ?=([* %pass * %g %deal * * %watch *] move)
2019-11-08 03:30:45 +03:00
$(moves t.moves, new-moves [move new-moves])
=/ =wire p.move.move
2019-11-08 05:25:19 +03:00
?> ?=([%use @ @ %out @ @ *] wire)
=/ short-wire t.t.t.t.t.t.wire
2019-11-08 03:30:45 +03:00
=/ =dock [q.p q]:q.move.move
=/ =path path.r.q.move.move
?: (~(has by outbound.watches.current-agent) short-wire dock)
2019-11-05 07:19:08 +03:00
=. ap-core
=/ =tang
2019-11-08 05:25:19 +03:00
~[leaf+"subscribe wire not unique" >agent-name< >short-wire< >dock<]
%- (slog >out=outbound.watches.current-agent< tang)
(ap-error %watch-not-unique tang)
$(moves t.moves)
=. outbound.watches.current-agent
(~(put by outbound.watches.current-agent) [short-wire dock] [| path])
2019-11-08 03:30:45 +03:00
$(moves t.moves, new-moves [move new-moves])
2019-08-29 21:44:37 +03:00
--
--
:: +call: request
::
++ call
2019-11-19 07:36:21 +03:00
~% %gall-call +> ~
2020-02-11 01:03:03 +03:00
|= [=duct dud=(unit goof) hic=(hypo (hobo task:able))]
2019-11-19 07:36:21 +03:00
^- [(list move) _gall-payload]
?^ dud
~|(%gall-call-dud (mean tang.u.dud))
2019-08-29 21:44:37 +03:00
::
2019-11-19 07:36:21 +03:00
~| [%gall-call-failed duct q.hic]
=/ =task:able ((harden task:able) q.hic)
2019-08-29 21:44:37 +03:00
::
=/ mo-core (mo-abed:mo duct)
2019-08-29 21:44:37 +03:00
?- -.task
%conf mo-abet:(mo-boot:mo-core dap.task our %home)
%deal
=/ [=sock =term =deal] [p q r]:task
2019-08-29 21:44:37 +03:00
?. =(q.sock our)
?> =(p.sock our)
mo-abet:(mo-send-foreign-request:mo-core q.sock term deal)
mo-abet:(mo-handle-local:mo-core p.sock term deal)
2019-08-29 21:44:37 +03:00
::
%goad mo-abet:(mo-goad:mo-core agent.task)
%init [~ gall-payload(system-duct.state duct)]
%plea
=/ =ship ship.task
2019-11-01 22:06:09 +03:00
=/ =path path.plea.task
=/ =noun payload.plea.task
2019-08-29 21:44:37 +03:00
::
~| [ship=ship plea-path=path]
?> ?=([%ge @ ~] path)
2019-08-29 21:44:37 +03:00
=/ agent-name i.t.path
::
=/ =ames-request ;;(ames-request noun)
=> (mo-handle-ames-request:mo-core ship agent-name ames-request)
2019-08-29 21:44:37 +03:00
mo-abet
::
%sear mo-abet:(mo-filter-queue:mo-core ship.task)
%trim [~ gall-payload]
%vega [~ gall-payload]
2019-08-29 21:44:37 +03:00
%wegh
=/ blocked
=/ queued (~(run by blocked.state) |=((qeu blocked-move) [%.y +<]))
2019-08-29 21:44:37 +03:00
(sort ~(tap by queued) aor)
::
=/ running
=/ active (~(run by yokes.state) |=(yoke [%.y +<]))
2019-08-29 21:44:37 +03:00
(sort ~(tap by active) aor)
::
=/ =mass
2019-11-19 07:36:21 +03:00
:+ %gall %.n
:~ [%foreign %.y contacts.state]
2019-08-29 21:44:37 +03:00
[%blocked %.n blocked]
[%active %.n running]
[%dot %.y state]
==
::
[[duct %give %mass mass]~ gall-payload]
2019-08-29 21:44:37 +03:00
==
:: +load: recreate vane
::
++ load
2019-12-02 14:20:34 +03:00
|^
|= =all-state
2019-11-19 07:36:21 +03:00
^+ gall-payload
2019-09-10 06:00:56 +03:00
::
2019-12-02 14:20:34 +03:00
=? all-state ?=(%0 -.all-state)
(state-0-to-1 all-state)
::
=? all-state ?=(%1 -.all-state)
(state-1-to-2 all-state)
::
=? all-state ?=(%2 -.all-state)
(state-2-to-3 all-state)
::
=? all-state ?=(%3 -.all-state)
(state-3-to-4 all-state)
::
=? all-state ?=(%4 -.all-state)
(state-4-to-5 all-state)
::
?> ?=(%5 -.all-state)
2019-12-02 14:20:34 +03:00
gall-payload(state all-state)
::
:: +all-state: upgrade path
::
++ all-state $%(state-0 state-1 state-2 state-3 state-4 state-5)
::
++ state-4-to-5
|= =state-4
^- state-5
%= state-4
- %5
running.agents-4
(~(run by running.agents-4.state-4) |=(yoke-3 +<+))
==
::
++ state-4
$: %4
agents-4=agents-3 :: agents-3 is unchanged in state-4
==
::
++ state-3-to-4
|= =state-3
^- state-4
%= state-3
- %4
outstanding.agents-3 ~
==
::
++ state-3
$: %3
=agents-3
==
::
++ agents-3
$: system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
running=(map term yoke-3)
blocked=(map term (qeu blocked-move))
==
::
++ yoke-3
$: cache=worm
control-duct=duct
live=?
=stats
=watches
=agent
=beak
marks=(map duct mark)
==
::
++ state-2-to-3
|= =state-2
^- state-3
%= state-2
- %3
running.agents-2
%- ~(run by running.agents-2.state-2)
|= =yoke-2
^- yoke-3
%= yoke-2
agent-2 (agent-2-to-3 agent-2.yoke-2)
==
==
::
++ agent-2-to-3
|= =agent-2
^- agent
=> |%
++ cards-2-to-3
|= cards=(list card:^agent-2)
^- (list card:agent)
%+ turn cards
|= =card:^agent-2
^- card:agent
?. ?=([%give ?(%fact %kick) *] card) card
%=(card path.p (drop path.p.card))
--
|_ =bowl:gall
+* this .
pass ~(. agent-2 bowl)
++ on-init
=^ cards agent-2 on-init:pass
[(cards-2-to-3 cards) this]
::
++ on-save
on-save:pass
::
++ on-load
|= old-state=vase
=^ cards agent-2 (on-load:pass old-state)
[(cards-2-to-3 cards) this]
::
++ on-poke
|= [=mark =vase]
=^ cards agent-2 (on-poke:pass mark vase)
[(cards-2-to-3 cards) this]
::
++ on-watch
|= =path
=^ cards agent-2 (on-watch:pass path)
[(cards-2-to-3 cards) this]
::
++ on-leave
|= =path
=^ cards agent-2 (on-leave:pass path)
[(cards-2-to-3 cards) this]
::
++ on-peek
|= =path
(on-peek:pass path)
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards agent-2 (on-agent:pass wire sign)
[(cards-2-to-3 cards) this]
::
++ on-arvo
|= [=wire =sign-arvo]
=^ cards agent-2 (on-arvo:pass wire sign-arvo)
[(cards-2-to-3 cards) this]
::
++ on-fail
|= [=term =tang]
=^ cards agent-2 (on-fail:pass term tang)
[(cards-2-to-3 cards) this]
--
::
++ state-2
$: %2
=agents-2
==
::
++ agents-2
$: system-duct=duct
outstanding=(map [wire duct] (qeu remote-request))
contacts=(set ship)
running=(map term yoke-2)
blocked=(map term (qeu blocked-move))
==
::
++ yoke-2
$: cache=worm
control-duct=duct
live=?
=stats
=watches
=agent-2
=beak
marks=(map duct mark)
==
::
++ agent-2
=< form
|%
+$ step (quip card form)
+$ card (wind note gift)
+$ note note:agent
+$ task task:agent
+$ sign sign:agent
+$ gift
$% [%fact path=(unit path) =cage]
[%kick path=(unit path) ship=(unit ship)]
[%watch-ack p=(unit tang)]
[%poke-ack p=(unit tang)]
==
++ form
$_ ^|
|_ bowl
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ old-state=vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
--
2019-12-02 14:20:34 +03:00
::
++ state-1-to-2
|= =state-1
^- state-2
%= state-1
- %2
+.agents-1 [~ +.agents-1.state-1]
==
::
++ state-1
$: %1
=agents-1
==
::
++ agents-1
$: system-duct=duct
contacts=(set ship)
running=(map term yoke-2)
blocked=(map term (qeu blocked-move))
==
::
2019-12-02 14:20:34 +03:00
++ state-0-to-1
|= =state-0
^- state-1
2019-12-02 14:20:34 +03:00
%= state-0
- %1
running.agents-0
%- ~(run by running.agents-0.state-0)
|= =yoke-0
^- yoke-2
%= yoke-0
agent-0 (agent-0-to-1 agent-0.yoke-0)
2019-12-02 14:20:34 +03:00
==
==
::
++ agent-0-to-1
|= =agent-0
^- agent-2
2019-12-02 14:20:34 +03:00
|_ =bowl:gall
+* this .
pass ~(. agent-0 bowl)
++ on-init
=^ cards agent-0 on-init:pass
[cards this]
::
++ on-save
on-save:pass
::
++ on-load
|= old-state=vase
=^ cards agent-0 (on-load:pass old-state)
[cards this]
::
++ on-poke
|= [=mark =vase]
=^ cards agent-0 (on-poke:pass mark vase)
[cards this]
::
++ on-watch
|= =path
=^ cards agent-0 (on-watch:pass path)
[cards this]
::
++ on-leave
|= =path
=^ cards agent-0 (on-leave:pass path)
[cards this]
::
++ on-peek
|= =path
(on-peek:pass path)
::
++ on-agent
|= [=wire =sign:agent:gall]
=^ cards agent-0 (on-agent:pass wire sign)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
?< ?=([%d %pack *] sign-arvo)
=^ cards agent-0 (on-arvo:pass wire `sign-arvo-0`sign-arvo)
[cards this]
::
++ on-fail
|= [=term =tang]
=^ cards agent-0 (on-fail:pass term tang)
[cards this]
--
::
++ state-0
$: %0
=agents-0
==
::
++ agents-0
$: system-duct=duct
contacts=(set ship)
running=(map term yoke-0)
blocked=(map term (qeu blocked-move))
2019-12-02 14:20:34 +03:00
==
::
++ yoke-0
2019-12-02 14:20:34 +03:00
$: cache=worm
control-duct=duct
live=?
=stats
=watches
2019-12-02 14:20:34 +03:00
=agent-0
=beak
marks=(map duct mark)
==
::
++ agent-0
=< form
|%
+$ step (quip card form)
+$ card (wind note gift)
+$ note note:agent
+$ task task:agent
+$ gift gift:agent-2
2019-12-02 14:20:34 +03:00
+$ sign sign:agent
++ form
$_ ^|
|_ bowl
++ on-init
*(quip card _^|(..on-init))
::
++ on-save
*vase
::
++ on-load
|~ old-state=vase
*(quip card _^|(..on-init))
::
++ on-poke
|~ [mark vase]
*(quip card _^|(..on-init))
::
++ on-watch
|~ path
*(quip card _^|(..on-init))
::
++ on-leave
|~ path
*(quip card _^|(..on-init))
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign]
*(quip card _^|(..on-init))
::
++ on-arvo
|~ [wire sign-arvo-0]
*(quip card _^|(..on-init))
::
++ on-fail
|~ [term tang]
*(quip card _^|(..on-init))
--
--
::
++ sign-arvo-0
$% {$a gift:able:ames}
$: $b
$% gift:able:behn
[%writ riot:clay]
$>(%mere gift:able:clay)
$>(%unto gift:able:gall)
==
==
{$c gift:able:clay}
{$d $<(%pack gift:able:dill)}
{$f gift:able:ford}
[%e gift:able:eyre]
{$g gift:able:gall}
[%i gift:able:iris]
{$j gift:able:jael}
==
--
2019-08-29 21:44:37 +03:00
:: +scry: standard scry
::
++ scry
2019-11-19 07:36:21 +03:00
~/ %gall-scry
|= [fur=(unit (set monk)) care=term =shop dap=desk =coin =path]
2019-08-29 21:44:37 +03:00
^- (unit (unit cage))
?. ?=(%.y -.shop)
~
=/ =ship p.shop
?: ?& =(%u care)
2019-08-29 21:44:37 +03:00
=(~ path)
=([%$ %da now] coin)
=(our ship)
==
[~ ~ noun+!>((~(has by yokes.state) dap))]
2019-08-29 21:44:37 +03:00
::
?. =(our ship)
~
?. =([%$ %da now] coin)
~
?. (~(has by yokes.state) dap)
[~ ~]
2019-08-29 21:44:37 +03:00
?. ?=(^ path)
~
=/ =routes [~ ship]
(mo-peek:mo dap routes care path)
2019-08-29 21:44:37 +03:00
:: +stay: save without cache
::
++ stay state
:: +take: response
::
++ take
2019-11-19 07:36:21 +03:00
~/ %gall-take
2020-02-11 01:03:03 +03:00
|= [=wire =duct dud=(unit goof) hin=(hypo sign-arvo)]
2019-11-19 07:36:21 +03:00
^- [(list move) _gall-payload]
?^ dud
~|(%gall-take-dud (mean tang.u.dud))
2019-08-29 21:44:37 +03:00
::
2019-11-19 07:36:21 +03:00
~| [%gall-take-failed wire]
::
2019-08-29 21:44:37 +03:00
?> ?=([?(%sys %use) *] wire)
=/ mo-core (mo-abed:mo duct)
2019-08-29 21:44:37 +03:00
=/ =sign-arvo q.hin
2019-09-29 07:44:31 +03:00
=> ?- i.wire
%sys (mo-handle-sys:mo-core t.wire sign-arvo)
%use (mo-handle-use:mo-core t.wire hin)
2019-09-29 07:44:31 +03:00
==
2019-08-29 21:44:37 +03:00
mo-abet
--