Merge branch 'develop' into i/6103/abet-pure

This commit is contained in:
jose 2023-05-22 13:23:02 +02:00 committed by GitHub
commit 7df931b375
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 136 additions and 72 deletions

View File

@ -300,7 +300,7 @@
~/ %handle-http-request
|= [eyre-id=@ta =inbound-request:eyre]
^- (quip card _state)
::?> authenticated.inbound-request
?> authenticated.inbound-request
=/ url
(parse-request-line:server url.request.inbound-request)
?> ?=([%spider @t @t @t @t ~] site.url)

View File

@ -0,0 +1,11 @@
:: Print keys for a ship, as stored in %ames
::
:- %say
|= [[now=time @ our=ship ^] [=ship ~] ~]
=+ .^ =ship-state:ames
%ax /(scot %p our)//(scot %da now)/peers/(scot %p ship)
==
:- %noun
?. ?=(%known -.ship-state)
%ship-still-alien
[life=life rift=rift]:+.ship-state

View File

@ -10,14 +10,11 @@
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
=/ existing-story .^(? %cu /(scot %p our)/[desk]/(scot %da now)/story)
?: ?&(existing-story !overwrite)
~& >> "Error: /{(trip (slav %tas desk))}/story already exists."
~& >> "To forcibly overwrite, use `=overwrite %.y`"
:: XX could use a better way to noop
helm-pass+[%d %noop ~]
:- %helm-pass
[%d %flog %text "Error: /{(trip (slav %tas desk))}/story already exists. To forcibly overwrite, use `=overwrite %.y`"]
=| tale=story
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -13,8 +13,7 @@
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
=/ tak=tako:clay
?: ?=([%tako tako:clay] cas)
p.cas
@ -25,12 +24,11 @@
::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one."
helm-pass+[%d %noop ~]
helm-pass+[%d %flog %text "Error: No story file found. Please use |story-init to create one."]
=/ tale=story .^(story %cx pax)
=. tale
?: =(*prose prz)
(~(del by tale) tak)
(~(del ju tale) tak prz)
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -13,8 +13,7 @@
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
helm-pass+[%d %flog %text "Error: desk {<desk>} does not exist."]
=/ tak=tako:clay
?: ?=([%tako tako:clay] cas)
p.cas
@ -25,10 +24,9 @@
::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one."
helm-pass+[%d %noop ~]
helm-pass+[%d %flog %text "Error: No story file found. Please use |story-init to create one."]
=/ tale=story .^(story %cx /(scot %p our)/[desk]/(scot %da now)/story)
=/ =prose [title ?~(body '' p.body)]
=. tale (~(put ju tale) tak prose)
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

View File

@ -2,6 +2,6 @@
:- %say
|= [[now=@da eny=@uvJ bec=beak] [syd=desk ~] verb=_&]
:* %tang
leaf+"Notice: +vat is deprecated as +vats now takes lists of one or more desks"
leaf+"Notice: +vat is deprecated. use +vats which now takes one or more desks as arguments. e.g. '+vats %base %garden'"
(report-vat (report-prep p.bec now) p.bec now syd verb)
==

View File

