urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-25 04:52:06 +03:00
Code Issues Packages Projects Releases Wiki Activity

fixed up kale

Browse Source
This commit is contained in:
Philip Monk 2019-07-18 15:26:15 -07:00
parent c5af9ffd84
commit 408b72b68e
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
9 changed files with 192 additions and 103 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:e4a4f8f86b18de5e410caeb491eecf8cf4fe24fbaba03ad8183b55a13eee154a
size 9108350
oid sha256:2954fa8a49e6f601d77af43af646449d80a26624b14c87e0276fef96ecf14529
size 9343490

105
pkg/arvo/app/azimuth-tracker.hoon
View File

@ -6,12 +6,18 @@
$: url=@ta
from-number=number:block
==
+$ app-state ~
+$ app-state
$: =number:block
=pending-udiffs
=blocks
==
+$ peek-data ~
+$ in-poke-data
$% [%watch =config]
[%clear ~]
[%noun *]
$: %azimuth-tracker-poke
$% [%init ~]
[%look whos=(set ship) =source:kale]
[%watch =config]
==
==
+$ out-poke-data ~
+$ in-peer-data ~
@ -224,24 +230,63 @@
=* loop $
?~ udiffs
(pure:m ~)
~& > [%update block i.udiffs]
:: ;< ~ bind:m (send-effect [%vent-update i.udiffs])
;< ~ bind:m (send-effect %new-event i.udiffs)
loop(udiffs t.udiffs)
--
::
:: Main loop
::
=> |%
++ watch
|= =config
=/ m (async:stdio ,~)
::
:: Subscribe to %sources from kale
::
++ init
|= state=app-state
=/ m (async:stdio ,app-state)
^- form:m
=/ =number:block from-number.config
=| =pending-udiffs
=| blocks=(list block)
|- ^- form:m
=* poll-loop $
~& [%poll-loop number]
;< ~ bind:m (send-effect %sources ~)
(pure:m state)
::
:: Send %look to kale
::
++ look
|= [state=app-state whos=(set ship) =source:kale]
=/ m (async:stdio ,app-state)
^- form:m
;< ~ bind:m (send-effect %look whos source)
(pure:m state)
::
:: Take %source from kale
::
++ take-source
|= [state=app-state whos=(set ship) =source:kale]
=/ m (async:stdio ,app-state)
^- form:m
?: ?=(%& -.source)
(pure:m state)
=/ =a=purl:eyre node.p.state
=/ url=@ta (crip (en-purl:html a-purl))
(watch state url launch:contracts:azimuth)
::
:: Start watching a node
::
++ watch
|= [state=app-state =config]
=/ m (async:stdio ,app-state)
^- form:m
=: number.state from-number.config
pending-udiffs.state *pending-udiffs
blocks.state *blocks
==
(get-updates state)
::
:: Get updates since last checked
::
++ get-updates
|= app-state
=/ m (async:stdio ,app-state)
^- form:m
~& [%get-updates number]
;< =latest=block bind:m (get-latest-block url.config)
|- ^- form:m
=* walk-loop $
@ -249,7 +294,7 @@
?: (gth number number.id.latest-block)
;< now=@da bind:m get-time:stdio
;< ~ bind:m (wait:stdio (add now ~s10))
poll-loop
(pure:m number pending-udiffs blocks)
;< =block bind:m (get-block-by-number url.config number)
;< [=new=^pending-udiffs new-blocks=(lest ^block)] bind:m
(take-block url.config pending-udiffs block blocks)
@ -259,6 +304,8 @@
==
walk-loop
::
:: Process a block, detecting and handling reorgs
::
++ take-block
|= [url=@ta =a=pending-udiffs =block blocks=(list block)]
=/ m (async:stdio ,[pending-udiffs (lest ^block)])
@ -274,6 +321,8 @@
=. b-pending-udiffs (~(put by b-pending-udiffs) number.id.block new-udiffs)
(pure:m b-pending-udiffs block blocks)
::
:: Release events if they're more than 30 blocks ago
::
++ release-old-events
|= [=pending-udiffs =number:block]
=/ m (async:stdio ,^pending-udiffs)
@ -283,6 +332,8 @@
;< ~ bind:m (jael-update udiffs)
(pure:m (~(del by pending-udiffs) rel-number))
::
:: Reorg detected, so rewind until we're back in sync
::
++ rewind
|= [url=@ta =pending-udiffs =block blocks=(list block)]
=/ m (async:stdio ,[^pending-udiffs (lest ^block)])
@ -300,6 +351,8 @@
=. pending-udiffs (~(del by pending-udiffs) number.id.block)
loop(block next-block, blocks t.blocks)
::
:: Tell subscribers there was a deep reorg
::
++ disavow
|= =block
=/ m (async:stdio ,~)
@ -311,22 +364,26 @@
::
=* default-tapp default-tapp:tapp
%- create-tapp-poke-peer-take:tapp
|_ [=bowl:gall state=app-state]
|_ [=bowl:gall =app-state]
|%
++ handle-poke
|= =in-poke-data
=/ m tapp-async
^- form:m
?- -.in-poke-data
%noun (watch (config +.in-poke-data))
%watch (watch +.in-poke-data)
%clear !!
?- +<.in-poke-data
%init (init app-state)
%look (look app-state +>.in-poke-data)
%watch (watch app-state +>.in-poke-data)
==
::
++ handle-take
|= =sign:tapp
!!
:: ?> ?=(%sources -.sign)
:: (handle-poke %watch +.sign)
=/ m tapp-async
^- form:m
?- -.sign
%sources (handle-poke %watch +.sign)
%wake (get-updates app-state)
==
::
++ handle-peer ~(handle-peer default-tapp bowl state)
--

