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

1627 lines
43 KiB
Plaintext
Raw Normal View History

!: :: %mall, agent execution
2019-08-29 21:44:37 +03:00
!? 163
!:
::::
|= pit=vase
=, mall
2019-08-29 21:44:37 +03:00
=> =~
|%
:: +coke: cook
::
++ coke
$? %inn
%out
%cay
==
:: +reverse-ames: reverse ames message
::
++ reverse-ames
$% :: diff
::
[%d p=mark q=*]
:: etc.
::
[%x ~]
==
:: +forward-ames: forward ames message
::
++ forward-ames
$% :: message
::
[%m =mark noun=*]
:: "peel" subscribe
::
[%l =mark =path]
:: subscribe
::
[%s =path]
:: cancel+unsubscribe
::
[%u ~]
==
:: +foreign-response: foreign response
::
++ foreign-response
$? %peer
%peel
%poke
%pull
==
--
|%
:: +move: Arvo-level move
::
++ move
$: =duct
move=(wind note-arvo gift-arvo)
==
--
|%
:: +state-old: upgrade path
::
++ state-old ?(state)
:: +state: all state
::
++ state
$: :: state version
::
%0
:: agents by ship
::
=agents
==
:: +subscribers: subscriber data
::
++ subscribers
$: :: incoming subscribers
::
incoming=bitt
:: outgoing subscribers
::
outgoing=boat
:: queue meter
::
meter=(map bone @ud)
==
:: +agents: ship state
::
++ agents
$: :: system duct
::
system-duct=duct
:: foreign contacts
::
contacts=(map ship foreign)
:: running agents
::
running=(map term running-agent)
:: waiting queue
::
blocked=(map term blocked)
==
:: +routes: new cuff
::
++ routes
$: :: disclosing to
::
disclosing=(unit (set ship))
:: attributed to
::
attributing=ship
==
:: +foreign: foreign connections
::
++ foreign
$: :: index
::
index=@ud
:: by duct
::
index-map=(map duct @ud)
:: by index
::
duct-map=(map @ud duct)
==
:: +ducts: opaque input
::
++ ducts
$: :: bone sequence
::
bone=@ud
:: by duct
::
bone-map=(map duct bone)
:: by bone
::
duct-map=(map bone duct)
==
:: +running-agent: agent state
::
++ running-agent
$: :: cache
::
cache=worm
:: control duct
::
control-duct=duct
:: unstopped
::
live=?
:: statistics
::
=stats
:: subscribers
::
=subscribers
:: agent core
::
=agent
:: update control
::
=beak
:: req'd translations
::
marks=(map bone mark)
:: opaque ducts
::
=ducts
==
:: +blocked: blocked tasks
::
++ blocked (qeu (trel duct routes agent-action))
:: +stats: statistics
::
++ stats
$: :: change number
::
change=@ud
:: entropy
::
eny=@uvJ
:: time
::
time=@da
==
--
. ==
=| =state
|= $: :: identity
::
our=ship
:: urban time
::
now=@da
:: entropy
::
eny=@uvJ
:: activate
::
ska=sley
==
~% %mall-top ..is ~
2019-08-29 21:44:37 +03:00
|%
:: +mall-payload: mall payload
2019-08-29 21:44:37 +03:00
::
++ mall-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
~% %mall-mo +> ~
2019-08-29 21:44:37 +03:00
|_
$: hen=duct
moves=(list move)
==
++ mo-core .
:: +mo-abed: initialise state with the provided duct.
::
++ mo-abed
|= =duct
^+ mo-core
::
mo-core(hen duct)
:: +mo-abet: resolve moves.
::
++ mo-abet
^- [(list move) _mall-payload]
2019-08-29 21:44:37 +03:00
::
=/ resolved (flop moves)
[resolved mall-payload]
2019-08-29 21:44:37 +03:00
::
:: +mo-boot: ask %ford to build us a core for the specified agent.
::
++ mo-boot
|= [=term =ship =desk]
^+ mo-core
::
=/ =case [%da now]
=/ =path
=/ ship (scot %p ship)
=/ case (scot case)
/sys/core/[term]/[ship]/[desk]/[case]
::
=/ =note-arvo
=/ =schematic:ford [%core [ship desk] /hoon/[term]/age]
2019-08-29 21:44:37 +03:00
[%f %build live=%.y schematic]
::
=/ pass [path note-arvo]
(mo-pass pass)
::
:: +mo-pass: prepend a standard %pass to the current list of moves.
::
++ mo-pass
|= pass=(pair path note-arvo)
^+ mo-core
::
=/ =move [hen [%pass pass]]
mo-core(moves [move moves])
:: +mo-give: prepend a standard %give to the current list of moves.
::
++ mo-give
|= =gift:able
^+ mo-core
::
=/ =move [hen [%give gift]]
mo-core(moves [move moves])
:: +mo-receive-core: receives an app core built by %ford.
::
:: Presuming we receive a good core, we first check to see if the agent
:: is already running. If so, we update its beak in %mall'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
:: got from %ford, add it to the collection of agents %mall 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
|= [=term =beak =made-result:ford]
^+ mo-core
::
?: ?=([%incomplete *] made-result)
(mo-give %onto %.n tang.made-result)
::
=/ build-result build-result.made-result
::
?: ?=([%error *] build-result)
(mo-give %onto %.n message.build-result)
::
=/ =cage (result-to-cage:ford build-result)
=/ result-vase q.cage
=/ maybe-agent=(unit running-agent)
(~(get by running.agents.state) term)
::
?^ maybe-agent
=/ agent u.maybe-agent(beak beak)
=. running.agents.state
(~(put by running.agents.state) term agent)
=/ =routes [disclosing=~ attributing=our]
=/ app (ap-abed:ap term routes)
=. app (ap-reinstall:app result-vase)
ap-abet:app
::
=/ maybe-new-agent !<(agent result-vase)
2019-08-29 22:57:33 +03:00
?~ maybe-new-agent
=/ err [[%leaf "{<term>}: not valid agent"] ~]
2019-08-29 21:44:37 +03:00
(mo-give %onto %.n err)
2019-08-29 22:57:33 +03:00
=. mo-core (mo-new-agent term beak u.maybe-new-agent)
2019-08-29 21:44:37 +03:00
=/ old mo-core
=/ wag
=/ =routes [disclosing=~ attributing=our]
=/ app (ap-abed:ap term routes)
(ap-prep:app ~)
::
=/ maybe-tang -.wag
=/ app +.wag
?^ maybe-tang
=. mo-core old
(mo-give %onto %.n u.maybe-tang)
::
=. mo-core ap-abet:app
=. mo-core (mo-clear-queue term)
=/ =suss [term %boot now]
(mo-give %onto [%.y suss])
:: +mo-new-agent: create a new agent and add it to %mall's state.
2019-08-29 21:44:37 +03:00
::
:: %mall maintains a collection of running agents. This arm creates a
2019-08-29 21:44:37 +03:00
:: new one with the provided name, beak, and state (held in a vase).
::
++ mo-new-agent
2019-08-29 22:57:33 +03:00
|= [=term =beak =agent]
2019-08-29 21:44:37 +03:00
^+ mo-core
::
=/ =ducts
:+ bone=1
bone-map=[[[~ ~] 0] ~ ~]
2019-08-29 22:57:33 +03:00
duct-map=[[0 [~ ~]] ~ ~]
2019-08-29 21:44:37 +03:00
::
=/ running-agent
=/ default-agent *running-agent
%_ default-agent
control-duct hen
beak beak
2019-08-29 22:57:33 +03:00
agent agent
2019-08-29 21:44:37 +03:00
ducts ducts
==
::
%_ mo-core
running.agents.state (~(put by running.agents.state) term running-agent)
2019-08-29 21:44:37 +03:00
==
:: +mo-handle-foreign-request: handle a foreign request.
::
:: Handles tasks received on a +call that have come from another ship.
::
++ mo-handle-foreign-request
~/ %mo-handle-foreign-request
|= [=ship =internal-task]
^+ mo-core
::
=/ =term p.internal-task
=/ =agent-action q.internal-task
?: ?=(%pump -.agent-action)
::
:: you'd think this would send an ack for the diff
:: that caused this pump. it would, but we already
:: sent it when we got the diff in +mo-handle-sys. then
:: we'd have to save the network duct and connect it
:: to this returning pump.
::
mo-core
::
?: ?=(%peer-not -.agent-action)
=/ =tang p.agent-action
(mo-give %unto %reap (some tang))
::
=^ bone mo-core (mo-assign-bone ship)
=/ =forward-ames
?- -.agent-action
%poke [%m p.p.agent-action q.q.p.agent-action]
%pull [%u ~]
%puff !!
%punk !!
%peel [%l agent-action]
%peer [%s p.agent-action]
==
::
=/ sys-path
=/ action -.agent-action
/sys/way/[action]
::
=/ =note-arvo
=/ =path /g/ge/[term]
=/ =noun [bone forward-ames]
[%a %want ship path noun]
::
(mo-pass sys-path note-arvo)
:: +mo-handle-foreign-response: handle foreign response.
::
:: Handle a received %woot from %ames.
::
++ mo-handle-foreign-response
|= [=foreign-response art=(unit ares)]
^+ mo-core
::
=/ to-tang
|= =ares
^- tang
?~ ares
~
=/ tape (trip p.u.ares)
[[%leaf tape] q.u.ares]
::
=/ result (bind art to-tang)
?- foreign-response
%peel (mo-give %unto %reap result)
%peer (mo-give %unto %reap result)
%poke (mo-give %unto %coup result)
%pull mo-core
==
:: +mo-assign-bone: assign an outbone to a ship.
::
:: If we know about the ship, we simply use its existing bone. Otherwise
:: we register a new entry for the ship, and use a default bone for it.
::
++ mo-assign-bone
|= =ship
^- [bone _mo-core]
::
=/ =foreign
=/ existing (~(get by contacts.agents.state) ship)
(fall existing [1 ~ ~])
::
=/ existing (~(get by index-map.foreign) hen)
?^ existing
[u.existing mo-core]
::
=/ index index.foreign
=/ contacts
=/ new-foreign
%_ foreign
index +(index)
index-map (~(put by index-map.foreign) hen index)
duct-map (~(put by duct-map.foreign) index hen)
==
(~(put by contacts.agents.state) ship new-foreign)
::
=/ next mo-core(contacts.agents.state contacts)
[index next]
:: +mo-retrieve-duct: retrieve a duct by index.
::
++ mo-retrieve-duct
|= [=ship index=@ud]
^- duct
::
=/ =foreign (~(got by contacts.agents.state) ship)
(~(got by duct-map.foreign) index)
:: +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 !!
%core (mo-handle-sys-core path sign-arvo)
%pel (mo-handle-sys-pel path sign-arvo)
%red (mo-handle-sys-red 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)
==
:: +mo-handle-sys-core: receive a core from %ford.
::
++ mo-handle-sys-core
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%f %made *] sign-arvo)
?> ?=([@ @ @ @ @ ~] path)
=/ beak-path t.t.path
=/ =beak
=/ =ship (slav %p i.beak-path)
=/ =desk i.t.beak-path
=/ =case [%da (slav %da i.t.t.beak-path)]
[ship desk case]
(mo-receive-core i.t.path beak result.sign-arvo)
:: +mo-handle-sys-pel: translated peer.
::
:: Validates a received %ford result and %gives an internal %diff.
::
++ mo-handle-sys-pel
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%f %made *] sign-arvo)
?> ?=([@ @ ~] path)
::
?: ?=([%incomplete *] result.sign-arvo)
=/ err (some tang.result.sign-arvo)
(mo-give %unto %coup err)
::
=/ build-result build-result.result.sign-arvo
::
?: ?=([%error *] build-result)
=/ err (some message.build-result)
(mo-give %unto %coup err)
::
=/ =cage (result-to-cage:ford build-result)
(mo-give %unto %diff cage)
:: +mo-handle-sys-red: diff ack.
::
:: On receipt of a valid +sign from %ames, we simply pass a %pump
:: acknowledgement internally; otherwise we pass both an internal
:: unsubscribing %pull, plus a %want to %ames, before complaining about a
:: bad message acknowledgment.
::
++ mo-handle-sys-red
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([@ @ @ @ ~] path)
?. ?=([%a %woot *] sign-arvo)
~& [%red-want path]
mo-core
::
=/ him (slav %p i.t.path)
=/ dap i.t.t.path
=/ num (slav %ud i.t.t.t.path)
=/ =coop q.+>.sign-arvo
=/ sys-path
=/ pax [%req t.path]
[%sys pax]
::
?~ coop
=/ =note-arvo
=/ =sock [him our]
=/ =internal-task [dap %pump ~]
=/ =task:able [%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
(mo-pass sys-path note-arvo)
::
=/ mall-move=note-arvo
2019-08-29 21:44:37 +03:00
=/ =sock [him our]
=/ =internal-task [dap %pull ~]
=/ =task:able [%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
::
=/ ames-move=note-arvo
=/ path [%m %gh dap ~]
2019-08-29 21:44:37 +03:00
=/ =noun [num %x ~]
=/ =task:able:ames [%want him path noun]
[%a task]
::
=. mo-core (mo-pass sys-path mall-move)
2019-08-29 21:44:37 +03:00
=. mo-core (mo-pass sys-path ames-move)
::
?. ?=([~ ~ %mack *] coop)
~& [%diff-bad-ack coop]
mo-core
::
~& [%diff-bad-ack %mack]
=/ print (slog (flop q.,.+>.coop))
(print mo-core)
:: +mo-handle-sys-rep: reverse request.
::
:: On receipt of a valid +sign from %ford, sets state to the appropriate
:: duct and gives an internal %diff containing the +sign payload.
::
++ mo-handle-sys-rep
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([@ @ @ @ ~] path)
?> ?=([%f %made *] sign-arvo)
=/ him (slav %p i.t.path)
=/ dap i.t.t.path
=/ num (slav %ud i.t.t.t.path)
::
?: ?=([%incomplete *] result.sign-arvo)
=/ err (some tang.result.sign-arvo)
(mo-give %mack err)
::
=/ build-result build-result.result.sign-arvo
?: ?=([%error *] build-result)
:: XX should crash
=/ err (some message.build-result)
(mo-give %mack err)
:: XX pump should ack
=. mo-core (mo-give %mack ~)
=/ duct (mo-retrieve-duct him num)
=. mo-core (mo-abed duct)
=/ =cage (result-to-cage:ford build-result)
=/ move [%unto [%diff cage]]
(mo-give move)
:: +mo-handle-sys-req: process an inbound request.
::
++ mo-handle-sys-req
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([@ @ @ @ ~] path)
=/ him (slav %p i.t.path)
=/ dap i.t.t.path
=/ num (slav %ud i.t.t.t.path)
::
?: ?=([%f %made *] sign-arvo)
?: ?=([%incomplete *] result.sign-arvo)
=/ err (some tang.result.sign-arvo)
(mo-give %mack err)
::
=/ build-result build-result.result.sign-arvo
?: ?=([%error *] build-result)
=/ err (some message.build-result)
(mo-give %mack err)
::
=/ sys-path [%sys path]
=/ =note-arvo
=/ =cage (result-to-cage:ford build-result)
[%m %deal [him our] i.t.t.path %poke cage]
2019-08-29 21:44:37 +03:00
(mo-pass sys-path note-arvo)
::
?: ?=([%a %woot *] sign-arvo)
mo-core
::
?> ?=([%m %unto *] sign-arvo)
2019-08-29 21:44:37 +03:00
=/ =internal-gift +>.sign-arvo
::
?- -.internal-gift
%coup
(mo-give %mack p.internal-gift)
::
%diff
=/ sys-path [%sys %red t.path]
=/ =note-arvo
=/ path [%m %gh dap ~]
2019-08-29 21:44:37 +03:00
=/ noun [num %d p.p.internal-gift q.q.p.internal-gift]
[%a %want him path noun]
(mo-pass sys-path note-arvo)
::
%quit
=/ sys-path [%sys path]
=/ =note-arvo
=/ path [%m %gh dap ~]
2019-08-29 21:44:37 +03:00
=/ noun [num %x ~]
[%a %want him path noun]
(mo-pass sys-path note-arvo)
::
%reap
(mo-give %mack p.internal-gift)
::
%http-response
!!
==
:: +mo-handle-sys-val: inbound validate.
::
:: Validates an incoming +sign from %ford and applies it to the specified
:: agent.
::
++ mo-handle-sys-val
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%f %made *] sign-arvo)
?> ?=([@ @ @ ~] path)
=/ =ship (slav %p i.t.path)
=/ =term i.t.t.path
?: ?=([%incomplete *] result.sign-arvo)
=/ err (some tang.result.sign-arvo)
(mo-give %unto %coup err)
::
=/ build-result build-result.result.sign-arvo
?: ?=([%error *] build-result)
=/ err (some message.build-result)
(mo-give %unto %coup err)
::
=/ =routes [disclosing=~ attributing=ship]
=/ =cage (result-to-cage:ford build-result)
=/ =agent-action [%poke cage]
(mo-apply term routes agent-action)
:: +mo-handle-sys-way: outbound request.
::
++ mo-handle-sys-way
|= [=path =sign-arvo]
^+ mo-core
::
?> ?=([%a %woot *] sign-arvo)
?> ?=([@ @ ~] path)
=/ =foreign-response (foreign-response i.t.path)
=/ maybe-ares +>+.sign-arvo
(mo-handle-foreign-response foreign-response maybe-ares)
:: +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.
::
++ mo-handle-use
~/ %mo-handle-use
|= [=path hin=(hypo sign-arvo)]
^+ mo-core
::
?. ?=([@ @ coke *] path)
~& [%mo-handle-use-bad-path path]
!!
::
=/ app
=/ =term i.path
=/ =ship (slav %p i.t.path)
=/ =routes [disclosing=~ attributing=ship]
(ap-abed:ap term routes)
::
=/ =sign-arvo q.hin
?- i.t.t.path
%inn
=/ =vase (slot 3 hin)
=. app (ap-generic-take:app t.t.t.path vase)
ap-abet:app
::
%cay
~& [%mo-handle-use-weird sign-arvo]
~& [%mo-handle-use-weird-path path]
mo-core
::
%out
?. ?=([%m %unto *] sign-arvo)
2019-08-29 21:44:37 +03:00
~& [%mo-handle-use-weird sign-arvo]
~& [%mo-handle-use-weird-path path]
mo-core
=. app
=/ =internal-gift +>.sign-arvo
(ap-specific-take:app t.t.t.path internal-gift)
ap-abet:app
==
:: +mo-clear-queue: clear blocked tasks from the specified running agent.
::
++ mo-clear-queue
|= =term
^+ mo-core
::
?. (~(has by running.agents.state) term)
mo-core
=/ maybe-blocked (~(get by blocked.agents.state) term)
?~ maybe-blocked
mo-core
::
=/ =blocked u.maybe-blocked
::
|- ^+ mo-core
?: =(~ blocked)
=/ blocked (~(del by blocked.agents.state) term)
%_ mo-core
blocked.agents.state blocked
==
=^ task blocked [p q]:~(get to blocked)
=/ =duct p.task
=/ =routes q.task
=/ =agent-action r.task
::
=/ move
=/ =sock [attributing.routes our]
=/ =internal-task [term agent-action]
=/ card [%slip %m %deal sock internal-task]
2019-08-29 21:44:37 +03:00
[duct card]
$(moves [move moves])
:: +mo-beak: assemble a beak for the specified agent.
::
++ mo-beak
|= =term
^- beak
::
?~ running=(~(get by running.agents.state) term)
:: XX this fallback is necessary, as .term could be either the source
:: or the destination app. ie, it might not exist locally ...
::
[our %home %da now]
beak.u.running
:: +mo-peek: call to +ap-peek (which is not accessible outside of +mo).
::
++ mo-peek
~/ %mo-peek
|= [agent=term =routes =term =path]
^- (unit (unit cage))
::
=/ app (ap-abed:ap agent routes)
(ap-peek:app term path)
:: +mo-apply: apply the supplied action to the specified agent.
::
++ mo-apply
|= [=term =routes =agent-action]
^+ mo-core
::
=/ =path
=/ ship (scot %p attributing.routes)
/sys/val/[ship]/[term]
::
=/ ship-desk
=/ =beak (mo-beak term)
[p q]:beak
::
?: ?=(%puff -.agent-action)
=/ =schematic:ford [%vale ship-desk +.agent-action]
=/ =note-arvo [%f %build live=%.n schematic]
(mo-pass path note-arvo)
::
?: ?=(%punk -.agent-action)
=/ =schematic:ford [%cast ship-desk p.agent-action [%$ q.agent-action]]
=/ =note-arvo [%f %build live=%.n schematic]
(mo-pass path note-arvo)
::
?: ?=(%peer-not -.agent-action)
=/ err (some p.agent-action)
(mo-give %unto %reap err)
::
=/ app (ap-abed:ap term routes)
=. app (ap-apply:app agent-action)
ap-abet:app
:: +mo-handle-local: handle locally.
::
:: If the agent is running or blocked, assign it the supplied +task.
:: Otherwise simply apply the action to the agent.
::
++ mo-handle-local
|= [=ship =internal-task]
^+ mo-core
::
=/ =routes [disclosing=~ attributing=ship]
=/ =term p.internal-task
=/ =agent-action q.internal-task
=/ is-running (~(has by running.agents.state) term)
=/ is-blocked (~(has by blocked.agents.state) term)
::
?: |(!is-running is-blocked)
=/ =blocked
=/ waiting (~(get by blocked.agents.state) term)
=/ tasks (fall waiting *blocked)
=/ task [hen routes agent-action]
(~(put to tasks) task)
::
%_ mo-core
blocked.agents.state (~(put by blocked.agents.state) term blocked)
==
(mo-apply term routes agent-action)
:: +mo-handle-forward: handle forward %ames message.
::
++ mo-handle-forward
|= [=ship =term =bone =forward-ames]
^+ mo-core
::
=. mo-core
?. ?=(%u -.forward-ames)
mo-core
(mo-give %mack ~)
::
=/ =path
=/ him (scot %p ship)
=/ num (scot %ud bone)
/sys/req/[him]/[term]/[num]
::
=/ =sock [ship our]
=/ =note-arvo
?- -.forward-ames
%m
=/ =task:able
=/ =internal-task [term %puff [mark noun]:forward-ames]
[%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
::
%l
=/ =task:able
=/ =internal-task [term %peel [mark path]:forward-ames]
[%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
::
%s
=/ =task:able
=/ =internal-task [term %peer path.forward-ames]
[%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
::
%u
=/ =task:able
=/ =internal-task [term %pull ~]
[%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
==
(mo-pass path note-arvo)
:: +mo-handle-backward: handle reverse %ames message.
::
++ mo-handle-backward
|= [=ship =term =bone =reverse-ames]
^+ mo-core
::
?- -.reverse-ames
%d
=/ =path
=/ him (scot %p ship)
=/ num (scot %ud bone)
/sys/rep/[him]/[term]/[num]
::
=/ =note-arvo
=/ beak (mo-beak term)
=/ info [p q]:beak
=/ =schematic:ford [%vale info p.reverse-ames q.reverse-ames]
[%f %build live=%.n schematic]
::
(mo-pass path note-arvo)
::
%x
:: XX should crash
=. mo-core (mo-give %mack ~)
=/ initialised
=/ out (mo-retrieve-duct ship bone)
(mo-abed out)
(mo-give:initialised %unto %quit ~)
==
:: +ap: agent engine
::
:: An inner, agent-level core. The sample refers to the agent we're
:: currently focused on.
::
++ ap
~% %mall-ap +> ~
2019-08-29 21:44:37 +03:00
|_ $: agent-name=term
agent-routes=routes
agent-bone=bone
agent-moves=(list internal-move)
agent-config=(list (each suss tang))
current-agent=running-agent
==
++ ap-core .
:: +ap-abed: initialise state for an agent, with the supplied routes.
::
:: The agent must already be running in +mall -- 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
::
=/ =running-agent
=/ running (~(got by running.agents.state) term)
=/ =stats
:+ +(change.stats.running)
(shaz (mix (add term change.stats.running) eny))
now
running(stats stats)
::
=. agent-name term
=. agent-routes routes
=. current-agent running-agent
=/ maybe-bone (~(get by bone-map.ducts.running-agent) hen)
?^ maybe-bone
ap-core(agent-bone u.maybe-bone)
::
=/ =ducts
:+ +(bone.ducts.running-agent)
(~(put by bone-map.ducts.running-agent) hen bone.ducts.running-agent)
(~(put by duct-map.ducts.running-agent) bone.ducts.running-agent hen)
::
%_ ap-core
agent-bone bone.ducts.running-agent
ducts.current-agent ducts
==
:: +ap-abet: resolve moves.
::
++ ap-abet
^+ mo-core
::
=> ap-track-queue
=/ running (~(put by running.agents.state) agent-name current-agent)
=/ moves
=/ giver |=(report=(each suss tang) [hen %give %onto report])
=/ from-internal (turn agent-moves ap-from-internal)
=/ from-suss (turn agent-config giver)
:(weld from-internal from-suss moves)
::
%_ mo-core
running.agents.state running
moves moves
==
:: +ap-track-queue: track queue.
::
++ ap-track-queue
^+ ap-core
::
=/ internal-moves agent-moves
=/ bones *(set bone)
|- ^+ ap-core
?^ internal-moves
=/ =internal-move i.internal-moves
?. ?=([%give %diff *] move.internal-move)
$(internal-moves t.internal-moves)
::
=^ filled ap-core ap-enqueue(agent-bone bone.internal-move)
=/ new-bones
?: filled
bones
(~(put in bones) bone.internal-move)
$(internal-moves t.internal-moves, bones new-bones)
::
=/ bones ~(tap in bones)
::
|- ^+ ap-core
?~ bones
ap-core
::
=> $(bones t.bones, agent-bone i.bones)
=/ incoming
(~(get by incoming.subscribers.current-agent) agent-bone)
?~ incoming
~& [%ap-track-queue-bad-bone agent-name agent-bone]
ap-core
::
=/ =ship p.u.incoming
ap-kill(attributing.agent-routes ship)
:: +ap-from-internal: internal move to move.
::
:: We convert from bone-indexed moves to duct-indexed moves when
:: resolving them in Arvo.
::
++ ap-from-internal
~/ %ap-from-internal
|= =internal-move
^- move
::
~| [%mall-move-conversion-failed internal-move]
2019-08-29 21:44:37 +03:00
=/ =duct
(~(got by duct-map.ducts.current-agent) bone.internal-move)
::
=/ card
?- -.move.internal-move
%slip !!
::
%give
?< =(0 bone.internal-move)
::
=/ =internal-gift p.move.internal-move
?. ?=(%diff -.internal-gift)
[%give %unto internal-gift]
::
=/ =cage p.internal-gift
=/ =mark
=/ mark (~(get by marks.current-agent) bone.internal-move)
(fall mark p.cage)
::
?: =(mark p.cage)
[%give %unto internal-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]
::
[%pass path note-arvo]
::
%pass
=/ =path p.move.internal-move
=/ =internal-note q.move.internal-move
=/ use-path [%use agent-name path]
=/ =note-arvo
?- -.internal-note
%send
=/ =task:able
=/ =sock [our ship.internal-note]
=/ =internal-task internal-task.internal-note
[%deal sock internal-task]
[%m task]
2019-08-29 21:44:37 +03:00
::
%meta
=/ =term term.internal-note
=/ =vase vase.internal-note
[term %meta vase]
==
[%pass use-path note-arvo]
==
[duct card]
:: +ap-agent-core: agent core with current bowl and state
::
++ ap-agent-core
~(. agent.current-agent ap-construct-bowl)
2019-08-29 21:44:37 +03:00
:: +ap-apply: apply effect.
::
++ ap-apply
|= =agent-action
^+ ap-core
::
?- -.agent-action
%peel (ap-peel +.agent-action)
%poke (ap-poke +.agent-action)
%peer (ap-peer +.agent-action)
%puff !!
%punk !!
%peer-not !!
%pull ap-load-delete
%pump ap-dequeue
==
:: +ap-peek: peek.
::
++ ap-peek
~/ %ap-peek
|= [=term tyl=path]
^- (unit (unit cage))
::
=/ peek-result=(each (unit (unit cage)) tang)
(mule |.((handle-peek:ap-agent-core [term tyl])))
::
?- -.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
|= [is-ok=? =ship =path]
^+ ap-core
::
=/ way [(scot %p ship) %out path]
::
?: is-ok
=/ =internal-note [%send ship -.path %pump ~]
(ap-pass way internal-note)
=. ap-core (ap-give %quit ~)
=/ =internal-note [%send ship -.path %pull ~]
(ap-pass way internal-note)
:: +ap-dequeue: drop from queue.
::
:: Dequeues along the current bone, deleting the queue entirely if it
:: drops to zero.
::
++ ap-dequeue
^+ ap-core
::
?. (~(has by incoming.subscribers.current-agent) agent-bone)
ap-core
=/ level (~(get by meter.subscribers.current-agent) agent-bone)
?: |(?=(~ level) =(0 u.level))
ap-core
::
=. u.level (dec u.level)
?: =(0 u.level)
=/ deleted (~(del by meter.subscribers.current-agent) agent-bone)
ap-core(meter.subscribers.current-agent deleted)
::
=/ dequeued
(~(put by meter.subscribers.current-agent) agent-bone u.level)
ap-core(meter.subscribers.current-agent dequeued)
:: +ap-enqueue: add to queue.
::
:: Every agent has a 'meter', that tracks the number of incoming
:: subscribers by bone. We get both the meter and ship associated with
:: the current bone; if the meter has hit twenty for another ship, we
:: don't enqueue the subscriber. Otherwise we increment the meter for
:: the current bone and update the agent's state with it.
::
:: Returns a yes if the meter has been incremented, and no otherwise.
::
++ ap-enqueue
^- [? _ap-core]
::
=/ meter (~(gut by meter.subscribers.current-agent) agent-bone 0)
=/ subscriber=(unit (pair ship path))
(~(get by incoming.subscribers.current-agent) agent-bone)
::
?: ?& =(20 meter)
?| ?=(~ subscriber)
!=(our p.u.subscriber)
==
==
=/ incoming (~(get by incoming.subscribers.current-agent) agent-bone)
=/ duct (~(get by duct-map.ducts.current-agent) agent-bone)
~& [%mall-pulling-20 agent-bone incoming duct]
2019-08-29 21:44:37 +03:00
[%.n ap-core]
::
=/ next
=/ meter
(~(put by meter.subscribers.current-agent) agent-bone +(meter))
ap-core(meter.subscribers.current-agent meter)
::
[%.y next]
:: +ap-give: return result.
::
++ ap-give
|= =internal-gift
^+ ap-core
::
=/ internal-moves
=/ move [%give internal-gift]
=/ =internal-move [agent-bone move]
[internal-move agent-moves]
ap-core(agent-moves internal-moves)
:: +ap-construct-bowl: set up bowl.
::
++ ap-construct-bowl
^- bowl
:* :* our :: host
attributing.agent-routes :: guest
agent-name :: agent
== ::
:* :: NB (jtobin): see urbit/urbit#1466
wex=~ :: outgoing
sup=incoming.subscribers.current-agent :: incoming
== ::
:* agent-bone=agent-bone :: cause
act=change.stats.current-agent :: tick
eny=eny.stats.current-agent :: nonce
now=time.stats.current-agent :: time
byk=beak.current-agent :: source
== ==
:: +ap-pass: request action.
::
++ ap-pass
|= [=path =internal-note]
^+ ap-core
::
=/ =internal-move
=/ move [%pass path internal-note]
[agent-bone move]
=/ internal-moves [internal-move agent-moves]
ap-core(agent-moves internal-moves)
:: +ap-reinstall: reinstall.
::
++ ap-reinstall
~/ %ap-reinstall
|= =vase
^+ ap-core
::
2019-08-29 22:57:33 +03:00
=/ maybe-agent !<(agent vase)
?~ maybe-agent
(ap-lame %new-core-not-agent ~)
::
2019-08-29 21:44:37 +03:00
=/ prep
2019-08-29 22:57:33 +03:00
=/ =agent u.maybe-agent
=/ running (some ~(handle-stay agent.current-agent ap-construct-bowl))
2019-08-29 21:44:37 +03:00
=/ installed ap-install(agent.current-agent agent)
(installed running)
::
=^ maybe-tang ap-core prep
?~ maybe-tang
ap-core
(ap-lame %prep-failed u.maybe-tang)
:: +ap-peel: apply %peel.
::
++ ap-peel
|= [=mark =path]
^+ ap-core
::
=. marks.current-agent (~(put by marks.current-agent) agent-bone mark)
(ap-peer path)
:: +ap-peer: apply %peer.
::
++ ap-peer
~/ %ap-peer
|= pax=path
^+ ap-core
::
=/ incoming [attributing.agent-routes pax]
=. incoming.subscribers.current-agent
(~(put by incoming.subscribers.current-agent) agent-bone incoming)
::
=^ maybe-tang ap-core
%+ ap-ingest %reap |.
(handle-peer:ap-agent-core pax)
?^ maybe-tang
ap-silent-delete
ap-core
:: +ap-poke: apply %poke.
::
++ ap-poke
~/ %ap-poke
|= =cage
^+ ap-core
::
=^ maybe-tang ap-core
%+ ap-ingest %coup |.
(handle-poke:ap-agent-core cage)
ap-core
:: +ap-lame: pour error.
::
++ ap-lame
|= [=term =tang]
^+ ap-core
::
=/ form |=(=tank [%rose [~ "! " ~] tank ~])
2019-08-29 22:57:33 +03:00
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(handle-lame: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 =vase]
^+ ap-core
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(handle-take:ap-agent-core wire vase)
?^ maybe-tang
(ap-lame %take u.maybe-tang)
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-specific-take: specific take.
::
++ ap-specific-take
|= [=path =internal-gift]
^+ ap-core
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(handle-mall:ap-agent-core +.path internal-gift)
2019-08-29 21:44:37 +03:00
?: ?=(%diff -.internal-gift)
(ap-update-subscription =(~ maybe-tang) attributing.agent-routes +.path)
2019-08-29 21:44:37 +03:00
?^ maybe-tang
(ap-lame -.internal-gift u.maybe-tang)
ap-core
:: +ap-install: install wrapper.
::
++ ap-install
|= maybe-vase=(unit vase)
^- [(unit tang) _ap-core]
::
=^ maybe-tang ap-core (ap-prep maybe-vase)
::
=/ new-agent-config
=/ =term ?~(maybe-vase %boot %bump)
=/ possibly-suss
?~ maybe-tang
=/ =suss [agent-name term now]
[%.y suss]
[%.n u.maybe-tang]
[possibly-suss agent-config]
::
=/ next
ap-core(agent-config new-agent-config)
2019-08-29 21:44:37 +03:00
::
[maybe-tang next]
:: +ap-prep: low-level install.
::
++ ap-prep
~/ %ap-prep
|= maybe-vase=(unit vase)
^- [(unit tang) _ap-core]
::
=^ maybe-tang ap-core
%+ ap-ingest ~
?~ maybe-vase
|. handle-init:ap-agent-core
|. (handle-prep:ap-agent-core u.maybe-vase)
[maybe-tang ap-core]
:: +ap-silent-delete: silent delete.
::
++ ap-silent-delete
^+ ap-core
::
?~ (~(get by incoming.subscribers.current-agent) agent-bone)
ap-core
::
=/ incoming (~(del by incoming.subscribers.current-agent) agent-bone)
=/ meter (~(del by meter.subscribers.current-agent) agent-bone)
%_ ap-core
incoming.subscribers.current-agent incoming
meter.subscribers.current-agent meter
==
:: +ap-load-delete: load delete.
::
++ ap-load-delete
^+ ap-core
::
=/ maybe-incoming
(~(get by incoming.subscribers.current-agent) agent-bone)
?~ maybe-incoming
ap-core
::
=/ incoming u.maybe-incoming
=. incoming.subscribers.current-agent
(~(del by incoming.subscribers.current-agent) agent-bone)
=. meter.subscribers.current-agent
(~(del by meter.subscribers.current-agent) agent-bone)
::
=^ maybe-tang ap-core
%+ ap-ingest ~ |.
(handle-pull:ap-agent-core q.incoming)
?^ maybe-tang
(ap-lame %pull u.maybe-tang)
2019-08-29 21:44:37 +03:00
ap-core
:: +ap-kill: queue kill.
::
++ ap-kill
^+ ap-core
::
=> ap-load-delete
(ap-give %quit ~)
:: +ap-ingest: call agent arm
::
:: Handle acks here because they need to be emitted before the
:: rest of the moves.
::
++ ap-ingest
|= [ack=?(%coup %reap ~) run=_^?(|.(*step:agent))]
2019-08-29 21:44:37 +03:00
^- [(unit tang) _ap-core]
=/ result (mule run)
=^ 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-08-29 21:44:37 +03:00
=/ ack-moves
?- ack
~ ~
%coup [agent-bone %give %coup maybe-tang]~
%reap [agent-bone %give %reap maybe-tang]~
==
::
=. agent-moves
:(weld new-moves ack-moves agent-moves)
[maybe-tang ap-core]
:: +ap-handle-result: handle result.
::
++ ap-handle-result
~/ %ap-handle-result
|= result=(each step:agent tang)
^- [(list move:agent) _ap-core]
2019-08-29 21:44:37 +03:00
?: ?=(%| -.result)
`ap-core
2019-08-29 21:44:37 +03:00
::
=/ new-subs (ap-handle-quits -.p.result)
2019-08-29 21:44:37 +03:00
::
:- (flop -.p.result)
%_ ap-core
agent.current-agent +.p.result
2019-08-29 21:44:37 +03:00
incoming.subscribers.current-agent new-subs
==
:: +ap-handle-quits: handle cancels of incoming subscriptions
::
++ ap-handle-quits
~/ %ap-handle-quits
|= moves=(list move:agent)
^- bitt
=/ quits=(list bone)
%+ murn moves
2019-08-29 21:44:37 +03:00
|= =move:agent
^- (unit bone)
2019-08-29 21:44:37 +03:00
?. ?=([%give %quit *] move.internal-move)
~
`bone.move
2019-08-29 21:44:37 +03:00
::
=/ quit-map=bitt
(malt (turn quits |=(=bone [bone *[ship path]])))
2019-08-29 21:44:37 +03:00
(~(dif by incoming.subscribers.current-agent) quit-map)
:: +ap-tang: standard tang.
::
++ ap-tang
|= =tape
^- tang
::
=/ =tank [%leaf (weld "mall: {<agent-name>}: " tape)]
2019-08-29 21:44:37 +03:00
[tank ~]
--
--
:: +call: request
::
++ call
~% %mall-call +> ~
2019-08-29 21:44:37 +03:00
|= [=duct hic=(hypo (hobo task:able))]
^- [(list move) _mall-payload]
2019-08-29 21:44:37 +03:00
::
~| [%mall-call-failed duct q.hic]
2019-08-29 21:44:37 +03:00
:: make sure our task is hard
::
=/ =task:able
?. ?=(%soft -.q.hic)
q.hic
;; task:able p.q.hic
::
=/ initialised (mo-abed:mo duct)
?- -.task
%conf-mall
2019-08-29 21:44:37 +03:00
=/ =dock p.task
=/ =ship p.dock
?. =(our ship)
~& [%mall-not-ours ship]
[~ mall-payload]
2019-08-29 21:44:37 +03:00
::
~& [%mall-ours ship]
2019-08-29 21:44:37 +03:00
=> (mo-boot:initialised q.dock q.task)
~& [%mall-initialized ship]
2019-08-29 21:44:37 +03:00
mo-abet
::
?(%deal %deal-mall)
2019-08-29 21:44:37 +03:00
=/ =sock p.task
=/ =internal-task q.task
?. =(q.sock our)
?> =(p.sock our)
=> (mo-handle-foreign-request:initialised q.sock internal-task)
mo-abet
::
=> (mo-handle-local:initialised p.sock internal-task)
mo-abet
::
%init
=/ payload mall-payload(system-duct.agents.state duct)
2019-08-29 21:44:37 +03:00
[~ payload]
::
%vega
[~ mall-payload]
2019-08-29 21:44:37 +03:00
::
%west
=/ =ship p.task
=/ =path q.task
=/ =noun r.task
::
?> ?=([?(%ge %gh) @ ~] path)
=/ agent-name i.t.path
::
?: ?=(%ge i.path)
=/ mes ;;((pair @ud forward-ames) noun)
=> (mo-handle-forward:initialised ship agent-name mes)
mo-abet
::
=/ mes ;;((pair @ud reverse-ames) noun)
=> (mo-handle-backward:initialised ship agent-name mes)
mo-abet
::
%wash
=. running.agents.state
%- ~(run by running.agents.state)
|= =running-agent
running-agent(cache *worm)
[~ mall-payload]
2019-08-29 21:44:37 +03:00
::
%wegh
=/ blocked
=/ queued (~(run by blocked.agents.state) |=(blocked [%.y +<]))
(sort ~(tap by queued) aor)
::
=/ running
=/ active (~(run by running.agents.state) |=(running-agent [%.y +<]))
2019-08-29 21:44:37 +03:00
(sort ~(tap by active) aor)
::
=/ =mass
:+ %mall %.n
2019-08-29 21:44:37 +03:00
:~ [%foreign %.y contacts.agents.state]
[%blocked %.n blocked]
[%active %.n running]
[%dot %.y state]
==
::
=/ moves
=/ =move [duct %give %mass mass]
[move ~]
::
[moves mall-payload]
2019-08-29 21:44:37 +03:00
==
:: +load: recreate vane
::
++ load
|= =state-old
^+ mall-payload
2019-08-29 21:44:37 +03:00
::
?- -.state-old
%0 mall-payload(state state-old)
2019-08-29 21:44:37 +03:00
==
:: +scry: standard scry
::
++ scry
~/ %mall-scry
2019-08-29 21:44:37 +03:00
|= [fur=(unit (set monk)) =term =shop =desk =coin =path]
^- (unit (unit cage))
?. ?=(%.y -.shop)
~
::
=/ =ship p.shop
?: ?& =(%u term)
=(~ path)
=([%$ %da now] coin)
=(our ship)
==
=/ =vase !>((~(has by running.agents.state) desk))
=/ =cage [%noun vase]
(some (some cage))
::
?. =(our ship)
~
::
?. =([%$ %da now] coin)
~
::
?. (~(has by running.agents.state) desk)
(some ~)
::
?. ?=(^ path)
~
::
=/ initialised mo-abed:mo
=/ =routes [~ ship]
(mo-peek:initialised desk routes term path)
:: +stay: save without cache
::
++ stay state
:: +take: response
::
++ take
~/ %mall-take
2019-08-29 21:44:37 +03:00
|= [=wire =duct hin=(hypo sign-arvo)]
^- [(list move) _mall-payload]
2019-08-29 21:44:37 +03:00
::
~| [%mall-take-failed wire]
2019-08-29 21:44:37 +03:00
?> ?=([?(%sys %use) *] wire)
=/ initialised (mo-abed:mo duct)
=/ =sign-arvo q.hin
=>
?- i.wire
%sys (mo-handle-sys:initialised t.wire sign-arvo)
%use (mo-handle-use:initialised t.wire hin)
==
mo-abet
--