urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 11:24:21 +03:00
Code Issues Packages Projects Releases Wiki Activity
d5dca99ba8
shrub/pkg/arvo/sys/vane/clay.hoon
fang d5dca99ba8
clay: scry for files by lobe 
Instead of scrying for revisions of files at paths in desks, we now scry
for data corresponding to a given lobe. This removes concerns of aeons,
paths, and other such frivolities, and lets us ask for the specific data
we need regardless of where it may live.

How we're supposed to answer permissioning questions around data this
way remains to be seen.
2022-05-05 16:59:09 +02:00

5586 lines
167 KiB
Plaintext
Raw Blame History

:: clay (4c), revision control
!:
:: The way to understand Clay is to take it section-by-section:
::
:: - Data structures. You *must* start here; make sure you understand
:: the entire contents of +raft.
::
:: - Individual reads. +aver is the entry point, follow it through
:: +read-at-aeon to understand each kind of read.
::
:: - Subscriptions. +wake is the center of this mechanism; nothing
:: else responds to subscriptions. +wake has no arguments, which means
:: every subscription response happens when something in Clay's *state*
:: has changed. No edge-triggered responses.
::
:: - Receiving foreign data. For individual requests, this is
:: +take-foreign-answer. For sync requests (%many, which is %sing %v
:: for a foreign desk), this is +foreign-update.
::
:: - Ford. +ford builds hoon files and gives files their types.
:: Read +build-file for the first, and +read-file is the second.
::
:: - Writing to a desk. Every write to a desk goes through +park, read
:: it thoroughly.
::
:: - Merges. Control flow starts at +start-merge, then +merge, but
:: everything is scaffolding for +merge-by-germ, which is the ideal of
:: a merge function: it takes two commits and a merge strategy and
:: produces a new commit.
::
:: - Tombstoning. This is in +tomb.
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
:: Here are the structures. `++raft` is the formal arvo state. It's also
:: worth noting that many of the clay-related structures are defined in lull.
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=/ bud
^~
=/ zuse !>(..zuse)
:* zuse=zuse
nave=(slap zuse !,(*hoon nave:clay))
cork=(slap zuse !,(*hoon cork))
same=(slap zuse !,(*hoon same))
mime=(slap zuse !,(*hoon mime))
cass=(slap zuse !,(*hoon cass:clay))
==
::
|= our=ship
=, clay
=> |%
+$ aeon @ud :: version number
::
:: Part of ++mery, representing the set of changes between the mergebase and
:: one of the desks being merged.
::
:: -- `new` is the set of files in the new desk and not in the mergebase.
:: -- `cal` is the set of changes in the new desk from the mergebase except
:: for any that are also in the other new desk.
:: -- `can` is the set of changes in the new desk from the mergebase and that
:: are also in the other new desk (potential conflicts).
:: -- `old` is the set of files in the mergebase and not in the new desk.
::
+$ cane
$: new=(map path lobe)
cal=(map path lobe)
can=(map path cage)
old=(map path ~)
==
::
:: Type of request.
::
:: %d produces a set of desks, %p gets file permissions, %t gets all paths
:: with the specified prefix, %u checks for existence, %v produces a ++dome
:: of all desk data, %w gets @ud and @da variants for the given case, %x
:: gets file contents, %y gets a directory listing, and %z gets a recursive
:: hash of the file contents and children.
::
:: ++ care ?(%d %p %t %u %v %w %x %y %z)
::
:: Keeps track of subscribers.
::
:: A map of requests to a set of all the subscribers who should be notified
:: when the request is filled/updated.
::
+$ cult (jug wove duct)
::
:: State for ongoing %fuse merges. `con` maintains the ordering,
:: `sto` stores the data needed to merge, and `bas` is the base
:: beak for the merge.
::
+$ melt [bas=beak con=(list [beak germ]) sto=(map beak (unit dome:clay))]
::
:: Domestic desk state.
::
:: Includes subscriber list, dome (desk content), possible commit state (for
:: local changes), possible merge state (for incoming merges), and permissions.
::
+$ dojo
$: qyx=cult :: subscribers
dom=dome :: desk state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: state for mega merges
==
::
:: Desk state.
::
:: Includes a checked-out ankh with current content, most recent version, map
:: of all version numbers to commit hashes (commits are in hut.rang), and map
:: of labels to version numbers.
::
:: `mim` is a cache of the content in the directories that are mounted
:: to unix. Often, we convert to/from mime without anything really
:: having changed; this lets us short-circuit that in some cases.
:: Whenever you give an `%ergo`, you must update this.
::
+$ dome
$: let=aeon :: top id
hit=(map aeon tako) :: versions by id
lab=(map @tas aeon) :: labels
tom=(map tako norm) :: tomb policies
nor=norm :: default policy
mim=(map path mime) :: mime cache
fod=flue :: ford cache
== ::
::
:: Commit state.
::
:: -- `del` is the paths we're deleting.
:: -- `ink` is the insertions of hoon files (short-circuited for
:: bootstrapping).
:: -- `ins` is all the other insertions.
:: -- `dif` is the diffs in `dig` applied to their files.
:: -- `mut` is the diffs between `muc` and the original files.
::
+$ dork :: diff work
$: del=(list path) :: deletes
ink=(list (pair path cage)) :: hoon inserts
ins=(list (pair path cage)) :: inserts
dif=(list (trel path lobe cage)) :: changes
mut=(list (trel path lobe cage)) :: mutations
== ::
::
:: Over-the-wire backfill request/response
::
+$ fill
$% [%0 =desk =lobe]
[%1 =desk =lobe]
==
::
+$ fell
$% [%direct p=lobe q=page]
[%delta p=lobe q=[p=mark q=lobe] r=page]
[%dead p=lobe ~]
[%1 peg=(unit page)]
==
::
:: Global ford cache
::
:: Refcount includes references from other items in the cache, and
:: from spills in each desk
::
:: This is optimized for minimizing the number of rebuilds, and given
:: that, minimizing the amount of memory used. It is relatively slow
:: to lookup, because generating a cache key can be fairly slow (for
:: files, it requires parsing; for tubes, it even requires building
:: the marks).
::
+$ flow (map leak [refs=@ud =soak])
::
:: Per-desk ford cache
::
:: Spill is the set of "roots" we have into the global ford cache.
:: We add a root for everything referenced directly or indirectly on
:: a desk, then invalidate them on commit only if their dependencies
:: change.
::
:: Sprig is a fast-lookup index over the global ford cache. The only
:: goal is to make cache hits fast.
::
+$ flue [spill=(set leak) sprig=(map mist [=leak =soak])]
::
:: Ford build without content.
::
+$ mist
$% [%file =path]
[%nave =mark]
[%dais =mark]
[%cast =mars]
[%tube =mars]
[%vale =path]
[%arch =path]
==
::
:: Ford build with content.
::
+$ pour
$% [%file =path]
[%nave =mark]
[%dais =mark]
[%cast =mars]
[%tube =mars]
:: leafs
::
[%vale =path =lobe]
[%arch =path =(map path lobe)]
==
::
:: Ford result.
::
+$ soak
$% [%cage =cage]
[%vase =vase]
[%arch dir=(map @ta vase)]
[%dais =dais]
[%tube =tube]
==
::
:: Ford cache key
::
:: This includes all build inputs, including transitive dependencies,
:: recursively.
::
+$ leak
$~ [*pour ~]
$: =pour
deps=(set leak)
==
::
:: New desk data.
::
:: Sent to other ships to update them about a particular desk.
:: Includes a map of all new aeons to hashes of their commits, the most
:: recent aeon, and sets of all new commits and data. `bar` is always
:: empty now because we expect you to request any data you don't have
:: yet
::
+$ nako :: subscription state
$: gar=(map aeon tako) :: new ids
let=aeon :: next id
lar=(set yaki) :: new commits
bar=~ :: new content
== ::
::
::
:: Formal vane state.
::
:: -- `rom` is our domestic state.
:: -- `hoy` is a collection of foreign ships where we know something about
:: their clay.
:: -- `ran` is the object store.
:: -- `mon` is a collection of mount points (mount point name to urbit
:: location).
:: -- `hez` is the unix duct that %ergo's should be sent to.
:: -- `cez` is a collection of named permission groups.
:: -- `pud` is an update that's waiting on a kernel upgrade
::
+$ raft :: filesystem
$: rom=room :: domestic
hoy=(map ship rung) :: foreign
ran=rang :: hashes
fad=flow :: ford cache
mon=(map term beam) :: mount points
hez=(unit duct) :: sync duct
cez=(map @ta crew) :: permission groups
pud=(unit [=desk =yoki]) :: pending update
sad=(map ship @da) :: scry known broken
== ::
::
:: Unvalidated response to a request.
::
:: Like a +$rant, but with a page of data rather than a cage of it.
::
+$ rand :: unvalidated rant
$: p=[p=care q=case r=@tas] :: clade release book
q=path :: spur
r=page :: data
== ::
::
:: Generic desk state.
::
:: -- `lim` is the most recent date we're confident we have all the
:: information for. For local desks, this is always `now`. For foreign
:: desks, this is the last time we got a full update from the foreign
:: urbit.
:: -- `ref` is a possible request manager. For local desks, this is null.
:: For foreign desks, this keeps track of all pending foreign requests
:: plus a cache of the responses to previous requests.
:: -- `qyx` is the set of subscriptions, with listening ducts. These
:: subscriptions exist only until they've been filled.
:: -- `dom` is the actual state of the filetree. Since this is used almost
:: exclusively in `++ze`, we describe it there.
::
+$ rede :: universal project
$: lim=@da :: complete to
ref=(unit rind) :: outgoing requests
qyx=cult :: subscribers
dom=dome :: revision state
per=regs :: read perms per path
pew=regs :: write perms per path
fiz=melt :: domestic mega merges
== ::
::
:: Foreign request manager.
::
:: When we send a request to a foreign ship, we keep track of it in here. This
:: includes a request counter, a map of request numbers to requests, a reverse
:: map of requesters to request numbers, a simple cache of common %sing
:: requests, and a possible nako if we've received data from the other ship and
:: are in the process of validating it.
::
+$ rind :: request manager
$: nix=@ud :: request index
bom=(map @ud update-state) :: outstanding
fod=(map duct @ud) :: current requests
haw=(map mood (unit cage)) :: simple cache
== ::
::
:: Active downloads
::
+$ update-state
$: =duct
=rave
scry=(unit @da) :: if scry, timeout
have=(map lobe fell)
need=(list lobe)
nako=(qeu (unit nako))
busy=_|
==
::
:: Domestic ship.
::
:: `hun` is the duct to dill, and `dos` is a collection of our desks.
::
+$ room :: fs per ship
$: hun=duct :: terminal duct
dos=(map desk dojo) :: native desk
== ::
::
:: Stored request.
::
:: Like a +$rave but with caches of current versions for %next and %many.
:: Generally used when we store a request in our state somewhere.
::
:: TODO: remove lobes from %many
::
+$ cach (unit (unit cage)) :: cached result
+$ wove [for=(unit [=ship ver=@ud]) =rove] :: stored source + req
+$ rove :: stored request
$% [%sing =mood] :: single request
[%next =mood aeon=(unit aeon) =cach] :: next version of one
$: %mult :: next version of any
=mool :: original request
aeon=(unit aeon) :: checking for change
old-cach=(map [=care =path] cach) :: old version
new-cach=(map [=care =path] cach) :: new version
== ::
[%many track=? =moat lobes=(map path lobe)] :: change range
== ::
::
:: Foreign desk data.
::
+$ rung
$: rus=(map desk rede) :: neighbor desks
==
::
+$ card (wind note gift) :: local card
+$ move [p=duct q=card] :: local move
+$ note :: out request $->
$~ [%b %wait *@da] ::
$% $: %$ :: to arvo
$>(%what waif) ::
== ::
$: %a :: to %ames
$>(?(%plea %keen %yawn) task:ames) ::
== ::
$: %b :: to %behn
$> $? %drip ::
%rest ::
%wait ::
== ::
task:behn ::
== ::
$: %c :: to %clay
$> $? %info :: internal edit
%merg :: merge desks
%fuse :: merge many
%park ::
%perm ::
%pork ::
%warp ::
%werp ::
== ::
task ::
== ::
$: %d :: to %dill
$>(%flog task:dill) ::
== ::
$: %g :: to %gall
$> $? %deal
%jolt
==
task:gall
== ::
$: %j :: by %jael
$>(%public-keys task:jael) ::
== == ::
+$ riot (unit rant) :: response+complete
+$ sign :: in result $<-
$~ [%behn %wake ~] ::
$% $: %ames ::
$> $? %boon :: response
%done :: (n)ack
%lost :: lost boon
%tune :: scry response
== ::
gift:ames ::
== ::
$: %behn ::
$% $>(%wake gift:behn) :: timer activate
$>(%writ gift) ::
== == ::
$: %clay ::
$> $? %mere ::
%note ::
%writ ::
== ::
gift ::
== ::
$: %gall
$> $? %onto
%unto
==
gift:gall
==
$: %jael ::
$>(%public-keys gift:jael) ::
== == ::
-- =>
~% %clay-utilities ..part ~
:: %utilities
::
|%
++ scry-timeout-time ~s5
++ scry-retry-time ~s30
:: +sort-by-head: sorts alphabetically using the head of each element
::
++ sort-by-head
|=([a=(pair path *) b=(pair path *)] (aor p.a p.b))
::
:: By convention: paf == (weld pax pat)
::
++ mode-to-commit
|= [hat=(map path lobe) pax=path all=? mod=mode]
^- [deletes=(set path) changes=(map path cage)]
=/ deletes
%- silt
%+ turn
^- (list path)
%+ weld
^- (list path)
%+ murn mod
|= [pat=path mim=(unit mime)]
^- (unit path)
?^ mim
~
`pat
^- (list path)
?. all
~
=+ mad=(malt mod)
=+ len=(lent pax)
=/ descendants=(list path)
%+ turn
%+ skim ~(tap by hat)
|= [paf=path lob=lobe]
=(pax (scag len paf))
|= [paf=path lob=lobe]
(slag len paf)
%+ skim
descendants
|= pat=path
(~(has by mad) pat)
|= pat=path
(weld pax pat)
::
=/ changes
%- malt
%+ murn mod
|= [pat=path mim=(unit mime)]
^- (unit [path cage])
?~ mim
~
`[(weld pax pat) %mime !>(u.mim)]
::
[deletes changes]
::
++ pour-to-mist
|= =pour
^- mist
?+ -.pour pour
%vale [%vale path.pour]
%arch [%arch path.pour]
==
::
++ fell-to-page
|= =fell
^- (unit page)
?- -.fell
%dead ~
%direct `q.fell
%delta ~
%1 peg.fell
==
::
++ rave-to-rove
|= rav=rave
^- rove
?- -.rav
%sing rav
%next [- mood ~ ~]:rav
%mult [- mool ~ ~ ~]:rav
%many [- track moat ~]:rav
==
::
++ rove-to-rave
|= rov=rove
^- rave
?- -.rov
%sing rov
%next [- mood]:rov
%mult [- mool]:rov
%many [- track moat]:rov
==
-- =>
~% %clay + ~
|%
:: Printable form of a wove; useful for debugging
::
++ print-wove
|= =wove
:- for.wove
?- -.rove.wove
%sing [%sing mood.rove.wove]
%next [%next [mood aeon]:rove.wove]
%mult [%mult [mool aeon]:rove.wove]
%many [%many [track moat]:rove.wove]
==
::
:: Printable form of a cult; useful for debugging
::
++ print-cult
|= =cult
%+ turn ~(tap by cult)
|= [=wove ducts=(set duct)]
[ducts (print-wove wove)]
::
++ fusion
|%
:: +wrap: external wrapper
::
++ wrap
|* [* state:ford]
[+<- +<+< +<+>-] :: [result cache.state flue]
::
++ with-face |=([face=@tas =vase] vase(p [%face face p.vase]))
++ with-faces
=| res=(unit vase)
|= vaz=(list [face=@tas =vase])
^- vase
?~ vaz (need res)
=/ faz (with-face i.vaz)
=. res `?~(res faz (slop faz u.res))
$(vaz t.vaz)
::
++ ford
=> |%
+$ state
$: cache=flow
flue
cycle=(set mist)
drain=(map mist leak)
stack=(list (set leak))
==
+$ args
$: files=(map path (each page lobe))
file-store=(map lobe page)
cache=flow
flue
==
--
|= args
:: nub: internal mutable state for this computation
::
=| nub=state
=. cache.nub cache
=. spill.nub spill
=. sprig.nub sprig
|%
:: +read-file: retrieve marked, validated file contents at path
::
++ read-file
|= =path
^- [cage state]
~| %error-validating^path
%- soak-cage
%+ gain-sprig vale+path |.
?^ got=(~(get by sprig.nub) vale+path)
=? stack.nub ?=(^ stack.nub)
stack.nub(i (~(put in i.stack.nub) leak.u.got))
[soak.u.got nub]
=. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) vale+path)
~|(cycle+vale+path^cycle.nub !!)
=. cycle.nub (~(put in cycle.nub) vale+path)
%+ gain-leak vale+path
|= nob=state
=. nub nob
::~> %slog.0^leaf/"ford: read file {(spud path)}"
=/ file
~| %file-not-found^path
(~(got by files) path)
=/ page
?: ?=(%& -.file)
p.file
~| %tombstoned-file^path^p.file
(~(got by file-store) p.file)
=^ =cage nub (validate-page path page)
[[%cage cage] nub]
::
:: +build-nave: build a statically typed mark core
::
++ build-nave
|= mak=mark
^- [vase state]
~| %error-building-mark^mak
%- soak-vase
%+ gain-sprig nave+mak |.
=. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) nave+mak)
~|(cycle+nave+mak^cycle.nub !!)
=. cycle.nub (~(put in cycle.nub) nave+mak)
:: ~> %slog.0^leaf/"ford: make mark {<mak>}"
=^ cor=vase nub (build-fit %mar mak)
=/ gad=vase (slap cor limb/%grad)
?@ q.gad
=+ !<(mok=mark gad)
=^ deg=vase nub ^$(mak mok)
=^ tub=vase nub (build-cast mak mok)
=^ but=vase nub (build-cast mok mak)
%+ gain-leak nave+mak
|= nob=state
=. nub nob
:_ nub :- %vase
^- vase :: vase of nave
%+ slap
(with-faces deg+deg tub+tub but+but cor+cor nave+nave.bud ~)
!, *hoon
=/ typ _+<.cor
=/ dif diff:deg
^- (nave typ dif)
|%
++ diff
|= [old=typ new=typ]
^- dif
(diff:deg (tub old) (tub new))
++ form form:deg
++ join join:deg
++ mash mash:deg
++ pact
|= [v=typ d=dif]
^- typ
(but (pact:deg (tub v) d))
++ vale noun:grab:cor
--
%+ gain-leak nave+mak
|= nob=state
=. nub nob
:_ nub :- %vase
^- vase :: vase of nave
%+ slap (slop (with-face cor+cor) zuse.bud)
!, *hoon
=/ typ _+<.cor
=/ dif _*diff:grad:cor
^- (nave:clay typ dif)
|%
++ diff |=([old=typ new=typ] (diff:~(grad cor old) new))
++ form form:grad:cor
++ join
|= [a=dif b=dif]
^- (unit (unit dif))
?: =(a b)
~
`(join:grad:cor a b)
++ mash
|= [a=[=ship =desk =dif] b=[=ship =desk =dif]]
^- (unit dif)
?: =(dif.a dif.b)
~
`(mash:grad:cor a b)
++ pact |=([v=typ d=dif] (pact:~(grad cor v) d))
++ vale noun:grab:cor
--
:: +build-dais: build a dynamically typed mark definition
::
++ build-dais
|= mak=mark
^- [dais state]
~| %error-building-dais^mak
%- soak-dais
%+ gain-sprig dais+mak |.
=. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) dais+mak)
~|(cycle+dais+mak^cycle.nub !!)
=. cycle.nub (~(put in cycle.nub) dais+mak)
=^ nav=vase nub (build-nave mak)
%+ gain-leak dais+mak
|= nob=state
=. nub nob
::~> %slog.0^leaf/"ford: make dais {<mak>}"
:_ nub :- %dais
^- dais
=> [..zuse nav=nav]
|_ sam=vase
++ diff
|= new=vase
(slam (slap nav limb/%diff) (slop sam new))
++ form !<(mark (slap nav limb/%form))
++ join
|= [a=vase b=vase]
^- (unit (unit vase))
=/ res=vase (slam (slap nav limb/%join) (slop a b))
?~ q.res ~
?~ +.q.res [~ ~]
``(slap res !,(*hoon ?>(?=([~ ~ *] .) u.u)))
++ mash
|= [a=[=ship =desk diff=vase] b=[=ship =desk diff=vase]]
^- (unit vase)
=/ res=vase
%+ slam (slap nav limb/%mash)
%+ slop
:(slop =>([..zuse ship.a] !>(+)) =>([..zuse desk.a] !>(+)) diff.a)
:(slop =>([..zuse ship.b] !>(+)) =>([..zuse desk.b] !>(+)) diff.b)
?~ q.res
~
`(slap res !,(*hoon ?>((^ .) u)))
++ pact
|= diff=vase
(slam (slap nav limb/%pact) (slop sam diff))
++ vale
|: noun=q:(slap nav !,(*hoon *vale))
(slam (slap nav limb/%vale) noun/noun)
--
:: +build-cast: produce gate to convert mark .a to, statically typed
::
++ build-cast
|= [a=mark b=mark]
^- [vase state]
~| error-building-cast+[a b]
%- soak-vase
%+ gain-sprig cast+a^b |.
=. stack.nub [~ stack.nub]
?: =([%mime %hoon] [a b])
:_(nub [%vase =>(..zuse !>(|=(m=mime q.q.m)))])
?: (~(has in cycle.nub) cast+[a b])
~|(cycle+cast+[a b]^cycle.nub !!)
:: try +grow; is there a +grow core with a .b arm?
::
:: ~> %slog.0^leaf/"ford: make cast {<a>} -> {<b>}"
=^ old=vase nub (build-fit %mar a)
?: =/ ram (mule |.((slap old !,(*hoon grow))))
?: ?=(%| -.ram) %.n
=/ lab (mule |.((slob b p.p.ram)))
?: ?=(%| -.lab) %.n
p.lab
:: +grow core has .b arm; use that
::
%+ gain-leak cast+a^b
|= nob=state
=. nub nob
:_ nub :- %vase
%+ slap (with-faces cor+old ~)
^- hoon
:+ %brcl !,(*hoon v=+<.cor)
:+ %tsgl limb/b
!,(*hoon ~(grow cor v))
:: try direct +grab
::
=^ new=vase nub (build-fit %mar b)
=/ rab (mule |.((slap new tsgl/[limb/a limb/%grab])))
?: &(?=(%& -.rab) ?=(^ q.p.rab))
%+ gain-leak cast+a^b
|= nob=state
=. 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)
?: ?=(%& -.rab)
(compose-casts a !<(mark p.rab) b)
?: ?=(%noun b)
%+ gain-leak cast+a^b
|= nob=state
=. nub nob
:_(nub vase+same.bud)
~|(no-cast-from+[a b] !!)
::
++ compose-casts
|= [x=mark y=mark z=mark]
^- [soak state]
=^ uno=vase nub (build-cast x y)
=^ dos=vase nub (build-cast y z)
%+ gain-leak cast+x^z
|= nob=state
=. nub nob
:_ nub :- %vase
%+ slap
(with-faces uno+uno dos+dos cork+=>([..zuse cork] !>(+)) ~)
!,(*hoon (cork uno dos))
:: +build-tube: produce a $tube mark conversion gate from .a to .b
::
++ build-tube
|= [a=mark b=mark]
^- [tube state]
~| error-building-tube+[a b]
%- soak-tube
%+ gain-sprig tube+a^b |.
=. stack.nub [~ stack.nub]
?: (~(has in cycle.nub) tube+[a b])
~|(cycle+tube+[a b]^cycle.nub !!)
=^ gat=vase nub (build-cast a b)
%+ gain-leak tube+a^b
|= nob=state
=. nub nob
:: ~> %slog.0^leaf/"ford: make tube {<a>} -> {<b>}"
:_(nub [%tube =>([..zuse gat=gat] |=(v=vase (slam gat v)))])
::
++ validate-page
|= [=path =page]
^- [cage state]
~| validate-page-fail+path^from+p.page
=/ mak=mark (head (flop path))
?: =(mak p.page)
(page-to-cage page)
=^ [mark vax=vase] nub (page-to-cage page)
=^ =tube nub (build-tube p.page mak)
:_(nub [mak (tube vax)])
::
++ page-to-cage
|= =page
^- [cage state]
?: =(%hoon p.page)
:_(nub [%hoon [%atom %t ~] q.page])
?: =(%mime p.page)
:_(nub [%mime =>([..zuse ;;(mime q.page)] !>(+))])
=^ =dais nub (build-dais p.page)
:_(nub [p.page (vale:dais q.page)])
::
++ cast-path
|= [=path mak=mark]
^- [cage state]
=/ mok (head (flop path))
~| error-casting-path+[path mok mak]
=^ cag=cage nub (read-file path)
?: =(mok mak)
[cag nub]
=^ =tube nub (build-tube mok mak)
~| error-running-cast+[path mok mak]
:_(nub [mak (tube q.cag)])
::
++ run-pact
|= [old=page diff=page]
^- [cage state]
?: ?=(%hoon p.old)
=/ txt=wain (to-wain:format ;;(@t q.old))
=+ ;;(dif=(urge cord) q.diff)
=/ new=@t (of-wain:format (lurk:differ txt dif))
:_(nub [%hoon =>([..zuse new] !>(+))])
=^ dys=dais nub (build-dais p.old)
=^ syd=dais nub (build-dais p.diff)
:_(nub [p.old (~(pact dys (vale:dys q.old)) (vale:syd q.diff))])
::
++ prelude
|= =path
^- vase
=^ cag=cage nub (read-file path)
?> =(%hoon p.cag)
=/ tex=tape (trip !<(@t q.cag))
=/ =pile (parse-pile path tex)
=. hoon.pile !,(*hoon .)
=^ res=vase nub (run-prelude pile)
res
::
++ build-dependency
|= dep=(each [dir=path fil=path] path)
^- [vase state]
=/ =path
?:(?=(%| -.dep) p.dep fil.p.dep)
~| %error-building^path
%- soak-vase
%+ gain-sprig file+path |.
=. stack.nub [~ stack.nub]
~> %slog.0^leaf/"ford: make file {(spud path)}"
?: (~(has in cycle.nub) file+path)
~|(cycle+file+path^cycle.nub !!)
=. cycle.nub (~(put in cycle.nub) file+path)
=^ cag=cage nub (read-file path)
?> =(%hoon p.cag)
=/ tex=tape (trip !<(@t q.cag))
=/ =pile (parse-pile path tex)
=^ sut=vase nub (run-prelude pile)
%+ gain-leak file+path
|= nob=state
=. nub nob
=/ res=vase (road |.((slap sut hoon.pile)))
[[%vase res] nub]
::
++ build-file
|= =path
(build-dependency |+path)
:: +build-directory: builds files in top level of a directory
::
:: this excludes files directly at /path/hoon,
:: instead only including files in the unix-style directory at /path,
:: such as /path/file/hoon, but not /path/more/file/hoon.
::
++ build-directory
|= =path
^- [(map @ta vase) state]
%- soak-arch
%+ gain-sprig arch+path |.
%+ gain-leak arch+path
|= nob=state
=. nub nob
=/ fiz=(list @ta)
=/ len (lent path)
%+ murn ~(tap by files)
|= [pax=^path *]
^- (unit @ta)
?. =(path (scag len pax))
~
=/ pat (slag len pax)
?: ?=([@ %hoon ~] pat)
`i.pat
~
::
=| rez=(map @ta vase)
|-
?~ fiz
[[%arch rez] nub]
=* nom=@ta i.fiz
=/ pax=^path (weld path nom %hoon ~)
=^ res nub (build-dependency &+[path pax])
$(fiz t.fiz, rez (~(put by rez) nom res))
::
++ run-prelude
|= =pile
=/ sut=vase zuse.bud
=^ sut=vase nub (run-tauts sut %sur sur.pile)
=^ sut=vase nub (run-tauts sut %lib lib.pile)
=^ sut=vase nub (run-raw sut raw.pile)
=^ sut=vase nub (run-raz sut raz.pile)
=^ sut=vase nub (run-maz sut maz.pile)
=^ sut=vase nub (run-caz sut caz.pile)
=^ sut=vase nub (run-bar sut bar.pile)
[sut nub]
::
++ parse-pile
|= [pax=path tex=tape]
^- pile
=/ [=hair res=(unit [=pile =nail])] ((pile-rule pax) [1 1] tex)
?^ res pile.u.res
%- mean %- flop
=/ lyn p.hair
=/ col q.hair
:~ leaf+"syntax error at [{<lyn>} {<col>}] in {<pax>}"
leaf+(trip (snag (dec lyn) (to-wain:format (crip tex))))
leaf+(runt [(dec col) '-'] "^")
==
::
++ pile-rule
|= pax=path
%- full
%+ ifix
:_ gay
:: parse optional /? and ignore
::
;~(plug gay (punt ;~(plug fas wut gap dem gap)))
|^
;~ plug
%+ cook (bake zing (list (list taut)))
%+ rune hep
(most ;~(plug com gaw) taut-rule)
::
%+ cook (bake zing (list (list taut)))
%+ rune lus
(most ;~(plug com gaw) taut-rule)
::
%+ rune tis
;~(plug sym ;~(pfix gap stap))
::
%+ rune sig
;~((glue gap) sym wyde:vast stap)
::
%+ rune cen
;~(plug sym ;~(pfix gap ;~(pfix cen sym)))
::
%+ rune buc
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix cen sym)
==
::
%+ rune tar
;~ (glue gap)
sym
;~(pfix cen sym)
;~(pfix stap)
==
::
%+ stag %tssg
(most gap tall:(vang & pax))
==
::
++ pant
|* fel=^rule
;~(pose fel (easy ~))
::
++ mast
|* [bus=^rule fel=^rule]
;~(sfix (more bus fel) bus)
::
++ rune
|* [bus=^rule fel=^rule]
%- pant
%+ mast gap
;~(pfix fas bus gap fel)
--
::
++ taut-rule
%+ cook |=(taut +<)
;~ pose
(stag ~ ;~(pfix tar sym))
;~(plug (stag ~ sym) ;~(pfix tis sym))
(cook |=(a=term [`a a]) sym)
==
::
++ run-tauts
|= [sut=vase wer=?(%lib %sur) taz=(list taut)]
^- [vase state]
?~ taz [sut nub]
=^ pin=vase nub (build-fit wer pax.i.taz)
=? p.pin ?=(^ face.i.taz) [%face u.face.i.taz p.pin]
$(sut (slop pin sut), taz t.taz)
::
++ run-raw
|= [sut=vase raw=(list [face=term =path])]
^- [vase state]
?~ raw [sut nub]
=^ pin=vase nub (build-file (snoc path.i.raw %hoon))
=. p.pin [%face face.i.raw p.pin]
$(sut (slop pin sut), raw t.raw)
::
++ run-raz
|= [sut=vase raz=(list [face=term =spec =path])]
^- [vase state]
?~ raz [sut nub]
=^ res=(map @ta vase) nub
(build-directory path.i.raz)
=; pin=vase
=. p.pin [%face face.i.raz p.pin]
$(sut (slop pin sut), raz t.raz)
::
=/ =type (~(play ut p.sut) [%kttr spec.i.raz])
:: ensure results nest in the specified type,
:: and produce a homogenous map containing that type.
::
:- %- ~(play ut p.sut)
[%kttr %make [%wing ~[%map]] ~[[%base %atom %ta] spec.i.raz]]
|-
?~ res ~
?. (~(nest ut type) | p.q.n.res)
~| [%nest-fail path.i.raz p.n.res]
!!
:- [p.n.res q.q.n.res]
[$(res l.res) $(res r.res)]
::
++ run-maz
|= [sut=vase maz=(list [face=term =mark])]
^- [vase state]
?~ maz [sut nub]
=^ pin=vase nub (build-nave mark.i.maz)
=. p.pin [%face face.i.maz p.pin]
$(sut (slop pin sut), maz t.maz)
::
++ run-caz
|= [sut=vase caz=(list [face=term =mars])]
^- [vase state]
?~ caz [sut nub]
=^ pin=vase nub (build-cast mars.i.caz)
=. p.pin [%face face.i.caz p.pin]
$(sut (slop pin sut), caz t.caz)
::
++ run-bar
|= [sut=vase bar=(list [face=term =mark =path])]
^- [vase state]
?~ bar [sut nub]
=^ =cage nub (cast-path [path mark]:i.bar)
=. p.q.cage [%face face.i.bar p.q.cage]
$(sut (slop q.cage sut), bar t.bar)
::
:: +build-fit: build file at path, maybe converting '-'s to '/'s in path
::
++ build-fit
|= [pre=@tas pax=@tas]
^- [vase state]
(build-file (fit-path pre pax))
::
:: +fit-path: find path, maybe converting '-'s to '/'s
::
:: Try '-' before '/', applied left-to-right through the path,
:: e.g. 'a-foo/bar' takes precedence over 'a/foo-bar'.
::
++ fit-path
|= [pre=@tas pax=@tas]
^- path
=/ paz (segments pax)
|- ^- path
?~ paz ~_(leaf/"clay: no files match /{(trip pre)}/{(trip pax)}/hoon" !!)
=/ pux=path pre^(snoc i.paz %hoon)
?: (~(has by files) pux)
pux
$(paz t.paz)
::
++ all-fits
|= [=term suf=term]
^- (list path)
%+ turn (segments suf)
|= seg=path
[term (snoc seg %hoon)]
::
:: Gets a map of the data at the given path and all children of it.
::
:: i.e. +dip:of for a map, except doesn't shorten paths
::
++ dip-hat
|= pax=path
^- (map path (each page lobe))
%- malt
%+ skim ~(tap by files)
|= [p=path *]
?| ?=(~ pax)
?& !?=(~ p)
=(-.pax -.p)
$(p +.p, pax +.pax)
== ==
::
++ mist-to-pour
|= =mist
^- pour
?+ -.mist mist
%vale
:+ %vale path.mist
~| %file-not-found-mist^path.mist
=/ lob (~(got by files) path.mist)
?- -.lob
%& (page-to-lobe p.lob)
%| p.lob
==
::
%arch
=/ dip (dip-hat path.mist)
:+ %arch path.mist
%- ~(run by dip)
|= file=(each page lobe)
?- -.file
%& (page-to-lobe p.file)
%| p.file
==
==
::
++ soak-cage |=([s=soak n=state] ?>(?=(%cage -.s) [cage.s n]))
++ soak-vase |=([s=soak n=state] ?>(?=(%vase -.s) [vase.s n]))
++ soak-dais |=([s=soak n=state] ?>(?=(%dais -.s) [dais.s n]))
++ soak-tube |=([s=soak n=state] ?>(?=(%tube -.s) [tube.s n]))
++ soak-arch |=([s=soak n=state] ?>(?=(%arch -.s) [dir.s n]))
::
++ gain-sprig
|= [=mist next=(trap [soak state])]
^- [soak state]
?~ got=(~(get by sprig.nub) mist)
$:next
=? stack.nub ?=(^ stack.nub)
stack.nub(i (~(put in i.stack.nub) leak.u.got))
[soak.u.got nub]
::
++ gain-leak
|= [=mist next=$-(state [soak state])]
^- [soak state]
=^ top=(set leak) stack.nub stack.nub
=/ =leak [(mist-to-pour mist) top]
=. cycle.nub (~(del in cycle.nub) mist)
=? stack.nub ?=(^ stack.nub)
stack.nub(i (~(put in i.stack.nub) leak))
=/ spilt (~(has in spill.nub) leak)
=^ =soak nub
?^ got=(~(get by cache.nub) leak)
=/ refs ?:(spilt 0 1)
:: %- =/ tape-1 "ford: cache {<pour.leak>}: adding {<refs>}"
:: =/ tape-2 ", giving {<(add refs refs.u.got)>}"
:: (slog leaf+(welp tape-1 tape-2) ~)
=? cache.nub !=(0 refs)
(~(put by cache.nub) leak [(add refs refs.u.got) soak.u.got])
[soak.u.got nub]
%- (slog leaf+"ford: cache {<pour.leak>}: creating" ~)
=^ =soak nub (next nub)
=. cache.nub (~(put by cache.nub) leak [1 soak])
:: If we're creating a cache entry, add refs to our dependencies
::
=/ deps ~(tap in deps.leak)
|-
?~ deps
[soak nub]
=/ got (~(got by cache.nub) i.deps)
:: %- =/ tape-1 "ford: cache {<pour.leak>} for {<pour.i.deps>}"
:: =/ tape-2 ": bumping to ref {<refs.got>}"
:: (slog leaf+(welp tape-1 tape-2) ~)
=. cache.nub (~(put by cache.nub) i.deps got(refs +(refs.got)))
$(deps t.deps)
?: spilt
[soak nub]
:: %- (slog leaf+"ford: spilt: {<spilt>}" ~)
=: spill.nub (~(put in spill.nub) leak)
sprig.nub (~(put by sprig.nub) mist leak soak)
==
[soak nub]
--
::
++ lose-leak
|= [fad=flow =leak]
^- flow
?~ got=(~(get by fad) leak)
%- (slog leaf+"ford: lose missing leak {<leak>}" ~)
fad
?: (lth 1 refs.u.got)
=/ tape "ford: cache {<pour.leak>}: decrementing from {<refs.u.got>}"
%- (slog leaf+tape ~)
=. fad (~(put by fad) leak u.got(refs (dec refs.u.got)))
fad
=+ ?. =(0 refs.u.got) ~
((slog leaf+"ford: lose zero leak {<leak>}" ~) ~)
%- (slog leaf+"ford: cache {<pour.leak>}: freeing" ~)
=. fad (~(del by fad) leak)
=/ leaks ~(tap in deps.leak)
|- ^- flow
?~ leaks
fad
=. fad ^$(leak i.leaks)
$(leaks t.leaks)
::
++ lose-leaks
|= [fad=flow leaks=(set leak)]
^- flow
=/ leaks ~(tap in leaks)
|-
?~ leaks
fad
$(fad (lose-leak fad i.leaks), leaks t.leaks)
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem logic
::
:: This core contains the main logic of clay. Besides `++ze`, this directly
:: contains the logic for commiting new revisions (local urbits), managing
:: and notifying subscribers (reactivity), and pulling and validating content
:: (remote urbits).
::
:: The state includes:
::
:: -- local urbit `our`
:: -- current time `now`
:: -- current duct `hen`
:: -- scry handler `ski`
:: -- all vane state `++raft` (rarely used, except for the object store)
:: -- target urbit `her`
:: -- target desk `syd`
::
:: For local desks, `our` == `her` is one of the urbits on our pier. For
:: foreign desks, `her` is the urbit the desk is on and `our` is the local
:: urbit that's managing the relationship with the foreign urbit. Don't mix
:: up those two, or there will be wailing and gnashing of teeth.
::
:: While setting up `++de`, we check if `our` == `her`. If so, we get
:: the desk information from `dos.rom`. Otherwise, we get the rung from
:: `hoy` and get the desk information from `rus` in there. In either case,
:: we normalize the desk information to a `++rede`, which is all the
:: desk-specific data that we utilize in `++de`. Because it's effectively
:: a part of the `++de` state, let's look at what we've got:
::
:: -- `lim` is the most recent date we're confident we have all the
:: information for. For local desks, this is always `now`. For foreign
:: desks, this is the last time we got a full update from the foreign
:: urbit.
:: -- `ref` is a possible request manager. For local desks, this is null.
:: For foreign desks, this keeps track of all pending foreign requests
:: plus a cache of the responses to previous requests.
:: -- `qyx` is the set of subscriptions, with listening ducts. These
:: subscriptions exist only until they've been filled.
:: -- `dom` is the actual state of the filetree. Since this is used almost
:: exclusively in `++ze`, we describe it there.
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
++ de :: per desk
|= [now=@da rof=roof hen=duct raft]
|= [her=ship syd=desk]
:: NB: ruf=raft crashes in the compiler
::
=* ruf |3.+6.^$
::
=/ [mow=(list move) hun=(unit duct) rede]
?. =(our her)
:: no duct, foreign +rede or default
::
:+ ?: (~(has by hoy.ruf) her)
~
[hun.rom.ruf %pass /sinks %j %public-keys (silt her ~)]~
~
=/ rus rus:(~(gut by hoy.ruf) her *rung)
%+ ~(gut by rus) syd
[lim=~2000.1.1 ref=`*rind qyx=~ dom=*dome per=~ pew=~ fiz=*melt]
:: administrative duct, domestic +rede
::
:+ ~ `hun.rom.ruf
=/ jod (~(gut by dos.rom.ruf) syd *dojo)
[lim=now ref=~ [qyx dom per pew fiz]:jod]
::
=* red=rede ->+
|%
++ abet :: resolve
^- [(list move) raft]
:- (flop mow)
?. =(our her)
:: save foreign +rede
::
=/ run (~(gut by hoy.ruf) her *rung)
=/ rug (~(put by rus.run) syd red)
ruf(hoy (~(put by hoy.ruf) her run(rus rug)))
:: save domestic +room
::
%= ruf
hun.rom (need hun)
dos.rom (~(put by dos.rom.ruf) syd [qyx dom per pew fiz]:red)
==
::
:: Handle `%sing` requests
::
++ aver
|= [for=(unit ship) mun=mood]
^- [(unit (unit cage)) _..park]
=+ ezy=?~(ref ~ (~(get by haw.u.ref) mun))
?^ ezy
[`u.ezy ..park]
?: ?=([%s [%ud *] %late *] mun)
:_ ..park
^- (unit (unit cage))
:+ ~ ~
^- cage
:- %cass
?~ let.dom
!>([0 *@da])
!>([let.dom t:(~(got by hut.ran) (~(got by hit.dom) let.dom))])
=+ nao=(case-to-aeon case.mun)
?: ?=([%s case %case ~] mun)
:: case existence check
[``[%flag !>(!=(~ nao))] ..park]
?~(nao [~ ..park] (read-at-aeon:ze for u.nao mun))
::
:: Queue a move.
::
++ emit
|= mof=move
%_(+> mow [mof mow])
::
:: Queue a list of moves
::
++ emil
|= mof=(list move)
%_(+> mow (weld (flop mof) mow))
::
:: Queue a list of moves, to be emitted before the rest
::
++ lime
|= mof=(list move)
%_(+> mow (weld mow (flop mof)))
::
:: Set timer.
::
++ bait
|= [hen=duct tym=@da]
(emit hen %pass /tyme/(scot %p her)/[syd] %b %wait tym)
::
:: Cancel timer.
::
++ best
|= [hen=duct tym=@da]
(emit hen %pass /tyme/(scot %p her)/[syd] %b %rest tym)
::
:: Give %writ, or slip a drip if foreign desk
::
++ writ
|= res=(unit [=mood =cage])
^- card
=/ =riot
?~ res
~
`[[care.mood case.mood syd] path.mood cage]:[u.res syd=syd]
?~ ref
[%give %writ riot]
[%slip %b %drip !>([%writ riot])]
::
++ case-to-date
|= =case
^- @da
:: if the case is already a date, use it.
::
?: ?=([%da *] case)
p.case
:: translate other cases to dates
::
=/ aey (case-to-aeon-before lim case)
?~ aey `@da`0
?: =(0 u.aey) `@da`0
t:(aeon-to-yaki:ze u.aey)
::
++ case-to-aeon (cury case-to-aeon-before lim)
::
:: Reduce a case to an aeon (version number)
::
:: We produce null if we can't yet reduce the case for whatever
:: resaon (usually either the time or aeon hasn't happened yet or
:: the label hasn't been created).
::
++ case-to-aeon-before
|= [lim=@da lok=case]
^- (unit aeon)
?- -.lok
%tas (~(get by lab.dom) p.lok)
%ud ?:((gth p.lok let.dom) ~ [~ p.lok])
%da
?: (gth p.lok lim) ~
|- ^- (unit aeon)
?: =(0 let.dom) [~ 0] :: avoid underflow
?: %+ gte p.lok
=< t
~| [%letdom let=let.dom hit=hit.dom hut=~(key by hut.ran)]
~| [%getdom (~(get by hit.dom) let.dom)]
%- aeon-to-yaki:ze
let.dom
[~ let.dom]
$(let.dom (dec let.dom))
==
::
:: Create a ford appropriate for the aeon
::
:: Don't forget to call +aeon-flow!
::
++ aeon-ford
|= yon=aeon
%- ford:fusion
=/ files (~(run by q:(aeon-to-yaki:ze yon)) |=(=lobe |+lobe))
[files lat.ran fad ?:(=(yon let.dom) fod.dom [~ ~])]
:: Produce ford cache appropriate for the aeon
::
++ aeon-flow
|* [yon=aeon res=* fud=flow fod=flue]
:- res
^+ ..park
?: &(?=(~ ref) =(let.dom yon))
..park(fad fud, fod.dom fod)
:: if in the past, don't update ford cache, since any results have
:: no roots
::
..park
::
++ request-wire
|= [kind=@ta =ship =desk index=@ud]
/[kind]/(scot %p ship)/[desk]/(scot %ud index)
::
:: Transfer a request to another ship's clay.
::
++ send-over-ames
|= [=duct =ship index=@ud =riff]
^+ +>
::
=/ =desk p.riff
=/ =wire (request-wire %warp-index ship desk index)
=/ =path [%question desk (scot %ud index) ~]
(emit duct %pass wire %a %plea ship %c path `riff-any`[%1 riff])
::
++ send-over-scry
|= [kind=@ta =duct =ship index=@ud =desk =path]
^- [timeout=@da _..send-over-scry]
=/ =time (add now scry-timeout-time)
=/ =wire (request-wire kind ship desk index)
=. path [%c path]
~& scrying/path^index
:- time
%- emil
:~ [hen %pass wire %a %keen ship path]
[hen %pass wire %b %wait time]
==
::
++ cancel-scry-timeout ::TODO make arg order more consistent
|= [kind=@ta =duct =ship index=@ud =desk time=@da]
=/ =wire (request-wire kind ship desk index)
(emit duct %pass wire %b %rest time)
::
++ foreign-capable
|= =rave
|^
?- -.rave
%many &
%sing (good-care care.mood.rave)
%next (good-care care.mood.rave)
%mult
%- ~(all in paths.mool.rave)
|= [=care =path]
(good-care care)
==
::
++ good-care
|= =care
(~(has in ^~((silt `(list ^care)`~[%u %w %x %y %z]))) care)
--
::
:: Create a request that cannot be filled immediately.
::
:: If it's a local request, we just put in in `qyx`, setting a timer if it's
:: waiting for a particular time. If it's a foreign request, we add it to
:: our request manager (ref, which is a ++rind) and make the request to the
:: foreign ship.
::
++ duce :: produce request
|= wov=wove
^+ +>
=. wov (dedupe wov)
=. qyx (~(put ju qyx) wov hen)
?~ ref
(run-if-future rove.wov |=(@da (bait hen +<)))
|- ^+ +>+.$
=/ =rave (rove-to-rave rove.wov)
=? rave ?=([%sing %v *] rave)
[%many %| [%ud let.dom] case.mood.rave path.mood.rave]
:: if it is a single request, and
:: :ship's remote scry isn't known to be broken,
:: or we learned it was broken more than an hour ago,
::
?: ?& ?=([%sing %x *] rave)
?| !(~(has by sad) her)
(gth now (add scry-retry-time (~(got by sad) her)))
== ==
:: send request as remote scry
::TODO can be deduplicated with the below?
::
=* inx nix.u.ref
=^ time=@da +>+.$
=< ?>(?=(^ ref) .)
=/ =path =,(mood.rave [care (scot case) syd path])
(send-over-scry %warp-index hen her inx syd path)
%= +>+.$
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen rave `time ~ ~ ~ |])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
?. (foreign-capable rave)
~|([%clay-bad-foreign-request-care rave] !!)
::
=+ inx=nix.u.ref
=. +>+.$
=< ?>(?=(^ ref) .)
(send-over-ames hen her inx syd `rave)
%= +>+.$
nix.u.ref +(nix.u.ref)
bom.u.ref (~(put by bom.u.ref) inx [hen rave ~ ~ ~ ~ |])
fod.u.ref (~(put by fod.u.ref) hen inx)
==
::
:: If a similar request exists, switch to the existing request.
::
:: "Similar" requests are those %next and %many requests which are the same
:: up to starting case, but we're already after the starting case. This
:: stacks later requests for something onto the same request so that they
:: all get filled at once.
::
++ dedupe :: find existing alias
|= wov=wove
^- wove
=; won=(unit wove) (fall won wov)
=* rov rove.wov
?- -.rov
%sing ~
%next
=+ aey=(case-to-aeon case.mood.rov)
?~ aey ~
%- ~(rep in ~(key by qyx))
|= [haw=wove res=(unit wove)]
?^ res res
?. =(for.wov for.haw) ~
=* hav rove.haw
=- ?:(- `haw ~)
?& ?=(%next -.hav)
=(mood.hav mood.rov(case case.mood.hav))
::
:: only a match if this request is before
:: or at our starting case.
=+ hay=(case-to-aeon case.mood.hav)
?~(hay | (lte u.hay u.aey))
==
::
%mult
=+ aey=(case-to-aeon case.mool.rov)
?~ aey ~
%- ~(rep in ~(key by qyx))
|= [haw=wove res=(unit wove)]
?^ res res
?. =(for.wov for.haw) ~
=* hav rove.haw
=- ?:(- `haw ~)
?& ?=(%mult -.hav)
=(mool.hav mool.rov(case case.mool.hav))
::
:: only a match if this request is before
:: or at our starting case, and it has been
:: tested at least that far.
=+ hay=(case-to-aeon case.mool.hav)
?& ?=(^ hay)
(lte u.hay u.aey)
?=(^ aeon.hav)
(gte u.aeon.hav u.aey)
==
==
::
%many
=+ aey=(case-to-aeon from.moat.rov)
?~ aey ~
%- ~(rep in ~(key by qyx))
|= [haw=wove res=(unit wove)]
?^ res res
?. =(for.wov for.haw) ~
=* hav rove.haw
=- ?:(- `haw ~)
?& ?=(%many -.hav)
=(hav rov(from.moat from.moat.hav))
::
:: only a match if this request is before
:: or at our starting case.
=+ hay=(case-to-aeon from.moat.hav)
?~(hay | (lte u.hay u.aey))
==
==
::
++ set-norm
|= =norm
=. nor.dom norm
..park
::
++ set-worn
|= [=tako =norm]
?: &(=(our her) =(tako (aeon-to-tako:ze let.dom)))
(mean leaf+"clay: can't set norm for current commit in {<syd>}" ~)
=. tom.dom (~(put by tom.dom) tako norm)
..park
::
:: Attach label to aeon
::
++ label
|= [bel=@tas aey=(unit aeon)]
^+ ..park
=/ yon ?~(aey let.dom u.aey)
=/ yen (~(get by lab.dom) bel) :: existing aeon?
:: no existing aeon is bound to this label
::
?~ yen
=. lab.dom (~(put by lab.dom) bel yon)
..park
:: an aeon is bound to this label,
:: but it is the same as the existing one, so we no-op
::
?: =(u.yen yon)
~& "clay: tried to rebind existing label {<bel>} to equivalent aeon {<yon>}"
..park
:: an existing aeon bound to the label
:: that is distinct from the requested one.
:: rewriting would violate referential transparency
::
~| %tried-to-rewrite-existing-label
~| "requested aeon: {<yon>}, existing aeon: {<u.yen>}"
!!
::
:: Porcelain commit
::
++ info
|= [deletes=(set path) changes=(map path cage)]
^+ ..park
?: =(0 let.dom)
?> ?=(~ deletes)
=/ data=(map path (each page lobe))
(~(run by changes) |=(=cage &+[p q.q]:cage))
(park | &+[~ data] *rang)
::
=/ parent-tako=tako (aeon-to-tako:ze let.dom)
=/ data=(map path (each page lobe))
=/ parent-yaki (tako-to-yaki:ze parent-tako)
=/ after-deletes
%- ~(dif by q.parent-yaki)
(malt (turn ~(tap in deletes) |=(=path [path *lobe])))
=/ after=(map path (each page lobe))
(~(run by after-deletes) |=(=lobe |+lobe))
%- ~(uni by after)
^- (map path (each page lobe))
(~(run by changes) |=(=cage &+[p q.q]:cage))
::
=/ =yuki [~[parent-tako] data]
(park | &+yuki *rang)
::
:: Unix commit
::
++ into
|= [pax=path all=? mod=(list [pax=path mim=(unit mime)])]
^+ ..park
:: filter out unchanged, cached %mime values
::
=. mod
%+ skip mod
|= [pax=path mim=(unit mime)]
?~ mim
|
?~ mum=(~(get by mim.dom) pax)
|
:: TODO: check mimetype
::
=(q.u.mim q.u.mum)
=/ =yaki
?: =(0 let.dom)
*yaki
(~(got by hut.ran) (~(got by hit.dom) let.dom))
(info (mode-to-commit q.yaki pax all mod))
::
:: Plumbing commit
::
:: Guaranteed to finish in one event.
::
:: TODO: needs to check tako in rang
::
++ park
=/ check-sane |
|^
|= [updated=? =yoki =rang]
^+ ..park
=: hut.ran (~(uni by hut.rang) hut.ran)
lat.ran (~(uni by lat.rang) lat.ran)
==
=/ new-data=(map path (each page lobe))
?- -.yoki
%& q.p.yoki
%| (~(run by q.p.yoki) |=(=lobe |+lobe))
==
?. %- ~(all in new-data) :: use +all:in so we get the key
|= [=path tum=(each page lobe)]
?: |(?=(%& -.tum) (~(has by lat.ran) p.tum))
&
(mean leaf/"clay: commit failed, file tombstoned: {<path>} {<`@uv`p.tum>}" ~)
!!
:: find desk kelvin
::
=/ kel=weft (get-kelvin yoki)
?. |(=(%base syd) =(kel [%zuse zuse]))
~>(%mean.|.(leaf/"clay: bad-kelvin, {<[need=zuse/zuse have=kel]>}") !!)
::
=/ old-yaki
?: =(0 let.dom)
*yaki
(aeon-to-yaki:ze let.dom)
=/ [deletes=(set path) changes=(map path (each page lobe))]
(get-changes q.old-yaki new-data)
~| [from=let.dom deletes=deletes changes=~(key by changes)]
::
:: promote ford cache
:: promote and fill in mime cache
::
=/ invalid (~(uni in deletes) ~(key by changes))
?: &(=(%base syd) !updated (~(any in invalid) is-kernel-path))
(sys-update yoki new-data)
::
~? (did-kernel-update invalid) %clay-kernel-updated
=? updated updated (did-kernel-update invalid)
=> ?. updated .
~>(%slog.0^leaf/"clay: rebuilding {<syd>} after kernel update" .)
:: clear caches if zuse reloaded
::
=/ old-fod fod.dom
=. fod.dom
?: updated [~ ~]
(promote-ford fod.dom invalid)
=. fad (lose-leaks:fusion fad (~(dif in spill.old-fod) spill.fod.dom))
=? changes updated (changes-for-upgrade q.old-yaki deletes changes)
::
=/ files
=/ original=(map path (each page lobe))
(~(run by q.old-yaki) |=(=lobe |+lobe))
%- ~(dif by (~(uni by original) changes))
%- ~(gas by *(map path (each page lobe)))
(turn ~(tap in deletes) |=(=path [path |+*lobe]))
=/ =args:ford:fusion [files lat.ran fad fod.dom]
::
=^ change-cages args (checkout-changes args changes)
=/ sane-continuation (sane-changes changes change-cages)
=/ new-pages=(map lobe page)
%- malt
%+ turn ~(tap by change-cages)
|= [=path =lobe =cage]
[lobe [p q.q]:cage]
=/ data=(map path lobe)
%- ~(urn by new-data)
|= [=path value=(each page lobe)]
?- -.value
%| p.value
%& lobe:(~(got by change-cages) path)
==
:: if we didn't change the data and it's not a merge commit, abort
::
:: very important to keep all permanent changes below this point
::
?: &(=([r.old-yaki ~] p.p.yoki) =(data q.old-yaki))
..park
=/ =yaki
?- -.yoki
%& (make-yaki p.p.yoki data now)
%| ?> =(data q.p.yoki)
p.yoki
==
=: let.dom +(let.dom)
hit.dom (~(put by hit.dom) +(let.dom) r.yaki)
hut.ran (~(put by hut.ran) r.yaki yaki)
lat.ran (~(uni by new-pages) lat.ran)
==
=. file-store.args lat.ran
::
=^ mim args (checkout-mime args deletes ~(key by changes))
=. mim.dom (apply-changes-to-mim mim.dom mim)
=. fod.dom [spill sprig]:args
=. fad cache.args
=. ..park (emil (print q.old-yaki data))
wake:(ergo 0 mim)
::
:: +is-kernel-path: should changing .pax cause a kernel or vane reload?
::
++ is-kernel-path |=(pax=path ?=([%sys *] pax))
::
++ did-kernel-update
|= invalid=(set path)
?. =(%base syd)
|
%- ~(any in invalid)
|=(p=path &((is-kernel-path p) !?=([%sys %vane *] p)))
:: +get-kelvin: read the desk's kernel version from /sys/kelvin
::
++ get-kelvin
|= =yoki
^- weft
|^ ?- -.yoki
%|
%- lobe-to-weft
~> %mean.(cat 3 'clay: missing /sys/kelvin on ' syd)
~| ~(key by q.p.yoki)
(~(got by q.p.yoki) /sys/kelvin)
::
%&
=/ fil=(each page lobe)
~> %mean.(cat 3 'clay: missing /sys/kelvin on ' syd)
~| ~(key by q.p.yoki)
(~(got by q.p.yoki) /sys/kelvin)
?- -.fil
%& (page-to-weft p.fil)
%| (lobe-to-weft p.fil)
==
==
::
++ lobe-to-weft
|= =lobe
^- weft
=/ peg=(unit page) (~(get by lat.ran) lobe)
?~ peg ~|([%sys-kelvin-tombstoned syd] !!)
(page-to-weft u.peg)
::
++ page-to-weft
|= =page
^- weft
?+ p.page ~|(clay-bad-kelvin-mark/p.page !!)
%kelvin ;;(weft q.page)
%mime
=+ ;;(=mime q.page)
!<(weft (slap !>(~) (ream q.q.mime)))
==
--
::
:: Find which files changed or were deleted
::
++ get-changes
|= [old=(map path lobe) new=(map path (each page lobe))]
^- [deletes=(set path) changes=(map path (each page lobe))]
=/ old=(map path (each page lobe))
(~(run by old) |=(=lobe |+lobe))
:* %- silt ^- (list path)
%+ murn ~(tap by (~(uni by old) new))
|= [=path *]
^- (unit ^path)
=/ a (~(get by new) path)
=/ b (~(get by old) path)
?: |(=(a b) !=(~ a))
~
`path
::
%- malt ^- (list [path (each page lobe)])
%+ murn ~(tap by (~(uni by old) new))
|= [=path *]
^- (unit [^path (each page lobe)])
=/ a (~(get by new) path)
=/ b (~(get by old) path)
?: |(=(a b) ?=(~ a))
~
`[path u.a]
==
:: Find all files for full desk rebuild
::
++ changes-for-upgrade
|= $: old=(map path lobe)
deletes=(set path)
changes=(map path (each page lobe))
==
^+ changes
=. old
%+ roll ~(tap in deletes)
|= [pax=path old=_old]
(~(del by old) pax)
=/ pre=_changes (~(run by old) |=(lob=lobe |+lob))
(~(uni by pre) changes)
::
++ promote-ford
|= [fod=flue invalid=(set path)]
^- flue
=/ old=(list leak) ~(tap in spill.fod)
=| new=flue
|- ^- flue
?~ old
new
=/ invalid
|- ^- ?
?| ?+ -.pour.i.old %|
%vale (~(has in invalid) path.pour.i.old)
%arch
:: TODO: overly conservative, should be only direct hoon
:: children
::
=/ len (lent path.pour.i.old)
%- ~(any in invalid)
|= =path
=(path.pour.i.old (scag len path))
==
::
=/ deps ~(tap in deps.i.old)
|- ^- ?
?~ deps
%|
?| ^$(i.old i.deps)
$(deps t.deps)
==
==
=? new !invalid
:- (~(put in spill.new) i.old)
=/ =mist (pour-to-mist pour.i.old)
?~ got=(~(get by sprig.fod) mist)
sprig.new
(~(put by sprig.new) mist u.got)
$(old t.old)
::
++ page-to-cord
|= =page
^- @t
?+ p.page ~|([%sys-bad-mark p.page] !!)
%hoon ;;(@t q.page)
%mime q.q:;;(mime q.page)
==
::
++ lobe-to-cord
|= =lobe
^- @t
=/ peg=(unit page) (~(get by lat.ran) lobe)
?~ peg
~|([%lobe-to-cord-tombstoned syd lobe] !!)
;;(@t q.u.peg)
::
:: Updated q.yaki
::
++ checkout-changes
|= [=ford=args:ford:fusion changes=(map path (each page lobe))]
^- [(map path [=lobe =cage]) args:ford:fusion]
%+ roll `(list [path (each page lobe)])`~(tap by changes)
|= $: [=path change=(each page lobe)]
[built=(map path [lobe cage]) cache=_ford-args]
==
^+ [built ford-args]
=. ford-args cache
=/ [=cage fud=flow fod=flue]
:: ~> %slog.[0 leaf/"clay: validating {(spud path)}"]
%- wrap:fusion
(read-file:(ford:fusion ford-args) path)
=. cache.ford-args fud
=. spill.ford-args spill.fod
=. sprig.ford-args sprig.fod
=/ =lobe
?- -.change
%| p.change
:: Don't use p.change.i.cans because that's before casting to
:: the correct mark.
::
%& (page-to-lobe [p q.q]:cage)
==
[(~(put by built) path [lobe cage]) ford-args]
::
:: Print notification to console
::
++ print
|= [old=(map path lobe) new=(map path lobe)]
^- (list move)
=/ [deletes=(set path) upserts=(map path (each page lobe))]
(get-changes old (~(run by new) |=(=lobe |+lobe)))
=/ upsert-set ~(key by upserts)
=/ old-set ~(key by old)
=/ changes=(set path) (~(int in upsert-set) old-set)
=/ additions=(set path) (~(dif in upsert-set) old-set)
?~ hun
~
?: (lte let.dom 1)
~
|^
;: weld
(paths-to-notes '-' deletes)
(paths-to-notes ':' changes)
(paths-to-notes '+' additions)
==
::
++ paths-to-notes
|= [prefix=@tD paths=(set path)]
%+ turn ~(tap in paths)
|= =path
[u.hun %give %note prefix (path-to-tank path)]
::
++ path-to-tank
|= =path
=/ pre=^path ~[(scot %p our) syd (scot %ud let.dom)]
:+ %rose ["/" "/" ~]
%+ turn (weld pre path)
|= a=cord
^- tank
?: ((sane %ta) a)
[%leaf (trip a)]
[%leaf (dash:us (trip a) '\'' ~)]
--
::
:: Check sanity
::
++ sane-changes
|= $: changes=(map path (each page lobe))
change-cages=(map path [lobe cage])
==
^- (unit [(map path [lobe cage]) args:ford:fusion])
?. check-sane
~
=/ tak=(unit tako) (~(get by hit.dom) let.dom)
?~ tak
~
=/ =yaki (~(got by hut.ran) u.tak)
:: Assert all pages hash to their lobe
::
=/ foo
%- ~(urn by lat.ran)
|= [=lobe =page]
=/ actual-lobe=^lobe `@uv`(page-to-lobe page)
~| [%bad-lobe have=lobe need=actual-lobe]
?> =(lobe actual-lobe)
~
:: Assert we calculated the same change-cages w/o cache
::
:: ? remove deletes
::
=/ all-changes=(map path (each page lobe))
=/ original=(map path (each page lobe))
(~(run by q.yaki) |=(=lobe |+lobe))
(~(uni by original) changes)
=/ =args:ford:fusion [all-changes lat.ran ~ ~ ~]
=^ all-change-cages args (checkout-changes args all-changes)
=/ ccs=(list [=path =lobe =cage]) ~(tap by change-cages)
|- ^+ *sane-changes
?^ ccs
?. =(`[lobe cage]:i.ccs (~(get by all-change-cages) path.i.ccs))
~| not-same-cages+path.i.ccs
!!
$(ccs t.ccs)
`[all-change-cages args]
::
:: Delay current update until sys update is complete
::
++ sys-update
|= $: =yoki
data=(map path (each page lobe))
==
^+ ..park
?> =(~ pud)
=. pud `[syd yoki]
|^ %. [hen %slip %c %pork ~]
emit:(pass-what files)
::
++ files
^- (list (pair path (cask)))
%+ murn
~(tap by data)
|= [pax=path dat=(each page lobe)]
^- (unit (pair path (cask)))
=/ xap (flop pax)
?> ?=(^ xap)
?. ?=(%hoon i.xap) ~
:^ ~ (flop t.xap) %hoon
~| [pax=pax p.dat]
?- -.dat
%& (page-to-cord p.dat)
%| (lobe-to-cord p.dat)
==
::
++ pass-what
|= fil=(list (pair path (cask)))
^+ ..park
(emit hen %pass /what %$ what/fil)
--
--
::
:: We always say we're merging from 'ali' to 'bob'. The basic steps,
:: not all of which are always needed, are:
::
:: -- fetch ali's desk, async in case it's remote
:: -- diff ali's desk against the mergebase
:: -- diff bob's desk against the mergebase
:: -- merge the diffs
:: -- commit
::
++ start-merge
|= [=ali=ship =ali=desk =case =germ]
^+ ..start-merge
=/ =wire /merge/[syd]/(scot %p ali-ship)/[ali-desk]/[germ]
(emit hen %pass wire %c %warp ali-ship ali-desk `[%sing %v case /])
::
++ make-melt
|= [bas=beak con=(list [beak germ])]
^- melt
:+ bas con
%- ~(gas by *(map beak (unit dome:clay)))
:- [bas *(unit dome:clay)]
(turn con |=(a=[beak germ] [-.a *(unit dome:clay)]))
::
++ start-fuse
|= [bas=beak con=(list [beak germ])]
^+ ..start-fuse
=/ moves=(list move)
%+ turn
[[bas *germ] con]
|= [bec=beak germ]
^- move
=/ wir=wire /fuse/[syd]/(scot %p p.bec)/[q.bec]/(scot r.bec)
[hen %pass wir %c %warp p.bec q.bec `[%sing %v r.bec /]]
::
:: We also want to clear the state (fiz) associated with this
:: merge and print a warning if it's non trivial i.e. we're
:: starting a new fuse before the previous one terminated.
::
=/ err=tang
?~ con.fiz
~
=/ discarded=tang
%+ turn
~(tap in sto.fiz)
|= [k=beak v=(unit dome:clay)]
^- tank
=/ received=tape ?~(v "missing" "received")
leaf+"{<(en-beam k ~)>} {received}"
:_ discarded
leaf+"fusing into {<syd>} from {<bas>} {<con>} - overwriting prior fuse"
=. fiz (make-melt bas con)
((slog err) (emil moves))
::
++ take-fuse
|^
::
|= [bec=beak =riot]
^+ ..take-fuse
?~ riot
::
:: By setting fiz to *melt the merge is aborted - any further
:: responses we get for the merge will cause take-fuse to crash
::
=. fiz *melt
=/ msg=tape <(en-beam bec ~)>
((slog [leaf+"clay: fuse failed, missing {msg}"]~) ..take-fuse)
?. (~(has by sto.fiz) bec)
=/ msg=tape <(en-beam bec ~)>
((slog [leaf+"clay: got strange fuse response {<msg>}"]~) ..take-fuse)
=. fiz
:+ bas.fiz con.fiz
(~(put by sto.fiz) bec `!<(dome:clay q.r.u.riot))
=/ all-done=flag
%- ~(all by sto.fiz)
|= res=(unit dome:clay)
^- flag
!=(res ~)
?. all-done
..take-fuse
=| rag=rang
=/ clean-state ..take-fuse
=/ initial-dome=dome:clay (need (~(got by sto.fiz) bas.fiz))
=/ next-yaki=yaki
(~(got by hut.ran) (~(got by hit.initial-dome) let.initial-dome))
=/ parents=(list tako) ~[(~(got by hit.initial-dome) let.initial-dome)]
=/ merges con.fiz
|-
^+ ..take-fuse
?~ merges
=. ..take-fuse (done-fuse clean-state %& ~)
(park | [%| next-yaki(p (flop parents))] rag)
=/ [bec=beak g=germ] i.merges
=/ ali-dom=dome:clay (need (~(got by sto.fiz) bec))
=/ result (merge-helper p.bec q.bec g ali-dom `next-yaki)
?- -.result
%|
=/ failing-merge=tape "{<bec>} {<g>}"
(done-fuse clean-state %| %fuse-merge-failed leaf+failing-merge p.result)
::
%&
=/ merge-result=(unit merge-result) +.result
?~ merge-result
::
:: This merge was a no-op, just continue
::
$(merges t.merges)
?^ conflicts.u.merge-result
::
:: If there are merge conflicts send the error and abort the merge
::
(done-fuse clean-state %& conflicts.u.merge-result)
=/ merged-yaki=yaki
?- -.new.u.merge-result
%| +.new.u.merge-result
%&
::
:: Convert the yuki to yaki
::
=/ yuk=yuki +.new.u.merge-result
=/ lobes=(map path lobe)
%- ~(run by q.yuk)
|= val=(each page lobe)
^- lobe
?- -.val
%& (page-to-lobe +.val)
%| +.val
==
(make-yaki p.yuk lobes now)
==
%= $
next-yaki merged-yaki
merges t.merges
hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki)
lat.rag (~(uni by lat.u.merge-result) lat.rag)
lat.ran (~(uni by lat.u.merge-result) lat.ran)
parents [(~(got by hit.ali-dom) let.ali-dom) parents]
==
==
:: +done-fuse: restore state after a fuse is attempted, whether it
:: succeeds or fails.
::
++ done-fuse
|= [to-restore=_..take-fuse result=(each (set path) (pair term tang))]
^+ ..take-fuse
=. fiz.to-restore *melt
(done:to-restore result)
--
::
++ done
|= result=(each (set path) (pair term tang))
^+ ..merge
(emit hen %give %mere result)
::
++ merge
|= [=ali=ship =ali=desk =germ =riot]
^+ ..merge
?~ riot
(done %| %ali-unavailable ~[>[ali-ship ali-desk germ]<])
=/ ali-dome=dome:clay !<(dome:clay q.r.u.riot)
=/ result=(each (unit merge-result) (pair term tang))
(merge-helper ali-ship ali-desk germ ali-dome ~)
?- -.result
%| (done %| +.result)
%&
=/ mr=(unit merge-result) +.result
?~ mr
(done %& ~)
=. ..merge (done %& conflicts.u.mr)
(park | new.u.mr ~ lat.u.mr)
==
::
+$ merge-result [conflicts=(set path) new=yoki lat=(map lobe page)]
::
++ merge-helper
|= [=ali=ship =ali=desk =germ ali-dome=dome:clay next-yaki=(unit yaki)]
^- (each (unit merge-result) [term tang])
|^
^- (each (unit merge-result) [term tang])
=/ ali-yaki=yaki (~(got by hut.ran) (~(got by hit.ali-dome) let.ali-dome))
=/ bob-yaki=(unit yaki)
?~ next-yaki
?~ let.dom
~
(~(get by hut.ran) (~(got by hit.dom) let.dom))
next-yaki
=/ res (mule |.((merge-by-germ ali-yaki bob-yaki)))
?- -.res
%& &+p.res
%| |+merge-failed+p.res
==
::
++ merge-by-germ
|= [=ali=yaki bob-yaki=(unit yaki)]
^- (unit merge-result)
::
:: If this is an %init merge, we set the ali's commit to be
:: bob's.
::
?: ?=(%init germ)
?> ?=(~ bob-yaki)
`[conflicts=~ new=|+ali-yaki lat=~]
::
=/ bob-yaki (need bob-yaki)
|^
^- (unit merge-result)
?- germ
::
:: If this is a %only-this merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done.
:: Otherwise, we create a new commit with bob's data plus ali and
:: bob as parents.
::
%only-this
?: =(r.ali-yaki r.bob-yaki)
~
:* ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.bob-yaki)]
lat=~
==
::
:: If this is a %only-that merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: create a new commit with ali's data plus ali and bob as
:: parents.
::
%only-that
?: =(r.ali-yaki r.bob-yaki)
~
:* ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki q.ali-yaki)]
lat=~
==
::
:: Create a merge commit with exactly the contents of the
:: destination desk except take any files from the source commit
:: which are not in the destination desk.
::
%take-this
?: =(r.ali-yaki r.bob-yaki)
~
=/ new-data (~(uni by q.ali-yaki) q.bob-yaki)
:* ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki new-data)]
lat=~
==
::
:: Create a merge commit with exactly the contents of the source
:: commit except preserve any files from the destination desk
:: which are not in the source commit.
::
%take-that
?: =(r.ali-yaki r.bob-yaki)
~
=/ new-data (~(uni by q.bob-yaki) q.ali-yaki)
:* ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki new-data)]
lat=~
==
::
:: If this is a %fine merge, we check to see if ali's and bob's
:: commits are the same, in which case we're done. Otherwise, we
:: check to see if ali's commit is in the ancestry of bob's, in
:: which case we're done. Otherwise, we check to see if bob's
:: commit is in the ancestry of ali's. If not, this is not a
:: fast-forward merge, so we error out. If it is, we add ali's
:: commit to bob's desk and checkout.
::
%fine
?: =(r.ali-yaki r.bob-yaki)
~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
~
?. (~(has in (reachable-takos:ze r.ali-yaki)) r.bob-yaki)
~_ %bad-fine-merge
~| "tried fast-forward but is not ancestor or descendant"
!!
`[conflicts=~ new=|+ali-yaki lat=~]
::
?(%meet %mate %meld %meet-this %meet-that)
?: =(r.ali-yaki r.bob-yaki)
~
?: (~(has in (reachable-takos:ze r.bob-yaki)) r.ali-yaki)
~
?: (~(has in (reachable-takos:ze r.ali-yaki)) r.bob-yaki)
$(germ %fine)
=/ merge-points (find-merge-points ali-yaki bob-yaki)
?~ merge-points
~_ %merge-no-merge-base
~| "consider a %this or %that merge to get a mergebase"
!!
=/ merge-point=yaki n.merge-points
?: ?=(?(%mate %meld) germ)
=/ ali-diffs=cane (diff-base ali-yaki bob-yaki merge-point)
=/ bob-diffs=cane (diff-base bob-yaki ali-yaki merge-point)
=/ bof=(map path (unit cage))
(merge-conflicts can.ali-diffs can.bob-diffs)
(build ali-yaki bob-yaki merge-point ali-diffs bob-diffs bof)
=/ ali-diffs=cane (calc-diffs ali-yaki merge-point)
=/ bob-diffs=cane (calc-diffs bob-yaki merge-point)
=/ both-diffs=(map path *)
%- %~ int by
%- ~(uni by `(map path *)`new.ali-diffs)
%- ~(uni by `(map path *)`cal.ali-diffs)
%- ~(uni by `(map path *)`can.ali-diffs)
`(map path *)`old.ali-diffs
%- ~(uni by `(map path *)`new.bob-diffs)
%- ~(uni by `(map path *)`cal.bob-diffs)
%- ~(uni by `(map path *)`can.bob-diffs)
`(map path *)`old.bob-diffs
?: &(?=(%meet germ) !=(~ both-diffs))
~_ %meet-conflict
~| [~(key by both-diffs) "consider a %mate merge"]
!!
=/ both-done=(map path lobe)
|^
?- germ
%meet ~
%meet-this (resolve (~(uni by new.bob-diffs) cal.bob-diffs))
%meet-that (resolve (~(uni by new.ali-diffs) cal.ali-diffs))
==
++ resolve
|= news=(map path lobe)
%- malt ^- (list [path lobe])
%+ murn ~(tap by both-diffs)
|= [=path *]
^- (unit [^path lobe])
=/ new (~(get by news) path)
?~ new
~
`[path u.new]
--
::
=/ deleted
%- ~(dif by (~(uni by old.ali-diffs) old.bob-diffs))
(~(run by both-done) |=(* ~))
=/ not-deleted=(map path lobe)
%+ roll ~(tap by deleted)
=< .(not-deleted q.merge-point)
|= [[pax=path ~] not-deleted=(map path lobe)]
(~(del by not-deleted) pax)
=/ hat=(map path lobe)
%- ~(uni by not-deleted)
%- ~(uni by new.ali-diffs)
%- ~(uni by new.bob-diffs)
%- ~(uni by cal.ali-diffs)
cal.bob-diffs
:* ~
conflicts=~
new=&+[[r.bob-yaki r.ali-yaki ~] (to-yuki hat)]
lat=~
==
==
::
++ to-yuki
|= m=(map path lobe)
^- (map path (each page lobe))
(~(run by m) |=(=lobe |+lobe))
::
:: The set of changes between the mergebase and one of the desks
:: being merged
::
:: -- `new` is the set of files in the new desk and not in the
:: mergebase.
:: -- `cal` is the set of changes in the new desk from the
:: mergebase except for any that are also in the other new desk.
:: -- `can` is the set of changes in the new desk from the
:: mergebase that are also in the other new desk (potential
:: conflicts).
:: -- `old` is the set of files in the mergebase and not in the
:: new desk.
::
+$ cane
$: new=(map path lobe)
cal=(map path lobe)
can=(map path cage)
old=(map path ~)
==
::
:: Calculate cane knowing there are no files changed by both
:: desks
::
++ calc-diffs
|= [hed=yaki bas=yaki]
^- cane
:* %- molt
%+ skip ~(tap by q.hed)
|= [pax=path lob=lobe]
(~(has by q.bas) pax)
::
%- molt
%+ skip ~(tap by q.hed)
|= [pax=path lob=lobe]
=+ (~(get by q.bas) pax)
|(=(~ -) =([~ lob] -))
::
~
::
%- malt ^- (list [path ~])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
^- (unit (pair path ~))
?. =(~ (~(get by q.hed) pax))
~
`[pax ~]
==
::
:: Diff yak against bas where different from yuk
::
++ diff-base
|= [yak=yaki yuk=yaki bas=yaki]
^- cane
=/ new=(map path lobe)
%- malt
%+ skip ~(tap by q.yak)
|= [=path =lobe]
(~(has by q.bas) path)
::
=/ cal=(map path lobe)
%- malt ^- (list [path lobe])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
^- (unit (pair path lobe))
=+ a=(~(get by q.yak) pax)
=+ b=(~(get by q.yuk) pax)
?. ?& ?=(^ a)
!=([~ lob] a)
=([~ lob] b)
==
~
`[pax +.a]
::
=/ can=(map path cage)
%- malt
%+ murn ~(tap by q.bas)
|= [=path =lobe]
^- (unit [^path cage])
=/ in-yak (~(get by q.yak) path)
?~ in-yak
~
?: =(lobe u.in-yak)
~
=/ in-yuk (~(get by q.yuk) path)
?~ in-yuk
~
?: =(lobe u.in-yuk)
~
?: =(u.in-yak u.in-yuk)
~
=/ cug=(unit cage) (diff-lobes lobe u.in-yak)
?~ cug
~_ %tombstoned-mergebase
~| path
~| "consider a 2-way merge such as %only-this or %only-that"
!!
`[path u.cug]
::
=/ old=(map path ~)
%- malt ^- (list [path ~])
%+ murn ~(tap by q.bas)
|= [pax=path lob=lobe]
?. =(~ (~(get by q.yak) pax))
~
(some pax ~)
::
[new cal can old]
::
:: These can/should save their caches
::
++ lobe-to-cage
|= =lobe
^- (unit cage)
=/ peg=(unit page) (~(get by lat.ran) lobe)
?~ peg
~
=/ [=cage *]
%- wrap:fusion
(page-to-cage:(aeon-ford let.dom) u.peg)
`cage
::
++ get-dais
|= =mark
^- dais
=/ [=dais *]
%- wrap:fusion
(build-dais:(aeon-ford let.dom) mark)
dais
::
:: Diff two files on bob-desk
::
++ diff-lobes
|= [=a=lobe =b=lobe]
^- (unit cage)
=/ a-cage (lobe-to-cage a-lobe)
=/ b-cage (lobe-to-cage b-lobe)
?: |(?=(~ a-cage) ?=(~ b-cage))
~
?> =(p.u.a-cage p.u.b-cage)
=/ =dais (get-dais p.u.a-cage)
`[form:dais (~(diff dais q.u.a-cage) q.u.b-cage)]
::
:: Merge diffs that are on the same file.
::
++ merge-conflicts
|= [ali-conflicts=(map path cage) bob-conflicts=(map path cage)]
^- (map path (unit cage))
%- ~(urn by (~(int by ali-conflicts) bob-conflicts))
|= [=path *]
^- (unit cage)
=/ cal=cage (~(got by ali-conflicts) path)
=/ cob=cage (~(got by bob-conflicts) path)
=/ =mark
=+ (slag (dec (lent path)) path)
?~(- %$ i.-)
=/ =dais (get-dais mark)
=/ res=(unit (unit vase)) (~(join dais *vale:dais) q.cal q.cob)
?~ res
`[form:dais q.cob]
?~ u.res
~
`[form:dais u.u.res]
::
:: Apply the patches in bof to get the new merged content.
::
:: Gather all the changes between ali's and bob's commits and the
:: mergebase. This is similar to the %meet of ++merge, except
:: where they touch the same file, we use the merged versions.
::
++ build
|= $: ali=yaki
bob=yaki
bas=yaki
dal=cane
dob=cane
bof=(map path (unit cage))
==
^- (unit merge-result)
=/ both-patched=(map path cage)
%- malt
%+ murn ~(tap by bof)
|= [=path cay=(unit cage)]
^- (unit [^path cage])
?~ cay
~
:+ ~ path
=+ (~(get by q.bas) path)
?~ -
~| %mate-strange-diff-no-base
!!
:: +need ok because we would have crashed in +diff-base
::
=/ =cage ~|([%build-need path] (need (lobe-to-cage u.-)))
=/ =dais (get-dais p.cage)
?> =(p.u.cay form.dais)
:- p.cage
(~(pact dais q.cage) q.u.cay)
=/ con=(map path *) :: 2-change conflict
%- molt
%+ skim ~(tap by bof)
|=([pax=path cay=(unit cage)] ?=(~ cay))
=/ cab=(map path lobe) :: conflict base
%- ~(urn by con)
|= [pax=path *]
(~(got by q.bas) pax)
=. con :: change+del conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skim ~(tap by old.dal)
|= [pax=path ~]
?: (~(has by new.dob) pax)
~| %strange-add-and-del
!!
(~(has by can.dob) pax)
=. con :: change+del conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skim ~(tap by old.dob)
|= [pax=path ~]
?: (~(has by new.dal) pax)
~| %strange-del-and-add
!!
(~(has by can.dal) pax)
=. con :: add+add conflict
%- ~(uni by con)
%- malt ^- (list [path *])
%+ skip ~(tap by (~(int by new.dal) new.dob))
|= [pax=path *]
=((~(got by new.dal) pax) (~(got by new.dob) pax))
?: &(?=(%mate germ) ?=(^ con))
=+ (turn ~(tap by `(map path *)`con) |=([path *] >[+<-]<))
~_ %mate-conflict
~| (turn ~(tap by `(map path *)`con) |=([path *] +<-))
!!
=/ old=(map path lobe) :: oldies but goodies
%+ roll ~(tap by (~(uni by old.dal) old.dob))
=< .(old q.bob)
|= [[pax=path ~] old=(map path lobe)]
(~(del by old) pax)
=/ [hot=(map path lobe) lat=(map lobe page)] :: new content
%+ roll ~(tap by both-patched)
|= [[pax=path cay=cage] hat=(map path lobe) lat=(map lobe page)]
=/ =page [p q.q]:cay
=/ =lobe (page-to-lobe page)
:- (~(put by hat) pax lobe)
?: (~(has by lat) lobe)
lat
(~(uni by (malt [lobe page] ~)) lat)
=/ hat=(map path lobe) :: all the content
%- ~(uni by old)
%- ~(uni by new.dal)
%- ~(uni by new.dob)
%- ~(uni by cal.dal)
%- ~(uni by cal.dob)
%- ~(uni by hot)
cab
=/ del=(map path ?)
(~(run by (~(uni by old.dal) old.dob)) |=(~ %|))
=/ new &+[[r.bob r.ali ~] (~(run by hat) |=(=lobe |+lobe))]
:* ~
(silt (turn ~(tap by con) head))
new
lat
==
--
--
::
:: Find the most recent common ancestor(s).
::
:: For performance, this depends on +reachable-takos being
:: memoized.
::
++ find-merge-points
|= [=ali=yaki =bob=yaki]
^- (set yaki)
:: Loop through ancestors breadth-first, lazily generating ancestry
::
=/ ali-takos (reachable-takos:ze r.ali-yaki)
:: Tako worklist
::
=/ takos=(qeu tako) [r.bob-yaki ~ ~]
:: Mergebase candidates. Have proven they're common ancestors, but
:: not that they're a most recent
::
=| bases=(set tako)
:: Takos we've already checked or are in our worklist
::
=| done=(set tako)
|- ^- (set yaki)
=* outer-loop $
:: If we've finished our worklist, convert to yakis and return
::
?: =(~ takos)
(silt (turn ~(tap in bases) ~(got by hut.ran)))
=^ =tako takos ~(get to takos)
=. done (~(put in done) tako)
:: If this is a common ancestor, stop recursing through our
:: parentage. Check if it's comparable to any existing candidate.
::
?: (~(has in ali-takos) tako)
=/ base-list ~(tap in bases)
|- ^- (set yaki)
=* bases-loop $
?~ base-list
:: Proven it's not an ancestor of any previous candidate.
:: Remove all ancestors of new candidate and add it to the
:: candidate list.
::
=. bases
=/ new-reachable (reachable-takos:ze tako)
(~(put in (~(dif in bases) new-reachable)) tako)
outer-loop
:: If it's an ancestor of another candidate, this is not most
:: recent, so skip and try next in worklist.
::
=/ base-reachable (reachable-takos:ze i.base-list)
?: (~(has in base-reachable) tako)
outer-loop
bases-loop(base-list t.base-list)
:: Append parents to list and recurse
::
=/ bob-yaki (~(got by hut.ran) tako)
=/ new-candidates (skip p.bob-yaki ~(has in done))
%_ outer-loop
done (~(gas in done) new-candidates)
takos (~(gas to takos) new-candidates)
==
::
:: Update mime cache
::
++ checkout-mime
|= $: =ford=args:ford:fusion
deletes=(set path)
changes=(set path)
==
^- [(map path (unit mime)) args:ford:fusion]
=/ mim=(map path (unit mime))
=/ dels=(list path) ~(tap by deletes)
|- ^- (map path (unit mime))
?~ dels
~
(~(put by $(dels t.dels)) i.dels ~)
=/ cans=(list path) ~(tap by changes)
|- ^- [(map path (unit mime)) args:ford:fusion]
?~ cans
[mim ford-args]
=/ [=cage fud=flow fod=flue]
~| mime-cast-fail+i.cans
(wrap:fusion (cast-path:(ford:fusion ford-args) i.cans %mime))
=. cache.ford-args fud
=. spill.ford-args spill.fod
=. sprig.ford-args sprig.fod
=^ mim ford-args $(cans t.cans)
[(~(put by mim) i.cans `!<(mime q.cage)) ford-args]
::
:: Add or remove entries to the mime cache
::
++ apply-changes-to-mim
|= [mim=(map path mime) changes=(map path (unit mime))]
^- (map path mime)
=/ changes-l=(list [pax=path change=(unit mime)])
~(tap by changes)
|- ^- (map path mime)
?~ changes-l
mim
?~ change.i.changes-l
$(changes-l t.changes-l, mim (~(del by mim) pax.i.changes-l))
$(changes-l t.changes-l, mim (~(put by mim) [pax u.change]:i.changes-l))
::
:: Emit update to unix sync
::
++ ergo
|= [yon=aeon mim=(map path (unit mime))]
^+ ..park
=/ must (must-ergo her syd yon mon (turn ~(tap by mim) head))
%- emil
%+ turn ~(tap by must)
|= [pot=term len=@ud pak=(set path)]
:* (need hez) %give %ergo pot
%+ turn ~(tap in pak)
|= pax=path
[(slag len pax) (~(got by mim) pax)]
==
::
:: Output is a map of mount points to {length-of-mounted-path set-of-paths}.
::
++ must-ergo
|= [our=ship syd=desk yon=aeon mon=(map term beam) can=(list path)]
^- (map term (pair @ud (set path)))
%- malt ^- (list (trel term @ud (set path)))
%+ murn ~(tap by mon)
|= [nam=term bem=beam]
^- (unit (trel term @ud (set path)))
=- ?~(- ~ `[nam (lent s.bem) (silt `(list path)`-)])
%+ skim can
|= pax=path
&(=(p.bem our) =(q.bem syd) =(r.bem ud+yon) =(s.bem (scag (lent s.bem) pax)))
::
:: Mount a beam to unix
::
++ mount
|= [pot=term =case =spur]
^+ ..mount
=/ old-mon (~(get by mon) pot)
?^ old-mon
%- (slog >%already-mounted< >u.old-mon< ~)
..mount
=/ yon (case-to-aeon case)
?~ yon
%- (slog >%unknown-case< >[her syd case spur]< ~)
..mount
=/ for-yon ?:(=(let.dom u.yon) 0 u.yon)
=. mon
(~(put by mon) pot [her syd ud+for-yon] spur)
=/ =yaki (~(got by hut.ran) (~(got by hit.dom) u.yon))
=/ files (~(run by q.yaki) |=(=lobe |+lobe))
=/ =args:ford:fusion
[files lat.ran fad ?:(=(yon let.dom) fod.dom [~ ~])]
=^ mim args
(checkout-mime args ~ ~(key by files))
=. mim.dom (apply-changes-to-mim mim.dom mim)
(ergo for-yon mim)
::
:: Set permissions for a node.
::
++ perm
|= [pax=path rit=rite]
^+ +>
=/ mis=(set @ta)
%+ roll
=- ~(tap in -)
?- -.rit
%r who:(fall red.rit *rule)
%w who:(fall wit.rit *rule)
%rw (~(uni in who:(fall red.rit *rule)) who:(fall wit.rit *rule))
==
|= [w=whom s=(set @ta)]
?: |(?=(%& -.w) (~(has by cez) p.w)) s
(~(put in s) p.w)
?^ mis
:: TODO remove this nasty hack
::
?. ?=([[%a *] *] hen)
+>.$
=- (emit hen %give %done `[%perm-fail [%leaf "No such group(s): {-}"]~])
%+ roll ~(tap in `(set @ta)`mis)
|= [g=@ta t=tape]
?~ t (trip g)
:(weld t ", " (trip g))
:: TODO remove this nasty hack
::
=< ?. ?=([[%a *] *] hen)
.
(emit hen %give %done ~)
::
?- -.rit
%r wake(per (put-perm per pax red.rit))
%w wake(pew (put-perm pew pax wit.rit))
%rw wake(per (put-perm per pax red.rit), pew (put-perm pew pax wit.rit))
==
::
++ put-perm
|= [pes=regs pax=path new=(unit rule)]
?~ new (~(del by pes) pax)
(~(put by pes) pax u.new)
::
:: Remove a group from all rules.
::
++ forget-crew
|= nom=@ta
%= +>
per (forget-crew-in nom per)
pew (forget-crew-in nom pew)
==
::
++ forget-crew-in
|= [nom=@ta pes=regs]
%- ~(run by pes)
|= r=rule
r(who (~(del in who.r) |+nom))
::
:: Cancel a request.
::
:: For local requests, we just remove it from `qyx`. For foreign requests,
:: we remove it from `ref` and tell the foreign ship to cancel as well.
::
++ cancel-request :: release request
^+ ..cancel-request
=^ wos=(list wove) qyx
:_ (~(run by qyx) |=(a=(set duct) (~(del in a) hen)))
%- ~(rep by qyx)
|= [[a=wove b=(set duct)] c=(list wove)]
?:((~(has in b) hen) [a c] c)
::
?~ ref
=> .(ref `(unit rind)`ref)
?: =(~ wos) ..cancel-request :: TODO handle?
|- ^+ ..cancel-request
?~ wos ..cancel-request
=. ..cancel-request (run-if-future rove.i.wos |=(@da (best hen +<)))
$(wos t.wos)
::
?~ nux=(~(get by fod.u.ref) hen)
..cancel-request(ref `(unit rind)`ref) :: XX TMI
=/ sat (~(got by bom.u.ref) u.nux)
=: fod.u.ref (~(del by fod.u.ref) hen)
bom.u.ref (~(del by bom.u.ref) u.nux)
==
:: cancel the request as appropriate
::
?~ scry.sat
%. [hen her u.nux [syd ~]]
send-over-ames(ref `(unit rind)`ref) :: XX TMI
=/ =path
~| [%strange-scried-request rave.sat]
?> ?=(%sing -.rave.sat)
=, mood.rave.sat
[(cat 3 %c care) (scot %p her) syd (scot case) path]
%- emil
::NOTE we don't know exactly which kind of request is exstant at
:: this time. or at least it seems very hard to find out.
:: so instead we simply emit the cancellation moves on both
:: possible wires. one will silently no-op, the other will
:: do what we want. this is ugly, but we should refactor the
:: separate flows eventually anyway.
=/ x=wire (request-wire %warp-index her syd u.nux)
=/ y=wire (request-wire %back-index her syd u.nux)
:~ [hen %pass x %a %yawn her path]
[hen %pass y %a %yawn her path]
[hen %pass x %b %rest u.scry.sat]
[hen %pass y %b %rest u.scry.sat]
==
::
:: Handles a request.
::
:: `%sing` requests are handled by ++aver. `%next` requests are handled by
:: running ++aver at the given case, and then subsequent cases until we find
:: a case where the two results aren't equivalent. If it hasn't happened
:: yet, we wait. `%many` requests are handled by producing as much as we can
:: and then waiting if the subscription range extends into the future.
::
++ start-request
|= [for=(unit [ship @ud]) rav=rave]
^+ ..start-request
?: &(?=(^ for) !(foreign-capable rav))
~& [%bad-foreign-request-care from=for rav]
..start-request
=^ [new-sub=(unit rove) cards=(list card)] ..start-request
(try-fill-sub for (rave-to-rove rav))
=. ..start-request (send-cards cards [hen ~ ~])
?~ new-sub
..start-request
(duce for u.new-sub)
::
:: +retry-with-ames: we tried scrying. now try with ames instead.
::
++ retry-with-ames
|= [kind=@ta inx=@ud]
^+ ..retry-with-ames
~| [%strange-retry-no-request her syd inx]
?> ?=(^ ref)
=/ sat=update-state (~(got by bom.u.ref) inx)
:: clean up scry request & timer
::
=. ..retry-with-ames
=< ?>(?=(^ ref) .)
~| [%strange-retry-not-scry her syd inx scry.sat -.rave]
?> ?=(^ scry.sat)
?> ?=(%sing -.rave.sat)
=/ =wire (request-wire kind her syd inx)
=/ =path
=, mood.rave.sat
[(cat 3 %c care) (scot %p her) syd (scot case) path]
%- emil
:~ [hen %pass wire %b %rest u.scry.sat]
[hen %pass wire %a %yawn her path]
==
:: re-send over ames
::
=. ..retry-with-ames
=< ?>(?=(^ ref) .)
(send-over-ames hen her inx syd `rave.sat)
=. bom.u.ref (~(put by bom.u.ref) inx sat(scry ~))
..retry-with-ames
::
:: Called when a foreign ship answers one of our requests.
::
:: If it's a `%many` request, process in +take-foreign-update
::
:: After updating ref (our request manager), we handle %x, %w, and %y
:: responses. For %x, we call ++validate-x to validate the type of
:: the response. For %y, we coerce the result to an arch.
::
++ take-foreign-answer :: external change
|= [inx=@ud rut=(unit rand)]
^+ +>
?> ?=(^ ref)
~& take-foreign/inx
=+ ruv=(~(get by bom.u.ref) inx)
?~ ruv
~& %bad-answer
+>.$
=? ..take-foreign-answer ?=(^ scry.u.ruv)
=< ?>(?=(^ ref) .)
(cancel-scry-timeout %warp-index hen her inx syd u.scry.u.ruv)
=/ rav=rave rave.u.ruv
?: ?=(%many -.rav)
abet:(apex:(foreign-update inx) rut)
?~ rut
:: nothing here, so cache that
::
%_ wake
haw.u.ref
?. ?=(%sing -.rav) haw.u.ref
(~(put by haw.u.ref) mood.rav ~)
==
|^
=/ result=(unit cage) (validate u.rut)
=/ =mood [p.p q.p q]:u.rut
=: haw.u.ref (~(put by haw.u.ref) mood result)
bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) hen)
==
wake
:: something here, so validate
::
++ validate
|= =rand
^- (unit cage)
?- p.p.rand
%a ~| %no-big-ford-builds-across-network-for-now !!
%b ~| %i-guess-you-ought-to-build-your-own-marks !!
%c ~| %casts-should-be-compiled-on-your-own-ship !!
%d ~| %totally-temporary-error-please-replace-me !!
%e ~| %yes-naves-also-shouldnt-cross-the-network !!
%f ~| %even-static-casts-should-be-built-locally !!
%p ~| %requesting-foreign-permissions-is-invalid !!
%r ~| %no-cages-please-they-are-just-way-too-big !!
%s ~| %please-dont-get-your-takos-over-a-network !!
%t ~| %requesting-foreign-directory-is-vaporware !!
%v ~| %weird-shouldnt-get-v-request-from-network !!
%u `(validate-u r.rand)
%w `(validate-w r.rand)
%x (validate-x [p.p q.p q r]:rand)
%y `[p.r.rand !>(;;(arch q.r.rand))]
%z `(validate-z r.rand)
==
::
:: Make sure the incoming data is a %u response
::
++ validate-u
|= =page
^- cage
?> ?=(%flag p.page)
:- p.page
!> ;;(? q.page)
::
:: Make sure the incoming data is a %w response
::
++ validate-w
|= =page
^- cage
:- p.page
?+ p.page ~| %strange-w-over-nextwork !!
%cass !>(;;(cass q.page))
%null [[%atom %n ~] ~]
%nako !>(~|([%molding [&1 &2 &3]:q.page] ;;(nako q.page)))
==
::
:: Make sure that incoming data is of the mark it claims to be.
::
++ validate-x
|= [car=care cas=case pax=path peg=page]
^- (unit cage)
=/ vale-result
%- mule |.
%- wrap:fusion
:: Use %base's marks to validate, so we don't have to build the
:: foreign marks
::
=/ base-dome dom:(~(got by dos.rom) %base)
=/ f (%*(. aeon-ford dom base-dome) let.base-dome)
(page-to-cage:f peg)
?: ?=(%| -.vale-result)
%- (slog >%validate-x-failed< p.vale-result)
~
`-.p.vale-result
::
:: Make sure the incoming data is a %z response
::
++ validate-z
|= =page
^- cage
?> ?=(%uvi p.page)
:- p.page
!> ;;(@uvI q.page)
--
::
:: Respond to backfill request
::
:: Maybe should verify the requester is allowed to access this lobe?
::
++ give-backfill
|= [ver=?(%0 %1) =lobe]
^+ ..give-backfill
=/ peg=(unit page) (~(get by lat.ran) lobe)
=/ res
?- ver
%0 ?~(peg ~ [%direct lobe u.peg])
%1 [%1 peg]
==
(emit hen %give %boon res)
::
:: Ingest foreign update, requesting missing lobes if necessary
::
++ foreign-update
|= inx=@ud
?> ?=(^ ref)
=/ [sat=update-state lost=?]
=/ ruv (~(get by bom.u.ref) inx)
?~ ruv
~& [%clay-foreign-update-lost her syd inx]
[*update-state &]
[u.ruv |]
=/ done=? |
=. hen duct.sat
:: if the request was done over scry, clear the timeout timer
::
=? ..foreign-update ?=(^ scry.sat)
=< ?>(?=(^ ref) .)
(cancel-scry-timeout %back-index hen her inx syd u.scry.sat)
=. scry.sat ~
|%
++ abet
^+ ..foreign-update
?: lost
..foreign-update
?: done
=: bom.u.ref (~(del by bom.u.ref) inx)
fod.u.ref (~(del by fod.u.ref) hen)
==
=<(?>(?=(^ ref) .) wake)
=. bom.u.ref (~(put by bom.u.ref) inx sat)
..foreign-update
::
++ apex
|= rut=(unit rand)
^+ ..abet
?: lost ..abet
?~ rut
=. nako.sat (~(put to nako.sat) ~)
work
?> ?=(%nako p.r.u.rut)
=/ nako ;;(nako q.r.u.rut)
=/ missing (missing-lobes nako)
=. need.sat (welp need.sat ~(tap in missing))
=. nako.sat (~(put to nako.sat) ~ nako)
work
::
++ missing-lobes
|= =nako
^- (set lobe)
=| missing=(set lobe)
=/ yakis ~(tap in lar.nako)
|- ^- (set lobe)
=* yaki-loop $
?~ yakis
missing
=/ =norm (~(gut by tom.dom) r.i.yakis nor.dom)
=/ lobes=(list [=path =lobe]) ~(tap by q.i.yakis)
|- ^- (set lobe)
=* lobe-loop $
?~ lobes
yaki-loop(yakis t.yakis)
=? missing
?& !(~(has by lat.ran) lobe.i.lobes)
!=([~ %|] (~(fit of norm) path.i.lobes))
==
(~(put in missing) lobe.i.lobes)
lobe-loop(lobes t.lobes)
::
:: Receive backfill response
::
++ take-backfill
|= =fell
^+ ..abet
?: lost ..abet
=. ..park =>((take-fell fell) ?>(?=(^ ref) .))
work(busy.sat |)
::
:: Fetch next lobe
::
++ work
^+ ..abet
?: busy.sat
..abet
|- ^+ ..abet
?~ need.sat
:: NB: if you change to release nakos as we get enough lobes
:: for them instead of all at the end, you *must* store the
:: `lim` that should be applied after the nako is complete and
:: not use the one in the rave, since that will apply to the
:: end of subscription.
::
|- ^+ ..abet
?: =(~ nako.sat)
..abet
=^ next=(unit nako) nako.sat ~(get to nako.sat)
?~ next
..abet(done &)
=. ..abet =>((apply-foreign-update u.next) ?>(?=(~ need.sat) .))
=. ..foreign-update =<(?>(?=(^ ref) .) wake)
$
:: This is what removes an item from `need`. This happens every
:: time we take a backfill response, but it could happen more than
:: once if we somehow got this data in the meantime (maybe from
:: another desk updating concurrently, or a previous update on this
:: same desk).
::
=* lobe i.need.sat
?: (~(has by lat.ran) lobe)
$(need.sat t.need.sat)
:: otherwise, fetch the next blob (aka fell)
::
=^ time=(unit @da) ..foreign-update
=< ?>(?=(^ ref) .)
:: if :ship's remote scry isn't known to be broken,
:: or we learned it was broken more than an hour ago,
::
?: ?| !(~(has by sad) her)
(gth now (add scry-retry-time (~(got by sad) her)))
==
:: make the request over remote scry
::
=/ =path /x/0//lobe/(scot %uv i.need.sat)
[`- +]:(send-over-scry %back-index hen her inx syd path)
:: otherwise, request over ames
::
:- ~
=/ =wire (request-wire %back-index her syd inx)
=/ =path [%backfill syd (scot %ud inx) ~]
:: TODO: upgrade to %1 when most ships have upgaded
=/ =fill [%0 syd lobe]
(emit hen %pass wire %a %plea her %c path fill)
..abet(busy.sat &, scry.sat time)
::
:: When we get a %w foreign update, store this in our state.
::
:: We get the commits from the nako and add them to our object
:: store, then we update the map of aeons to commits and the latest
:: aeon.
::
++ apply-foreign-update
|= =nako
^+ ..abet
:: hit: updated commit-hashes by @ud case
:: nut: new commit-hash/commit pairs
:: hut: updated commits by hash
::
=/ hit (~(uni by hit.dom) gar.nako)
=/ nut (turn ~(tap in lar.nako) |=(=yaki [r.yaki yaki]))
=/ hut (~(uni by (malt nut)) hut.ran)
:: traverse updated state and sanity check
::
=+ ~| :* %bad-foreign-update
[gar=gar.nako let=let.nako nut=(turn nut head)]
[hitdom=hit.dom letdom=let.dom]
==
?: =(0 let.nako)
~
=/ =aeon 1
|- ^- ~
=/ =tako
~| [%missing-aeon aeon] (~(got by hit) aeon)
=/ =yaki
~| [%missing-tako tako] (~(got by hut) tako)
?: =(let.nako aeon)
~
$(aeon +(aeon))
:: produce updated state
::
=/ =rave rave:(~(got by bom.u.ref) inx)
?> ?=(%many -.rave)
=: let.dom (max let.nako let.dom)
hit.dom hit
hut.ran hut
:: Is this correct? Seeems like it should only go to `to` if
:: we've gotten all the way to the end. Leaving this
:: behavior unchanged for now, but I believe it's wrong.
::
lim ?.(?=(%da -.to.moat.rave) lim p.to.moat.rave)
==
..abet
--
::
++ seek
|= =cash
^+ ..park
?> ?=(^ ref)
=/ =tako
?: ?=(%tako -.cash)
p.cash
(aeon-to-tako:ze (need (case-to-aeon cash)))
=/ =yaki (tako-to-yaki:ze tako)
=/ lobes=(list lobe)
%+ murn ~(tap by q.yaki)
|= [=path =lobe]
?: (~(has by lat.ran) lobe)
~
`lobe
%- emil
%+ turn lobes
|= =lobe
:: TODO: upgrade to %1 when most ships have upgaded
::
=/ =fill [%0 syd lobe]
=/ =wire /seek/(scot %p her)/[syd]
=/ =path [%backfill syd ~]
[hen %pass wire %a %plea her %c path fill]
::
++ take-fell
|= =fell
^+ ..park
?> ?=(^ ref)
=/ peg=(unit page) (fell-to-page fell)
=? lat.ran ?=(^ peg)
(~(uni by (malt [(page-to-lobe u.peg) u.peg] ~)) lat.ran)
..park
::
:: fire function if request is in future
::
++ run-if-future
|= [rov=rove fun=$-(@da _.)]
^+ +>.$
=/ date=(unit @da)
?- -.rov
%sing
?. ?=(%da -.case.mood.rov) ~
`p.case.mood.rov
::
%next ~
%mult ~
%many
%^ hunt lth
?. ?=(%da -.from.moat.rov) ~
?. (lth now p.from.moat.rov) ~
[~ p.from.moat.rov]
?. ?=(%da -.to.moat.rov) ~
`(max now p.to.moat.rov)
==
?~ date
+>.$
(fun u.date)
::
++ send-cards
|= [cards=(list card) ducts=(set duct)]
^+ ..wake
%- emil
%- zing
%+ turn cards
|= =card
%+ turn ~(tap by ducts)
|= =duct
[duct card]
::
:: Loop through open subscriptions and check if we can fill any of
:: them.
::
++ wake
^+ .
=/ subs=(list [=wove ducts=(set duct)]) ~(tap by qyx)
=| qux=cult
|- ^+ ..wake
?~ subs
..wake(qyx qux)
?: =(~ ducts.i.subs)
$(subs t.subs)
=^ [new-sub=(unit rove) cards=(list card)] ..park
(try-fill-sub wove.i.subs)
=. ..wake (send-cards cards ducts.i.subs)
=? qux ?=(^ new-sub)
=/ =wove [for.wove.i.subs u.new-sub]
%+ ~(put by qux) wove
(~(uni in ducts.i.subs) (~(get ju qux) wove))
$(subs t.subs)
::
:: Try to fill a subscription
::
++ try-fill-sub
|= [far=(unit [=ship ver=@ud]) rov=rove]
^- [[(unit rove) (list card)] _..park]
=/ for=(unit ship) ?~(far ~ `ship.u.far)
?- -.rov
%sing
=/ cache-value=(unit (unit cage))
?~(ref ~ (~(get by haw.u.ref) mood.rov))
?^ cache-value
:: if we have a result in our cache, produce it
::
:_ ..park :- ~ :_ ~
(writ ?~(u.cache-value ~ `[mood.rov u.u.cache-value]))
:: else, check to see if rove is for an aeon we know
::
=/ aeon=(unit aeon) (case-to-aeon case.mood.rov)
?~ aeon
[[`rov ~] ..park]
:: we have the appropriate aeon, so read in the data
::
=^ value=(unit (unit cage)) ..park
(read-at-aeon:ze for u.aeon mood.rov)
?~ value
:: we don't have the data directly. how can we fetch it?
::
?: =(0 u.aeon)
~& [%clay-sing-indirect-data-0 `path`[syd '0' path.mood.rov]]
[[~ ~] ..park]
~& [%clay-sing-indirect-data desk=syd mood=mood.rov aeon=u.aeon]
[[`rov ~] ..park]
:: we have the data, so produce the results
::
:_ ..park :- ~ :_ ~
%- writ
?~ u.value
~
`[mood.rov u.u.value]
::
:: %next is just %mult with one path, so we pretend %next = %mult here.
::
?(%next %mult)
:: because %mult requests need to wait on multiple files for each
:: revision that needs to be checked for changes, we keep two
:: cache maps. {old} is the revision at {(dec aeon)}, {new} is
:: the revision at {aeon}. if we have no {aeon} yet, that means
:: it was still unknown last time we checked.
::
=* vor rov
|^
=/ rov=rove
?: ?=(%mult -.vor) vor
:* %mult
[case [[care path] ~ ~]]:mood.vor
aeon.vor
[[[care.mood.vor path.mood.vor] cach.vor] ~ ~]
~
==
?> ?=(%mult -.rov)
:: recurse here on next aeon if possible/needed.
::
|-
:: if we don't have an aeon yet, see if we have one now.
::
?~ aeon.rov
=/ aeon=(unit aeon) (case-to-aeon case.mool.rov)
:: if we still don't, wait.
::
?~ aeon [(store rov) ..park]
:: if we do, update the request and retry.
::
$(aeon.rov `+(u.aeon), old-cach.rov ~, new-cach.rov ~)
:: if old isn't complete, try filling in the gaps.
::
=^ o ..park
?: (complete old-cach.rov)
[old-cach.rov ..park]
(read-unknown mool.rov(case [%ud (dec u.aeon.rov)]) old-cach.rov)
=. old-cach.rov o
:: if the next aeon we want to compare is in the future, wait again.
::
=/ next-aeon=(unit aeon) (case-to-aeon [%ud u.aeon.rov])
?~ next-aeon [(store rov) ..park]
:: if new isn't complete, try filling in the gaps.
::
=^ n ..park
?: (complete new-cach.rov)
[new-cach.rov ..park]
(read-unknown mool.rov(case [%ud u.aeon.rov]) new-cach.rov)
=. new-cach.rov n
:: if new still isn't complete, wait again.
::
?. (complete new-cach.rov)
[(store rov) ..park]
:: if old not complete, give a result (possible false positive).
::
?: !(complete old-cach.rov)
:_ ..park
%- respond
%- malt
%+ murn ~(tap in paths.mool.rov)
|= [=care =path]
^- (unit [mood (unit cage)])
=/ cached (~(get by new-cach.rov) [care path])
?. ?=([~ ~ *] cached)
%- (slog 'clay: strange new-cache' >[care path cached]< ~)
~
`u=[[care [%ud let.dom] path] u.u.cached]
:: both complete, so check if anything has changed
::
=/ changes=(map mood (unit cage))
%+ roll ~(tap by old-cach.rov)
|= $: [[car=care pax=path] old-cach=cach]
changes=(map mood (unit cage))
==
=/ new-cach=cach (~(got by new-cach.rov) car pax)
?< |(?=(~ old-cach) ?=(~ new-cach))
=/ new-entry=(unit (pair mood (unit cage)))
=/ =mood [car [%ud u.aeon.rov] pax]
?~ u.new-cach
:: if new does not exist, always notify
::
`[mood ~]
?~ u.old-cach
:: added
::
`[mood `u.u.new-cach]
?: =([p q.q]:u.u.new-cach [p q.q]:u.u.old-cach)
:: unchanged
::
~
:: changed
::
`[mood `u.u.new-cach]
:: if changed, save the change
::
?~ new-entry
changes
(~(put by changes) u.new-entry)
:: if there are any changes, send response. if none, move on to
:: next aeon.
::
?^ changes [(respond changes) ..park]
$(u.aeon.rov +(u.aeon.rov), new-cach.rov ~)
::
:: check again later
::
++ store
|= rov=rove
^- [(unit rove) (list card)]
=/ new-rove=rove
?> ?=(%mult -.rov)
?: ?=(%mult -.vor) rov
?> ?=([* ~ ~] old-cach.rov)
=* one n.old-cach.rov
[%next [care.p.one case.mool.rov path.p.one] aeon.rov q.one]
[`new-rove ~]
::
:: send changes
::
++ respond
|= res=(map mood (unit cage))
^- [(unit rove) (list card)]
:- ~
?: ?=(%mult -.vor)
:_ ~
=/ moods ~(key by res)
=/ cas
?> ?=(^ moods)
[%da (case-to-date case.n.moods)]
=/ res
(~(run in moods) |=(m=mood [care.m path.m]))
=/ gift [%wris cas res]
?: ?=(^ ref)
[%slip %b %drip !>(gift)]
[%give gift]
?> ?=([* ~ ~] res)
:_ ~
%- writ
?~ q.n.res
~
`[p u.q]:n.res
::
:: no unknowns
::
++ complete
|= hav=(map (pair care path) cach)
?& !=(~ hav)
(levy ~(tap by hav) know)
==
::
:: know about file in cach
::
++ know |=([(pair care path) c=cach] ?=(^ c))
::
:: fill in the blanks
::
++ read-unknown
|= [=mool hav=(map (pair care path) cach)]
^- [_hav _..park]
=? hav ?=(~ hav)
%- malt ^- (list (pair (pair care path) cach))
%+ turn
~(tap in paths.mool)
|= [c=care p=path]
^- [[care path] cach]
[[c p] ~]
|- ^+ [hav ..park]
?~ hav [hav ..park]
=^ lef ..park $(hav l.hav)
=. l.hav lef
=^ rig ..park $(hav r.hav)
=. r.hav rig
=/ [[=care =path] =cach] n.hav
?^ cach
[hav ..park]
=^ q ..park (aver for care case.mool path)
=. q.n.hav q
[hav ..park]
--
::
%many
:_ ..park
=/ from-aeon (case-to-aeon from.moat.rov)
?~ from-aeon
:: haven't entered the relevant range, so do nothing
::
[`rov ~]
=/ to-aeon (case-to-aeon to.moat.rov)
:: TODO: shouldn't skip if tracking
::
=/ up-to ?~(to-aeon let.dom u.to-aeon)
=/ ver ?~(far %1 ver.u.far)
=. from.moat.rov [%ud +(let.dom)]
=/ =card
=/ =cage
?: track.rov
[%null [%atom %n ~] ~]
[%nako !>((make-nako:ze ver u.from-aeon up-to))]
(writ ~ [%w ud+let.dom /] cage)
?~ to-aeon
:: we're in the middle of the range, so produce what we can,
:: but don't end the subscription
::
[`rov card ~]
:: we're past the end of the range, so end subscription
::
[~ [card (writ ~) ~]]
==
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
:: This core has no additional state, and the distinction exists purely for
:: documentation. The overarching theme is that `++de` directly contains
:: logic for metadata about the desk, while `++ze` is composed primarily
:: of helper functions for manipulating the desk state (`++dome`) itself.
:: Functions include:
::
:: -- converting between cases, commit hashes, commits, content hashes,
:: and content
:: -- creating commits and content and adding them to the tree
:: -- finding which data needs to be sent over the network to keep the
:: other urbit up-to-date
:: -- reading from the file tree through different `++care` options
:: -- the `++me` core for merging.
::
:: The dome is composed of the following:
::
:: -- `let` is the number of the most recent revision.
:: -- `hit` is a map of revision numbers to commit hashes.
:: -- `lab` is a map of labels to revision numbers.
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
::
::
:: Other utility functions
::
++ ze
|%
:: These convert between aeon (version number), tako (commit hash),
:: and yaki (commit data structure)
::
++ aeon-to-tako ~(got by hit.dom)
++ aeon-to-yaki |=(=aeon (tako-to-yaki (aeon-to-tako aeon)))
++ tako-to-yaki ~(got by hut.ran)
::
:: Creates a nako of all the changes between a and b.
::
++ make-nako
|= [ver=@ud a=aeon b=aeon]
^- nako
:+ ?> (lte b let.dom)
|-
?: =(b let.dom)
hit.dom
:: del everything after b
$(hit.dom (~(del by hit.dom) let.dom), let.dom (dec let.dom))
b
?: =(0 b)
[~ ~]
=/ excludes=(set tako)
=| acc=(set tako)
=/ lower=@ud 1
|-
:: a should be excluded, so wait until we're past it
?: (gte lower +(a))
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) lower))
$(acc (~(uni in acc) res), lower +(lower))
=/ includes=(set tako)
=| acc=(set tako)
=/ upper=@ud b
|-
?: (lte upper a)
acc
=/ res=(set tako) (reachable-takos (~(got by hit.dom) upper))
$(acc (~(uni in acc) res), upper (dec upper))
[(~(run in (~(dif in includes) excludes)) tako-to-yaki) ~]
:: Traverse parentage and find all ancestor hashes
::
++ reachable-takos :: reachable
|= p=tako
^- (set tako)
~+
=| s=(set tako)
|- ^- (set tako)
=. s (~(put in s) p)
=+ y=(tako-to-yaki p)
|- ^- (set tako)
?~ p.y
s
?: (~(has in s) i.p.y)
$(p.y t.p.y)
=. s ^$(p i.p.y)
$(p.y t.p.y)
::
++ read-a
!.
|= [=aeon =path]
^- [(unit (unit cage)) _..park]
=^ =vase ..park
~_ leaf/"clay: %a build failed {<[syd aeon path]>}"
%+ aeon-flow aeon
%- wrap:fusion
(build-file:(aeon-ford aeon) path)
:_(..park [~ ~ %vase !>(vase)])
::
++ read-b
!.
|= [=aeon =path]
^- [(unit (unit cage)) _..park]
?. ?=([@ ~] path)
[[~ ~] ..park]
=^ =dais ..park
%+ aeon-flow aeon
%- wrap:fusion
(build-dais:(aeon-ford aeon) i.path)
:_(..park [~ ~ %dais !>(dais)])
::
++ read-c
!.
|= [=aeon =path]
^- [(unit (unit cage)) _..park]
?. ?=([@ @ ~] path)
[[~ ~] ..park]
=^ =tube ..park
%+ aeon-flow aeon
%- wrap:fusion
(build-tube:(aeon-ford aeon) [i i.t]:path)
:_(..park [~ ~ %tube !>(tube)])
::
++ read-e
!.
|= [=aeon =path]
^- [(unit (unit cage)) _..park]
?. ?=([@ ~] path)
[[~ ~] ..park]
=^ =vase ..park
%+ aeon-flow aeon
%- wrap:fusion
(build-nave:(aeon-ford aeon) i.path)
:_(..park [~ ~ %nave vase])
::
++ read-f
!.
|= [=aeon =path]
^- [(unit (unit cage)) _..park]
?. ?=([@ @ ~] path)
[[~ ~] ..park]
=^ =vase ..park
%+ aeon-flow aeon
%- wrap:fusion
(build-cast:(aeon-ford aeon) [i i.t]:path)
:_(..park [~ ~ %cast vase])
::
:: XX move to +read-buc
::
++ read-d
!.
|= [=aeon =path]
^- (unit (unit cage))
?. =(our her)
[~ ~]
?^ path
~&(%no-cd-path [~ ~])
[~ ~ %noun !>(~(key by dos.rom.ruf))]
::
:: Gets the permissions that apply to a particular node.
::
:: If the node has no permissions of its own, we use its parent's.
:: If no permissions have been set for the entire tree above the node,
:: we default to fully private (empty whitelist).
::
++ read-p
|= pax=path
^- (unit (unit cage))
=- [~ ~ %noun !>(-)]
:- (read-p-in pax per.red)
(read-p-in pax pew.red)
::
++ read-p-in
|= [pax=path pes=regs]
^- dict
=/ rul=(unit rule) (~(get by pes) pax)
?^ rul
:+ pax mod.u.rul
%- ~(rep in who.u.rul)
|= [w=whom out=(pair (set ship) (map @ta crew))]
?: ?=([%& @p] w)
[(~(put in p.out) +.w) q.out]
=/ cru=(unit crew) (~(get by cez.ruf) +.w)
?~ cru out
[p.out (~(put by q.out) +.w u.cru)]
?~ pax [/ %white ~ ~]
$(pax (scag (dec (lent pax)) `path`pax))
::
++ may-read
|= [who=ship car=care yon=aeon pax=path]
^- ?
?+ car
(allowed-by who pax per.red)
::
%p
=(who our)
::
?(%y %z)
=+ tak=(~(get by hit.dom) yon)
?~ tak |
=+ yak=(tako-to-yaki u.tak)
=+ len=(lent pax)
=- (levy ~(tap in -) |=(p=path (allowed-by who p per.red)))
%+ roll ~(tap in (~(del in ~(key by q.yak)) pax))
|= [p=path s=(set path)]
?. =(pax (scag len p)) s
%- ~(put in s)
?: ?=(%z car) p
(scag +(len) p)
==
::
++ may-write
|= [w=ship p=path]
(allowed-by w p pew.red)
::
++ allowed-by
|= [who=ship pax=path pes=regs]
^- ?
=/ rul=real rul:(read-p-in pax pes)
=/ in-list/?
?| (~(has in p.who.rul) who)
::
%- ~(rep by q.who.rul)
|= [[@ta cru=crew] out=_|]
?: out &
(~(has in cru) who)
==
?: =(%black mod.rul)
!in-list
in-list
:: +content-hash: get hash of contents (%cz hash)
::
++ content-hash
|= [=yaki pax=path]
^- @uvI
=+ len=(lent pax)
=/ descendants=(list (pair path lobe))
%+ turn
%+ skim ~(tap by (~(del by q.yaki) pax))
|= [paf=path lob=lobe]
=(pax (scag len paf))
|= [paf=path lob=lobe]
[(slag len paf) lob]
=+ us=(~(get by q.yaki) pax)
?: &(?=(~ descendants) ?=(~ us))
*@uvI
%+ roll
^- (list (pair path lobe))
[[~ ?~(us *lobe u.us)] descendants]
|=([[path lobe] @uvI] (shax (jam +<)))
:: +read-r: %x wrapped in a vase
::
++ read-r
|= [yon=aeon pax=path]
^- [(unit (unit cage)) _..park]
=^ x ..park (read-x yon pax)
:_ ..park
?~ x ~
?~ u.x [~ ~]
``[p.u.u.x !>(q.u.u.x)]
:: +read-s: produce miscellaneous
::
++ read-s
|= [yon=aeon pax=path]
^- (unit (unit cage))
?. ?=([@ * *] pax)
`~
?+ i.pax `~
%tako
=/ tak=(unit tako) (~(get by hit.dom) yon)
?~ tak
~
``tako+[-:!>(*tako) u.tak]
::
%yaki
=/ yak=(unit yaki) (~(get by hut.ran) (slav %uv i.t.pax))
?~ yak
~
``yaki+[-:!>(*yaki) u.yak]
::
%blob
=/ peg=(unit page) (~(get by lat.ran) (slav %uv i.t.pax))
?~ peg
~
``blob+[-:!>(*page) u.peg]
::
%hash
=/ yak=(unit yaki) (~(get by hut.ran) (slav %uv i.t.pax))
?~ yak
~
``uvi+[-:!>(*@uvI) (content-hash u.yak /)]
::
%cage
:: should save ford cache
::
=/ =lobe (slav %uv i.t.pax)
=/ peg=(unit page) (~(get by lat.ran) lobe)
?~ peg
~
=/ [=cage *]
%- wrap:fusion
(page-to-cage:(aeon-ford yon) u.peg)
``cage+[-:!>(*^cage) cage]
::
%open ``open+!>(prelude:(aeon-ford yon))
%late !! :: handled in +aver
%case !! :: handled in +aver
%base-tako
:: XX this ignores the given beak
:: maybe move to +aver?
?> ?=(^ t.t.pax)
:^ ~ ~ %uvs !>
^- (list @uv)
=/ tako-a (slav %uv i.t.pax)
=/ tako-b (slav %uv i.t.t.pax)
=/ yaki-a (~(got by hut.ran) tako-a)
=/ yaki-b (~(got by hut.ran) tako-b)
%+ turn ~(tap in (find-merge-points yaki-a yaki-b))
|= =yaki
r.yaki
::
%base
?> ?=(^ t.t.pax)
:^ ~ ~ %uvs !>
^- (list @uv)
=/ him (slav %p i.t.pax)
=/ other dom:((de now rof hen ruf) him i.t.t.pax)
?: =(0 let.other)
~
=/ our-yaki (~(got by hut.ran) (~(got by hit.dom) yon))
=/ other-yaki (~(got by hut.ran) (~(got by hit.other) let.other))
%+ turn ~(tap in (find-merge-points other-yaki our-yaki))
|= =yaki
r.yaki
==
:: +read-t: produce the list of paths within a yaki with :pax as prefix
::
++ read-t
|= [yon=aeon pax=path]
^- (unit (unit [%file-list (hypo (list path))]))
:: if asked for version 0, produce an empty list of files
::
?: =(0 yon)
``[%file-list -:!>(*(list path)) *(list path)]
:: if asked for a future version, we don't have an answer
::
?~ tak=(~(get by hit.dom) yon)
~
:: look up the yaki snapshot based on the version
::
=/ yak=yaki (tako-to-yaki u.tak)
:: calculate the path length once outside the loop
::
=/ path-length (lent pax)
::
:^ ~ ~ %file-list
:- -:!>(*(list path))
^- (list path)
:: sort the matching paths alphabetically
::
=- (sort - aor)
:: traverse the filesystem, filtering for paths with :pax as prefix
::
%+ skim ~(tap in ~(key by q.yak))
|=(paf=path =(pax (scag path-length paf)))
::
:: Checks for existence of a node at an aeon.
::
:: This checks for existence of content at the node, and does *not* look
:: at any of its children.
::
++ read-u
|= [yon=aeon pax=path]
^- (unit (unit [%flag (hypo ?)]))
:: if asked for version 0, that never exists, so always give false
::
?: =(0 yon)
``[%flag -:!>(*?) |]
:: if asked for a future version, we don't have an answer
::
?~ tak=(~(get by hit.dom) yon)
~
:: look up the yaki snapshot based on the version
::
=/ yak=yaki (tako-to-yaki u.tak)
:: produce the result based on whether or not there's a file at :pax
::
``[%flag -:!>(*?) (~(has by q.yak) pax)]
::
:: Gets the dome (desk state) at a particular aeon.
::
++ read-v
|= [yon=aeon pax=path]
^- (unit (unit [%dome (hypo dome:clay)]))
?: (lth yon let.dom)
:* ~ ~ %dome -:!>(*dome:clay)
^- dome:clay
:* let=yon
hit=(molt (skim ~(tap by hit.dom) |=([p=@ud *] (lte p yon))))
lab=(molt (skim ~(tap by lab.dom) |=([* p=@ud] (lte p yon))))
== ==
?: (gth yon let.dom)
~
``[%dome -:!>(*dome:clay) [let hit lab]:dom]
::
:: Gets all cases refering to the same revision as the given case.
::
:: For the %da case, we give just the canonical timestamp of the revision.
::
++ read-w
|= yon=aeon
^- (unit (unit cage))
=- [~ ~ %cass !>(-)]
^- cass
:- yon
?: =(0 yon) `@da`0
t:(aeon-to-yaki yon)
::
:: Get the data at a node.
::
:: Use ford to read the file. Note this special-cases the hoon
:: mark for bootstrapping purposes.
::
++ read-x
|= [yon=aeon pax=path]
^- [(unit (unit cage)) _..park]
?: =(0 yon)
[[~ ~] ..park]
=+ tak=(~(get by hit.dom) yon)
?~ tak
[~ ..park]
=+ yak=(tako-to-yaki u.tak)
=+ lob=(~(get by q.yak) pax)
?~ lob
[[~ ~] ..park]
=/ peg=(unit page) (~(get by lat.ran) u.lob)
:: if tombstoned, nothing to return
::
?~ peg
[~ ..park]
:: should convert any lobe to cage
::
=^ =cage ..park
%+ aeon-flow yon
%- wrap:fusion
(page-to-cage:(aeon-ford yon) u.peg)
[``cage ..park]
::
:: Gets an arch (directory listing) at a node.
::
++ read-y
|= [yon=aeon pax=path]
^- (unit (unit [%arch (hypo arch)]))
?: =(0 yon)
``[%arch -:!>(*arch) *arch]
=+ tak=(~(get by hit.dom) yon)
?~ tak
~
=+ yak=(tako-to-yaki u.tak)
=+ len=(lent pax)
:^ ~ ~ %arch
:: ~& cy+pax
:- -:!>(*arch)
^- arch
:- (~(get by q.yak) pax)
^- (map knot ~)
%- molt ^- (list (pair knot ~))
%+ turn
^- (list (pair path lobe))
%+ skim ~(tap by (~(del by q.yak) pax))
|= [paf=path lob=lobe]
=(pax (scag len paf))
|= [paf=path lob=lobe]
=+ pat=(slag len paf)
[?>(?=(^ pat) i.pat) ~]
::
:: Gets a recursive hash of a node and all its children.
::
++ read-z
|= [yon=aeon pax=path]
^- (unit (unit [%uvi (hypo @uvI)]))
?: =(0 yon)
``uvi+[-:!>(*@uvI) *@uvI]
=+ tak=(~(get by hit.dom) yon)
?~ tak
~
[~ ~ %uvi [%atom %'uvI' ~] (content-hash (tako-to-yaki u.tak) pax)]
::
:: Get a value at an aeon.
::
:: Value can be either null, meaning we don't have it yet, [null null],
:: meaning we know it doesn't exist, or [null null cage],
:: meaning we either have the value directly or a content hash of the
:: value.
::
++ read-at-aeon :: read-at-aeon:ze
|= [for=(unit ship) yon=aeon mun=mood] :: seek and read
^- [(unit (unit cage)) _..park]
?. |(?=(~ for) (may-read u.for care.mun yon path.mun))
[~ ..park]
:: virtualize to catch and produce deterministic failures
::
!:
|^ =/ res (mule |.(read))
?: ?=(%& -.res) p.res
%. [[~ ~] ..park]
(slog leaf+"clay: read-at-aeon fail {<[desk=syd mun]>}" p.res)
::
++ read
^- [(unit (unit cage)) _..park]
?- care.mun
%a (read-a yon path.mun)
%b (read-b yon path.mun)
%c (read-c yon path.mun)
%d [(read-d yon path.mun) ..park]
%e (read-e yon path.mun)
%f (read-f yon path.mun)
%p [(read-p path.mun) ..park]
%r (read-r yon path.mun)
%s [(read-s yon path.mun) ..park]
%t [(read-t yon path.mun) ..park]
%u [(read-u yon path.mun) ..park]
%v [(read-v yon path.mun) ..park]
%w [(read-w yon) ..park]
%x (read-x yon path.mun)
%y [(read-y yon path.mun) ..park]
%z [(read-z yon path.mun) ..park]
==
--
--
--
--
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
:: section 4cA, filesystem vane
::
:: This is the arvo interface vane. Our formal state is a `++raft`, which
:: has five components:
::
:: -- `rom` is the state for all local desks.
:: -- `hoy` is the state for all foreign desks.
:: -- `ran` is the global, hash-addressed object store.
:: -- `mon` is the set of mount points in unix.
:: -- `hez` is the duct to the unix sync.
::
::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
=| :: instrument state
$: ver=%11 :: vane version
ruf=raft :: revision tree
== ::
|= [now=@da eny=@uvJ rof=roof] :: current invocation
~% %clay-top ..part ~
|% ::
++ call :: handle request
~/ %clay-call
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
==
^- [(list move) _..^$]
::
=/ req=task ((harden task) wrapped-task)
::
:: TODO handle error notifications
::
?^ dud
[[[hen %slip %d %flog %crud [-.req tang.u.dud]] ~] ..^$]
::
?- -.req
%boat
:_ ..^$
[hen %give %hill (turn ~(tap by mon.ruf) head)]~
::
%cred
=. cez.ruf
?~ cew.req (~(del by cez.ruf) nom.req)
(~(put by cez.ruf) nom.req cew.req)
:: wake all desks, a request may have been affected.
=| mos=(list move)
=/ des ~(tap in ~(key by dos.rom.ruf))
|-
?~ des [[[hen %give %done ~] mos] ..^^$]
=/ den ((de now rof hen ruf) our i.des)
=^ mor ruf
=< abet:wake
?: ?=(^ cew.req) den
(forget-crew:den nom.req)
$(des t.des, mos (weld mos mor))
::
%crew
[[hen %give %cruz cez.ruf]~ ..^$]
::
%crow
=/ des ~(tap by dos.rom.ruf)
=| rus=(map desk [r=regs w=regs])
|^
?~ des [[hen %give %croz rus]~ ..^^$]
=+ per=(filter-rules per.q.i.des)
=+ pew=(filter-rules pew.q.i.des)
=? rus |(?=(^ per) ?=(^ pew))
(~(put by rus) p.i.des per pew)
$(des t.des)
::
++ filter-rules
|= pes=regs
^+ pes
=- (~(gas in *regs) -)
%+ skim ~(tap by pes)
|= [p=path r=rule]
(~(has in who.r) |+nom.req)
--
::
%drop
~& %clay-idle
[~ ..^$]
::
%info
?: ?=(%| -.dit.req)
=/ bel=@tas p.dit.req
=/ aey=(unit aeon) q.dit.req
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(label:den bel aey)
[mos ..^$]
=/ [deletes=(set path) changes=(map path cage)]
=/ =soba p.dit.req
=| deletes=(set path)
=| changes=(map path cage)
|- ^+ [deletes changes]
?~ soba
[deletes changes]
?- -.q.i.soba
%del $(soba t.soba, deletes (~(put in deletes) p.i.soba))
%ins $(soba t.soba, changes (~(put by changes) [p p.q]:i.soba))
%mut $(soba t.soba, changes (~(put by changes) [p p.q]:i.soba))
%dif ~|(%dif-not-implemented !!)
==
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(info:den deletes changes)
[mos ..^$]
::
%init
[~ ..^$(hun.rom.ruf hen)]
::
%into
=. hez.ruf `hen
=+ bem=(~(get by mon.ruf) des.req)
?: &(?=(~ bem) !=(%$ des.req))
~|([%bad-mount-point-from-unix des.req] !!)
=/ bem=beam
?^ bem
u.bem
[[our %base %ud 1] ~] :: TODO: remove this fallback?
=/ dos (~(get by dos.rom.ruf) q.bem)
?~ dos
!! :: fire next in queue
=^ mos ruf
=/ den ((de now rof hen ruf) our q.bem)
abet:(into:den s.bem all.req fis.req)
[mos ..^$]
::
%merg :: direct state up
?: =(%$ des.req)
~&(%merg-no-desk !!)
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(start-merge:den her.req dem.req cas.req how.req)
[mos ..^$]
::
%fuse
?: =(%$ des.req)
~&(%fuse-no-desk !!)
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(start-fuse:den bas.req con.req)
[mos ..^$]
::
%mont
=. hez.ruf ?^(hez.ruf hez.ruf `[[%$ %sync ~] ~])
=^ mos ruf
=/ den ((de now rof hen ruf) p.bem.req q.bem.req)
abet:(mount:den pot.req r.bem.req s.bem.req)
[mos ..^$]
::
%dirk
?~ hez.ruf
~& %no-sync-duct
[~ ..^$]
?. (~(has by mon.ruf) des.req)
~& [%not-mounted des.req]
[~ ..^$]
[~[[u.hez.ruf %give %dirk des.req]] ..^$]
::
%ogre
?~ hez.ruf
~& %no-sync-duct
[~ ..^$]
=* pot pot.req
?@ pot
?. (~(has by mon.ruf) pot)
~& [%not-mounted pot]
[~ ..^$]
:_ ..^$(mon.ruf (~(del by mon.ruf) pot))
[u.hez.ruf %give %ogre pot]~
:_ %_ ..^$
mon.ruf
%- molt
%+ skip ~(tap by mon.ruf)
(corl (cury test pot) tail)
==
%+ turn
(skim ~(tap by mon.ruf) (corl (cury test pot) tail))
|= [pon=term bem=beam]
[u.hez.ruf %give %ogre pon]
::
%park
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(park:den | [yok ran]:req)
[mos ..^$]
::
%pork
=/ [syd=desk =yoki] (need pud.ruf)
=. pud.ruf ~
=^ mos ruf
=/ den ((de now rof hen ruf) our syd)
abet:(park:den & yoki *rang)
[mos ..^$]
::
%perm
=^ mos ruf
=/ den ((de now rof hen ruf) our des.req)
abet:(perm:den pax.req rit.req)
[mos ..^$]
::
%tomb (tomb-clue:tomb hen clue.req)
%trim [~ ..^$]
::
%vega
:: wake all desks, then send pending notifications
::
=^ wake-moves ..^$
=/ desks=(list [=ship =desk])
%+ welp
(turn ~(tap by dos.rom.ruf) |=([=desk *] [our desk]))
%- zing
%+ turn ~(tap by hoy.ruf)
|= [=ship =rung]
%+ turn ~(tap by rus.rung)
|= [=desk *]
[ship desk]
|- ^+ [*(list move) ..^^$]
?~ desks
[~ ..^^$]
=^ moves-1 ..^^$ $(desks t.desks)
=^ moves-2 ruf abet:wake:((de now rof hen ruf) [ship desk]:i.desks)
[(weld moves-1 moves-2) ..^^$]
[wake-moves ..^$]
::
?(%warp %werp)
:: capture whether this read is on behalf of another ship
:: for permissions enforcement
::
=^ for req
?: ?=(%warp -.req)
[~ req]
:: ?: =(our who.req)
:: [~ [%warp wer.req rif.req]]
:- ?:(=(our who.req) ~ `[who.req -.rif.req])
[%warp wer.req riff.rif.req]
::
?> ?=(%warp -.req)
=* rif rif.req
=^ mos ruf
=/ den ((de now rof hen ruf) wer.req p.rif)
=< abet
?~ q.rif
cancel-request:den
(start-request:den for u.q.rif)
[mos ..^$]
::
%plea
=* her ship.req
=* pax path.plea.req
=* res payload.plea.req
::
?: ?=([%backfill *] pax)
=+ ;;(=fill res)
=^ mos ruf
=/ den ((de now rof hen ruf) our desk.fill)
abet:(give-backfill:den -.fill lobe.fill)
[[[hen %give %done ~] mos] ..^$]
?> ?=([%question *] pax)
=+ ryf=;;(riff-any res)
:_ ..^$
:~ [hen %give %done ~]
=/ =wire
[%foreign-warp (scot %p her) t.pax]
[hen %pass wire %c %werp her our ryf]
==
==
::
++ load
=> |%
+$ raft-any
$% [%11 raft-11]
[%10 raft-10]
[%9 raft-9]
[%8 raft-8]
[%7 raft-7]
[%6 raft-6]
==
+$ raft-11 raft
+$ raft-10
$: rom=room-10
hoy=(map ship rung-10)
ran=rang-10
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
dist-upgraded=_|
==
+$ rang-10
$: hut=(map tako yaki)
lat=(map lobe blob-10)
==
+$ blob-10
$% [%delta p=lobe q=[p=mark q=lobe] r=page]
[%direct p=lobe q=page]
[%dead p=lobe ~]
==
+$ room-10
$: hun=duct
dos=(map desk dojo-10)
==
+$ dojo-10
$: qyx=cult-10
dom=dome-10
per=regs
pew=regs
fiz=melt-10
==
+$ dome-10
$: ank=ankh-10
let=aeon
hit=(map aeon tako)
lab=(map @tas aeon)
mim=(map path mime)
fod=*
==
+$ ankh-10 (axal [p=lobe q=cage])
+$ rung-10
$: rus=(map desk rede-10)
==
+$ rede-10
$: lim=@da
ref=(unit rind-10)
qyx=cult-10
dom=dome-10
per=regs
pew=regs
fiz=melt-10
==
+$ rind-10
$: nix=@ud
bom=(map @ud update-state-10)
fod=(map duct @ud)
haw=(map mood (unit cage))
==
+$ update-state-10
$: =duct
=rave
have=(map lobe blob-10)
need=(list lobe)
nako=(qeu (unit nako-10))
busy=_|
==
+$ nako-10
$: gar=(map aeon tako)
let=aeon
lar=(set yaki)
bar=(set blob-10)
==
+$ melt-10
[bas=beak con=(list [beak germ]) sto=(map beak (unit dome-clay-10))]
+$ dome-clay-10
$: ank=ankh-10
let=@ud
hit=(map @ud tako)
lab=(map @tas @ud)
==
+$ cult-10 (jug wove-10 duct)
+$ wove-10 [for=(unit [=ship ver=@ud]) =rove-10]
+$ rove-10
$% [%sing =mood]
[%next =mood aeon=(unit aeon) =cach-10]
$: %mult
=mool
aeon=(unit aeon)
old-cach=(map [=care =path] cach-10)
new-cach=(map [=care =path] cach-10)
==
[%many track=? =moat lobes=(map path lobe)]
==
+$ cach-10 (unit (unit (each cage lobe)))
+$ raft-9
$: rom=room-10
hoy=(map ship rung-10)
ran=rang-10
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
==
+$ raft-8
$: rom=room-8
hoy=(map ship rung-8)
ran=rang-10
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
==
+$ room-8
$: hun=duct
dos=(map desk dojo-8)
==
+$ rung-8
$: rus=(map desk rede-8)
==
+$ dojo-8
$: qyx=cult-10
dom=dome-8
per=regs
pew=regs
fiz=melt-10
==
+$ dome-8
$: ank=ankh-10
let=aeon
hit=(map aeon tako)
lab=(map @tas aeon)
mim=(map path mime)
fod=*
fer=* :: reef cache, obsolete
==
+$ rede-8
$: lim=@da
ref=(unit rind-10)
qyx=cult-10
dom=dome-8
per=regs
pew=regs
fiz=melt-10
==
+$ raft-7
$: rom=room-7
hoy=(map ship rung-7)
ran=rang-10
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
==
+$ room-7
$: hun=duct
dos=(map desk dojo-7)
==
+$ rung-7
$: rus=(map desk rede-7)
==
+$ dojo-7
$: qyx=cult-10
dom=dome-8
per=regs
pew=regs
==
+$ rede-7
$: lim=@da
ref=(unit rind-10)
qyx=cult-10
dom=dome-8
per=regs
pew=regs
==
+$ raft-6
$: rom=room-6
hoy=(map ship rung-6)
ran=rang-10
mon=(map term beam)
hez=(unit duct)
cez=(map @ta crew)
pud=(unit [=desk =yoki])
== ::
+$ room-6 [hun=duct dos=(map desk dojo-6)]
+$ dojo-6
$: qyx=cult-10
dom=dome-6
per=regs
pew=regs
==
+$ dome-6
$: ank=ankh-10
let=aeon
hit=(map aeon tako)
lab=(map @tas aeon)
mim=(map path mime)
fod=*
fer=*
==
+$ rung-6
$: rus=(map desk rede-6)
==
+$ rede-6
$: lim=@da
ref=(unit rind-10)
qyx=cult-10
dom=dome-6
per=regs
pew=regs
==
--
|= old=raft-any
|^
=? old ?=(%6 -.old) 7+(raft-6-to-7 +.old)
=? old ?=(%7 -.old) 8+(raft-7-to-8 +.old)
=? old ?=(%8 -.old) 9+(raft-8-to-9 +.old)
=? old ?=(%9 -.old) 10+(raft-9-to-10 +.old)
=? old ?=(%10 -.old) 11+(raft-10-to-11 +.old)
?> ?=(%11 -.old)
..^^$(ruf +.old)
:: +raft-6-to-7: delete stale ford caches (they could all be invalid)
::
++ raft-6-to-7
|= raf=raft-6
^- raft-7
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= doj=dojo-6
^- dojo-7
doj(fod.dom **)
::
hoy
%- ~(run by hoy.raf)
|= =rung-6
%- ~(run by rus.rung-6)
|= =rede-6
rede-6(dom dom.rede-6(fod **))
==
:: +raft-7-to-8: create bunted melts in each dojo/rede
::
++ raft-7-to-8
|= raf=raft-7
^- raft-8
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= doj=dojo-7
^- dojo-8
[qyx.doj dom.doj per.doj pew.doj *melt-10]
::
hoy
%- ~(run by hoy.raf)
|= =rung-7
%- ~(run by rus.rung-7)
|= r=rede-7
^- rede-8
[lim.r ref.r qyx.r dom.r per.r pew.r *melt-10]
==
:: +raft-8-to-9: remove reef cache
::
++ raft-8-to-9
|= raf=raft-8
^- raft-9
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= =dojo-8
^- dojo-10
=/ dom dom.dojo-8
dojo-8(dom [ank.dom let.dom hit.dom lab.dom mim.dom *flow])
::
hoy
%- ~(run by hoy.raf)
|= =rung-8
%- ~(run by rus.rung-8)
|= =rede-8
^- rede-10
=/ dom dom.rede-8
rede-8(dom [ank.dom let.dom hit.dom lab.dom mim.dom *flow])
==
:: +raft-9-to-10: add .dist-upgraded
++ raft-9-to-10
|= raf=raft-9
^- raft-10
raf(pud [pud.raf dist-upgraded=|])
::
:: +raft-10-to-11:
::
:: add tom and nor to dome
:: remove parent-mark from delta blobs
:: change blobs to pages
:: remove have from update-state
:: remove bar from nako
:: remove ankh
:: set cases in mon to ud+0
:: add fad
:: change fod type in dom
:: change bom type in dom
::
++ raft-10-to-11
|= raf=raft-10
|^
^- raft-11
%= raf
dos.rom
%- ~(run by dos.rom.raf)
|= =dojo-10
^- dojo
%= dojo-10
fiz *melt
qyx (cult-10-to-cult qyx.dojo-10)
dom
:* let.dom.dojo-10
hit.dom.dojo-10
lab.dom.dojo-10
~
*norm
mim.dom.dojo-10
~
~
==
==
::
hoy
%- ~(run by hoy.raf)
|= =rung-10
%- ~(run by rus.rung-10)
|= =rede-10
^- rede
%= rede-10
fiz *melt
qyx (cult-10-to-cult qyx.rede-10)
dom
:* let.dom.rede-10
hit.dom.rede-10
lab.dom.rede-10
~
*norm
mim.dom.rede-10
~
~
==
::
ref
?~ ref.rede-10
~
%= ref.rede-10
bom.u
%- ~(run by bom.u.ref.rede-10)
|= =update-state-10
^- update-state
%= update-state-10
|2
:- `(unit @da)`~
%= |2.update-state-10
nako
%- ~(gas to *(qeu (unit nako)))
%+ turn ~(tap to nako.update-state-10)
|= nak=(unit nako-10)
?~ nak ~
`u.nak(bar ~)
==
==
==
==
::
lat.ran
%- ~(gas by *(map lobe page))
%+ murn ~(tap by lat.ran.raf)
|= [=lobe =blob-10]
^- (unit [^lobe page])
?- -.blob-10
%delta ((slog 'clay: tombstoning delta!' ~) ~)
%dead ~
%direct `[lobe q.blob-10]
==
::
|3
:- *flow
%= |3.raf
mon (~(run by mon.raf) |=(=beam beam(r ud+0)))
|3 [pud.raf ~]
==
==
::
++ cult-10-to-cult
|= qyx=cult-10
^- cult
=/ qux=(list [=wove-10 ducts=(set duct)]) ~(tap by qyx)
%- malt
|- ^- (list [wove (set duct)])
?~ qux
~
:_ $(qux t.qux)
%= i.qux
rove-10.wove-10
?- -.rove-10.wove-10.i.qux
%sing rove-10.wove-10.i.qux
%many rove-10.wove-10.i.qux
%next
%= rove-10.wove-10.i.qux
cach-10 (cach-10-to-cach cach-10.rove-10.wove-10.i.qux)
==
::
%mult
%= rove-10.wove-10.i.qux
old-cach (caches-10-to-caches old-cach.rove-10.wove-10.i.qux)
new-cach (caches-10-to-caches new-cach.rove-10.wove-10.i.qux)
==
==
==
::
++ cach-10-to-cach
|= =cach-10
^- cach
?~ cach-10
~
?~ u.cach-10
[~ ~]
?- -.u.u.cach-10
%& ``p.u.u.cach-10
%| ~
==
::
++ caches-10-to-caches
|= caches-10=(map [=care =path] cach-10)
^- (map [=care =path] cach)
(~(run by caches-10) cach-10-to-cach)
--
--
::
++ scry :: inspect
~/ %clay-scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
|^
=* ren car
=/ why=shop &/p.bem
=* syd q.bem
=/ lot=coin $/r.bem
=* tyl s.bem
::
?. ?=(%& -.why) ~
=* his p.why
?: &(=(ren %$) =(tyl /whey))
``mass+!>(whey)
:: ~& scry+[ren `path`[(scot %p his) syd ~(rent co lot) tyl]]
:: =- ~& %scry-done -
=+ luk=?.(?=(%$ -.lot) ~ ((soft case) p.lot))
?~ luk [~ ~]
?: =(%$ ren)
[~ ~]
=+ run=((soft care) ren)
?~ run [~ ~]
::TODO if it ever gets filled properly, pass in the full fur.
::
=/ for=(unit ship) ?~(lyc ~ ?~(u.lyc ~ `n.u.lyc))
?: &(=(%x ren) =(%$ syd) =([%ud 0] u.luk))
(read-buc-public u.run tyl)
?: &(=(our his) =(%x ren) =(%$ syd) =([%da now] u.luk))
(read-buc u.run tyl)
=/ den ((de now rof [/scryduct ~] ruf) his syd)
=/ result (mule |.(-:(aver:den for u.run u.luk tyl)))
?: ?=(%| -.result)
%- (slog >%clay-scry-fail< p.result)
~
p.result
::
++ read-buc-public
|= [=care =path]
^- (unit (unit cage))
?+ path ~
[%lobe @ ~]
?~ hash=(slaw %uv i.t.path) ~
?~ page=(~(get by lat.ran.ruf) u.hash) ~
``[%page !>(u.page)]
==
::
++ read-buc
|= [=care =path]
^- (unit (unit cage))
?~ path
~
?+ i.path ~
%sweep ``[%sweep !>(sweep)]
%rang ``[%rang !>(ran.ruf)]
%domes
=/ domes
%- ~(gas by *cone)
%+ turn ~(tap by dos.rom.ruf)
|= [=desk =dojo]
[[our desk] [let hit lab]:dom.dojo]
=. domes
%- ~(uni by domes)
%- ~(gas by *cone)
^- (list [[ship desk] dome:clay])
%- zing
^- (list (list [[ship desk] dome:clay]))
%+ turn ~(tap by hoy.ruf)
|= [=ship =rung]
^- (list [[^ship desk] dome:clay])
%+ turn ~(tap by rus.rung)
|= [=desk =rede]
[[ship desk] [let hit lab]:dom.rede]
``[%domes !>(`cone`domes)]
==
::
:: Check for refcount errors
::
++ sweep
^- (list [need=@ud have=@ud leak])
=/ marked=(map leak [need=@ud have=@ud])
(~(run by fad.ruf) |=([refs=@ud *] [0 refs]))
=. marked
=/ items=(list [=leak *]) ~(tap by fad.ruf)
|- ^+ marked
?~ items
marked
=/ deps ~(tap in deps.leak.i.items)
|- ^+ marked
?~ deps
^$(items t.items)
=. marked
%+ ~(put by marked) i.deps
=/ gut (~(gut by marked) i.deps [0 0])
[+(-.gut) +.gut]
$(deps t.deps)
::
=/ spills=(list (set leak))
%+ welp
%+ turn ~(tap by dos.rom.ruf)
|= [* =dojo]
spill.fod.dom.dojo
%- zing
%+ turn ~(tap by hoy.ruf)
|= [* =rung]
%+ turn ~(tap by rus.rung)
|= [* =rede]
spill.fod.dom.rede
::
=. marked
|-
?~ spills
marked
=/ leaks ~(tap in i.spills)
|-
?~ leaks
^$(spills t.spills)
=. marked
%+ ~(put by marked) i.leaks
=/ gut (~(gut by marked) i.leaks [0 0])
[+(-.gut) +.gut]
$(leaks t.leaks)
::
%+ murn ~(tap by marked)
|= [=leak need=@ud have=@ud]
?: =(need have)
~
`u=[need have leak]
--
::
:: We clear the ford cache by replacing it with its bunt as a literal.
:: This nests within +flow without reference to +type, +hoon, or
:: anything else in the sample of cache objects. Otherwise we would be
:: contravariant in the those types, which makes them harder to change.
::
++ stay
:- ver
%= ruf
fad ~
dos.rom
%- ~(run by dos.rom.ruf)
|= =dojo
dojo(fod.dom `flue`[~ ~])
::
hoy
%- ~(run by hoy.ruf)
|= =rung
%= rung
rus
%- ~(run by rus.rung)
|= =rede
rede(fod.dom `flue`[~ ~])
==
==
::
++ take :: accept response
~/ %clay-take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^+ [*(list move) ..^$]
?^ dud
~|(%clay-take-dud (mean tang.u.dud))
?: ?=([%dist *] tea)
?: ?=(%onto +<.hin)
[~ ..^$]
?> ?=(%unto +<.hin)
?> ?=(%poke-ack -.p.hin)
?~ p.p.hin
[~ ..^$]
=+ ((slog 'clay: dist migration failed' u.p.p.hin) ~)
!!
::
?: ?=([%merge @ @ @ @ ~] tea)
?> ?=(%writ +<.hin)
=* syd i.t.tea
=/ ali-ship (slav %p i.t.t.tea)
=* ali-desk i.t.t.t.tea
=/ germ (germ i.t.t.t.t.tea)
=^ mos ruf
=/ den ((de now rof hen ruf) our i.t.tea)
abet:(merge:den ali-ship ali-desk germ p.hin)
[mos ..^$]
::
?: ?=([%fuse @ @ @ @ ~] tea)
?> ?=(%writ +<.hin)
=* syd i.t.tea
=/ ali-ship=@p (slav %p i.t.t.tea)
=* ali-desk=desk i.t.t.t.tea
=/ ali-case (rash i.t.t.t.t.tea nuck:so)
?> ?=([%$ *] ali-case)
=^ mos ruf
=/ den ((de now rof hen ruf) our i.t.tea)
abet:(take-fuse:den [ali-ship ali-desk (case +.ali-case)] p.hin)
[mos ..^$]
::
?: ?=([%foreign-warp *] tea)
?> ?=(%writ +<.hin)
:_ ..^$
[hen %give %boon `(unit rand)`(bind `riot`p.hin rant-to-rand)]~
::
?: ?=([%warp-index @ @ @ ~] tea)
?+ +<.hin ~| %clay-warp-index-strange !!
%done
?~ error.hin
[~ ..^$]
:: TODO better error handling
::
~& %clay-take-warp-index-error^our^tea^tag.u.error.hin
%- (slog tang.u.error.hin)
[~ ..^$]
::
%lost
%- (slog leaf+"clay: lost warp from {<tea>}" ~)
[~ ..^$]
::
?(%boon %tune)
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=/ index=@ud (slav %ud i.t.t.t.tea)
::
=^ mos ruf
=; res=(unit rand)
~& taking-foreign-answer/=(~ res)
=/ den ((de now rof hen ruf) her desk)
abet:(take-foreign-answer:den index res)
?: ?=(%boon +<.hin) ;;((unit rand) payload.hin)
%+ bind data.hin
|= =(cask)
^- rand
:: retrieve the request from the scry path
::
=+ (need (de-omen path.hin))
=/ =care ;;(care ?@(vis (rsh 3 vis) car.vis))
[[care r.bem q.bem] s.bem cask]
[mos ..^$]
::
%wake
?^ error.hin
[[hen %slip %d %flog %crud %wake u.error.hin]~ ..^$]
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=/ index=@ud (slav %ud i.t.t.t.tea)
~& [%clay %scry-broken her]
=^ mos ruf
=. sad.ruf (~(put by sad.ruf) her now)
=/ den ((de now rof hen ruf) her desk)
abet:(retry-with-ames:den %warp-index index)
[mos ..^$]
==
::
?: ?=([%back-index @ @ @ ~] tea)
?+ +<.hin ~| %clay-backfill-index-strange !!
%done
?~ error.hin
[~ ..^$]
:: TODO better error handling
::
~& %clay-take-backfill-index-error^our^tea^tag.u.error.hin
%- (slog tang.u.error.hin)
[~ ..^$]
::
%lost
%- (slog leaf+"clay: lost backfill from {<tea>}" ~)
[~ ..^$]
::
?(%boon %tune)
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=/ index=@ud (slav %ud i.t.t.t.tea)
::
=/ fell=(unit fell)
?: ?=(%boon +<.hin) `;;(fell payload.hin)
?~ data.hin ~
?> =(%page p.u.data.hin)
`[%direct (page-to-lobe u.data.hin) ;;(page q.u.data.hin)]
::
=^ mos ruf
=/ den ((de now rof hen ruf) her desk)
?~ fell
abet:(retry-with-ames:den %back-index index)
abet:abet:(take-backfill:(foreign-update:den index) u.fell)
[mos ..^$]
::
%wake
?^ error.hin
[[hen %slip %d %flog %crud %wake u.error.hin]~ ..^$]
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=/ index=@ud (slav %ud i.t.t.t.tea)
=^ mos ruf
=. sad.ruf (~(put by sad.ruf) her now)
=/ den ((de now rof hen ruf) her desk)
abet:(retry-with-ames:den %back-index index)
[mos ..^$]
==
::
?: ?=([%seek @ @ ~] tea)
?+ +<.hin ~| %clay-seek-strange !!
%done
?~ error.hin
[~ ..^$]
%- (slog leaf+"clay: seek nack from {<tea>}" u.error.hin)
[~ ..^$]
::
%lost
%- (slog leaf+"clay: lost boon from {<tea>}" ~)
[~ ..^$]
::
%boon
=+ ;; =fell payload.hin
::
=/ her=ship (slav %p i.t.tea)
=/ =desk (slav %tas i.t.t.tea)
=^ mos ruf
=/ den ((de now rof hen ruf) her desk)
abet:(take-fell:den fell)
[mos ..^$]
==
::
?: ?=([%sinks ~] tea)
?> ?=(%public-keys +<.hin)
?. ?=(%breach -.public-keys-result.hin)
[~ ..^$]
=/ who who.public-keys-result.hin
?: =(our who)
[~ ..^$]
:: Cancel subscriptions
::
=/ foreign-desk=(unit rung)
(~(get by hoy.ruf) who)
?~ foreign-desk
[~ ..^$]
=/ cancel-ducts=(list duct)
%- zing ^- (list (list duct))
%+ turn ~(tap by rus.u.foreign-desk)
|= [=desk =rede]
^- (list duct) %- zing ^- (list (list duct))
%+ turn ~(tap by qyx.rede)
|= [=wove ducts=(set duct)]
:: ~& [%sunk-wove desk (print-wove wove) ducts]
~(tap in ducts)
=/ cancel-moves=(list move)
%+ turn cancel-ducts
|=(=duct [duct %slip %b %drip !>([%writ ~])])
:: delete local state of foreign desk
::
=. hoy.ruf (~(del by hoy.ruf) who)
[cancel-moves ..^$]
::
?- -.+.hin
%public-keys ~|([%public-keys-raw tea] !!)
::
%mere
?: ?=(%& -.p.+.hin)
~& 'initial merge succeeded'
[~ ..^$]
~> %slog.
:^ 0 %rose [" " "[" "]"]
:^ leaf+"initial merge failed"
leaf+"my most sincere apologies"
>p.p.p.+.hin<
q.p.p.+.hin
[~ ..^$]
::
%note [[hen %give +.hin]~ ..^$]
%wake
:: TODO: handle behn errors
::
?^ error.hin
[[hen %slip %d %flog %crud %wake u.error.hin]~ ..^$]
::
?. ?=([%tyme @ @ ~] tea)
~& [%clay-strange-timer tea]
[~ ..^$]
=/ her (slav %p i.t.tea)
=/ syd (slav %tas i.t.t.tea)
=^ mos ruf
=/ den ((de now rof hen ruf) her syd)
abet:wake:den
[mos ..^$]
::
:: handled in the wire dispatcher
::
%boon !!
%tune !!
%lost !!
%onto !!
%unto !!
%writ
%- (slog leaf+"clay: strange writ (expected on upgrade to Fusion)" ~)
[~ ..^$]
::
%done
?~ error=error.hin
[~ ..^$]
%- (slog >%clay-lost< >tag.u.error< tang.u.error)
[~ ..^$]
==
::
++ rant-to-rand
|= rant
^- rand
[p q [p q.q]:r]
:: +whey: produce memory usage report
::
++ whey
^- (list mass)
=/ domestic
%+ turn (sort ~(tap by dos.rom.ruf) aor)
|= [=desk =dojo]
:+ desk %|
:~ mime+&+mim.dom.dojo
flue+&+fod.dom.dojo
dome+&+dom.dojo
==
:~ domestic+|+domestic
foreign+&+hoy.ruf
ford-cache+&+fad.ruf
:+ %object-store %|
:~ commits+&+hut.ran.ruf
pages+&+lat.ran.ruf
==
==
::
++ tomb
|%
:: +tomb-clue: safely remove objects
::
++ tomb-clue
|= [=duct =clue]
^- [(list move) _..^$]
?- -.clue
%lobe `(tomb-lobe lobe.clue &)
%all
=/ lobes=(list [=lobe =page]) ~(tap by lat.ran.ruf)
|-
?~ lobes
`..^^$
=. ..^^$ (tomb-lobe lobe.i.lobes &)
$(lobes t.lobes)
::
%pick pick
%norm
=^ mos ruf
=/ den ((de now rof duct ruf) ship.clue desk.clue)
abet:(set-norm:den norm.clue)
[mos ..^$]
::
%worn
=^ mos ruf
=/ den ((de now rof duct ruf) ship.clue desk.clue)
abet:(set-worn:den tako.clue norm.clue)
[mos ..^$]
::
%seek
=^ mos ruf
=/ den ((de now rof duct ruf) ship.clue desk.clue)
abet:(seek:den cash.clue)
[mos ..^$]
==
:: +tomb-lobe: remove specific lobe
::
++ tomb-lobe
|= [lob=lobe veb=?]
^+ ..^$
=/ peg=(unit page) (~(get by lat.ran.ruf) lob)
?~ peg
(noop veb leaf+"clay: file already tombstoned" ~)
::
=/ used=(unit beam)
=/ desks=(list [=desk =dojo]) ~(tap by dos.rom.ruf)
|-
=* desk-loop $
?~ desks
~
?: =(0 let.dom.dojo.i.desks)
desk-loop(desks t.desks)
=/ =yaki
%- ~(got by hut.ran.ruf)
%- ~(got by hit.dom.dojo.i.desks)
let.dom.dojo.i.desks
=/ paths=(list [=path =lobe]) ~(tap by q.yaki)
|-
=* path-loop $
?~ paths
desk-loop(desks t.desks)
?: =(lob lobe.i.paths)
`[[our desk.i.desks ud+let.dom.dojo.i.desks] path.i.paths]
path-loop(paths t.paths)
::
?^ used
(noop veb leaf+"clay: file used in {<(en-beam u.used)>}" ~)
::
=. lat.ran.ruf (~(del by lat.ran.ruf) lob)
(noop veb leaf+"clay: file successfully tombstoned" ~)
::
++ noop
|= [veb=? =tang]
?. veb
..^$
((slog tang) ..^$)
::
++ draw-raft
^- (set [norm yaki])
=/ room-yakis
=/ rooms=(list [=desk =dojo]) ~(tap by dos.rom.ruf)
|- ^- (set [norm yaki])
?~ rooms
~
(~(uni in $(rooms t.rooms)) (draw-dome dom.dojo.i.rooms))
=/ rung-yakis
=/ rungs=(list [=ship =rung]) ~(tap by hoy.ruf)
|- ^- (set [norm yaki])
?~ rungs
~
%- ~(uni in $(rungs t.rungs))
=/ redes=(list [=desk =rede]) ~(tap by rus.rung.i.rungs)
|- ^- (set [norm yaki])
?~ redes
~
(~(uni in $(redes t.redes)) (draw-dome dom.rede.i.redes))
(~(uni in room-yakis) rung-yakis)
::
++ draw-dome
|= =dome
^- (set [norm yaki])
=/ =aeon 1
|- ^- (set [norm yaki])
?: (lth let.dome aeon)
~
=/ =tako (~(got by hit.dome) aeon)
=/ yakis=(set [norm yaki])
?. =(let.dome aeon)
~
[[*norm (~(got by hut.ran.ruf) tako)] ~ ~]
%- ~(uni in yakis)
%- ~(uni in (draw-tako tom.dome nor.dome tako))
$(aeon +(aeon))
::
++ draw-tako
|= [tom=(map tako norm) nor=norm =tako]
^- (set [norm yaki])
~+
=/ =norm (~(gut by tom) tako nor)
=/ =yaki (~(got by hut.ran.ruf) tako)
=/ takos
|- ^- (set [^norm ^yaki])
?~ p.yaki
~
(~(uni in $(p.yaki t.p.yaki)) ^$(tako i.p.yaki))
(~(put in takos) norm yaki)
::
:: +pick: copying gc based on norms
::
++ pick
=| lat=(map lobe page)
=| sen=(set [norm (map path lobe)])
|^
=. ..pick-raft pick-raft
=. lat.ran.ruf lat
`..^$
::
++ pick-raft
^+ ..pick-raft
=/ yakis=(list [=norm =yaki]) ~(tap in draw-raft)
|- ^+ ..pick-raft
?~ yakis
..pick-raft
:: ~& > [%picking [norm r.yaki]:i.yakis]
$(yakis t.yakis, ..pick-raft (pick-yaki i.yakis))
::
:: NB: recurring tree-wise with the `sen` cache provides
:: approximately a 100x speedup on a mainnet moon in 4/2022
::
++ pick-yaki
|= [=norm =yaki]
^+ ..pick-raft
|- ^+ ..pick-raft
?~ q.yaki
..pick-raft
?: (~(has in sen) norm q.yaki)
..pick-raft
=. sen (~(put in sen) norm q.yaki)
=/ peg=(unit page) (~(get by lat.ran.ruf) q.n.q.yaki)
:: ~& >> [%picking-lobe ?=(^ peg) +:(~(fit of norm) p.n.q.yaki) n.q.yaki]
=? lat &(?=(^ peg) !=([~ %|] +:(~(fit of norm) p.n.q.yaki)))
(~(uni by `(map lobe page)`[[q.n.q.yaki u.peg] ~ ~]) lat)
=. ..pick-raft $(q.yaki l.q.yaki)
$(q.yaki r.q.yaki)
--
--
--
Reference in New Issue View Git Blame Copy Permalink