3
pkg/arvo/gen/azimuth-tracker/init.hoon Normal file
View File

@ -0,0 +1,3 @@
:- %say
|= [* ~ ~]
[%azimuth-tracker-poke %init ~]

3
pkg/arvo/gen/azimuth-tracker/look.hoon Normal file
View File

@ -0,0 +1,3 @@
:- %say
|= [* [whos=(set ship) =source:kale] ~]
[%azimuth-tracker-poke %look whos source]

7
pkg/arvo/gen/azimuth-tracker/watch.hoon Normal file
View File

@ -0,0 +1,7 @@
=> |%
+$ config
[url=@ta =from=number:block:able:kale]
--
:- %say
|= [* config ~]
[%azimuth-tracker-poke %watch config]

1
pkg/arvo/sur/tapp.hoon
View File

@ -15,6 +15,7 @@
[%connect wire binding:eyre term]
[%http-response =http-event:http]
[%rule wire %turf %put turf]
[%source whos=(set ship) src=source:kale]
==
::
:: Possible async responses

2
pkg/arvo/sys/vane/gall.hoon
View File

@ -1337,11 +1337,13 @@
%merg `%c
%mint `%j
%mont `%c
%new-event `%k
%nuke `%a
%ogre `%c
%perm `%c
%rest `%b
%snap `%j
%sources `%k
%wait `%b
%want `%a
%warp `%c

94
pkg/arvo/sys/vane/kale.hoon
View File

@ -52,7 +52,7 @@
lyf=life :: version
jaw=(map life ring) :: private keys
== ::
$= zim :: ethereum (vent)
$= zim :: public
$: yen=(jug duct ship) :: trackers
ney=(jug ship duct) :: reverse trackers
dns=dnses :: on-chain dns state
@ -69,7 +69,7 @@
+$ message :: message to her kale
$% [%nuke whos=(set ship)] :: cancel trackers
[%public-keys whos=(set ship)] :: view ethereum events
[%public-keys-result who=ship =vent-result] :: tmp workaround
[%public-keys-result =public-keys-result] :: tmp workaround
== ::
+$ card :: i/o action
(wind note gift) ::
@ -246,19 +246,21 @@
=. tuf.own.pki turf.tac
:: our initial galaxy table as a +map from +life to +public
::
=/ =udiffs:point
=/ diffs=(list [=ship =diff:point])
%~ tap by
%- ~(run by czar.tac)
|=([=life =pass] `udiff:point`[*[@ @] %keys life 1 pass])
|= [=a=life =a=pass]
^- diff:point
[%keys [*life 0 *pass] [a-life 1 a-pass]]
=. +>.$
|- ^+ +>.^$
?~ udiffs
?~ diffs
+>.^$
=. +>.^$
%- curd =< abet
%- public-keys:~(feel su hen our pki etn sap)
[%diff ship udiff]:i.udiffs
$(udiffs t.udiffs)
[%diff ship diff]:i.diffs
$(diffs t.diffs)
::
=. moz
%+ weld moz
@ -400,11 +402,11 @@
+>.$(moz [[hen %give %turf tuf.own.pki] moz])
::
:: Update from app
:: [%vent-update =vent-result]
:: [%new-event =ship =udiff:point]
::
%vent-update
%new-event
%- curd =< abet
(public-keys:~(feel su hen our pki etn sap) vent-result.tac)
(~(new-event su hen our pki etn sap) ship.tac udiff.tac)
::
:: learn of kernel upgrade
:: [%vega ~]
@ -456,11 +458,12 @@
$(tac mes)
::
:: receive keys result
:: [%public-keys-result =vent-result]
:: [%public-keys-result =public-keys-result]
::
%public-keys-result
=. moz [[hen %give %mack ~] moz]
$(tac [%vent-update vent-result.mes])
%- curd =< abet
(public-keys:~(feel su hen our pki etn sap) public-keys-result.mes)
==
::
:: rewind to snapshot
@ -527,8 +530,8 @@
:: any subscribers.
::
=| moz=(list move)
=| $: hen/duct
our/ship
=| $: hen=duct
our=ship
state-pki
state-eth-node
state-snapshots
@ -556,8 +559,8 @@
?~ noy this-su
$(noy t.noy, moz [[i.noy cad] moz])
::
++ vent-give
|= [yen=(set duct) =vent-result]
++ public-keys-give
|= [yen=(set duct) =public-keys-result]
=+ yez=~(tap in yen)
|- ^+ this-su
?~ yez this-su
@ -565,10 +568,10 @@
=. this-su
?. ?=([[%a @ @ *] *] d)
%- emit
[d %give %public-keys vent-result]
[d %give %public-keys public-keys-result]
=/ our (slav %p i.t.i.d)
=/ who (slav %p i.t.t.i.d)
=/ =message [%public-keys-result who vent-result]
=/ =message [%public-keys-result public-keys-result]
%- emit
:^ d
%pass
@ -600,7 +603,14 @@
sources-reverse.etn (~(put by sources-reverse) source top-source-id.etn)
==
::
++ extract-snap :: extract rewind point
++ new-event
|= [=a=ship =a=udiff:point]
^+ this-su
=/ a-point=point (~(gut by pos.zim.pki) a-ship *point)
=/ a-diff=diff:point (udiff-to-diff:point a-udiff a-point)
(public-keys:feel %diff a-ship a-diff)
::
++ extract-snap :: extract rewind point
^- snapshot
~
:: :: ++feed:su
@ -619,7 +629,7 @@
?~ whol
ney.zim
(~(put ju $(whol t.whol)) i.whol hen)
=/ =vent-result
=/ =public-keys-result
:- %full
?: =(~ whos)
pos.zim
@ -637,7 +647,7 @@
%+ turn ~(tap in whos)
|= who=ship
[hen who]
=. ..feed (vent-give (sy hen ~) vent-result)
=. ..feed (public-keys-give (sy hen ~) public-keys-result)
..feed
::
++ private-keys :: private keys
@ -676,13 +686,7 @@
^- [who=ship =point]
[who [rift=1 life=1 (my [1 1 pass] ~) `(^sein:title who)]]
=. moz [[hen %give %public-keys %full (my points)] moz]
|- ^+ ..feel
?~ passes
..feel
=. ..feel
%- public-keys:feel
[%diff who.i.passes *[@ @] %keys 1 1 pass.i.passes]
$(passes t.passes)
..feel
--
--
:: :: ++feel:su
@ -690,49 +694,45 @@
|%
:: :: ++pubs:feel:su
++ public-keys
|= =vent-result
|= =public-keys-result
^+ ..feel
?: ?=(%full -.vent-result)
=. pos.zim (~(uni by pos.zim) points.vent-result)
?: ?=(%full -.public-keys-result)
=. pos.zim (~(uni by pos.zim) points.public-keys-result)
=/ pointl=(list [who=ship =point])
~(tap by points.vent-result)
~(tap by points.public-keys-result)
|- ^+ ..feel
?~ pointl
..feel
%+ vent-give
%+ public-keys-give
(~(get ju ney.zim) who.i.pointl)
[%full (my i.pointl ~)]
=* who who.vent-result
=* udiff udiff.vent-result
=* who who.public-keys-result
=/ a-diff=diff:point diff.public-keys-result
=/ maybe-point (~(get by pos.zim) who)
=/ =point (fall maybe-point *point)
:: XX don't do max etc, just do the thing
=. point
?- +<.udiff
?- -.a-diff
%spon
point(sponsor sponsor.udiff)
point(sponsor to.a-diff)
::
%rift
point(rift (max rift.udiff rift.point))
point(rift to.a-diff)
::
%keys
%_ point
life (max life.udiff life.point)
life life.to.a-diff
keys
%+ ~(put by keys.point)
life.udiff
[crypto-suite pass]:udiff
life.to.a-diff
[crypto-suite pass]:to.a-diff
==
::
%disavow
~| %not-implemented !!
==
=. pos.zim (~(put by pos.zim) who point)
%+ vent-give
%+ public-keys-give
(~(get ju ney.zim) who)
?~ maybe-point
[%full (my [who point]~)]
[%diff who udiff]
[%diff who a-diff]
:: :: ++vein:feel:su
++ private-keys :: kick private keys
|= [=life =ring]

