urbit/sys/vane/jael.hoon

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 %e %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 %e %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 ..^$]
--