ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-18 12:22:10 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'develop' into i/5788/remote-scry

Browse Source
This commit is contained in:
yosoyubik 2023-04-07 19:24:08 +02:00
commit 538b0e920e
24 changed files with 527 additions and 249 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.github/workflows/develop.yml vendored
View File

@ -9,7 +9,7 @@ on:
- '.github/workflows/develop.yml'
- '.github/workflows/release.yml'
- '.github/workflows/master.yml'
- '.github/workflows/vere.yml'
- '.github/workflows/shared.yml'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
@ -24,7 +24,7 @@ on:
jobs:
call-vere:
uses: ./.github/workflows/vere.yml
uses: ./.github/workflows/shared.yml
with:
pace: 'edge'
upload: >-

4
.github/workflows/feature.yml vendored
View File

@ -7,7 +7,7 @@ on:
- '.github/workflows/develop.yml'
- '.github/workflows/release.yml'
- '.github/workflows/master.yml'
- '.github/workflows/vere.yml'
- '.github/workflows/shared.yml'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
@ -22,7 +22,7 @@ on:
jobs:
call-vere:
uses: ./.github/workflows/vere.yml
uses: ./.github/workflows/shared.yml
with:
pace: 'edge'
upload: >-

4
.github/workflows/master.yml vendored
View File

@ -9,7 +9,7 @@ on:
- '.github/workflows/develop.yml'
- '.github/workflows/release.yml'
- '.github/workflows/master.yml'
- '.github/workflows/vere.yml'
- '.github/workflows/shared.yml'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
@ -24,7 +24,7 @@ on:
jobs:
call-vere:
uses: ./.github/workflows/vere.yml
uses: ./.github/workflows/shared.yml
with:
pace: 'live'
upload: >-

31
.github/workflows/next.yml vendored Normal file
View File