@ -1741,41 +1741,56 @@
++ on-stir
|= arg=@t
^+ event-core
=/ want=(set [@da ^duct])
%- ~(rep by peers.ames-state)
|= [[who=ship s=ship-state] acc=(set [@da ^duct])]
?. ?=(%known -.s) acc
%- ~(rep by snd.+.s)
|= [[b=bone m=message-pump-state] acc=_acc]
=* tim next-wake.packet-pump-state.m
?~ tim acc
%- ~(put in acc)
[u.tim `^duct`~[ames+(make-pump-timer-wire who b) /ames]]
=. want
(~(put in want) (add now ~d1) ~[/ames/recork /ames])
|^ ?+ arg do-stir
%rift do-rift
==
::
=/ have
%- ~(gas in *(set [@da ^duct]))
=/ tim
;; (list [@da ^duct])
=< q.q %- need %- need
(rof ~ %bx [[our %$ da+now] /debug/timers])
(skim tim |=([@da hen=^duct] ?=([[%ames ?(%pump %recork) *] *] hen)))
++ do-rift
=/ =rift
=- ~|(%no-rift (,@ q.q:(need (need -))))
(rof ~ %j `beam`[[our %rift %da now] /(scot %p our)])
?: =(rift rift.ames-state)
event-core
~& "ames: fixing rift from {<rift.ames-state>} to {<rift>}"
event-core(ames-state ames-state(rift rift))
::
:: set timers for flows that should have one set but don't
::
=. event-core
%- ~(rep in (~(dif in want) have))
++ do-stir
=/ want=(set [@da ^duct])
%- ~(rep by peers.ames-state)
|= [[who=ship s=ship-state] acc=(set [@da ^duct])]
?. ?=(%known -.s) acc
%- ~(rep by snd.+.s)
|= [[b=bone m=message-pump-state] acc=_acc]
=* tim next-wake.packet-pump-state.m
?~ tim acc
%- ~(put in acc)
[u.tim `^duct`~[ames+(make-pump-timer-wire who b) /ames]]
=. want
(~(put in want) (add now ~d1) ~[/ames/recork /ames])
::
=/ have
%- ~(gas in *(set [@da ^duct]))
=/ tim
;; (list [@da ^duct])
=< q.q %- need %- need
(rof ~ %bx [[our %$ da+now] /debug/timers])
(skim tim |=([@da hen=^duct] ?=([[%ames ?(%pump %recork) *] *] hen)))
::
:: set timers for flows that should have one set but don't
::
=. event-core
%- ~(rep in (~(dif in want) have))
|= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen)
(emit:this ~[/ames] %pass t.i.hen %b %wait wen)
::
:: cancel timers for flows that have one set but shouldn't
::
%- ~(rep in (~(dif in have) want))
|= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen)
(emit:this ~[/ames] %pass t.i.hen %b %wait wen)
::
:: cancel timers for flows that have one set but shouldn't
::
%- ~(rep in (~(dif in have) want))
|= [[wen=@da hen=^duct] this=_event-core]
?> ?=([^ *] hen)
(emit:this t.hen %pass t.i.hen %b %rest wen)
(emit:this t.hen %pass t.i.hen %b %rest wen)
--
:: +on-crud: handle event failure; print to dill
::
++ on-crud
@ -2206,7 +2221,11 @@
=/ peer-core (abed-peer:pe her.u.res u.state)
?- -.u.res
%pump abet:(on-wake:peer-core bone.u.res error)
%fine abet:fi-abet:fi-take-wake:(abed:fi:peer-core wire.u.res)
::
%fine
?. (~(has by keens.peer-state.peer-core) wire.u.res)
event-core
abet:fi-abet:fi-take-wake:(abed:fi:peer-core wire.u.res)
==
::
=. event-core (emit duct %pass /recork %b %wait `@da`(add now ~d1))
@ -2903,6 +2922,10 @@
:: expire direct route if the peer is not responding
::
=. peer-state (update-peer-route her peer-state)
:: required so that the following +send-blob's (including
:: inside +call:mu), access up-to-date peer state
::
=. event-core abet
:: resend comet attestation packet if first message times out
::
:: The attestation packet doesn't get acked, so if we tried to
@ -4478,7 +4501,7 @@
:: if this was a re-send, don't adjust rtt or downstream state
::
?: (gth tries.packet-state 1)
metrics
metrics(rto (clamp-rto (add rtt (mul 4 rttvar))))
:: rtt-datum: new rtt measurement based on packet roundtrip
::
=/ rtt-datum=@dr (sub-safe now last-sent.packet-state)

View File

@ -714,7 +714,14 @@
=. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) cast+[a b])
~|(cycle+cast+[a b]^cycle.nub !!)
?: =(a b)
%+ gain-leak cast+a^b
|= nob=state
%- (trace 4 |.("identity shortcircuit"))
=. nub nob
:_(nub vase+same.bud)
?: =([%mime %hoon] [a b])
%- (trace 4 |.("%mime -> %hoon shortcircuit"))
:_(nub [%vase =>(..zuse !>(|=(m=mime q.q.m)))])
:: try +grow; is there a +grow core with a .b arm?
::
@ -729,6 +736,7 @@
::
%+ gain-leak cast+a^b
|= nob=state
%- (trace 4 |.("{<a>} -> {<b>}: +{(trip b)}:grow:{(trip a)}"))
=. nub nob
:_ nub :- %vase
%+ slap (with-faces cor+old ~)
@ -743,18 +751,24 @@
?: &(?=(%& -.rab) ?=(^ q.p.rab))
%+ gain-leak cast+a^b
|= nob=state
%- (trace 4 |.("{<a>} -> {<b>}: +{(trip a)}:grab:{(trip b)}"))
=. nub nob
:_(nub vase+p.rab)
:: try +jump
::
=/ jum (mule |.((slap old tsgl/[limb/b limb/%jump])))
?: ?=(%& -.jum)
(compose-casts a !<(mark p.jum) b)
=/ via !<(mark p.jum)
%- (trace 4 |.("{<a>} -> {<b>}: via {<via>} per +jump:{(trip a)}"))
(compose-casts a via b)
?: ?=(%& -.rab)
(compose-casts a !<(mark p.rab) b)
=/ via !<(mark p.rab)
%- (trace 4 |.("{<a>} -> {<b>}: via {<via>} per +grab:{(trip b)}"))
(compose-casts a via b)
?: ?=(%noun b)
%+ gain-leak cast+a^b
|= nob=state
%- (trace 4 |.("{<a>} -> {<b>} default"))
=. nub nob
:_(nub vase+same.bud)
~|(no-cast-from+[a b] !!)
@ -1818,7 +1832,11 @@
=? ..park !?=(%base syd) wick :: [wick]
%- (slog leaf+"clay: wait-for-kelvin, {<[need=zuse/zuse have=kel]>}" ~)
tare :: [tare] >
=. wic.dom (~(del by wic.dom) zuse+zuse)
=. wic.dom
%- ~(gas by *(map weft ^yoki))
%+ skip ~(tap by wic.dom)
|= [w=weft ^yoki]
(gte num.w zuse)
::
=/ old-yaki
?: =(0 let.dom)
@ -3304,7 +3322,6 @@
|= [inx=@ud rut=(unit rand)]
^+ +>
?> ?=(^ ref)
~& take-foreign/inx
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv
~& %bad-answer
@ -4489,13 +4506,14 @@
++ read-at-tako :: read-at-tako:ze
|= [for=(unit ship) tak=tako mun=mood] :: seek and read
^- [(unit (unit cage)) _..park]
?. |(?=(~ for) (may-read u.for care.mun tak path.mun))
[~ ..park]
:: the commit must be known, and reachable from within this desk
:: non-zero commits must be known, and reachable from within this desk
::
?. ?| =(0v0 tak)
?& (~(has by hut.ran) tak)
(~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak)
?| (~(any by hit.dom) |=(=tako =(tak tako))) :: fast-path
(~(has in (reachable-takos (aeon-to-tako:ze let.dom))) tak)
==
|(?=(~ for) (may-read u.for care.mun tak path.mun))
== ==
[~ ..park]
:: virtualize to catch and produce deterministic failures