76
pkg/arvo/sys/zuse.hoon
View File

@ -2327,19 +2327,22 @@
:: of (list point-diff). Composition of arrows is concatenation,
:: and you can apply the diffs to a +point with +apply.
::
:: It's simplest to consider +point as the product of three
:: groupoids, Rift, Keys, and Sponsor. The objects of the product
:: are the product of the objects of the underlying groupoids. The
:: It's simplest to consider +point as the coproduct of three
:: groupoids, Rift, Keys, and Sponsor. Recall that the coproduct
:: of monoids is the free monoid (Kleene star) of the coproduct of
:: the underlying sets of the monoids. The construction for
:: groupoids is similar. Thus, the objects of the coproduct are
:: the product of the objects of the underlying groupoids. The
:: arrows are a list of a sum of the diff types of the underlying
:: groupoids. Given an arrow=(list diff), you can project to the
:: underlying arrows with +skim filtering on the head of each
:: diff.
:: underlying arrows with +skim filtering on the head of each diff.
::
:: The identity element is ~. Clearly, composing this with any +diff
:: gives the original +diff. Since this is a category, +compose must
:: be associative (true, because concatenation is associative). This
:: is a groupoid, so we must further have that every +point-diff has an
:: inverse. These are given by the +inverse operation.
:: The identity element is ~. Clearly, composing this with any
:: +diff gives the original +diff. Since this is a category, ::
:: +compose must be associative (true, because concatenation is
:: associative). This is a groupoid, so we must further have that
:: every +point-diff has an inverse. These are given by the
:: +inverse operation.
::
++ point
=< point
@ -2373,6 +2376,19 @@
[%disavow ~]
== ==
::
++ udiff-to-diff
|= [=a=udiff =a=point]
^- diff
?- +<.a-udiff
%disavow ~|(%udiff-to-diff-disavow !!)
%rift [%rift rift.a-point rift.a-udiff]
%spon [%spon sponsor.a-point sponsor.a-udiff]
%keys
:+ %keys
[life.a-point (~(got by keys.a-point) life.a-point)]
[life crypto-suite pass]:a-udiff
==
::
++ inverse
|= diffs=(list diff)
^- (list diff)
@ -2381,44 +2397,44 @@
|= =diff
^- ^diff
?- -.diff
%rift [%rift &2 |2]:diff
%keys [%keys &2 |2]:diff
%spon [%spon &2 |2]:diff
%rift [%rift +.diff]
%keys [%keys +.diff]
%spon [%spon +.diff]
==
::
++ compose
(bake weld ,[(list diff) (list diff)])
::
++ apply
|= [diffs=(list diff) =point]
(roll diffs (apply-diff point))
|= [diffs=(list diff) =a=point]
(roll diffs (apply-diff a-point))
::
++ apply-diff
|= =point
|: [*=diff point]
^- ^point
|= a=point
|: [*=diff a-point=a]
^- point
?- -.diff
%rift
?> =(rift.point from.diff)
point(rift to.diff)
?> =(rift.a-point from.diff)
a-point(rift to.diff)
::
%keys
?> =(life.point life.from.diff)
?> =((~(get by keys.point) life.point) `+.from.diff)
%_ point
?> =(life.a-point life.from.diff)
?> =((~(get by keys.a-point) life.a-point) `+.from.diff)
%_ a-point
life life.to.diff
keys (~(put by keys.point) life.to.diff +.to.diff)
keys (~(put by keys.a-point) life.to.diff +.to.diff)
==
::
%spon
?> =(sponsor.point from.diff)
point(sponsor to.diff)
?> =(sponsor.a-point from.diff)
a-point(sponsor to.diff)
==
--
::
+$ vent-result
+$ public-keys-result
$% [%full points=(map ship point)]
[%diff who=ship =udiff:point]
[%diff who=ship =diff:point]
==
:: ::
++ gift :: out result <-$
@ -2428,7 +2444,7 @@
[%source whos=(set ship) src=source] ::
[%turf turf=(list turf)] :: domains
[%private-keys =life vein=(map life ring)] :: private keys
[%public-keys p=vent-result] :: ethereum changes
[%public-keys =public-keys-result] :: ethereum changes
== ::
:: +seed: private boot parameters
::
@ -2455,7 +2471,7 @@
[%meet =ship =life =pass] :: met after breach
[%snap snap=snapshot kick=?] :: load snapshot
[%turf ~] :: view domains
[%vent-update =vent-result] :: update from app
[%new-event =ship =udiff:point] :: update from app
$>(%vega vane-task) :: report upgrade
$>(%wegh vane-task) :: memory usage request
$>(%west vane-task) :: remote request