@ -0,0 +1,31 @@
name: Push to next/kelvin/*
on:
push:
branches:
- 'next/kelvin/*'
paths:
- '.github/workflows/feature.yml'
- '.github/workflows/develop.yml'
- '.github/workflows/release.yml'
- '.github/workflows/master.yml'
- '.github/workflows/shared.yml'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
- 'pkg/ge-additions/**'
- 'pkg/libaes_siv/**'
- 'pkg/urbit/**'
- 'pkg/urcrypt/**'
- 'tests/**'
- 'bin/**'
- 'nix/**'
- 'default.nix'
jobs:
call-vere:
uses: ./.github/workflows/shared.yml
with:
upload: true
next: ${{ github.ref | replace('refs/heads/next/kelvin/', '') }}
secrets: inherit

4
.github/workflows/release.yml vendored
View File

@ -9,7 +9,7 @@ on:
- '.github/workflows/develop.yml'
- '.github/workflows/release.yml'
- '.github/workflows/master.yml'
- '.github/workflows/vere.yml'
- '.github/workflows/shared.yml'
- 'pkg/arvo/**'
- 'pkg/docker-image/**'
- 'pkg/ent/**'
@ -24,7 +24,7 @@ on:
jobs:
call-vere:
uses: ./.github/workflows/vere.yml
uses: ./.github/workflows/shared.yml
with:
pace: 'soon'
upload: >-

14
.github/workflows/vere.yml → .github/workflows/shared.yml vendored
View File

@ -14,6 +14,11 @@ on:
type: string
default: 'edge'
required: false
next:
description: 'next kelvin version'
type: string
default: null
required: false
secrets:
CACHIX_AUTH_TOKEN:
required: false
@ -73,9 +78,14 @@ jobs:
name: run urbit-tests
run: |
cp -RL tests pkg/arvo/tests
vere=$(curl https://bootstrap.urbit.org/vere/${{ inputs.pace }}/last)
if ${{ inputs.next != null }}; then
base="https://bootstrap.urbit.org/vere/next/kelvin/${{ inputs.next }}"
else
base="https://bootstrap.urbit.org/vere/${{ inputs.pace }}"
fi
vere=$(curl ${base}/last)
url="$(echo ${base}/v${vere}/vere-v${vere}-linux-x86_64)"
echo $vere
url="$(echo https://bootstrap.urbit.org/vere/${{ inputs.pace }}/v${vere}/vere-v${vere}-linux-x86_64)"
echo $url
# put in .jam so it doesn't crash when it gets -A'd in
curl -Lo pkg/arvo/vere.jam "$url"

5
pkg/arvo/app/aqua.hoon
View File

@ -496,11 +496,10 @@
=/ =desk +.val
=. userspace-ova.pil
:: take all files from a userspace desk
=/ all-dirs=(list path) ~[/]
:_ ~
%- unix-event:pill-lib
%+ %*(. file-ovum:pill-lib directories all-dirs)
desk /(scot %p our.hid)/[desk]/(scot %da now.hid)
%- file-ovum:pill-lib
[desk /(scot %p our.hid)/[desk]/(scot %da now.hid) ~]
=^ ms state (poke-pill pil)
(emit-cards ms)
::

5
pkg/arvo/app/ping.hoon
View File

@ -42,10 +42,9 @@
%- (slog leaf+"ping: strange state {<ship s>}" ~)
`state
:: NAT timeouts are often pretty short for UDP entries. 5
:: minutes is a common value. We use 30 seconds, which is fairly
:: aggressive, but should be safe.
:: minutes is a common value. We use 25 seconds, same as Wireguard.
::
=/ until (add ~s30 now)
=/ until (add ~s25 now)
=. ships.state
(~(put by ships.state) ship u.s(ship-state [%waiting until]))
:_ state

3
pkg/arvo/gen/brass.hoon
View File

@ -25,6 +25,7 @@
==
::
prime=_|
exc=(list spur)
==
:- %pill
^- pill:pill
@ -45,4 +46,4 @@
|= =desk
[desk /(scot %p p.bec)/[desk]/(scot %da now)]
::
(brass:pill sys dez prime)
(brass:pill sys dez prime exc)

15
pkg/arvo/gen/hood/new-desk.hoon
View File

@ -5,7 +5,7 @@
:- %ask
|= $: [now=@da eny=@uvJ bek=beak]
[=desk ~]
[from=$~(%base desk) hard=_|]
[from=$~(%base desk) hard=_| gall=_|]
==
::
=; make-new-desk
@ -27,12 +27,23 @@
%- ~(gas by *(map path page:clay))
|^ =- (turn - mage)
^- (list path)
:~ /mar/noun/hoon
=/ common-files=(list path) :~
/mar/noun/hoon
/mar/hoon/hoon
/mar/txt/hoon
/mar/kelvin/hoon
/sys/kelvin
==
=/ extra-files=(list path) ?. gall [~]
:~
/mar/bill/hoon
/mar/mime/hoon
/mar/json/hoon
/lib/skeleton/hoon
/lib/default-agent/hoon
/lib/dbug/hoon
==
(weld common-files extra-files)
::
++ mage
|= =path

3
pkg/arvo/gen/solid.hoon
View File

@ -29,6 +29,7 @@
::
dub=_|
prime=_|
exc=(list spur)
==
:- %pill
^- pill:pill
@ -46,4 +47,4 @@
|= =desk
[desk /(scot %p p.bec)/[desk]/(scot %da now)]
::
(solid:pill sys dez dub now prime)
(solid:pill sys dez dub now prime exc)

9
pkg/arvo/gen/vat.hoon
View File

@ -1,6 +1,11 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
[syd=desk ~]
verb=?
==
[%tang ~[(report-vat (report-prep p.bec now) p.bec now desk)]]
=+ ~(abed report-vats p.bec now)
=+ %+ report-vat
verb
%- vat-info syd
[%tang -]

18
pkg/arvo/gen/vats.hoon
View File

@ -1,6 +1,20 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[arg=~ ~]
$@(~ [?(%suspended %running %blocking %nonexistent) ~])
$: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
[%tang (report-vats p.bec now)]
==
=+ :- verb
?~ +<+< +<+>+
?- -.+<+<
%suspended [& | | |]
%running [| & | |]
%blocking [| | & |]
%nonexistent [| | | &]
==
tang+((report-vats p.bec now) -)

8
pkg/arvo/lib/hood/kiln.hoon
View File

@ -583,15 +583,13 @@
..abet
=/ kel i.wic
%- emil
=/ cards
=/ desks=(list [=desk =zest])
%+ murn ~(tap by rock)
|= [=desk =zest wic=(set weft)]
?: |(=(%base desk) !?=(%live zest) (~(has in wic) kel))
~
`u=[%pass /kiln/bump/[desk] %arvo %c %zest desk %held]
?~ cards
[%pass /kiln/bump/wick %arvo %c %wick ~]~
cards
`u=[desk %held]
[%pass /kiln/bump/zeal %arvo %c %zeal desks]~
::
++ poke-cancel
|= a=@tas

11
pkg/arvo/sys/arvo.hoon
View File

@ -776,6 +776,7 @@
::
~> %slog.[0 leaf+"1-c (compiling compiler, wait a few minutes)"]
=/ compiler-tool
~> %bout
.*([compiler-gate noun/hoon.log] [%9 2 %10 [6 %0 3] %0 2])
::
:: switch to the second-generation compiler. we want to be
@ -784,7 +785,7 @@
:: generate last-generation spans for `!>`, etc.
::
~> %slog.[0 leaf+"1-d"]
=. compiler-gate .*(0 +.compiler-tool)
=. compiler-gate ~>(%bout .*(0 +.compiler-tool))
::
:: get the span (type) of the kernel core, which is the context
:: of the compiler gate. we just compiled the compiler,
@ -794,17 +795,20 @@
::
~> %slog.[0 leaf+"1-e"]
=/ kernel-span
~> %bout
-:.*([compiler-gate -.compiler-tool '+>'] [%9 2 %10 [6 %0 3] %0 2])
::
:: compile the arvo source against the kernel core.
::
~> %slog.[0 leaf+"1-f"]
=/ kernel-tool
~> %bout
.*([compiler-gate kernel-span arvo.log] [%9 2 %10 [6 %0 3] %0 2])
::
:: create the arvo kernel, whose subject is the kernel core.
::
~> %slog.[0 leaf+"1-g"]
~> %bout
[.*(+>.compiler-gate +.kernel-tool) epic.log]
--
::
@ -1049,6 +1053,7 @@
|= [cap=tape sub=vase pax=path txt=@t]
^- vase
~> %slog.[0 leaf/"{cap}: {(scow p+(mug txt))}"]
~> %bout
%- road |.
~_ leaf/"{cap}: build failed"
(slap sub (rain pax txt))
@ -1626,6 +1631,7 @@
?~ hun
=/ gat
~> %slog.[0 'arvo: compiling next arvo']
~> %bout
%- road |.
(slap !>(..ride) (rain /sys/arvo/hoon van))
=/ lod
@ -1643,6 +1649,7 @@
::
=/ raw
~> %slog.[0 'arvo: compiling hoon']
~> %bout
(road |.((ride %noun u.hun)))
:: activate the new compiler gate, producing +ride
::
@ -1668,6 +1675,7 @@
[raw cop]
=/ hot
~> %slog.[0 leaf/"arvo: recompiling hoon %{(scow %ud nex)}"]
~> %bout
(road |.((slum cop [%noun u.hun])))
[hot .*(0 +.hot)]
:: extract the hoon core from the outer gate (+ride)
@ -1683,6 +1691,7 @@
::
=/ rav
~> %slog.[0 'arvo: compiling next arvo']
~> %bout
(road |.((slum cop [hyp van])))
:: activate arvo and extract the arvo core from the outer gate
::

1
pkg/arvo/sys/lull.hoon
View File

@ -1796,6 +1796,7 @@
[%warp wer=ship rif=riff] :: internal file req
[%werp who=ship wer=ship rif=riff-any] :: external file req
[%wick ~] :: try upgrade
[%zeal lit=(list [=desk =zest])] :: batch zest
[%zest des=desk liv=zest] :: live
$>(%plea vane-task) :: ames request
== ::

17
pkg/arvo/sys/vane/ames.hoon
View File

@ -4154,7 +4154,14 @@
++ clamp-rto
|= rto=@dr
^+ rto
(min ~m2 (max ^~((div ~s1 5)) rto))
(min max-backoff (max ^~((div ~s1 5)) rto))
:: +max-backoff: calculate highest re-send interval
::
:: Keeps pinhole to sponsors open by inspecting the duct (hack).
::
++ max-backoff
^- @dr
?:(?=([[%gall %use %ping *] *] duct) ~s25 ~m2)
:: +in-slow-start: %.y iff we're in "slow-start" mode
::
++ in-slow-start
@ -4512,6 +4519,7 @@
:: /ax/protocol/version @
:: /ax/peers (map ship ?(%alien %known))
:: /ax/peers/[ship] ship-state
:: /ax/peers/[ship]/last-contact (unit @da)
:: /ax/peers/[ship]/forward-lane (list lane)
:: /ax/bones/[ship] [snd=(set bone) rcv=(set bone)]
:: /ax/snd-bones/[ship]/[bone] vase
@ -4538,6 +4546,13 @@
?~ peer
[~ ~]
``noun+!>(u.peer)
::
[%last-contact ~]
:^ ~ ~ %noun
!> ^- (unit @da)
?. ?=([~ %known *] peer)
~
`last-contact.qos.u.peer
::
[%forward-lane ~]
::

17
pkg/arvo/sys/vane/clay.hoon
View File

@ -5095,9 +5095,22 @@
::
%wick
=^ mos ruf
=/ den ((de now rof hen ruf) our %base)
abet:wick:den :: [wick]
abet:wick:((de now rof hen ruf) our %base) :: [wick]
[mos ..^$]
::
%zeal
=^ m1 ruf
=| mos=(list move)
|- ^+ [mos ruf]
?~ lit.req
[mos ruf]
=/ den ((de now rof hen ruf) our desk.i.lit.req)
=^ mos-new ruf abet:(set-zest:den zest.i.lit.req)
$(mos (weld mos mos-new), lit.req t.lit.req)
=^ m2 ruf
abet:wick:((de now rof hen ruf) our %base)
=^ m3 ruf abet:goad:(lu now rof hen ruf)
[:(weld m1 m2 m3) ..^$]
::
%zest
=^ m1 ruf

4
pkg/arvo/sys/vane/dill.hoon
View File

@ -250,8 +250,10 @@
wrapped-task=(hobo task)
==
^+ [*(list move) ..^$]
=/ task=task
~| wrapped-task
=/ task=task ((harden task) wrapped-task)
((harden task) wrapped-task)
~| -.task
:: unwrap session tasks, default to session %$
::
=^ ses=@tas task

53
pkg/base-dev/lib/pill.hoon
View File

@ -32,25 +32,23 @@
[/sys/hoon hoon/hoon]
[/sys/arvo hoon/arvo]
==
:: +dirs: filter for userspace directories to include
::
++ dirs
|= [bas=path exc=(list spur)]
^- (list spur)
?~ exc ~(tap in dir:.^(arch %cy bas))
%+ skim
~(tap in dir:.^(arch %cy bas))
|=(=spur =(~ (find ~[spur] exc)))
:: +file-ovum: userspace filesystem load
::
:: bas: full path to / directory
::
++ file-ovum
=/ directories=(list path)
:~ /app :: %gall applications
/gen :: :dojo generators
/lib :: libraries
/mar :: mark definitions
/sur :: structures
/sys :: system files
/ted :: :spider strands
/web :: %eyre web content
/desk :: desk manifest
==
|= [des=desk bas=path]
|= [des=desk bas=path exc=(list spur)]
^- unix-event
%. directories
%. (dirs bas exc)
|= :: sal: all spurs to load from
::
sal=(list spur)
@ -99,7 +97,7 @@
::
:: +file-ovum2: electric boogaloo
::
++ file-ovum2 |=(p=path `unix-event`[//arvo what/(user-files p)])
++ file-ovum2 |=(z=[path (list spur)] `unix-event`[//arvo what/(user-files z)])
::
++ prep-ovum
|= dez=(list path)
@ -114,8 +112,8 @@
:: +user-files: all userspace hoon files
::
++ user-files
|= bas=path
%. directories:file-ovum
|= [bas=path exc=(list spur)]
%. (dirs bas exc)
|= sal=(list spur)
^- (list (pair path (cask)))
::
@ -154,8 +152,9 @@
++ solid
:: sys: root path to boot system, `/~me/[desk]/now/sys`
:: dez: secondary desks and their root paths
:: exc: list of desk folders to exclude
::
|= [sys=path dez=(list [desk path]) dub=? now=@da prime=?]
|= [sys=path dez=(list [desk path]) dub=? now=@da prime=? exc=(list spur)]
^- pill
=/ bas=path (scag 3 sys)
=/ compiler-path (weld sys /hoon)
@ -201,7 +200,8 @@
:- (boot-ovum:pill compiler-src arvo-src)
%+ turn
(snoc (turn dez tail) bas)
file-ovum2:pill
|= =path
(file-ovum2 [path exc])
.*(0 arvo-formula)
|= [ovo=ovum ken=*]
[~ (slum ken [now ovo])]
@ -230,15 +230,18 @@
:+ boot-ova ~
=. dez (snoc dez [%base bas])
%+ weld
(turn dez file-ovum)
%+ turn dez
|= [dek=desk bas=path]
(file-ovum [dek bas exc])
?. prime ~
[(prep-ovum (turn dez tail))]~
::
++ brass
:: sys: root path to boot system, `/~me/[desk]/now/sys`
:: dez: secondary desks and their root paths
:: exc: list of desk folders to exclude
::
|= [sys=path dez=(list [desk path]) prime=?]
|= [sys=path dez=(list [desk path]) prime=? exc=(list spur)]
^- pill
=/ bas=path (scag 3 sys)
:: compiler-source: hoon source file producing compiler, `sys/hoon`
@ -274,12 +277,14 @@
::
:+ %pill %brass
:+ boot-ova
:~ (boot-ovum:pill compiler-source arvo-source)
(file-ovum2:pill bas)
:~ (boot-ovum compiler-source arvo-source)
(file-ovum2 [bas exc])
==
=. dez (snoc dez [%base bas])
%+ weld
(turn dez file-ovum)
%+ turn dez
|= [dek=desk bas=path]
(file-ovum [dek bas exc])
?. prime ~
[(prep-ovum (turn dez tail))]~
::
@ -355,7 +360,7 @@
::TODO will exclude non-:directories files, such as /changelog/txt
=- (murn - same)
^- (list (unit ovum))
:~ `(file-ovum as (en-beam beak /))
:~ `(file-ovum as (en-beam beak /) ~)
::
?. pri ~
`(prep-ovum (en-beam beak /) ~)

284
pkg/base-dev/lib/sss.hoon
View File

@ -40,75 +40,119 @@
|* [=(lake) paths=mold]
=>
|%
+$ flow [=aeon fail=_| =rock:lake]
+$ from (on-rock:poke lake paths)
+$ into (response:poke lake paths)
+$ result (request:poke paths)
+$ fail [paths ship dude]
+$ flow [=aeon stale=_| fail=_| =rock:lake]
+$ subs [%0 (map [ship dude paths] (unit flow))]
--
|_ [sub=(map [ship dude paths] flow) =bowl:gall result-type=type on-rock-type=type]
++ surf pine :: Subscribe to [ship dude path].
|= $: sub=subs
=bowl:gall
result-type=type
on-rock-type=type
fail-type=type
==
=> .(sub +.sub)
|%
++ surf :: Subscribe to [ship dude path].
|= which=[ship dude paths]
^- (quip card:agent:gall subs)
?+ flow=(~(get by sub) which) `0/sub
~ [~[(pine which)] 0/(~(put by sub) which ~)]
[~ ~] [~[(pine which)] 0/sub]
[~ ~ [* %& * *]] [~[(scry `+(aeon.u.u.flow) which)] 0/sub]
==
++ quit (corl (lead %0) ~(del by sub)) :: Unsub from [ship dude path].
++ read :: See current subscribed states.
^- (map [ship dude paths] [fail=? rock:lake])
%- ~(run by sub)
|= =flow
[fail rock]:flow
:: :: Check poke-acks for errors.
^- (map [ship dude paths] [stale=? fail=? =rock:lake])
%- malt %+ murn ~(tap by sub)
|= [key=[ship dude paths] val=(unit flow)]
?~ val ~
`[key +.u.val]
:: :: Check poke-ack for errors.
:: :: If an %sss-on-rock poke nacks,
++ chit :: that state is flagged as failed.
|= [[aeon=term ship=term dude=term path=paths] =sign:agent:gall]
^+ sub
^- subs
:- %0
?> ?=(%poke-ack -.sign)
?~ p.sign sub
%+ ~(jab by sub) [(slav %p ship) dude path]
|= =flow
|= (unit flow)
=/ =flow (need +<)
?> =(aeon.flow (slav %ud aeon))
flow(fail &)
`flow(fail &)
:: :: Check poke-ack for errors.
:: :: If a scry request nacks,
++ tell :: that state is flagged as stale.
|= [[ship=term =dude aeon=term path=paths] =sign:agent:gall]
^- (quip card:agent:gall subs)
?> ?=(%poke-ack -.sign)
?~ p.sign `0/sub
=/ current [ship=(slav %p ship) dude=dude path=path]
?+ flow=(~(get by sub) current) `0/sub
[~ ~ *]
=. stale.u.u.flow &
:_ 0/(~(put by sub) current u.flow)
~[(on-rock-poke current u.u.flow ~)]
::
[~ ~]
:_ 0/(~(del by sub) current) :_ ~
:* %pass (zoom surf-fail/aeon/ship/dude/path)
%agent [our dap]:bowl
%poke %sss-surf-fail fail-type ^- fail
[path ship dude]:current
==
==
:: :: Check if we're still interested
:: :: in a wave. If no, no-op.
:: :: If yes, scry.
++ behn :: (See https://gist.github.com/belisarius222/7f8452bfea9b199c0ed717ab1778f35b)
|= [ship=term =dude aeon=term path=paths]
^- (list card:agent:gall)
%- fall :_ ~ %- mole |.
=/ ship (slav %p ship)
=/ aeon (slav %ud aeon)
?: (lte aeon aeon:(~(got by sub) ship dude path)) ~
?: (lte aeon aeon:(fall (~(got by sub) ship dude path) *flow)) ~
~[(scry `aeon ship dude path)]
::
++ apply :: Handle response from publisher.
|= res=(response:poke lake paths)
^- (quip card:agent:gall _sub)
^- (quip card:agent:gall subs)
%- fall :_ `0/sub %- mole |.
=* current [src.bowl dude.res path.res]
=/ old=flow (fall (~(got by sub) current) *flow)
?- type.res
%tomb
=/ =flow old(stale &)
:_ 0/(~(put by sub) current `flow) :_ ~
(on-rock-poke current flow ~)
::
%yore
:_ sub :_ ~
:_ 0/sub :_ ~
(pine src.bowl dude.res path.res)
::
%nigh
:_ sub :_ ~
:_ 0/sub :_ ~
(behn-s25 [dude aeon path]:res)
::
%scry
=* current [src.bowl dude.res path.res]
=/ [wave=(unit wave:lake) =flow]
=/ old=flow (~(gut by sub) current *flow)
?- what.res
%rock ?> (gte aeon.res aeon.old)
`[aeon.res | rock.res]
%wave ~| [%weird-wave res=res old=old]
?> =(aeon.res +(aeon.old))
[`wave.res [aeon.res | (wash:lake rock.old wave.res)]]
[~ [aeon.res | | rock.res]]
%wave ?> =(aeon.res +(aeon.old))
[`wave.res [aeon.res | | (wash:lake rock.old wave.res)]]
==
:_ 0/(~(put by sub) current `flow)
:~ (on-rock-poke current flow wave)
(scry `+(aeon.res) src.bowl dude.res path.res)
==
:_ (~(put by sub) current flow)
%- flop
:~ (scry `+(aeon.res) src.bowl dude.res path.res)
:* %pass (zoom on-rock/(scot %ud aeon.flow)^(scot %p src.bowl)^dude.res^path.res)
%agent [our dap]:bowl
%poke %sss-on-rock on-rock-type ^- from
[path.res src.bowl dude.res rock.flow wave]
== ==
==
::
:: Non-public facing arms below
::
+$ from (on-rock:poke lake paths)
+$ into (response:poke lake paths)
+$ result (request:poke paths)
++ behn-s25
|= [=dude =aeon path=noun]
^- card:agent:gall
@ -119,71 +163,130 @@
++ scry
|= [when=(unit aeon) who=ship which=dude where=paths]
^- card:agent:gall
=/ when ?~ when %~ (scot %ud u.when)
:* %pass (zoom request/scry/(scot %p who)^which^when^where)
=/ when ?~ when ~ (scot %ud u.when)
:* %pass (zoom scry-request/(scot %p who)^which^when^where)
%agent [who which]
%poke %sss-to-pub :- result-type ^- result
[where which ^when]
[where dap.bowl ^when]
==
++ on-rock-poke
|= [[=ship =dude path=paths] flow wave=(unit wave:lake)]
^- card:agent:gall
:* %pass (zoom on-rock/(scot %ud aeon)^(scot %p ship)^dude^path)
%agent [our dap]:bowl
%poke %sss-on-rock on-rock-type ^- from
[path ship dude stale fail rock wave]
==
--
++ du :: Manage publications.
|* [=(lake) paths=mold]
=>
|%
+$ into (request:poke paths)
+$ result (response:poke lake paths)
+$ rule [rocks=_1 waves=_5] :: Retention policy
+$ tide
$: rok=((mop aeon rock:lake) gte)
wav=((mop aeon wave:lake) lte)
rul=rule
mem=(mip aeon [ship dude] @da)
mem=(mip ship dude @da)
==
+$ buoy
$: tid=$~(*tide $@(aeon tide))
alo=(unit (set ship))
==
+$ pubs [%0 (map paths buoy)]
--
|_ [pub=(map paths tide) =bowl:gall result-type=type]
+* rok ((on aeon rock:lake) gte)
wav ((on aeon wave:lake) lte)
::
|= [pub=pubs =bowl:gall result-type=type]
=> .(pub +.pub)
=* rok ((on aeon rock:lake) gte)
=* wav ((on aeon wave:lake) lte)
|%
++ rule :: Set new retention policy.
|= [path=paths =^rule]
^+ pub
^- pubs
:- %0
%+ ~(jab by pub) path
|= =tide
(form tide(rul rule))
|= =buoy
?@ tid.buoy buoy
buoy(tid (form tid.buoy(rul rule)))
::
++ wipe :: Create new rock and wipe rest.
|= path=paths
^+ pub
^- pubs
:- %0
%+ ~(jab by pub) path
|= =tide
%* . (form tide(rul [0 1]))
rul rul.tide
wav ~
|= =buoy
?@ tid.buoy buoy
%* . buoy(tid (form tid.buoy(rul [0 1])))
rul.tid rul.tid.buoy
wav.tid ~
==
++ give :: Give a wave on a path.
|= [path=paths =wave:lake]
^- (quip card:agent:gall _pub)
?~ ;;((soft ^path) path) ~| %need-path !!
=/ =tide (~(gut by pub) path *tide)
=/ next=aeon
.+ %+ max
(fall (bind (pry:rok rok.tide) head) 0)
(fall (bind (ram:wav wav.tide) head) 0)
::
:_ %+ ~(put by pub) path
^- (quip card:agent:gall pubs)
?~ ((soft ^path) path) ~| %need-path !!
=/ buoy (~(gut by pub) path *buoy)
?@ tide=tid.buoy ~| %dead-path !! ::TODO is this good behavior?
=/ next=aeon +((latest tide))
:- %+ murn ~(tap bi mem.tide)
|= [=ship =dude =@da]
?: (lth da now.bowl) ~
`(send scry/wave/wave ship dude next path)
:- %0
%+ ~(put by pub) path
=/ last=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
=. wav.tide (put:wav wav.tide next wave)
=. mem.tide (~(del by mem.tide) next)
?. =(next (add aeon.last waves.rul.tide)) tide
(form tide)
?. =(next (add aeon.last waves.rul.tide)) buoy
buoy(tid (form tide))
::
++ perm :: Change permissions with gate.
|= [where=(list paths) diff=$-((unit (set ship)) (unit (set ship)))]
^- pubs
%+ edit where
|= =buoy
=/ new=_alo.buoy (diff alo.buoy)
?@ tid.buoy buoy(alo new)
%= buoy
alo new
mem.tid ?~ new mem.tid.buoy
%. mem.tid.buoy
~(int by (malt (turn ~(tap in u.new) (late *(map @ @)))))
==
++ public (curr perm _~) :: Make list of paths public.
++ secret (curr perm _`~) :: Make list of paths secret.
:: :: Block ships from paths.
++ block :: No-ops on public paths.
|= [who=(list ship) whence=(list paths)]
^- pubs
%+ perm whence
|= old=(unit (set ship))
?~ old ~ `(~(dif in u.old) (sy who))
:: :: Allow ships to paths.
++ allow :: Any public paths will no-op.
|= [who=(list ship) where=(list paths)]
^- pubs
%+ perm where
|= old=(unit (set ship))
?~ old ~ `(~(gas in u.old) who)
:: :: Kill a list of paths, i.e. tell
++ kill :: subs to not expect updates.
(curr edit |=(=buoy buoy(tid (latest tid.buoy))))
:: :: Reopen list of killed paths.
++ live :: No-ops on live paths.
%+ curr edit
|= =buoy
?^ tid.buoy buoy
%*(. buoy(tid *tide) rok.tid (put:rok ~ +(tid.buoy) *rock:lake))
::
%+ murn ~(tap by (~(gut by mem.tide) next ~))
|= [[=ship =dude] =@da]
?: (lth da now.bowl) ~
`(send scry/wave/wave ship dude next path)
++ read :: See current published states.
^- (map paths rock:lake)
%- ~(run by pub)
|= =tide
=< rock
^- (map paths [allowed=(unit (set ship)) =rock:lake])
%- malt %+ murn ~(tap by pub)
|= [path=paths =buoy]
^- (unit [paths (unit (set ship)) rock:lake])
?@ tide=tid.buoy ~
:^ ~ path alo.buoy =< rock
=/ snap=[=aeon =rock:lake] (fall (pry:rok rok.tide) *[key val]:rok)
%+ roll (tap:wav (lot:wav wav.tide `aeon.snap ~))
|= [[=aeon =wave:lake] =_snap]
@ -192,39 +295,58 @@
::
++ apply :: Handle request from subscriber.
|= req=(request:poke paths)
^- (quip card:agent:gall _pub)
=/ =tide (~(gut by pub) path.req *tide)
^- (quip card:agent:gall pubs)
=/ =buoy (~(gut by pub) path.req *buoy)
?< &(?=(^ alo.buoy) !(~(has in u.alo.buoy) src.bowl))
?@ tid.buoy
:_ 0/pub :_ ~
(send tomb/~ src.bowl dude.req tid.buoy path.req)
?~ when.req
=/ last (fall (pry:rok rok.tide) *[=key =val]:rok)
:_ pub :_ ~
=/ last (fall (pry:rok rok.tid.buoy) *[=key =val]:rok)
:_ 0/pub :_ ~
(send scry/rock/val.last src.bowl dude.req key.last path.req)
?^ dat=(get:wav wav.tide u.when.req)
:_ pub :_ ~
?^ dat=(get:wav wav.tid.buoy u.when.req)
:_ 0/pub :_ ~
(send scry/wave/u.dat src.bowl [dude u.when path]:req)
?: %+ lte u.when.req
key::(fall (ram:wav wav.tide) (pry:rok rok.tide) [=key val]:wav)
:_ pub :_ ~
key::(fall (ram:wav wav.tid.buoy) (pry:rok rok.tid.buoy) [=key val]:wav)
:_ 0/pub :_ ~
(send yore/~ src.bowl [dude u.when path]:req)
?> =(u.when.req +((latest tid.buoy)))
:- ~[(send nigh/~ src.bowl [dude u.when path]:req)]
:- %0
%+ ~(put by pub) path.req
%= tide mem
%^ ~(put bi mem.tide) u.when.req [src.bowl dude.req]
(add ~s25 now.bowl)
%= buoy
mem.tid (~(put bi mem.tid.buoy) src.bowl dude.req (add ~s25 now.bowl))
==
::
:: Non-public facing arms below
::
+$ into (request:poke paths)
+$ result (response:poke lake paths)
++ send
|= [payload=_|3:*(response:poke lake paths) =ship =dude =aeon path=paths]
^- card:agent:gall
=* mark (cat 3 %sss- name:lake)
:* %pass (zoom response/scry/(scot %p ship)^dude^(scot %ud aeon)^path)
:* %pass (zoom scry-response/(scot %p ship)^dude^(scot %ud aeon)^path)
%agent [ship dude]
%poke mark result-type ^- (response:poke lake paths)
[path dap.bowl aeon payload]
==
++ latest
|= =$@(aeon tide)
^- aeon
?@ tide tide
%+ max (fall (bind (pry:rok rok.tide) head) 0)
(fall (bind (ram:wav wav.tide) head) 0)
::
++ edit
|= [ps=(list paths) edit=$-(buoy buoy)]
^- pubs
:- %0
%- ~(rep in (sy ps))
|= [path=paths =_pub]
%- fall :_ pub %- mole |.
(~(jab by pub) path edit)
::
++ form
|= =tide
^+ tide

160
pkg/base-dev/sur/hood.hoon
View File

@ -16,73 +16,66 @@
::
+$ sync-state [nun=@ta kid=(unit desk) let=@ud]
+$ sink (unit [her=@p sud=desk kid=(unit desk) let=@ud])
:: +report-prep: get data required for reports
::
++ report-prep
|= [our=@p now=@da]
=/ ego (scot %p our)
=/ wen (scot %da now)
:* .^(rock:tire %cx /(scot %p our)//(scot %da now)/tire)
.^(=cone %cx /(scot %p our)//(scot %da now)/domes)
.^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
.^ (map [desk ship desk] sync-state) %gx
++ report-vats
=| $: =cone
sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
desks=(set desk)
=pikes
=rock:tire:clay
kel=weft
==
|_ [our=@p now=@da]
+* ego (scot %p our)
wen (scot %da now)
++ $
|= [? ? ? ? ?]
(report-vats:abed +<)
++ abed
%= ..abed
cone .^(^cone %cx /[ego]//[wen]/domes)
sor .^((map desk [ship desk]) %gx /[ego]/hood/[wen]/kiln/sources/noun)
zyn .^ (map [desk ship desk] sync-state) %gx
/[ego]/hood/[wen]/kiln/syncs/noun
==
desks .^((set desk) %cd /[ego]/base/[wen])
pikes .^(^pikes %gx /[ego]/hood/[wen]/kiln/pikes/kiln-pikes)
rock .^(rock:tire:clay %cx /[ego]//[wen]/tire)
kel (weft .^(* cx/(en-beam [our %base da+now] /sys/kelvin)))
==
:: +report-vats: report on all desk installations
::
++ report-vats
|= [our=@p now=@da]
^- tang
=/ desks .^((set desk) %cd /(scot %p our)/base/(scot %da now))
=/ prep (report-prep our now)
%+ turn ~(tap in desks)
|=(syd=desk (report-vat prep our now syd))
:: +report-vat: report on a single desk installation
::
++ report-vat
|= $: $: tyr=rock:tire =cone sor=(map desk [ship desk])
zyn=(map [desk ship desk] sync-state)
==
our=ship now=@da syd=desk
==
^- tank
=/ ego (scot %p our)
=/ wen (scot %da now)
=+ .^(=cass %cw /[ego]/[syd]/[wen])
?: =(ud.cass 0)
leaf+"desk does not yet exist: {<syd>}"
?: =(%kids syd)
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
leaf+"%kids %cz hash: {<hash>}"
=/ kel-path
/[ego]/[syd]/[wen]/sys/kelvin
?. .^(? %cu kel-path)
leaf+"bad desk: {<syd>}"
=+ .^(=waft %cx kel-path)
:+ %rose ["" "{<syd>}" "::"]
^- tang
=/ hash .^(@uv %cz /[ego]/[syd]/[wen])
=/ =sink
?~ s=(~(get by sor) syd)
++ vat-info
|= desk=_`desk`%base
=/ pike (~(got by pikes) desk)
=/ zest -:(~(got by rock) desk)
=/ kel-path /[ego]/[desk]/[wen]/sys/kelvin
=/ sink=sink
?~ s=(~(get by sor) desk)
~
?~ z=(~(get by zyn) syd u.s)
?~ z=(~(get by zyn) desk u.s)
~
`[-.u.s +.u.s +.u.z]
=/ meb=(list @uv)
=/ hash .^(@uv %cz /[ego]/[desk]/[wen])
=/ dek (~(got by rock) desk)
=/ =dome (~(got by cone) our desk)
=+ .^(=waft %cx kel-path)
:* &1 &2 &3 &4 &5 &6 &7 &8
desk=desk
^= running =(%live zest)
^= suspended =(%dead zest)
^= exists !=(ud.cass 0):.^(=cass %cw /[ego]/[desk]/[wen])
^= bad-desk ?!(.^(? %cu kel-path))
^= meb :: =(list @uv)
?~ sink [hash]~
(mergebase-hashes our syd now her.u.sink sud.u.sink)
=/ dek (~(got by tyr) syd)
=/ =dome (~(got by cone) our syd)
=/ [on=(list [@tas ?]) of=(list [@tas ?])]
(mergebase-hashes our desk now her.u.sink sud.u.sink)
^- [on=(list [@tas ?]) of=(list [@tas ?])]
(skid ~(tap by ren.dome) |=([* ?] +<+))
=/ sat
^= sat
?- zest.dek
%live "running"
%dead "suspended"
%held "suspended until next update"
==
=/ kul=tape
^- kul=tape
%+ roll
%+ sort
~(tap in (waft-to-wefts:clay waft))
@ -92,6 +85,52 @@
(lte lal.a lal.b)
|= [=weft =tape]
(welp " {<[lal num]:weft>}" tape)
^= blocking
?& !=(%base desk)
!=(%live zest.pike)
!(~(has in wic.pike) kel)
== ==
++ report-vats
|= $: verb=?
show-suspended=?
show-running=?
show-blocking=?
show-nonexistent=?
==
%+ turn
%+ skim
%+ turn ~(tap in desks)
|= =desk (vat-info desk)
|= vat-info
:: just unconditionally show "bad" desks, whatever that means
?| bad-desk
&(suspended show-suspended)
&(running show-running)
&(blocking show-blocking)
&(!exists show-nonexistent)
==
|= =vat-info
:+ %rose [" " " " "::"]
:- leaf+"{<desk.vat-info>}"
%- flop
%- report-vat
[verb vat-info]
++ report-vat
|= [verb=? vat-info]
^- tang
?: !exists
~[leaf+"desk does not yet exist: {<desk>}"]
?: =(%kids desk)
~[leaf+"%kids %cz hash: {<hash>}"]
?: bad-desk
~[leaf+"bad desk: {<desk>}"]
%- flop
?. verb
:~ leaf/"/sys/kelvin: {kul}"
leaf/"app status: {sat}"
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:~ leaf/"/sys/kelvin: {kul}"
leaf/"base hash: {?.(=(1 (lent meb)) <meb> <(head meb)>)}"
leaf/"%cz hash: {<hash>}"
@ -100,7 +139,7 @@
leaf/"force on: {?:(=(~ on) "~" <on>)}"
leaf/"force off: {?:(=(~ of) "~" <of>)}"
::
leaf/"publishing ship: {?~(sink <~> <(get-publisher our syd now)>)}"
leaf/"publishing ship: {?~(sink <~> <(get-publisher our desk now)>)}"
leaf/"updates: {?~(sink "local" "remote")}"
leaf/"source ship: {?~(sink <~> <her.u.sink>)}"
leaf/"source desk: {?~(sink <~> <sud.u.sink>)}"
@ -108,18 +147,13 @@
leaf/"kids desk: {?~(sink <~> ?~(kid.u.sink <~> <u.kid.u.sink>))}"
leaf/"pending updates: {<`(list [@tas @ud])`~(tap in wic.dek)>}"
==
:: +report-kids: non-vat cz hash report for kids desk
::
++ report-kids
|= [our=ship now=@da]
^- tank
=/ syd %kids
=/ ego (scot %p our)
=/ wen (scot %da now)
?. (~(has in .^((set desk) %cd /[ego]//[wen])) syd)
?. (~(has in .^((set desk) %cd /[ego]//[wen])) %kids)
leaf/"no %kids desk"
=+ .^(hash=@uv %cz /[ego]/[syd]/[wen])
=+ .^(hash=@uv %cz /[ego]/kids/[wen])
leaf/"%kids %cz hash: {<hash>}"
--
:: +read-bill-foreign: read /desk/bill from a foreign desk
::
++ read-bill-foreign

11
pkg/base-dev/sur/sss.hoon
View File

@ -24,13 +24,20 @@
$: path=paths
=dude
=aeon
$% [type=?(%nigh %yore) ~]
$% [type=?(%nigh %yore %tomb) ~]
$: type=%scry
$% [what=%rock =rock:lake]
[what=%wave =wave:lake]
== == == ==
++ on-rock
|* [=(lake) paths=mold]
,[path=paths src=ship from=dude =rock:lake wave=(unit wave:lake)]
$: path=paths
src=ship
from=dude
stale=?
fail=?
=rock:lake
wave=(unit wave:lake)
==
--
--

1
pkg/landscape/sys.kelvin
View File

@ -1,2 +1,3 @@
[%zuse 416]
[%zuse 415]
[%zuse 414]