View File

@ -2358,12 +2358,24 @@
::
=/ task=task ((harden task) wrapped-task)
::
:: XX handle error notifications
:: XX handle more error notifications
::
?^ dud
=/ moves=(list move)
[[duct %slip %d %flog %crud [-.task tang.u.dud]] ~]
[moves http-server-gate]
:_ http-server-gate
:: always print the error trace
::
:- [duct %slip %d %flog %crud [-.task tang.u.dud]]
^- (list move)
:: if a request caused the crash, respond with a 500
::
?. ?=(?(%request %request-local) -.task) ~
^~
=/ data (as-octs:mimes:html 'crud!')
=/ head
:~ ['content-type' 'text/html']
['content-length' (crip (a-co:co p.data))]
==
[duct %give %response %start 500^head `data &]~
:: %init: tells us what our ship name is
::
?: ?=(%init -.task)

View File

@ -433,7 +433,7 @@
|- ^+ mo-core
?~ agents
mo-core
=. mo-core
=? mo-core ?=(%live -.yoke.i.agents)
=/ =routes [disclosing=~ attributing=ship]
=/ app (ap-abed:ap name.i.agents routes)
ap-abet:(ap-breach:app ship)
@ -474,12 +474,12 @@
?> ?=([%lag ~] wire)
?> ?=([%ames %clog *] sign-arvo)
::
=/ agents=(list term) ~(tap in ~(key by yokes.state))
=/ agents=(list [=dude =yoke]) ~(tap by yokes.state)
|- ^+ mo-core
?~ agents mo-core
::
=. mo-core
=/ app (ap-abed:ap i.agents `our)
=? mo-core ?=(%live -.yoke.i.agents)
=/ app (ap-abed:ap dude.i.agents `our)
ap-abet:(ap-clog:app ship.sign-arvo)
::
$(agents t.agents)
@ -704,7 +704,8 @@
++ mo-idle
|= dap=dude
^+ mo-core
?. (~(has by yokes.state) dap)
=/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %idle for {<dap>}, not running"
mo-core
ap-abet:ap-idle:(ap-abed:ap dap `our)
@ -713,14 +714,15 @@
++ mo-nuke
|= dap=dude
^+ mo-core
?. (~(has by yokes.state) dap)
=/ yoke=(unit yoke) (~(get by yokes.state) dap)
?: |(?=(~ yoke) ?=(%nuke -.u.yoke))
~> %slog.0^leaf/"gall: ignoring %nuke for {<dap>}, not running"
mo-core
~> %slog.0^leaf/"gall: nuking {<dap>}"
=. mo-core ap-abet:ap-nuke:(ap-abed:ap dap `our)
=- mo-core(yokes.state -)
%+ ~(jab by yokes.state) dap
|= =yoke
|= =^yoke
?: ?=(%nuke -.yoke) yoke
:- %nuke
%- ~(run by sky.yoke)
@ -755,6 +757,7 @@
|= [veb=? dap=term =routes care=term =path]
^- (unit (unit cage))
::
?. ?=([~ %live *] (~(get by yokes.state) dap)) [~ ~]
=/ app (ap-abed:ap dap routes)
(ap-peek:app veb care path)
::
@ -766,6 +769,10 @@
(mo-apply-sure dap routes deal)
::
%raw-poke
:: don't validate %noun pokes, for performance
::
?: =(%noun mark.deal)
(mo-apply-sure dap routes [%poke %noun %noun noun.deal])
=/ =case da+now
=/ yok (~(got by yokes.state) dap)
=/ =desk q.beak:?>(?=(%live -.yok) yok) ::TODO acceptable assertion?
@ -970,7 +977,7 @@
++ ap-idle
^+ ap-core
?: ?=(%| -.agent.yoke) ap-core
=> [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all *agent]))]
=> [ken=ken.yoke (ap-ingest ~ |.([ap-yawn-all p.agent.yoke]))]
ap-core(ken.yoke ken, agent.yoke |+on-save:ap-agent-core)
::
++ ap-nuke