mirror of
https://github.com/urbit/shrub.git
synced 2024-12-15 12:43:31 +03:00
cdb8267caf
Instead of continuing to struggle with all the places in arvo where we assume that vane names are one letter and that one letter is the first letter of the full vane name, just use %l/lient and %r/rver for now to finish the split of %light into a separate http client and server vane.
2444 lines
76 KiB
Plaintext
2444 lines
76 KiB
Plaintext
!: :: /van/jael
|
|
:: :: %reference/0
|
|
!? 150
|
|
::
|
|
::
|
|
:: %jael: secrets and promises.
|
|
::
|
|
:: todo:
|
|
::
|
|
:: - communication with other vanes:
|
|
:: - actually use %behn for expiring secrets
|
|
:: - report %ames propagation errors to user
|
|
::
|
|
:: - nice features:
|
|
:: - scry namespace
|
|
:: - task for converting invites to tickets
|
|
::
|
|
|= pit/vase
|
|
=, pki:jael
|
|
=, rights:jael
|
|
=, able:jael
|
|
=, crypto
|
|
=, jael
|
|
=, ethereum
|
|
=, rpc
|
|
=, azimuth
|
|
:: ::::
|
|
:::: # models :: data structures
|
|
:: ::::
|
|
:: the %jael state comes in two parts: absolute
|
|
:: and relative.
|
|
::
|
|
:: ++state-absolute is objective -- defined without
|
|
:: reference to our ship. if you steal someone else's
|
|
:: private keys, we have a place to put them. when
|
|
:: others make promises to us, we store them in the
|
|
:: same structures we use to make promises to others.
|
|
::
|
|
:: ++state-relative is subjective, denormalized and
|
|
:: derived. it consists of all the state we need to
|
|
:: manage subscriptions efficiently.
|
|
::
|
|
=> |%
|
|
++ state :: all vane state
|
|
$: ver/$0 :: vane version
|
|
yen/(set duct) :: raw observers
|
|
urb/state-absolute :: all absolute state
|
|
sub/state-relative :: all relative state
|
|
etn=state-eth-node :: eth connection state
|
|
sap=state-snapshots :: state snapshots
|
|
== ::
|
|
++ state-relative :: urbit metadata
|
|
$: $= bal :: balance sheet (vest)
|
|
$: yen/(set duct) :: trackers
|
|
== ::
|
|
$= own :: vault (vein)
|
|
$: yen/(set duct) :: trackers
|
|
sig=(unit oath) :: for a moon
|
|
:: XX reconcile with .dns.eth ::
|
|
tuf=(list turf) :: domains
|
|
:: XX use for eth replay ::
|
|
boq=@ud :: boot block
|
|
nod=(unit purl:eyre) :: eth gateway
|
|
fak/_| :: fake keys
|
|
lyf/life :: version
|
|
jaw/(map life ring) :: private keys
|
|
== ::
|
|
$= puk :: public keys (pubs)
|
|
$: yen=(jug ship duct) :: trackers
|
|
kyz=(map ship public) :: public key state
|
|
== ::
|
|
$= eth :: ethereum (vent)
|
|
::TODO the subscribers here never hear dns or pos...
|
|
$: yen=(set duct) :: trackers
|
|
dns=dnses :: on-chain dns state
|
|
pos=(map ship point) :: on-chain ship state
|
|
::TODO do we want (map ship diff-point) too?
|
|
== ::
|
|
== ::
|
|
++ state-absolute :: absolute urbit
|
|
$: pry/(map ship (map ship safe)) :: promises
|
|
== ::
|
|
++ state-snapshots :: rewind points
|
|
$: interval=_100 :: block interval
|
|
max-count=_10 :: max snaps
|
|
count=@ud :: length of snaps
|
|
last-block=@ud :: number of last snap
|
|
snaps=(qeu [block-number=@ud snap=snapshot]) :: old states
|
|
== ::
|
|
++ message :: p2p message
|
|
$% [%hail p=remote] :: reset rights
|
|
[%nuke ~] :: cancel trackers
|
|
[%vent ~] :: view ethereum events
|
|
[%vent-result p=vent-result] :: tmp workaround
|
|
== ::
|
|
++ card :: i/o action
|
|
(wind note:able gift) ::
|
|
:: ::
|
|
++ move :: output
|
|
{p/duct q/card} ::
|
|
-- ::
|
|
:: ::::
|
|
:::: # light :: light cores
|
|
:: ::::
|
|
=> |%
|
|
:: :: ++py
|
|
:::: ## sparse/light :: sparse range
|
|
:: ::::
|
|
++ py
|
|
:: because when you're a star with 2^16 unissued
|
|
:: planets, a (set) is kind of lame...
|
|
::
|
|
|_ a/pile
|
|
:: :: ++dif:py
|
|
++ dif :: add/remove a->b
|
|
|= b/pile
|
|
^- (pair pile pile)
|
|
[(sub(a b) a) (sub b)]
|
|
:: :: ++div:py
|
|
++ div :: allocate
|
|
|= b/@ud
|
|
^- (unit (pair pile pile))
|
|
=< ?-(- %& [~ p], %| ~)
|
|
|- ^- (each (pair pile pile) @u)
|
|
?: =(0 b)
|
|
[%& ~ a]
|
|
?~ a [%| 0]
|
|
=/ al $(a l.a)
|
|
?- -.al
|
|
%& [%& p.p.al a(l q.p.al)]
|
|
%|
|
|
=. b (^sub b p.al)
|
|
=/ top +((^sub q.n.a p.n.a))
|
|
?: =(b top)
|
|
[%& a(r ~) r.a]
|
|
?: (lth b top)
|
|
:+ %& a(r ~, q.n (add p.n.a (dec b)))
|
|
=. p.n.a (add p.n.a b)
|
|
(uni(a r.a) [n.a ~ ~])
|
|
=/ ar $(a r.a, b (^sub b top))
|
|
?- -.ar
|
|
%& [%& a(r p.p.ar) q.p.ar]
|
|
%| [%| :(add top p.al p.ar)]
|
|
==
|
|
==
|
|
::
|
|
++ gas :: ++gas:py
|
|
|= b/(list @) ^- pile :: insert list
|
|
?~ b a
|
|
$(b t.b, a (put i.b))
|
|
:: :: ++gud:py
|
|
++ gud :: validate
|
|
=| {bot/(unit @) top/(unit @)}
|
|
|- ^- ?
|
|
?~ a &
|
|
?& (lte p.n.a q.n.a)
|
|
?~(top & (lth +(q.n.a) u.top))
|
|
?~(bot & (gth p.n.a +(u.bot)))
|
|
::
|
|
?~(l.a & (mor p.n.a p.n.l.a))
|
|
$(a l.a, top `p.n.a)
|
|
::
|
|
?~(l.a & (mor p.n.a p.n.l.a))
|
|
$(a r.a, bot `q.n.a)
|
|
==
|
|
:: :: ++int:py
|
|
++ int :: intersection
|
|
|= b/pile ^- pile
|
|
?~ a ~
|
|
?~ b ~
|
|
?. (mor p.n.a p.n.b) $(a b, b a)
|
|
?: (gth p.n.a q.n.b)
|
|
(uni(a $(b r.b)) $(a l.a, r.b ~))
|
|
?: (lth q.n.a p.n.b)
|
|
(uni(a $(b l.b)) $(a r.a, l.b ~))
|
|
?: (gte p.n.a p.n.b)
|
|
?: (lte q.n.a q.n.b)
|
|
[n.a $(a l.a, r.b ~) $(a r.a, l.b ~)]
|
|
[n.a(q q.n.b) $(a l.a, r.b ~) $(l.a ~, b r.b)]
|
|
%- uni(a $(r.a ~, b l.b))
|
|
?: (lte q.n.a q.n.b)
|
|
%- uni(a $(l.b ~, a r.a))
|
|
[n.b(q q.n.a) ~ ~]
|
|
%- uni(a $(l.a ~, b r.b))
|
|
[n.b ~ ~]
|
|
:: :: ++put:py
|
|
++ put :: insert
|
|
|= b/@ ^- pile
|
|
(uni [b b] ~ ~)
|
|
:: :: ++sub:py
|
|
++ sub :: subtract
|
|
|= b/pile ^- pile
|
|
?~ b a
|
|
?~ a a
|
|
?: (gth p.n.a q.n.b)
|
|
$(b r.b, l.a $(a l.a, r.b ~))
|
|
?: (lth q.n.a p.n.b)
|
|
$(b l.b, r.a $(a r.a, l.b ~))
|
|
%- uni(a $(a l.a, r.b ~))
|
|
%- uni(a $(a r.a, l.b ~))
|
|
?: (gte p.n.a p.n.b)
|
|
?: (lte q.n.a q.n.b)
|
|
~
|
|
$(b r.b, a [[+(q.n.b) q.n.a] ~ ~])
|
|
?: (lte q.n.a q.n.b)
|
|
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
|
|
%- uni(a $(b r.b, a [[+(q.n.b) q.n.a] ~ ~]))
|
|
$(b l.b, a [[n.a(q (min q.n.a (dec p.n.b)))] ~ ~])
|
|
:: :: ++tap:py
|
|
++ tap :: into full list
|
|
=| out/(list @)
|
|
|- ^+ out
|
|
?~ a out
|
|
$(a l.a, out (welp (gulf n.a) $(a r.a)))
|
|
:: :: ++uni:py
|
|
++ uni :: merge two piles
|
|
|= b/pile
|
|
^- pile
|
|
?~ b a
|
|
?~ a b
|
|
?. (mor p.n.a p.n.b) $(a b, b a)
|
|
?: (lth +(q.n.b) p.n.a)
|
|
$(b r.b, l.a $(a l.a, r.b ~))
|
|
?: (lth +(q.n.a) p.n.b)
|
|
$(b l.b, r.a $(a r.a, l.b ~))
|
|
?: =(n.a n.b) [n.a $(a l.a, b l.b) $(a r.a, b r.b)]
|
|
?: (lth p.n.a p.n.b)
|
|
?: (gth q.n.a q.n.b)
|
|
$(b l.b, a $(b r.b))
|
|
$(b l.b, a $(b r.b, a $(b r.a, r.a ~, q.n.a q.n.b)))
|
|
?: (gth q.n.a q.n.b)
|
|
$(a l.a, b $(a r.a, b $(a r.b, r.b ~, q.n.b q.n.a)))
|
|
$(a l.a, b $(a r.a))
|
|
-- ::py
|
|
:: :: ++ry
|
|
:::: ## rights/light :: rights algebra
|
|
:: ::::
|
|
++ ry
|
|
::
|
|
:: we need to be able to combine rights, and
|
|
:: track changes by taking differences between them.
|
|
::
|
|
:: ++ry must always crash when you try to make it
|
|
:: do something that makes no sense.
|
|
::
|
|
:: language compromises: the type system can't enforce
|
|
:: that lef and ryt match, hence the asserts.
|
|
::
|
|
=< |_ $: :: lef: old right
|
|
:: ryt: new right
|
|
::
|
|
lef/rite
|
|
ryt/rite
|
|
==
|
|
:: :: ++uni:ry
|
|
++ uni ~(sum +> lef ryt) :: add rights
|
|
:: :: ++dif:ry
|
|
++ dif :: r->l: {add remove}
|
|
^- (pair (unit rite) (unit rite))
|
|
[~(dif +> ryt lef) ~(dif +> lef ryt)]
|
|
:: :: ++sub:ry
|
|
++ sub :: l - r
|
|
^- (unit rite)
|
|
=/ vid dif
|
|
~| vid
|
|
?>(?=($~ q.vid) p.vid)
|
|
--
|
|
|_ $: :: lef: old right
|
|
:: ryt: new right
|
|
::
|
|
lef/rite
|
|
ryt/rite
|
|
==
|
|
:: :: ++sub-by:py
|
|
++ sub-by :: subtract elements
|
|
|* {new/(map) old/(map) sub/$-(^ *)} ^+ new
|
|
%- ~(rep by new)
|
|
|* {{key/* val/*} acc/_^+(new ~)}
|
|
=> .(+<- [key val]=+<-)
|
|
=/ var (~(get by old) key)
|
|
=. val ?~(var val (sub val u.var))
|
|
?~ val acc
|
|
(~(put by ,.acc) key val)
|
|
:: :: ++dif:ry
|
|
++ dif :: in r and not l
|
|
^- (unit rite)
|
|
|^ ?- -.lef
|
|
$apple ?>(?=($apple -.ryt) (table %apple p.lef p.ryt))
|
|
$block ?>(?=($block -.ryt) ~)
|
|
$email ?>(?=($email -.ryt) (sable %email p.lef p.ryt))
|
|
$final ?>(?=($final -.ryt) (table %final p.lef p.ryt))
|
|
$fungi ?>(?=($fungi -.ryt) (noble %fungi p.lef p.ryt))
|
|
$guest ?>(?=($guest -.ryt) ~)
|
|
$hotel ?>(?=($hotel -.ryt) (bible %hotel p.lef p.ryt))
|
|
$jewel ?>(?=($jewel -.ryt) (table %jewel p.lef p.ryt))
|
|
$login ?>(?=($login -.ryt) (sable %login p.lef p.ryt))
|
|
$pword ?>(?=($pword -.ryt) (ruble %pword p.lef p.ryt))
|
|
$token ?>(?=($token -.ryt) (ruble %token p.lef p.ryt))
|
|
$urban ?>(?=($urban -.ryt) (table %urban p.lef p.ryt))
|
|
==
|
|
:: :: ++cable:dif:ry
|
|
++ cable :: diff atom
|
|
|* {nut/@tas new/@ old/@}
|
|
^- (unit rite)
|
|
?: =(new old) ~
|
|
`[nut new]
|
|
:: :: ++bible:dif:ry
|
|
++ bible :: diff pile
|
|
|* {nut/@tas old/(map dorm pile) new/(map dorm pile)}
|
|
^- (unit rite)
|
|
=; mor/_new
|
|
?~(mor ~ `[nut mor])
|
|
%^ sub-by new old
|
|
|=({a/pile b/pile} (~(sub py a) b))
|
|
:: :: ++noble:dif:ry
|
|
++ noble :: diff map of @ud
|
|
|* {nut/@tas old/(map * @ud) new/(map * @ud)}
|
|
^- (unit rite)
|
|
=; mor/_new
|
|
?~(mor ~ `[nut mor])
|
|
%^ sub-by new old
|
|
|=({a/@u b/@u} (sub a (min a b)))
|
|
:: :: ++ruble:dif:ry
|
|
++ ruble :: diff map of maps
|
|
|* {nut/@tas old/(map * (map)) new/(map * (map))}
|
|
^- (unit rite)
|
|
=; mor/_new
|
|
?~(mor ~ `[nut mor])
|
|
%^ sub-by new old
|
|
=* valu (~(got by new))
|
|
|= {a/_^+(valu ~) b/_^+(valu ~)} ^+ a
|
|
(sub-by a b |*({a2/* b2/*} a2))
|
|
:: :: ++sable:dif:ry
|
|
++ sable :: diff set
|
|
|* {nut/@tas old/(set) new/(set)}
|
|
^- (unit rite)
|
|
=; mor ?~(mor ~ `[nut mor])
|
|
(~(dif in new) old)
|
|
:: :: ++table:dif:ry
|
|
++ table :: diff map
|
|
|* {nut/@tas old/(map) new/(map)}
|
|
^- (unit rite)
|
|
=; mor ?~(mor ~ `[nut mor])
|
|
(sub-by new old |*({a/* b/*} a))
|
|
-- ::dif
|
|
:: :: ++sum:ry
|
|
++ sum :: lef new, ryt old
|
|
^- rite
|
|
|^ ?- -.lef
|
|
$apple ?>(?=($apple -.ryt) [%apple (table p.lef p.ryt)])
|
|
$block ?>(?=($block -.ryt) [%block ~])
|
|
$email ?>(?=($email -.ryt) [%email (sable p.lef p.ryt)])
|
|
$final ?>(?=($final -.ryt) [%final (table p.lef p.ryt)])
|
|
$fungi ?>(?=($fungi -.ryt) [%fungi (noble p.lef p.ryt)])
|
|
$guest ?>(?=($guest -.ryt) [%guest ~])
|
|
$hotel ?>(?=($hotel -.ryt) [%hotel (bible p.lef p.ryt)])
|
|
$jewel ?>(?=($jewel -.ryt) [%jewel (table p.lef p.ryt)])
|
|
$login ?>(?=($login -.ryt) [%login (sable p.lef p.ryt)])
|
|
$pword ?>(?=($pword -.ryt) [%pword (ruble p.lef p.ryt)])
|
|
$token ?>(?=($token -.ryt) [%token (ruble p.lef p.ryt)])
|
|
$urban ?>(?=($urban -.ryt) [%urban (table p.lef p.ryt)])
|
|
==
|
|
:: :: ++bible:uni:ry
|
|
++ bible :: union pile
|
|
|= {new/(map dorm pile) old/(map dorm pile)}
|
|
^+ new
|
|
%- (~(uno by old) new)
|
|
|= (trel dorm pile pile)
|
|
(~(uni py q) r)
|
|
:: :: ++noble:uni:ry
|
|
++ noble :: union map of @ud
|
|
|= {new/(map term @ud) old/(map term @ud)}
|
|
^+ new
|
|
%- (~(uno by old) new)
|
|
|= (trel term @ud @ud)
|
|
(add q r)
|
|
:: :: ++ruble:uni:ry
|
|
++ ruble :: union map of maps
|
|
|= {new/(map site (map @t @t)) old/(map site (map @t @t))}
|
|
^+ new
|
|
%- (~(uno by old) new)
|
|
|= (trel site (map @t @t) (map @t @t))
|
|
%- (~(uno by q) r)
|
|
|= (trel @t @t @t)
|
|
?>(=(q r) r)
|
|
:: :: ++sable:uni:ry
|
|
++ sable :: union set
|
|
|* {new/(set) old/(set)}
|
|
^+ new
|
|
(~(uni in old) new)
|
|
:: :: ++table:uni:ry
|
|
++ table :: union map
|
|
|* {new/(map) old/(map)}
|
|
^+ new
|
|
%- (~(uno by old) new)
|
|
|= (trel _p.-<.new _q.->.new _q.->.new)
|
|
?>(=(q r) r)
|
|
-- ::uni
|
|
-- ::ry
|
|
:: :: ++up
|
|
:::: ## wallet^light :: wallet algebra
|
|
:: ::::
|
|
++ up
|
|
:: a set of rites is stored as a tree (++safe), sorted
|
|
:: by ++gor on the stem, balanced by ++mor on the stem.
|
|
:: (this is essentially a ++map with stem as key, but
|
|
:: ++map doesn't know how to link stem and bulb types.)
|
|
:: the goal of the design is to make it easy to add new
|
|
:: kinds of rite without a state adapter.
|
|
::
|
|
:: wallet operations always crash if impossible;
|
|
:: %jael has no concept of negative rights.
|
|
::
|
|
:: performance issues: ++differ and ++splice, naive.
|
|
::
|
|
:: external issues: much copy and paste from ++by. it
|
|
:: would be nice to resolve this somehow, but not urgent.
|
|
::
|
|
:: language issues: if hoon had an equality test
|
|
:: that informed inference, ++expose could be
|
|
:: properly inferred, eliminating the ?>.
|
|
::
|
|
|_ pig/safe
|
|
:: :: ++delete:up
|
|
++ delete :: delete right
|
|
|= ryt/rite
|
|
^- safe
|
|
?~ pig
|
|
~
|
|
?. =(-.ryt -.n.pig)
|
|
?: (gor -.ryt -.n.pig)
|
|
[n.pig $(pig l.pig) r.pig]
|
|
[n.pig l.pig $(pig r.pig)]
|
|
=/ dub ~(sub ry n.pig ryt)
|
|
?^ dub [u.dub l.pig r.pig]
|
|
|- ^- safe
|
|
?~ l.pig r.pig
|
|
?~ r.pig l.pig
|
|
?: (mor -.n.l.pig -.n.r.pig)
|
|
[n.l.pig l.l.pig $(l.pig r.l.pig)]
|
|
[n.r.pig $(r.pig l.r.pig) r.r.pig]
|
|
:: :: ++differ:up
|
|
++ differ :: delta pig->gob
|
|
|= gob/safe
|
|
^- bump
|
|
|^ [way way(pig gob, gob pig)]
|
|
++ way
|
|
%- intern(pig ~)
|
|
%+ skip linear(pig gob)
|
|
|=(rite (~(has in pig) +<))
|
|
--
|
|
:: :: ++exists:up
|
|
++ exists :: test presence
|
|
|= tag/@tas
|
|
!=(~ (expose tag))
|
|
:: :: ++expose:up
|
|
++ expose :: typed extract
|
|
|= tag/@tas
|
|
^- (unit rite)
|
|
?~ pig ~
|
|
?: =(tag -.n.pig)
|
|
[~ u=n.pig]
|
|
?:((gor tag -.n.pig) $(pig l.pig) $(pig r.pig))
|
|
:: :: ++insert:up
|
|
++ insert :: insert item
|
|
|= ryt/rite
|
|
^- safe
|
|
?~ pig
|
|
[ryt ~ ~]
|
|
?: =(-.ryt -.n.pig)
|
|
[~(uni ry ryt n.pig) l.pig r.pig]
|
|
?: (gor -.ryt -.n.pig)
|
|
=. l.pig $(pig l.pig)
|
|
?> ?=(^ l.pig)
|
|
?: (mor -.n.pig -.n.l.pig)
|
|
[n.pig l.pig r.pig]
|
|
[n.l.pig l.l.pig [n.pig r.l.pig r.pig]]
|
|
=. r.pig $(pig r.pig)
|
|
?> ?=(^ r.pig)
|
|
?: (mor -.n.pig -.n.r.pig)
|
|
[n.pig l.pig r.pig]
|
|
[n.r.pig [n.pig l.pig l.r.pig] r.r.pig]
|
|
:: :: ++intern:up
|
|
++ intern :: insert list
|
|
|= lin/(list rite)
|
|
^- safe
|
|
?~ lin pig
|
|
=. pig $(lin t.lin)
|
|
(insert i.lin)
|
|
:: :: ++linear:up
|
|
++ linear :: convert to list
|
|
=| lin/(list rite)
|
|
|- ^+ lin
|
|
?~ pig ~
|
|
$(pig r.pig, lin [n.pig $(pig l.pig)])
|
|
:: :: ++redact:up
|
|
++ redact :: conceal secrets
|
|
|- ^- safe
|
|
?~ pig ~
|
|
:_ [$(pig l.pig) $(pig r.pig)]
|
|
=* rys n.pig
|
|
^- rite
|
|
?+ -.rys rys
|
|
$apple
|
|
[%apple (~(run by p.rys) |=(@ (shax +<)))]
|
|
::
|
|
$final
|
|
[%final (~(run by p.rys) |=(@ (shax +<)))]
|
|
::
|
|
$login
|
|
[%login ~]
|
|
::
|
|
$pword
|
|
:- %pword
|
|
%- ~(run by p.rys)
|
|
|= (map @ta @t)
|
|
(~(run by +<) |=(@t (fil 3 (met 3 +<) '*')))
|
|
::
|
|
$jewel
|
|
[%jewel (~(run by p.rys) |=(@ (shax +<)))]
|
|
::
|
|
$token
|
|
:- %token
|
|
%- ~(run by p.rys)
|
|
|=((map @ta @) (~(run by +<) |=(@ (shax +<))))
|
|
::
|
|
$urban
|
|
[%urban (~(run by p.rys) |=({@da code:ames} [+<- (shax +<+)]))]
|
|
==
|
|
:: :: ++remove:up
|
|
++ remove :: pig minus gob
|
|
|= gob/safe
|
|
^- safe
|
|
=/ buv ~(tap by gob)
|
|
|- ?~ buv pig
|
|
$(buv t.buv, pig (delete i.buv))
|
|
:: :: ++splice:up
|
|
++ splice :: pig plus gob
|
|
|= gob/safe
|
|
^- safe
|
|
=/ buv ~(tap by gob)
|
|
|- ?~ buv pig
|
|
$(buv t.buv, pig (insert i.buv))
|
|
:: :: ++update:up
|
|
++ update :: arbitrary change
|
|
|= del/bump
|
|
^- safe
|
|
(splice(pig (remove les.del)) mor.del)
|
|
--
|
|
:: :: ++ez
|
|
:::: ## ethereum^light :: wallet algebra
|
|
:: ::::
|
|
++ ez
|
|
:: simple ethereum-related utility arms.
|
|
::
|
|
|%
|
|
::
|
|
:: +order-events: sort changes by block and log numbers
|
|
::
|
|
++ order-events
|
|
|= loz=(list (pair event-id diff-azimuth))
|
|
^+ loz
|
|
%+ sort loz
|
|
:: sort by block number, then by event log number,
|
|
::TODO then by diff priority.
|
|
|= [[[b1=@ud l1=@ud] *] [[b2=@ud l2=@ud] *]]
|
|
?. =(b1 b2) (lth b1 b2)
|
|
?. =(l1 l2) (lth l1 l2)
|
|
&
|
|
--
|
|
--
|
|
:: ::::
|
|
:::: # heavy :: heavy engines
|
|
:: ::::
|
|
=> |%
|
|
:: :: ++of
|
|
:::: ## main^heavy :: main engine
|
|
:: ::::
|
|
++ of
|
|
:: this core handles all top-level %jael semantics,
|
|
:: changing state and recording moves.
|
|
::
|
|
:: logically we could nest the ++su and ++ur cores
|
|
:: within it, but we keep them separated for clarity.
|
|
:: the ++curd and ++cure arms complete relative and
|
|
:: absolute effects, respectively, at the top level.
|
|
::
|
|
:: a general pattern here is that we use the ++ur core
|
|
:: to generate absolute effects (++change), then invoke
|
|
:: ++su to calculate the derived effect of these changes.
|
|
::
|
|
:: for ethereum-related events, this is preceded by
|
|
:: invocation of ++et, which produces ethereum-level
|
|
:: changes (++chain). these get turned into absolute
|
|
:: effects by ++cute.
|
|
::
|
|
:: arvo issues: should be merged with the top-level
|
|
:: vane interface when that gets cleaned up a bit.
|
|
::
|
|
=| moz/(list move)
|
|
=| $: $: :: our: identity
|
|
:: now: current time
|
|
:: eny: unique entropy
|
|
::
|
|
our=ship
|
|
now=@da
|
|
eny=@uvJ
|
|
==
|
|
:: all vane state
|
|
::
|
|
state
|
|
==
|
|
:: lex: all durable state
|
|
:: moz: pending actions
|
|
::
|
|
=* lex ->
|
|
|%
|
|
:: :: ++abet:of
|
|
++ abet :: resolve
|
|
[(flop moz) lex]
|
|
:: :: ++burb:of
|
|
++ burb :: per ship
|
|
|= who/ship
|
|
~(able ~(ex ur urb) who)
|
|
:: :: ++scry:of
|
|
++ scry :: read
|
|
|= {syd/@tas pax/path}
|
|
~| %jael-scry-of-stub
|
|
=^ mar pax =/(a (flop pax) [-.a (flop t.+.a)])
|
|
!!
|
|
:: :: ++sein:of
|
|
++ sein :: sponsor
|
|
|= who=ship
|
|
^- ship
|
|
:: XX save %dawn sponsor in .own.sub, check there
|
|
::
|
|
=/ pot (~(get by pos.eth.sub) who)
|
|
?: ?& ?=(^ pot)
|
|
?=(^ net.u.pot)
|
|
==
|
|
who.sponsor.u.net.u.pot
|
|
(^sein:title who)
|
|
:: :: ++saxo:of
|
|
++ saxo :: sponsorship chain
|
|
|= who/ship
|
|
^- (list ship)
|
|
=/ dad (sein who)
|
|
[who ?:(=(who dad) ~ $(who dad))]
|
|
:: :: ++call:of
|
|
++ call :: invoke
|
|
|= $: :: hen: event cause
|
|
:: tac: event data
|
|
::
|
|
hen/duct
|
|
tac/task
|
|
==
|
|
^+ +>
|
|
?- -.tac
|
|
::
|
|
:: destroy promises
|
|
:: {$burn p/ship q/safe}
|
|
::
|
|
$burn
|
|
%+ cure hen
|
|
abet:abet:(deal:(burb our) p.tac [~ q.tac])
|
|
::
|
|
:: boot from keys
|
|
:: $: $dawn
|
|
:: =seed
|
|
:: spon=ship
|
|
:: czar=(map ship [=life =pass])
|
|
:: turf=(list turf)}
|
|
:: bloq=@ud
|
|
:: node=purl
|
|
:: ==
|
|
::
|
|
%dawn
|
|
:: single-homed
|
|
::
|
|
?> =(our who.seed.tac)
|
|
:: save our boot block
|
|
::
|
|
=. boq.own.sub bloq.tac
|
|
:: save our ethereum gateway (required for galaxies)
|
|
::
|
|
=. nod.own.sub node.tac
|
|
:: save our parent signature (only for moons)
|
|
::
|
|
=. sig.own.sub sig.seed.tac
|
|
:: if we're given a snapshot, restore it
|
|
::
|
|
=. +>.$
|
|
?~ snap.tac +>.$
|
|
(restore-snap hen u.snap.tac |)
|
|
:: load our initial public key, overriding snapshot
|
|
::
|
|
=. kyz.puk.sub
|
|
=/ cub (nol:nu:crub:crypto key.seed.tac)
|
|
%+ ~(put by kyz.puk.sub)
|
|
our
|
|
[lyf.seed.tac (my [lyf.seed.tac pub:ex:cub] ~)]
|
|
:: our initial private key, as a +tree of +rite
|
|
::
|
|
=/ rit (sy [%jewel (my [lyf.seed.tac key.seed.tac] ~)] ~)
|
|
=. +>.$ $(tac [%mint our rit])
|
|
:: our initial galaxy table as a +map from +life to +public
|
|
::
|
|
=/ kyz
|
|
%- ~(run by czar.tac)
|
|
|=([=life =pass] `public`[life (my [life pass] ~)])
|
|
=. +>.$
|
|
%- curd =< abet
|
|
(pubs:~(feel su hen our urb sub etn sap) kyz)
|
|
:: XX save sponsor in .own.sub
|
|
:: XX reconcile with .dns.eth
|
|
:: set initial domains
|
|
::
|
|
=. tuf.own.sub turf.tac
|
|
::
|
|
=. moz
|
|
%+ weld moz
|
|
:: order is crucial!
|
|
::
|
|
:: %dill must init after %gall
|
|
:: the %give init (for unix) must be after %dill init
|
|
:: %jael init must be deferred (makes http requests)
|
|
::
|
|
^- (list move)
|
|
:~ [hen %pass /(scot %p our)/init %b %wait +(now)]
|
|
[hen %give %init our]
|
|
[hen %slip %r %init our]
|
|
[hen %slip %d %init our]
|
|
[hen %slip %g %init our]
|
|
[hen %slip %c %init our]
|
|
[hen %slip %a %init our]
|
|
==
|
|
+>.$
|
|
::
|
|
:: boot fake
|
|
:: [%fake =ship]
|
|
::
|
|
%fake
|
|
:: single-homed
|
|
::
|
|
?> =(our ship.tac)
|
|
:: fake keys are deterministically derived from the ship
|
|
::
|
|
=/ cub (pit:nu:crub:crypto 512 our)
|
|
:: save our parent signature (only for moons)
|
|
::
|
|
:: XX move logic to zuse
|
|
::
|
|
=. sig.own.sub
|
|
?. ?=(%earl (clan:title our))
|
|
~
|
|
=/ yig (pit:nu:crub:crypto 512 (^sein:title our))
|
|
[~ (sign:as:yig (shaf %earl (sham our 1 pub:ex:cub)))]
|
|
:: our initial public key
|
|
::
|
|
=. kyz.puk.sub
|
|
(~(put by kyz.puk.sub) our [1 (my [1 pub:ex:cub] ~)])
|
|
:: our private key, as a +tree of +rite
|
|
::
|
|
:: Private key updates are disallowed for fake ships,
|
|
:: so we do this first.
|
|
::
|
|
=/ rit (sy [%jewel (my [1 sec:ex:cub] ~)] ~)
|
|
=. +>.$ $(tac [%mint our rit])
|
|
:: set the fake bit
|
|
::
|
|
=. fak.own.sub &
|
|
:: initialize other vanes per the usual procedure
|
|
::
|
|
:: Except for ourselves!
|
|
::
|
|
=. moz
|
|
%+ weld moz
|
|
^- (list move)
|
|
:~ [hen %give %init our]
|
|
[hen %slip %r %init our]
|
|
[hen %slip %d %init our]
|
|
[hen %slip %g %init our]
|
|
[hen %slip %c %init our]
|
|
[hen %slip %a %init our]
|
|
==
|
|
+>.$
|
|
::
|
|
:: remote update
|
|
:: {$hail p/ship q/remote}
|
|
::
|
|
$hail
|
|
%+ cure hen
|
|
abet:abet:(hail:(burb our) p.tac q.tac)
|
|
::
|
|
:: set ethereum source
|
|
:: [%look p=(each ship purl)]
|
|
::
|
|
%look
|
|
%+ cute hen =< abet
|
|
(~(look et hen our now urb.lex sub.lex etn.lex sap.lex) src.tac)
|
|
::
|
|
:: create promises
|
|
:: {$mint p/ship q/safe}
|
|
::
|
|
$mint
|
|
~| %fake-jael
|
|
?< ?& fak.own.sub
|
|
(~(exists up q.tac) %jewel)
|
|
==
|
|
%+ cure hen
|
|
abet:abet:(deal:(burb our) p.tac [q.tac ~])
|
|
::
|
|
::
|
|
:: move promises
|
|
:: {$move p/ship q/ship r/safe}
|
|
::
|
|
$move
|
|
=. +>
|
|
%+ cure hen
|
|
abet:abet:(deal:(burb our) p.tac [~ r.tac])
|
|
=. +>
|
|
%+ cure hen
|
|
abet:abet:(deal:(burb our) q.tac [r.tac ~])
|
|
+>
|
|
::
|
|
:: cancel all trackers from duct
|
|
:: {$nuke $~}
|
|
::
|
|
$nuke
|
|
%_ +>
|
|
yen (~(del in yen) hen)
|
|
yen.bal.sub (~(del in yen.bal.sub) hen)
|
|
yen.own.sub (~(del in yen.own.sub) hen)
|
|
yen.eth.sub (~(del in yen.eth.sub) hen)
|
|
==
|
|
::
|
|
:: watch public keys
|
|
:: [%pubs =ship]
|
|
::
|
|
%pubs
|
|
%- curd =< abet
|
|
(~(pubs ~(feed su hen our urb sub etn sap) hen) ship.tac)
|
|
::
|
|
:: seen after breach
|
|
:: [%meet our=ship who=ship]
|
|
::
|
|
%meet
|
|
%+ cure hen
|
|
[[%meet ship.tac life.tac pass.tac]~ urb]
|
|
::
|
|
:: restore snapshot
|
|
:: [%snap snap=snapshot kick=?]
|
|
%snap
|
|
(restore-snap hen snap.tac kick.tac)
|
|
::
|
|
:: XX should be a subscription
|
|
:: XX reconcile with .dns.eth
|
|
:: request domains
|
|
:: [%turf ~]
|
|
::
|
|
%turf
|
|
:: ships with real keys must have domains,
|
|
:: those with fake keys must not
|
|
::
|
|
?< =(fak.own.sub ?=(^ tuf.own.sub))
|
|
+>.$(moz [[hen %give %turf tuf.own.sub] moz])
|
|
::
|
|
:: learn of kernel upgrade
|
|
:: [%vega ~]
|
|
::
|
|
%vega
|
|
+>.$
|
|
::
|
|
:: watch private keys
|
|
:: {$vein $~}
|
|
::
|
|
$vein
|
|
(curd abet:~(vein ~(feed su hen our urb sub etn sap) hen))
|
|
::
|
|
:: watch ethereum events
|
|
:: [%vent ~]
|
|
::
|
|
%vent
|
|
=. moz [[hen %give %mack ~] moz]
|
|
(curd abet:~(vent ~(feed su hen our urb sub etn sap) hen))
|
|
::
|
|
:: monitor assets
|
|
:: {$vest $~}
|
|
::
|
|
$vest
|
|
(curd abet:~(vest ~(feed su hen our urb sub etn sap) hen))
|
|
::
|
|
:: monitor all
|
|
:: {$vine $~}
|
|
::
|
|
$vine
|
|
+>(yen (~(put in yen) hen))
|
|
::
|
|
%wegh
|
|
%_ +>
|
|
moz
|
|
:_ moz
|
|
^- move
|
|
:^ hen %give %mass
|
|
^- mass
|
|
:+ %jael %|
|
|
:~ yen+&+yen
|
|
urb+&+urb
|
|
sub+&+sub
|
|
etn+&+etn
|
|
sap+&+sap
|
|
dot+&+lex
|
|
==
|
|
==
|
|
::
|
|
:: authenticated remote request
|
|
:: {$west p/ship q/path r/*}
|
|
::
|
|
$west
|
|
=* her p.tac
|
|
=/ mes (message r.tac)
|
|
?- -.mes
|
|
::
|
|
:: reset remote rights
|
|
:: [%hail p=remote]
|
|
::
|
|
%hail
|
|
%+ cure hen
|
|
abet:abet:(hail:(burb our) her p.mes)
|
|
::
|
|
:: cancel trackers
|
|
:: [%nuke ~]
|
|
::
|
|
%nuke
|
|
$(tac mes)
|
|
::
|
|
:: view ethereum events
|
|
:: [%vent ~]
|
|
::
|
|
%vent
|
|
$(tac [%vent ~])
|
|
::
|
|
::
|
|
%vent-result
|
|
:: ignore if not from currently configured source.
|
|
?. &(-.source.etn =(her p.source.etn))
|
|
+>.$
|
|
=. moz [[hen %give %mack ~] moz]
|
|
%+ cute hen =< abet
|
|
(~(hear-vent et hen our now urb.lex sub.lex etn.lex sap.lex) p.mes)
|
|
==
|
|
::
|
|
:: rewind to snapshot
|
|
:: {$wind p/@ud}
|
|
::
|
|
%wind
|
|
(wind hen p.tac)
|
|
==
|
|
::
|
|
++ take
|
|
|= [tea=wire hen=duct hin=sign]
|
|
^+ +>
|
|
?> ?=([@ *] tea)
|
|
=* wir t.tea
|
|
?- hin
|
|
[%a %woot *]
|
|
?~ q.hin +>.$
|
|
?~ u.q.hin ~&(%ares-fine +>.$)
|
|
~& [%woot-bad p.u.u.q.hin]
|
|
~_ q.u.u.q.hin
|
|
::TODO fail:et
|
|
+>.$
|
|
::
|
|
[%e %sigh *]
|
|
%+ cute hen =< abet
|
|
(~(sigh et hen our now urb.lex sub.lex etn.lex sap.lex) wir p.hin)
|
|
::
|
|
[%b %wake ~]
|
|
%+ cute hen
|
|
:: XX cleanup
|
|
::
|
|
?. ?=([%init ~] wir)
|
|
abet:~(wake et hen our now urb.lex sub.lex etn.lex sap.lex)
|
|
abet:(~(init et hen our now [urb sub etn sap]:lex) our (sein our))
|
|
::
|
|
[%j %vent *]
|
|
%+ cute hen =< abet
|
|
(~(hear-vent et hen our now urb.lex sub.lex etn.lex sap.lex) p.hin)
|
|
==
|
|
:: :: ++curd:of
|
|
++ curd :: relative moves
|
|
|= $: moz/(list move)
|
|
sub/state-relative
|
|
etn/state-eth-node
|
|
sap/state-snapshots
|
|
==
|
|
+>(sub sub, etn etn, sap sap, moz (weld (flop moz) ^moz))
|
|
:: :: ++cure:of
|
|
++ cure :: absolute edits
|
|
|= [hen=duct hab=(list change) urb=state-absolute]
|
|
^+ +>
|
|
=. ^urb urb
|
|
(curd abet:(~(apex su hen our urb sub etn sap) hab))
|
|
:: :: ++cute:of
|
|
++ cute :: ethereum changes
|
|
|= $: hen=duct
|
|
mos=(list move)
|
|
ven=chain
|
|
urb=state-absolute
|
|
sub=state-relative
|
|
etn=state-eth-node
|
|
sap=state-snapshots
|
|
==
|
|
^+ +>
|
|
=: ^urb urb
|
|
^sub sub
|
|
^etn etn
|
|
^sap sap
|
|
==
|
|
%- cure(moz (weld (flop mos) moz))
|
|
[hen abet:(link:(burb our) ven)]
|
|
:: :: ++wind:of
|
|
++ wind :: rewind to snap
|
|
|= [hen=duct block=@ud]
|
|
^+ +>
|
|
=. +>.$ (restore-block hen block)
|
|
%= +>.$
|
|
moz
|
|
=- [[hen %pass /wind/look %j %look -] moz]
|
|
?- -.source.etn
|
|
%& &+p.source.etn
|
|
%| |+node.p.source.etn
|
|
==
|
|
==
|
|
:: :: ++restore-block:of
|
|
++ restore-block :: rewind before block
|
|
|= [hen=duct block=@ud]
|
|
%+ cute hen =< abet
|
|
(~(restore-block et hen our now urb.lex sub.lex etn.lex sap.lex) block)
|
|
:: :: ++restore-snap:of
|
|
++ restore-snap :: restore snapshot
|
|
|= [hen=duct snap=snapshot look=?]
|
|
%+ cute hen =< abet
|
|
%- ~(restore-snap et hen our now urb.lex sub.lex etn.lex sap.lex)
|
|
[snap look]
|
|
--
|
|
:: :: ++su
|
|
:::: ## relative^heavy :: subjective engine
|
|
:: ::::
|
|
++ su
|
|
:: the ++su core handles all derived state,
|
|
:: subscriptions, and actions.
|
|
::
|
|
:: ++feed:su registers subscriptions.
|
|
::
|
|
:: ++feel:su checks if a ++change should notify
|
|
:: any subscribers.
|
|
::
|
|
:: ++fire:su generates outgoing network messages.
|
|
::
|
|
:: ++form:su generates the actual report data.
|
|
::
|
|
=| moz/(list move)
|
|
=| evs=logs
|
|
=| $: hen/duct
|
|
our/ship
|
|
state-absolute
|
|
state-relative
|
|
state-eth-node
|
|
state-snapshots
|
|
==
|
|
:: moz: moves in reverse order
|
|
:: urb: absolute urbit state
|
|
:: sub: relative urbit state
|
|
::
|
|
=* urb ->+<
|
|
=* sub ->+>-
|
|
=* etn ->+>+<
|
|
=* sap ->+>+>
|
|
|%
|
|
:: :: ++abet:su
|
|
++ abet :: resolve
|
|
::TODO we really want to just send the %give, but ames is being a pain.
|
|
:: => (exec yen.eth [%give %vent |+evs])
|
|
=> ?~ evs .
|
|
(vent-pass yen.eth chain+|+evs)
|
|
[(flop moz) sub etn sap]
|
|
:: :: ++apex:su
|
|
++ apex :: apply changes
|
|
|= hab/(list change)
|
|
^+ +>
|
|
?~ hab +>
|
|
%= $
|
|
hab t.hab
|
|
+>
|
|
?- -.i.hab
|
|
%ethe (file can.i.hab)
|
|
%meet (meet +.i.hab)
|
|
%rite (paid +.i.hab)
|
|
==
|
|
==
|
|
:: :: ++exec:su
|
|
++ exec :: mass gift
|
|
|= {yen/(set duct) cad/card}
|
|
=/ noy ~(tap in yen)
|
|
|- ^+ ..exec
|
|
?~ noy ..exec
|
|
$(noy t.noy, moz [[i.noy cad] moz])
|
|
::
|
|
++ vent-pass
|
|
|= [yen=(set duct) res=vent-result]
|
|
=+ yez=~(tap in yen)
|
|
|- ^+ ..vent-pass
|
|
?~ yez ..vent-pass
|
|
=* d i.yez
|
|
?> ?=([[%a @ @ *] *] d)
|
|
=+ our=(slav %p i.t.i.d)
|
|
=+ who=(slav %p i.t.t.i.d)
|
|
%+ exec [d ~ ~]
|
|
:+ %pass
|
|
/(scot %p our)/vent-result
|
|
^- note:able
|
|
[%a %want who /j/(scot %p our)/vent-result %vent-result res]
|
|
::
|
|
++ extract-snap :: extract rewind point
|
|
^- snapshot
|
|
:* kyz.puk.sub
|
|
[dns pos]:eth.sub
|
|
heard.etn
|
|
latest-block.etn
|
|
==
|
|
:: :: ++feed:su
|
|
++ feed :: subscribe to view
|
|
|_ :: hen: subscription source
|
|
::
|
|
hen/duct
|
|
::
|
|
++ pubs
|
|
|= who=ship
|
|
?: fak.own.sub
|
|
(pubs:fake who)
|
|
%_ ..feed
|
|
moz =/ pub (~(get by kyz.puk) who)
|
|
?~ pub moz
|
|
?: =(0 life.u.pub) moz
|
|
[[hen %give %pubs u.pub] moz]
|
|
yen.puk (~(put ju yen.puk) who hen)
|
|
==
|
|
:: :: ++vein:feed:su
|
|
++ vein :: private keys
|
|
%_ ..feed
|
|
moz [[hen %give %vein [lyf jaw]:own] moz]
|
|
yen.own (~(put in yen.own) hen)
|
|
==
|
|
:: :: ++vest:feed:su
|
|
++ vest :: balance
|
|
%_ ..feed
|
|
moz [[hen %give %vest %& vest:form] moz]
|
|
yen.bal (~(put in yen.bal) hen)
|
|
==
|
|
::
|
|
++ vent
|
|
=/ last-snap extract-snap
|
|
%. [[hen ~ ~] snap+last-snap]
|
|
%_ vent-pass
|
|
:: %_ ..feed ::TODO see ++abet
|
|
:: moz [[hen %give %vent] moz]
|
|
yen.eth (~(put in yen.eth) hen)
|
|
==
|
|
:: :: ++fake:feed:su
|
|
++ fake :: fake subs and state
|
|
?> fak.own.sub
|
|
|%
|
|
++ pubs
|
|
|= who=ship
|
|
=/ cub (pit:nu:crub:crypto 512 who)
|
|
=/ pub [life=1 (my [1 pub:ex:cub] ~)]
|
|
=. moz [[hen %give %pubs pub] moz]
|
|
(pubs:feel (my [who pub] ~))
|
|
--
|
|
--
|
|
:: :: ++feel:su
|
|
++ feel :: update tracker
|
|
|%
|
|
:: :: ++pubs:feel:su
|
|
++ pubs :: kick public keys
|
|
:: puz: new public key states
|
|
::
|
|
|= puz=(map ship public)
|
|
=/ pus ~(tap by puz)
|
|
::
|
|
:: process change for each ship separately
|
|
:: XX check for diffs before sending?
|
|
::
|
|
|- ^+ ..feel
|
|
?~ pus ..feel
|
|
=; fel $(pus t.pus, ..feel fel)
|
|
=* who p.i.pus
|
|
=* pub q.i.pus
|
|
::
|
|
:: update public key store and notify subscribers
|
|
:: of the new state
|
|
::
|
|
:: ~& [%sending-pubs-about who life.pub]
|
|
%+ exec(kyz.puk (~(put by kyz.puk) who pub))
|
|
(~(get ju yen.puk) who)
|
|
[%give %pubs pub]
|
|
:: :: ++vein:feel:su
|
|
++ vein :: kick private keys
|
|
^+ ..feel
|
|
=/ yam vein:form
|
|
?: &(=(lyf.own p.yam) =(jaw.own q.yam))
|
|
..feel
|
|
=. lyf.own p.yam
|
|
=. jaw.own q.yam
|
|
(exec yen.own [%give %vein lyf.own jaw.own])
|
|
:: :: ++vest:feel:su
|
|
++ vest :: kick balance
|
|
|= hug/action
|
|
^+ ..feel
|
|
?: =([~ ~] +.q.hug) ..feel
|
|
::
|
|
:: notify all local listeners
|
|
::
|
|
=. ..feel (exec yen.bal [%give %vest %| p.hug q.hug])
|
|
::
|
|
:: pig: purse report for partner
|
|
::
|
|
?. ?=(%| -.q.hug) ..feel
|
|
=* pig (~(lawn ur urb) our p.hug)
|
|
%_ ..feel
|
|
moz
|
|
:_ moz
|
|
:^ *duct %pass /vest/(scot %p p.hug)
|
|
:+ %a %want
|
|
:+ p.hug /j
|
|
^- message
|
|
[%hail |+pig]
|
|
==
|
|
::
|
|
++ vent
|
|
|= ver=vent-result
|
|
^+ ..feel
|
|
::TODO see ++abet
|
|
:: (exec yen.eth [%give %vent can])
|
|
(vent-pass yen.eth ver)
|
|
--
|
|
:: :: ++form:su
|
|
++ form :: generate reports
|
|
|%
|
|
:: :: ++vein:form:su
|
|
++ vein :: private key report
|
|
^- (pair life (map life ring))
|
|
(~(lean ur urb) our)
|
|
:: :: ++vest:form:su
|
|
++ vest :: balance report
|
|
^- balance
|
|
:- ::
|
|
:: raw: all our liabilities by ship
|
|
:: dud: delete liabilities to self
|
|
:: cul: mask secrets
|
|
::
|
|
=* raw =-(?~(- ~ u.-) (~(get by pry.urb) our))
|
|
=* dud (~(del by raw) our)
|
|
=* cul (~(run by dud) |=(safe ~(redact up +<)))
|
|
cul
|
|
::
|
|
:: fub: all assets by ship
|
|
:: veg: all nontrivial assets, secrets masked
|
|
::
|
|
=/ fub
|
|
^- (list (pair ship (unit safe)))
|
|
%+ turn
|
|
~(tap by pry.urb)
|
|
|= (pair ship (map ship safe))
|
|
[p (~(get by q) our)]
|
|
=* veg
|
|
|- ^- (list (pair ship safe))
|
|
?~ fub ~
|
|
=+ $(fub t.fub)
|
|
?~(q.i.fub - [[p.i.fub ~(redact up u.q.i.fub)] -])
|
|
::
|
|
(~(gas by *(map ship safe)) veg)
|
|
--
|
|
:: :: ++paid:su
|
|
++ paid :: track asset change
|
|
|= $: :: rex: promise from
|
|
:: pal: promise to
|
|
:: del: change to existing
|
|
::
|
|
rex/ship
|
|
pal/ship
|
|
del/bump
|
|
==
|
|
^+ +>
|
|
:: ignore empty delta; keep secrets out of metadata
|
|
::
|
|
?: =([~ ~] del) +>
|
|
=. del [~(redact up mor.del) ~(redact up les.del)]
|
|
?. =(our pal)
|
|
::
|
|
:: track promises we made to others
|
|
::
|
|
?. =(our rex) +>
|
|
::
|
|
:: track liabilities
|
|
::
|
|
(vest:feel pal %& del)
|
|
::
|
|
:: track private keys
|
|
::
|
|
?. (~(exists up mor.del) %jewel) +>
|
|
vein:feel
|
|
:: :: ++meet:su
|
|
++ meet :: seen after breach
|
|
|= [who=ship =life =pass]
|
|
^+ +>
|
|
=; new=public
|
|
(pubs:feel (my [who new] ~))
|
|
::
|
|
=/ old=(unit public)
|
|
(~(get by kyz.puk) who)
|
|
?: ?| ?=(?(%earl %pawn) (clan:title who))
|
|
:: XX save %dawn sponsor in .own.sub, check there
|
|
:: XX or move sein:of to sein:su?
|
|
:: XX full saxo chain?
|
|
::
|
|
=(who (^sein:title our))
|
|
==
|
|
?~ old
|
|
[life (my [life pass] ~)]
|
|
=/ fyl life.u.old
|
|
=/ sap (~(got by pubs.u.old) fyl)
|
|
~| [%met-mismatch who life=[old=fyl new=life] pass=[old=sap new=pass]]
|
|
?> ?: =(fyl life)
|
|
=(sap pass)
|
|
=(+(fyl) life)
|
|
[life (~(put by pubs.u.old) life pass)]
|
|
?. ?=(^ old)
|
|
~| [%met-unknown-ship who] !!
|
|
=/ fyl life.u.old
|
|
=/ sap (~(got by pubs.u.old) fyl)
|
|
~| [%met-mismatch who life=[old=fyl new=life] pass=[old=sap new=pass]]
|
|
?> &(=(fyl life) =(sap pass))
|
|
[life pubs.u.old]
|
|
:: :: ++file:su
|
|
++ file :: process event logs
|
|
::TODO whenever we add subscriptions for data,
|
|
:: outsource the updating of relevant state
|
|
:: to a ++feel arm.
|
|
|= [new=? evs=logs]
|
|
^+ +>
|
|
=? +> new
|
|
::TODO should we be mutating state here,
|
|
:: or better to move this into ++vent:feel?
|
|
+>(dns.eth *dnses, pos.eth ~, kyz.puk ~)
|
|
=? +> |(new !=(0 ~(wyt by evs)))
|
|
%- vent:feel
|
|
:- %chain
|
|
?:(new &+evs |+evs)
|
|
::
|
|
=+ vez=(order-events:ez ~(tap by evs))
|
|
=| kyz=(map ship public)
|
|
|^ ?~ vez (pubs:feel kyz)
|
|
=^ kyn ..file (file-event i.vez)
|
|
$(vez t.vez, kyz kyn)
|
|
::
|
|
++ get-public
|
|
|= who=ship
|
|
^- public
|
|
%+ fall (~(get by kyz) who)
|
|
::NOTE we can only do this because ++pubs:feel
|
|
:: sends out entire new state, rather than
|
|
:: just the processed changes.
|
|
%+ fall (~(get by kyz.puk) who)
|
|
*public
|
|
::
|
|
++ file-keys
|
|
|= [who=ship =life =pass]
|
|
^+ kyz
|
|
=/ pub (get-public who)
|
|
=/ puk (~(get by pubs.pub) life)
|
|
?^ puk
|
|
:: key known, nothing changes
|
|
~| [%key-mismatch who life `@ux`u.puk `@ux`pass (get-public ~zod)]
|
|
?>(=(u.puk pass) kyz)
|
|
%+ ~(put by kyz) who
|
|
:- (max life life.pub)
|
|
(~(put by pubs.pub) life pass)
|
|
::
|
|
++ file-discontinuity
|
|
|= who=ship
|
|
^+ kyz
|
|
=+ (get-public who)
|
|
(~(put by kyz) who -)
|
|
::
|
|
++ file-event
|
|
|= [wer=event-id dif=diff-azimuth]
|
|
^+ [kyz ..file]
|
|
?: (~(has in heard) wer)
|
|
~& %ignoring-already-heard-event
|
|
[kyz ..file]
|
|
::
|
|
:: sanity check, should never fail if we operate correctly
|
|
::
|
|
?> (gte block.wer latest-block)
|
|
=: evs (~(put by evs) wer dif)
|
|
heard (~(put in heard) wer)
|
|
latest-block (max latest-block block.wer)
|
|
==
|
|
=^ kyz ..file
|
|
?- -.dif
|
|
%point ~|(wer=wer (file-point +.dif))
|
|
%dns [kyz (file-dns +.dif)]
|
|
==
|
|
[kyz (file-snap wer)]
|
|
::
|
|
++ file-point
|
|
|= [who=ship dif=diff-point]
|
|
^+ [kyz ..file]
|
|
=- ::TODO =; with just the type
|
|
=. pos.eth (~(put by pos.eth) who pon)
|
|
:: new keys
|
|
::
|
|
?: ?=(%& -.new)
|
|
[(file-keys who p.new) ..file]
|
|
:: kept continuity (no-op)
|
|
::
|
|
?: p.new
|
|
[kyz ..file]
|
|
:: discontinuity
|
|
::
|
|
:- (file-discontinuity who)
|
|
%= ..file
|
|
:: these must be appended here; +abet flops them
|
|
::
|
|
moz =/ lyf=life
|
|
~| sunk-unknown+who
|
|
life:(~(got by kyz.puk))
|
|
%+ weld moz
|
|
^- (list move)
|
|
:~ [hen %slip %a %sunk who lyf]
|
|
[hen %slip %c %sunk who lyf]
|
|
[hen %slip %d %sunk who lyf]
|
|
[hen %slip %e %sunk who lyf]
|
|
[hen %slip %f %sunk who lyf]
|
|
[hen %slip %g %sunk who lyf]
|
|
==
|
|
==
|
|
:: pon: updated point
|
|
:: new: new keypair or "kept continuity?" (yes is no-op)
|
|
^- [pon=point new=(each (pair life pass) ?)]
|
|
=+ pot=(fall (~(get by pos.eth) who) *point)
|
|
::
|
|
:: sanity checks, should never fail if we operate correctly
|
|
::
|
|
~| [%diff-order-insanity -.dif who (~(get by pos.eth) who)]
|
|
?> ?+ -.dif &
|
|
%spawned ?> ?=(^ kid.pot)
|
|
!(~(has in spawned.u.kid.pot) who.dif)
|
|
%keys ?> ?=(^ net.pot)
|
|
=(life.dif +(life.u.net.pot))
|
|
%continuity ?> ?=(^ net.pot)
|
|
=(new.dif +(continuity-number.u.net.pot))
|
|
==
|
|
::
|
|
:: apply point changes, catch continuity and key changes
|
|
::
|
|
:- (apply-point-diff pot dif)
|
|
=* nop |+& :: no-op
|
|
?+ -.dif nop
|
|
%continuity |+|
|
|
%keys &+[life pass]:dif
|
|
%full ?~ net.new.dif nop
|
|
::TODO do we want/need to do a diff-check
|
|
&+[life pass]:u.net.new.dif
|
|
==
|
|
::
|
|
++ file-dns
|
|
|= dns=dnses
|
|
..file(dns.eth dns)
|
|
::
|
|
++ file-snap :: save snapshot
|
|
|= wer=event-id
|
|
^+ ..file
|
|
=? sap
|
|
%+ lth 2
|
|
%+ sub.add
|
|
(div block.wer interval.sap)
|
|
(div last-block.sap interval.sap)
|
|
:: ~& :* %snap
|
|
:: count=count.sap
|
|
:: max-count=max-count.sap
|
|
:: last-block=last-block.sap
|
|
:: interval=interval.sap
|
|
:: lent=(lent ~(tap to snaps.sap))
|
|
:: ==
|
|
%= sap
|
|
snaps (~(put to snaps.sap) block.wer extract-snap)
|
|
count +(count.sap)
|
|
last-block block.wer
|
|
==
|
|
=? sap (gth count.sap max-count.sap)
|
|
~& :* %dump
|
|
count=count.sap
|
|
max-count=max-count.sap
|
|
lent=(lent ~(tap to snaps.sap))
|
|
==
|
|
%= sap
|
|
snaps +:~(get to snaps.sap)
|
|
count (dec count)
|
|
==
|
|
..file
|
|
--
|
|
--
|
|
:: :: ++ur
|
|
:::: ## absolute^heavy :: objective engine
|
|
:: ::::
|
|
++ ur
|
|
:: the ++ur core handles primary, absolute state.
|
|
:: it is the best reference for the semantics of
|
|
:: the urbit pki.
|
|
::
|
|
:: it is absolutely verboten to use [our] in ++ur.
|
|
::
|
|
=| hab/(list change)
|
|
=| state-absolute
|
|
::
|
|
:: hab: side effects, reversed
|
|
:: urb: all urbit state
|
|
::
|
|
=* urb -
|
|
|%
|
|
:: :: ++abet:ur
|
|
++ abet :: resolve
|
|
[(flop hab) `state-absolute`urb]
|
|
::
|
|
++ link
|
|
|= ven=chain
|
|
%_ +>
|
|
hab [[%ethe ven] hab]
|
|
==
|
|
:: :: ++lawn:ur
|
|
++ lawn :: debts, rex to pal
|
|
|= {rex/ship pal/ship}
|
|
^- safe
|
|
(lawn:~(able ex rex) pal)
|
|
:: :: ++lean:ur
|
|
++ lean :: private keys
|
|
|= rex/ship
|
|
^- (pair life (map life ring))
|
|
lean:~(able ex rex)
|
|
:: :: ++ex:ur
|
|
++ ex :: server engine
|
|
:: shy: private state
|
|
:: rug: domestic will
|
|
::
|
|
=| $: shy/(map ship safe)
|
|
==
|
|
=| :: rex: server ship
|
|
::
|
|
rex/ship
|
|
|%
|
|
:: :: ++abet:ex:ur
|
|
++ abet :: resolve
|
|
%_ ..ex
|
|
pry (~(put by pry) rex shy)
|
|
==
|
|
:: :: ++able:ex:ur
|
|
++ able :: initialize
|
|
%_ .
|
|
shy (fall (~(get by pry) rex) *(map ship safe))
|
|
==
|
|
:: :: ++deal:ex:ur
|
|
++ deal :: alter rights
|
|
|= {pal/ship del/bump}
|
|
^+ +>
|
|
=/ gob (fall (~(get by shy) pal) *safe)
|
|
=* hep (~(update up gob) del)
|
|
%_ +>.$
|
|
shy (~(put by shy) pal hep)
|
|
hab [[%rite rex pal del] hab]
|
|
==
|
|
::
|
|
++ hail :: ++hail:ex:ur
|
|
|= {pal/ship rem/remote} :: report rights
|
|
^+ +>
|
|
=/ gob (fall (~(get by shy) pal) *safe)
|
|
:: yer: pair of change and updated safe.
|
|
=/ yer ^- (pair bump safe)
|
|
?- -.rem
|
|
:: change: add rem. result: old + rem.
|
|
%& [[p.rem ~] (~(splice up gob) p.rem)]
|
|
:: change: difference. result: rem.
|
|
%| [(~(differ up gob) p.rem) p.rem]
|
|
==
|
|
%_ +>.$
|
|
shy (~(put by shy) pal q.yer)
|
|
hab [[%rite rex pal p.yer] hab]
|
|
==
|
|
:: :: ++lean:ex:ur
|
|
++ lean :: private keys
|
|
^- (pair life (map life ring))
|
|
::
|
|
:: par: promises by rex, to rex
|
|
:: jel: %jewel rights
|
|
:: lyf: latest life of
|
|
::
|
|
=* par (~(got by shy) rex)
|
|
=/ jel=rite (need (~(expose up par) %jewel))
|
|
?> ?=($jewel -.jel)
|
|
=; lyf=life
|
|
[lyf p.jel]
|
|
%+ roll ~(tap in ~(key by p.jel))
|
|
|= [liv=life max=life]
|
|
?:((gth liv max) liv max)
|
|
:: :: ++lawn:ex:ur
|
|
++ lawn :: liabilities to pal
|
|
|= pal/ship
|
|
^- safe
|
|
=-(?~(- ~ u.-) (~(get by shy) pal))
|
|
--
|
|
--
|
|
:: :: ++et
|
|
:::: ## ethereum^heavy :: ethereum engine
|
|
:: ::::
|
|
++ et
|
|
::
|
|
:: the ++et core handles all logic necessary to maintain the
|
|
:: absolute record of on-chain state changes, "events".
|
|
::
|
|
:: we either subscribe to a parent ship's existing record, or
|
|
:: communicate directly with an ethereum node.
|
|
::
|
|
:: moves: effects; either behn timers, subscriptions,
|
|
:: or ethereum node rpc requests.
|
|
:: reset: whether the found changes assume a fresh state.
|
|
:: changes: on-chain changes heard from our source.
|
|
::
|
|
=| moves=(list move)
|
|
=+ reset=|
|
|
=| changes=logs
|
|
=| rewind-block=(unit @ud)
|
|
=| $: hen=duct
|
|
our=ship
|
|
now=@da
|
|
state-absolute
|
|
state-relative
|
|
state-eth-node
|
|
state-snapshots
|
|
==
|
|
=* urb ->+>-
|
|
=* sub ->+>+<
|
|
=* etn ->+>+>-
|
|
=* sap ->+>+>+
|
|
::
|
|
:: +| outward
|
|
|%
|
|
::
|
|
:: +abet: produce results
|
|
::
|
|
++ abet
|
|
^- $: (list move) chain state-absolute state-relative
|
|
state-eth-node state-snapshots
|
|
==
|
|
=. .
|
|
?~ rewind-block
|
|
.
|
|
:: if we're rewinding to a block, then we throw away any moves
|
|
:: and changes we were going to make.
|
|
::
|
|
=: moves *(list move)
|
|
changes *logs
|
|
==
|
|
(restore-block u.rewind-block)
|
|
[(flop moves) ?:(reset &+changes |+changes) urb sub etn sap]
|
|
::
|
|
:: +put-move: store side-effect
|
|
::
|
|
++ put-move
|
|
|= mov=move
|
|
%_(+> moves [mov moves])
|
|
::
|
|
:: +put-request: store rpc request to ethereum node
|
|
::
|
|
++ put-request
|
|
|= [wir=wire id=(unit @t) req=request]
|
|
(put-move (rpc-hiss wir (request-to-json id req)))
|
|
::
|
|
:: +put-change: store change made by event
|
|
::
|
|
++ put-change
|
|
|= [cause=event-id dif=diff-azimuth]
|
|
?: (~(has by changes) cause) :: one diff per event
|
|
~& [%duplicate-cause cause]
|
|
!!
|
|
+>(changes (~(put by changes) cause dif))
|
|
::
|
|
:: +| move-generation
|
|
::
|
|
:: +wrap-note: %pass a note using a made-up duct
|
|
::
|
|
++ wrap-note
|
|
|= [wir=wire not=note:able]
|
|
^- move
|
|
:- [/jael/eth-logic ~ ~]
|
|
[%pass (weld /(scot %p our) wir) not]
|
|
::
|
|
:: +rpc-hiss: make an http request to our ethereum rpc source
|
|
::
|
|
++ rpc-hiss
|
|
|= [wir=wire jon=json]
|
|
^- move
|
|
%+ wrap-note wir
|
|
:^ %e %hiss ~
|
|
:+ %httr %hiss
|
|
?> ?=(%| -.source)
|
|
!> (json-request node.p.source jon)
|
|
::
|
|
:: +| source-operations
|
|
::
|
|
:: +listen-to-ship: depend on who for ethereum events
|
|
::
|
|
++ listen-to-ship
|
|
|= [our=ship who=ship]
|
|
%- put-move(source &+who)
|
|
%+ wrap-note /vent/(scot %p who)
|
|
[%a %want who /j/(scot %p our)/vent `*`[%vent ~]]
|
|
::
|
|
:: +unsubscribe-from-source: stop listening to current source ship
|
|
::
|
|
++ unsubscribe-from-source
|
|
|= our=ship
|
|
%- put-move
|
|
?> ?=(%& -.source)
|
|
%+ wrap-note /vent/(scot %p p.source)
|
|
::TODO should we maybe have a %nuke-vent,
|
|
:: or do we have a unique duct here?
|
|
[%a %want p.source /j/(scot %p our)/vent `*`[%nuke ~]]
|
|
::
|
|
:: +listen-to-node: start syncing from a node
|
|
::
|
|
:: Get latest block from eth node and compare to our own latest block.
|
|
:: Get intervening blocks in chunks until we're caught up, then set
|
|
:: up a filter going forward.
|
|
::
|
|
++ listen-to-node
|
|
|= url=purl:eyre
|
|
get-latest-block(source |+%*(. *node-src node url))
|
|
::
|
|
:: +| catch-up-operations
|
|
::
|
|
:: +get-latest-block
|
|
::
|
|
:: Get latest known block number from eth node.
|
|
::
|
|
++ get-latest-block
|
|
(put-request /catch-up/block-number `'block number' %eth-block-number ~)
|
|
::
|
|
:: +catch-up: get next chunk
|
|
::
|
|
++ catch-up
|
|
|= from-block=@ud
|
|
?: (gte from-block foreign-block)
|
|
new-filter
|
|
=/ next-block (min foreign-block (add from-block 5.760)) :: ~d1
|
|
~& [%catching-up from=from-block to=foreign-block]
|
|
%- put-request
|
|
:+ /catch-up/step/(scot %ud from-block)/(scot %ud next-block)
|
|
`'catch up'
|
|
:* %eth-get-logs
|
|
`number+from-block
|
|
`number+next-block
|
|
~[azimuth:contracts]
|
|
~
|
|
==
|
|
::
|
|
:: +| filter-operations
|
|
::
|
|
:: +new-filter: request a new polling filter
|
|
::
|
|
:: Listens only to the Azimuth state contract, and only from
|
|
:: the last-heard block onward.
|
|
::
|
|
++ new-filter
|
|
%- put-request
|
|
:+ /filter/new `'new filter'
|
|
:* %eth-new-filter
|
|
`number+latest-block
|
|
:: XX We want to load from a snapshot at least 40 blocks behind, then
|
|
:: replay to the present
|
|
:: `[%number ?:((lte latest-block 40) 0 (sub.add latest-block 40))]
|
|
::TODO or Azimuth origin block when 0
|
|
~ ::TODO we should probably chunck these, maybe?
|
|
:: https://stackoverflow.com/q/49339489
|
|
~[azimuth:contracts]
|
|
~
|
|
==
|
|
::
|
|
:: +read-filter: get all events the filter captures
|
|
::
|
|
++ read-filter
|
|
?> ?=(%| -.source)
|
|
%- put-request
|
|
:+ /filter/logs `'filter logs'
|
|
[%eth-get-filter-logs filter-id.p.source]
|
|
::
|
|
:: +poll-filter: get all new events since the last poll (or filter creation)
|
|
::
|
|
++ poll-filter
|
|
?> ?=(%| -.source)
|
|
?: =(0 filter-id.p.source)
|
|
~& %no-filter-bad-poll
|
|
.
|
|
%- put-request
|
|
:+ /filter/changes `'poll filter'
|
|
[%eth-get-filter-changes filter-id.p.source]
|
|
::
|
|
:: +wait-poll: remind us to poll in four minutes
|
|
::
|
|
:: Four minutes because Ethereum RPC filters time out after five.
|
|
:: We don't check for an existing timer or clear an old one here,
|
|
:: sane flows shouldn't see this being called superfluously.
|
|
::
|
|
++ wait-poll
|
|
?> ?=(%| -.source)
|
|
=+ wen=(add now ~m4)
|
|
%- put-move(poll-timer.p.source wen)
|
|
(wrap-note /poll %b %wait wen)
|
|
::
|
|
:: +cancel-wait-poll: remove poll reminder
|
|
::
|
|
++ cancel-wait-poll
|
|
?> ?=(%| -.source)
|
|
%- put-move(poll-timer.p.source *@da)
|
|
%+ wrap-note /poll/cancel
|
|
[%b %rest poll-timer.p.source]
|
|
::
|
|
:: +| configuration
|
|
::
|
|
:: +init: initialize with default ethereum connection
|
|
::
|
|
:: for galaxies, we default to a localhost geth node.
|
|
:: for stars and under, we default to the parent ship.
|
|
::
|
|
++ init
|
|
|= [our=ship bos=ship]
|
|
^+ +>
|
|
:: TODO: ship or node as sample?
|
|
::
|
|
=. latest-block (max latest-block launch:contracts)
|
|
?: |(=(our bos) ?=(^ nod.own))
|
|
~| %jael-init-node
|
|
(listen-to-node (need nod.own))
|
|
(listen-to-ship our bos)
|
|
::
|
|
:: +look: configure the source of ethereum events
|
|
::
|
|
++ look
|
|
|= src=(each ship purl:eyre)
|
|
^+ +>
|
|
=. +>
|
|
?: ?=(%| -.source)
|
|
cancel-wait-poll
|
|
(unsubscribe-from-source our)
|
|
?: ?=(%| -.src)
|
|
(listen-to-node p.src)
|
|
(listen-to-ship our p.src)
|
|
::
|
|
:: +| subscription-results
|
|
::
|
|
:: +hear-vent: process incoming events
|
|
::
|
|
++ hear-vent
|
|
|= =vent-result
|
|
^+ +>
|
|
?- -.vent-result
|
|
:: `look` can be | because we know we're listening to a ship
|
|
:: rather than a node, so the subscription was never broken
|
|
::
|
|
%snap (restore-snap snap.vent-result |)
|
|
%chain
|
|
?- -.can.vent-result
|
|
%& (assume p.can.vent-result)
|
|
::
|
|
%|
|
|
=+ evs=~(tap by p.can.vent-result)
|
|
|-
|
|
?~ evs +>.^$
|
|
=. +>.^$ (accept i.evs)
|
|
$(evs t.evs)
|
|
==
|
|
==
|
|
::
|
|
:: +assume: clear state and process events
|
|
::
|
|
++ assume
|
|
|= evs=logs
|
|
^+ +>
|
|
%. chain+|+evs
|
|
%_ hear-vent
|
|
heard ~
|
|
latest-block 0
|
|
reset &
|
|
==
|
|
::
|
|
:: +accept: process single event
|
|
::
|
|
++ accept
|
|
|= [cause=event-id dif=diff-azimuth]
|
|
^+ +>
|
|
?: (~(has in heard) cause)
|
|
~& %accept-ignoring-duplicate-event
|
|
+>.$
|
|
(put-change cause dif)
|
|
::
|
|
:: +| filter-results
|
|
::
|
|
:: +wake: kick polling, unless we changed source
|
|
::
|
|
++ wake
|
|
?. ?=(%| -.source) .
|
|
poll-filter
|
|
::
|
|
:: +sigh: parse rpc response and process it
|
|
::
|
|
++ sigh
|
|
|= [cuz=wire mar=mark res=vase]
|
|
^+ +>
|
|
?: ?=(%& -.source) +>
|
|
?: ?=(%tang mar)
|
|
::TODO proper error handling
|
|
~_ q.res
|
|
~& [%yikes cuz]
|
|
+>.$
|
|
?> ?=(%httr mar)
|
|
=+ raw-rep=~|(res ((hard httr:eyre) q.res))
|
|
=+ rep=(httr-to-rpc-response raw-rep)
|
|
?: ?=(%fail -.rep)
|
|
?: =(405 p.hit.rep)
|
|
~& 'HTTP 405 error (expected if using infura)'
|
|
+>.$
|
|
?. =(5 (div p.hit.rep 100))
|
|
~& [%http-error hit.rep]
|
|
+>.$
|
|
?+ cuz
|
|
~& [%retrying-node ((soft tang) q.res)]
|
|
wait-poll
|
|
[%catch-up %step @ta @ta ~]
|
|
~& %retrying-catch-up
|
|
(catch-up (slav %ud `@ta`i.t.t.cuz))
|
|
==
|
|
?+ cuz ~|([%weird-sigh-wire cuz] !!)
|
|
[%filter %new *]
|
|
(take-new-filter rep)
|
|
::
|
|
[%filter *]
|
|
(take-filter-results rep)
|
|
::
|
|
[%catch-up %block-number ~]
|
|
(take-block-number rep)
|
|
::
|
|
[%catch-up %step @ta @ta ~]
|
|
=/ from-block (slav %ud `@ta`i.t.t.cuz)
|
|
=/ next-block (slav %ud `@ta`i.t.t.t.cuz)
|
|
(take-catch-up-step rep from-block next-block)
|
|
==
|
|
::
|
|
:: httr-to-rpc-response
|
|
::
|
|
++ httr-to-rpc-response
|
|
|= hit/httr:eyre
|
|
^- response:rpc:jstd
|
|
~| hit
|
|
?. ?=($2 (div p.hit 100))
|
|
fail+hit
|
|
=/ a=json (need (de-json:html q:(need r.hit)))
|
|
=, dejs-soft:format
|
|
^- response:rpc:jstd
|
|
=; dere
|
|
=+ res=((ar dere) a)
|
|
?~ res (need (dere a))
|
|
[%batch u.res]
|
|
|= a=json
|
|
^- (unit response:rpc:jstd)
|
|
=/ res=(unit [@t json])
|
|
::TODO breaks when no id present
|
|
((ot id+so result+some ~) a)
|
|
?^ res `[%result u.res]
|
|
~| a
|
|
:+ ~ %error %- need
|
|
((ot id+so error+(ot code+no message+so ~) ~) a)
|
|
::
|
|
:: +take-new-filter: store filter-id and read it
|
|
::
|
|
++ take-new-filter
|
|
|= rep=response:rpc:jstd
|
|
^+ +>
|
|
~| rep
|
|
?< ?=(%batch -.rep)
|
|
?< ?=(%fail -.rep)
|
|
?: ?=(%error -.rep)
|
|
~& [%filter-error--retrying message.rep]
|
|
new-filter
|
|
?> ?=(%| -.source)
|
|
=- read-filter(filter-id.p.source -)
|
|
(parse-eth-new-filter-res res.rep)
|
|
::
|
|
:: +take-filter-results: parse results into event-logs and process them
|
|
::
|
|
++ take-filter-results
|
|
|= rep=response:rpc:jstd
|
|
^+ +>
|
|
?< ?=(%batch -.rep)
|
|
?< ?=(%fail -.rep)
|
|
?: ?=(%error -.rep)
|
|
?. ?| =('filter not found' message.rep) :: geth
|
|
=('Filter not found' message.rep) :: parity
|
|
==
|
|
~& [%unhandled-filter-error +.rep]
|
|
+>
|
|
::~& [%filter-timed-out--recreating block=latest-block +.rep]
|
|
:: arguably should rewind 40 blocks on the off chance the chain reorganized
|
|
:: when we blinked. this will also restart the filter.
|
|
::
|
|
:: (restore-block ?:((lth latest-block 40) 0 (sub.add latest-block 40)))
|
|
::
|
|
:: counter-argument: it's a royal pain to restore from a snapshot
|
|
:: every time you can't ping the node for 5 minutes. this is likely
|
|
:: to destabilize the network. better to manually restore if we
|
|
:: notice an anomaly.
|
|
::
|
|
:: third way: don't trust anything that doesn't have 40 confirmations
|
|
::
|
|
new-filter
|
|
:: kick polling timer, only if it hasn't already been.
|
|
=? +> ?& ?=(%| -.source)
|
|
(gth now poll-timer.p.source)
|
|
==
|
|
wait-poll
|
|
(take-events rep)
|
|
::
|
|
:: +take-block-number: take block number and start catching up
|
|
::
|
|
++ take-block-number
|
|
|= rep=response:rpc:jstd
|
|
^+ +>
|
|
?< ?=(%batch -.rep)
|
|
?< ?=(%fail -.rep)
|
|
?: ?=(%error -.rep)
|
|
~& [%take-block-number-error--retrying message.rep]
|
|
get-latest-block
|
|
=. foreign-block (parse-eth-block-number res.rep)
|
|
~& [%setting-foreign-block foreign-block]
|
|
(catch-up latest-block)
|
|
::
|
|
:: +take-catch-up-step: process chunk
|
|
::
|
|
++ take-catch-up-step
|
|
|= [rep=response:rpc:jstd from-block=@ud next-block=@ud]
|
|
^+ +>
|
|
?< ?=(%batch -.rep)
|
|
?< ?=(%fail -.rep)
|
|
?: ?=(%error -.rep)
|
|
~& [%catch-up-step-error--retrying message.rep]
|
|
(catch-up from-block)
|
|
=. +>.$ (take-events rep)
|
|
(catch-up next-block)
|
|
::
|
|
:: +take-events: process events
|
|
::
|
|
++ take-events
|
|
|= rep=response:rpc:jstd
|
|
^+ +>
|
|
?< ?=(%batch -.rep)
|
|
?< ?=(%fail -.rep)
|
|
?< ?=(%error -.rep)
|
|
?. ?=(%a -.res.rep)
|
|
~& [%events-not-array rep]
|
|
!!
|
|
=* changes p.res.rep
|
|
~? (gth (lent changes) 0)
|
|
:* %processing-changes
|
|
changes=(lent changes)
|
|
block=latest-block
|
|
id=?.(?=(%| -.source) ~ `@ux`filter-id.p.source)
|
|
==
|
|
|- ^+ +>.^$
|
|
?~ changes +>.^$
|
|
=. +>.^$
|
|
(take-event-log (parse-event-log i.changes))
|
|
$(changes t.changes)
|
|
::
|
|
:: +take-event-log: obtain changes from event-log
|
|
::
|
|
++ take-event-log
|
|
|= log=event-log
|
|
^+ +>
|
|
?~ mined.log
|
|
~& %ignoring-unmined-event
|
|
+>
|
|
=* place u.mined.log
|
|
?: (~(has in heard) block-number.place log-index.place)
|
|
?. removed.u.mined.log
|
|
:: ~& [%ignoring-duplicate-event tx=transaction-hash.u.mined.log]
|
|
+>
|
|
:: block was reorganized away, so rewind to this block and
|
|
:: start syncing again.
|
|
::
|
|
~& :* 'removed event! Perhaps chain has reorganized?'
|
|
tx-hash=transaction-hash.u.mined.log
|
|
block-number=block-number.u.mined.log
|
|
block-hash=block-hash.u.mined.log
|
|
==
|
|
%= +>
|
|
rewind-block
|
|
:- ~
|
|
?~ rewind-block
|
|
block-number.place
|
|
(min block-number.place u.rewind-block)
|
|
==
|
|
=+ cuz=[block-number.place log-index.place]
|
|
::
|
|
?: =(event.log changed-dns:azimuth-events)
|
|
=+ ^- [pri=tape sec=tape ter=tape]
|
|
%+ decode-results data.log
|
|
~[%string %string %string]
|
|
%+ put-change cuz
|
|
[%dns (crip pri) (crip sec) (crip ter)]
|
|
::
|
|
=+ dif=(event-log-to-point-diff log)
|
|
?~ dif +>.$
|
|
(put-change cuz %point u.dif)
|
|
:: :: ++restore-block:et
|
|
++ restore-block :: rewind before block
|
|
|= block=@ud
|
|
^+ +>
|
|
=/ old-qeu snaps.sap
|
|
=: snaps.sap ~
|
|
count.sap 0
|
|
last-block.sap 0
|
|
==
|
|
=^ snap=snapshot +>.$
|
|
?: |(=(~ old-qeu) (lth block block-number:(need ~(top to old-qeu))))
|
|
[%*(. *snapshot latest-block launch:contracts) +>.$]
|
|
|- ^- [snapshot _+>.^$]
|
|
=^ snap=[block-number=@ud snap=snapshot] old-qeu
|
|
~(get to old-qeu)
|
|
=: count.sap +(count.sap)
|
|
last-block.sap block-number.snap
|
|
snaps.sap (~(put to snaps.sap) snap)
|
|
==
|
|
?: |(=(~ old-qeu) (lth block block-number:(need ~(top to old-qeu))))
|
|
[snap.snap +>.^$]
|
|
$
|
|
~& [%restoring-block block latest-block.snap ~(wyt by pos.eth.snap)]
|
|
(restore-snap snap &)
|
|
:: :: ++restore-snap:et
|
|
++ restore-snap :: restore snapshot
|
|
|= [snap=snapshot look=?]
|
|
^+ +>
|
|
:: update pub subscribers
|
|
::
|
|
=. +>.$
|
|
=/ subs=(list (pair ship (set duct)))
|
|
~(tap by yen.puk.sub)
|
|
|- ^+ +>.^$
|
|
?~ subs +>.^$
|
|
=/ pub (fall (~(get by kyz.snap) p.i.subs) *public)
|
|
=. +>.^$ (exec q.i.subs [%give %pubs pub])
|
|
$(subs t.subs)
|
|
:: update vent subscribers
|
|
::
|
|
=. +>.$ (vent-pass yen.eth snap+snap)
|
|
:: keep the following in sync with ++extract-snap:file:su
|
|
::
|
|
%= +>.$
|
|
heard.etn heard.snap
|
|
latest-block.etn latest-block.snap
|
|
kyz.puk.sub kyz.snap
|
|
dns.eth.sub dns.eth.snap
|
|
pos.eth.sub pos.eth.snap
|
|
sap sap(last-block 0)
|
|
moves
|
|
?. look moves
|
|
=- [[hen %pass /wind/look %j %look -] moves]
|
|
?- -.source.etn
|
|
%& &+p.source.etn
|
|
%| |+node.p.source.etn
|
|
==
|
|
==
|
|
:: :: ++exec:et
|
|
++ exec :: mass gift
|
|
|= {yen/(set duct) cad/card}
|
|
=/ noy ~(tap in yen)
|
|
|- ^+ ..exec
|
|
?~ noy ..exec
|
|
$(noy t.noy, moves [[i.noy cad] moves])
|
|
:: :: ++vent-pass:et
|
|
++ vent-pass :: "give" vent
|
|
|= [yen=(set duct) res=vent-result]
|
|
=+ yez=~(tap in yen)
|
|
|- ^+ ..vent-pass
|
|
?~ yez ..vent-pass
|
|
=* d i.yez
|
|
?> ?=([[%a @ @ *] *] d)
|
|
=+ our=(slav %p i.t.i.d)
|
|
=+ who=(slav %p i.t.t.i.d)
|
|
%+ exec [d ~ ~]
|
|
:+ %pass
|
|
/(scot %p our)/vent-result
|
|
^- note:able
|
|
[%a %want who /j/(scot %p our)/vent-result %vent-result res]
|
|
:: :: ++feed:su
|
|
--
|
|
--
|
|
:: ::::
|
|
:::: # vane :: interface
|
|
:: ::::
|
|
::
|
|
:: lex: all durable %jael state
|
|
::
|
|
=| lex/state
|
|
|= $: ::
|
|
:: our: identity
|
|
:: now: current time
|
|
:: eny: unique entropy
|
|
:: ski: namespace resolver
|
|
::
|
|
our=ship
|
|
now=@da
|
|
eny=@uvJ
|
|
ski=sley
|
|
==
|
|
|%
|
|
:: :: ++call
|
|
++ call :: request
|
|
|= $: :: hen: cause of this event
|
|
:: hic: event data
|
|
::
|
|
hen/duct
|
|
hic/(hypo (hobo task:able))
|
|
==
|
|
^- [(list move) _..^$]
|
|
=/ =task:able
|
|
?. ?=($soft -.q.hic)
|
|
q.hic
|
|
(task:able p.q.hic)
|
|
=^ did lex
|
|
abet:(~(call of [our now eny] lex) hen task)
|
|
[did ..^$]
|
|
:: :: ++load
|
|
++ load :: upgrade
|
|
|= $: :: old: previous state
|
|
::
|
|
old/state
|
|
==
|
|
^+ ..^$
|
|
..^$(lex old)
|
|
:: :: ++scry
|
|
++ scry :: inspect
|
|
|= $: :: fur: event security
|
|
:: ren: access mode
|
|
:: why: owner
|
|
:: syd: desk (branch)
|
|
:: lot: case (version)
|
|
:: tyl: rest of path
|
|
::
|
|
fur/(unit (set monk))
|
|
ren/@tas
|
|
why/shop
|
|
syd/desk
|
|
lot/coin
|
|
tyl/spur
|
|
==
|
|
^- (unit (unit cage))
|
|
:: XX review for security, stability, cases other than now
|
|
::
|
|
?. =(lot [%$ %da now]) ~
|
|
?. =(%$ ren) [~ ~]
|
|
?+ syd
|
|
~
|
|
::
|
|
%code
|
|
?. ?=([@ ~] tyl) [~ ~]
|
|
?. ?& ?=(%& -.why)
|
|
(~(has by pry.urb.lex) p.why)
|
|
==
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
?~ who [~ ~]
|
|
=/ sec (~(got by jaw.own.sub.lex) lyf.own.sub.lex)
|
|
=/ cub (nol:nu:crub:crypto sec)
|
|
:: XX use pac:ex:cub?
|
|
::
|
|
``[%noun !>((end 6 1 (shaf %pass (shax sec:ex:cub))))]
|
|
::
|
|
%life
|
|
?. ?=([@ ~] tyl) [~ ~]
|
|
?. ?& ?=(%& -.why)
|
|
(~(has by pry.urb.lex) p.why)
|
|
==
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
?~ who [~ ~]
|
|
:: fake ships always have life=1
|
|
::
|
|
?: fak.own.sub.lex
|
|
``[%atom !>(1)]
|
|
?: =(u.who p.why)
|
|
``[%atom !>(lyf.own.sub.lex)]
|
|
=/ pub (~(get by kyz.puk.sub.lex) u.who)
|
|
?~ pub ~
|
|
``[%atom !>(life.u.pub)]
|
|
::
|
|
%deed
|
|
?. ?=([@ @ ~] tyl) [~ ~]
|
|
?. &(?=(%& -.why) =(p.why our))
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
=/ lyf (slaw %ud i.t.tyl)
|
|
?~ who [~ ~]
|
|
?~ lyf [~ ~]
|
|
=/ rac (clan:title u.who)
|
|
::
|
|
?: ?=(%pawn rac)
|
|
?. =(u.who p.why)
|
|
[~ ~]
|
|
?. =(1 u.lyf)
|
|
[~ ~]
|
|
=/ sec (~(got by jaw.own.sub.lex) u.lyf)
|
|
=/ cub (nol:nu:crub:crypto sec)
|
|
=/ sig (sign:as:cub (shaf %self (sham [u.who 1 pub:ex:cub])))
|
|
:^ ~ ~ %noun
|
|
!> ^- deed:ames
|
|
[1 pub:ex:cub `sig]
|
|
::
|
|
?: ?=(%earl rac)
|
|
?. =(u.who p.why)
|
|
[~ ~]
|
|
?: (gth u.lyf lyf.own.sub.lex)
|
|
~
|
|
?: (lth u.lyf lyf.own.sub.lex)
|
|
[~ ~]
|
|
=/ sec (~(got by jaw.own.sub.lex) u.lyf)
|
|
=/ cub (nol:nu:crub:crypto sec)
|
|
:^ ~ ~ %noun
|
|
!> ^- deed:ames
|
|
[u.lyf pub:ex:cub sig.own.sub.lex]
|
|
::
|
|
=/ pub (~(get by kyz.puk.sub.lex) u.who)
|
|
?~ pub
|
|
~
|
|
?: (gth u.lyf life.u.pub)
|
|
~
|
|
=/ pas (~(get by pubs.u.pub) u.lyf)
|
|
?~ pas
|
|
~
|
|
:^ ~ ~ %noun
|
|
!> `deed:ames`[u.lyf u.pas ~]
|
|
::
|
|
%earl
|
|
?. ?=([@ @ @ ~] tyl) [~ ~]
|
|
?. ?& ?=(%& -.why)
|
|
(~(has by pry.urb.lex) p.why)
|
|
==
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
=/ lyf (slaw %ud i.t.tyl)
|
|
=/ pub (slaw %ux i.t.t.tyl)
|
|
?~ who [~ ~]
|
|
?~ lyf [~ ~]
|
|
?~ pub [~ ~]
|
|
?: (gth u.lyf lyf.own.sub.lex)
|
|
~
|
|
?: (lth u.lyf lyf.own.sub.lex)
|
|
[~ ~]
|
|
:: XX check that who/lyf hasn't been booted
|
|
::
|
|
=/ sec (~(got by jaw.own.sub.lex) u.lyf)
|
|
=/ cub (nol:nu:crub:crypto sec)
|
|
=/ sig (sign:as:cub (shaf %earl (sham u.who u.lyf u.pub)))
|
|
``[%atom !>(sig)]
|
|
::
|
|
%sein
|
|
?. ?=([@ ~] tyl) [~ ~]
|
|
?. ?& ?=(%& -.why)
|
|
(~(has by pry.urb.lex) p.why)
|
|
==
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
?~ who [~ ~]
|
|
:^ ~ ~ %atom
|
|
!> ^- ship
|
|
(~(sein of [our now eny] lex) u.who)
|
|
::
|
|
%saxo
|
|
?. ?=([@ ~] tyl) [~ ~]
|
|
?. ?& ?=(%& -.why)
|
|
(~(has by pry.urb.lex) p.why)
|
|
==
|
|
[~ ~]
|
|
=/ who (slaw %p i.tyl)
|
|
?~ who [~ ~]
|
|
:^ ~ ~ %noun
|
|
!> ^- (list ship)
|
|
(~(saxo of [our now eny] lex) u.who)
|
|
::
|
|
%eth-status
|
|
?. ?=(~ tyl) [~ ~]
|
|
:^ ~ ~ %noun !>
|
|
^- [latest-block=@ud source=(each ship node-src)]
|
|
[latest-block.etn.lex source.etn.lex]
|
|
::
|
|
%snap
|
|
?. ?=(~ tyl) [~ ~]
|
|
?: =(~ snaps.sap.lex)
|
|
`~
|
|
:^ ~ ~ %noun !>
|
|
|- ^- snapshot
|
|
=^ snap=[@ud snap=snapshot] snaps.sap.lex
|
|
~(get to snaps.sap.lex)
|
|
?: =(~ snaps.sap.lex)
|
|
snap.snap
|
|
$
|
|
==
|
|
:: :: ++stay
|
|
++ stay :: preserve
|
|
lex
|
|
:: :: ++take
|
|
++ take :: accept
|
|
|= $: :: tea: order
|
|
:: hen: cause
|
|
:: hin: result
|
|
::
|
|
tea/wire
|
|
hen/duct
|
|
hin/(hypo sign)
|
|
==
|
|
^- [(list move) _..^$]
|
|
=^ did lex abet:(~(take of [our now eny] lex) tea hen q.hin)
|
|
[did ..^$]
|
|
--
|