urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 20:47:27 +03:00
Code Issues Packages Projects Releases Wiki Activity
3fdef14688
shrub/pkg/arvo/sys/vane/jael.hoon
Philip Monk 65d477b0fc
Merge pull request #4184 from urbit/philip/jael-order 
jael: fix breach notification ordering
2020-12-17 16:24:38 -08:00

1240 lines
36 KiB
Plaintext
Raw Blame History

!: :: /vane/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
::
|= our=ship
=, pki:jael
=, jael
=, crypto
=, jael
=, ethereum-types
=, azimuth-types
=, point=point:jael
:: ::::
:::: # models :: data structures
:: ::::
:: the %jael state comes in two parts: absolute
:: and relative.
::
:: ++state-relative is subjective, denormalized and
:: derived. it consists of all the state we need to
:: manage subscriptions efficiently.
::
=> |%
+$ state-1
$: %1
pki=state-pki-1 ::
etn=state-eth-node :: eth connection state
== ::
+$ state-pki-1 :: urbit metadata
$: $= own :: vault (vein)
$: yen=(set duct) :: trackers
sig=(unit oath) :: for a moon
tuf=(list turf) :: domains
boq=@ud :: boot block
nod=purl:eyre :: eth gateway
fak=_| :: fake keys
lyf=life :: version
step=@ud :: login code step
jaw=(map life ring) :: private keys
== ::
$= zim :: public
$: yen=(jug duct ship) :: trackers
ney=(jug ship duct) :: reverse trackers
nel=(set duct) :: trackers of all
dns=dnses :: on-chain dns state
pos=(map ship point) :: on-chain ship state
== ::
== ::
+$ message-all
$% [%0 message]
==
+$ message :: message to her jael
$% [%nuke whos=(set ship)] :: cancel trackers
[%public-keys whos=(set ship)] :: view ethereum events
== ::
+$ message-result
$% [%public-keys-result =public-keys-result] :: public keys boon
==
+$ card :: i/o action
(wind note gift) ::
:: ::
+$ move :: output
[p=duct q=card] ::
:: ::
+$ note :: out request $->
$~ [%a %plea *ship *plea:ames] ::
$% $: %a :: to %ames
$>(%plea task:ames) :: send request message
== ::
$: %b :: to %behn
$>(%wait task:behn) :: set timer
== ::
$: %e :: to %eyre
[%code-changed ~] :: notify code changed
== ::
$: %g :: to %gall
$>(%deal task:gall) :: talk to app
== ::
$: %j :: to self
$>(%listen task) :: set ethereum source
== ::
$: @tas ::
$% $>(%init vane-task) :: report install
== == == ::
:: ::
+$ sign :: in result $<-
$~ [%behn %wake ~] ::
$% $: %ames ::
$% $>(%boon gift:ames) :: message response
$>(%done gift:ames) :: message (n)ack
$>(%lost gift:ames) :: lost boon
== == ::
$: %behn ::
$>(%wake gift:behn) ::
== ::
$: %gall ::
$> $? %onto ::
%unto ::
== ::
gift:gall ::
==
== ::
-- ::
:: ::::
:::: # light :: light cores
:: ::::
=> |%
:: :: ++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
:: ::::
=>
~% %jael ..part ~
|%
:: :: ++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 core within it, but
:: we keep them separated for clarity. the ++curd and
:: ++cure arms complete relative and absolute effects,
:: respectively, at the top level.
::
:: XX doc
::
:: a general pattern here is that we use the ++et 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)
=| $: $: :: now: current time
:: eny: unique entropy
::
now=@da
eny=@uvJ
==
:: all vane state
::
state-1
==
:: lex: all durable state
:: moz: pending actions
::
=* lex ->
|%
:: :: ++abet:of
++ abet :: resolve
[(flop moz) lex]
:: :: ++sein:of
++ emit
|= =move
+>.$(moz [move moz])
::
++ poke-watch
|= [hen=duct app=term =purl:eyre]
%- emit
:* hen
%pass
/[app]/poke
%g
%deal
[our our]
app
%poke
%azimuth-tracker-poke
!>([%watch (crip (en-purl:html purl))])
==
::
++ sein :: sponsor
|= who=ship
^- ship
:: XX save %dawn sponsor in .own.sub, check there
::
=/ pot (~(get by pos.zim.pki) who)
?: ?& ?=(^ pot)
?=(^ sponsor.u.pot)
==
u.sponsor.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
::
:: boot from keys
:: $: %dawn
:: =seed
:: spon=ship
:: czar=(map ship [=rift =life =pass])
:: turf=(list turf)
:: bloq=@ud
:: node=purl
:: ==
::
%dawn
:: single-homed
::
~| [our who.seed.tac]
?> =(our who.seed.tac)
:: save our boot block
::
=. boq.own.pki bloq.tac
:: save our ethereum gateway (required for galaxies)
::
=. nod.own.pki
%+ fall node.tac
(need (de-purl:html 'http://eth-mainnet.urbit.org:8545'))
:: save our parent signature (only for moons)
::
=. sig.own.pki sig.seed.tac
:: load our initial public key
::
=/ spon-ship=(unit ship)
=/ flopped-spon (flop spon.tac)
?~(flopped-spon ~ `ship.i.flopped-spon)
=. pos.zim.pki
=/ cub (nol:nu:crub:crypto key.seed.tac)
%+ ~(put by pos.zim.pki)
our
[0 lyf.seed.tac (my [lyf.seed.tac [1 pub:ex:cub]] ~) spon-ship]
:: our initial private key
::
=. lyf.own.pki lyf.seed.tac
=. jaw.own.pki (my [lyf.seed.tac key.seed.tac] ~)
:: XX save sponsor in .own.pki
:: XX reconcile with .dns.eth
:: set initial domains
::
=. tuf.own.pki turf.tac
:: our initial galaxy table as a +map from +life to +public
::
=/ spon-points=(list [ship point])
%+ turn spon.tac
|= [=ship az-point=point:azimuth-types]
~| [%sponsor-point az-point]
?> ?=(^ net.az-point)
:* ship
continuity-number.u.net.az-point
life.u.net.az-point
(malt [life.u.net.az-point 1 pass.u.net.az-point] ~)
?. has.sponsor.u.net.az-point
~
`who.sponsor.u.net.az-point
==
=/ points=(map =ship =point)
%- ~(run by czar.tac)
|= [=a=rift =a=life =a=pass]
^- point
[a-rift a-life (malt [a-life 1 a-pass] ~) ~]
=. points
(~(gas by points) spon-points)
=. +>.$
%- curd =< abet
(public-keys:~(feel su hen now pki etn) pos.zim.pki %full points)
::
:: start subscriptions
::
=. +>.$ (poke-watch hen %azimuth-tracker nod.own.pki)
=. +>.$
:: get everything from azimuth-tracker because jael subscriptions
:: seem to be flaky for now
::
?: &
%- curd =< abet
(sources:~(feel su hen now pki etn) ~ [%| %azimuth-tracker])
::
?- (clan:title our)
%czar
%- curd =< abet
(sources:~(feel su hen now pki etn) ~ [%| %azimuth-tracker])
::
*
=. +>.$
%- curd =< abet
%+ sources:~(feel su hen now pki etn)
(silt (turn spon-points head))
[%| %azimuth-tracker]
%- curd =< abet
(sources:~(feel su hen now pki etn) ~ [%& (need spon-ship)])
==
::
=. 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 %slip %e %init ~]
[hen %slip %d %init ~]
[hen %slip %g %init ~]
[hen %slip %c %init ~]
[hen %slip %a %init ~]
==
+>.$
::
:: 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)
:: our initial public key
::
=. pos.zim.pki
%+ ~(put by pos.zim.pki)
our
[rift=1 life=1 (my [`@ud`1 [`life`1 pub:ex:cub]] ~) `(^sein:title our)]
:: our private key
::
:: Private key updates are disallowed for fake ships,
:: so we do this first.
::
=. lyf.own.pki 1
=. jaw.own.pki (my [1 sec:ex:cub] ~)
:: set the fake bit
::
=. fak.own.pki &
:: initialize other vanes per the usual procedure
::
:: Except for ourselves!
::
=. moz
%+ weld moz
^- (list move)
:~ [hen %slip %e %init ~]
[hen %slip %d %init ~]
[hen %slip %g %init ~]
[hen %slip %c %init ~]
[hen %slip %a %init ~]
==
+>.$
::
:: set ethereum source
:: [%listen whos=(set ship) =source]
::
%listen
~& [%jael-listen whos source]:tac
%- curd =< abet
(sources:~(feel su hen now pki etn) [whos source]:tac)
::
:: cancel all trackers from duct
:: [%nuke whos=(set ship)]
::
%nuke
=/ ships=(list ship)
%~ tap in
%- ~(int in whos.tac)
(~(get ju yen.zim.pki) hen)
=. ney.zim.pki
|- ^- (jug ship duct)
?~ ships
ney.zim.pki
(~(del ju $(ships t.ships)) i.ships hen)
=. yen.zim.pki
|- ^- (jug duct ship)
?~ ships
yen.zim.pki
(~(del ju $(ships t.ships)) hen i.ships)
=? nel.zim.pki ?=(~ whos.tac)
(~(del in nel.zim.pki) hen)
?^ whos.tac
+>.$
%_ +>.$
yen.own.pki (~(del in yen.own.pki) hen)
==
::
:: update private keys
::
%rekey
%- curd =< abet
(private-keys:~(feel su hen now pki etn) life.tac ring.tac)
::
:: update private keys
::
%moon
?. =(%earl (clan:title ship.tac))
~& [%not-moon ship.tac]
+>.$
?. =(our (^sein:title ship.tac))
~& [%not-our-moon ship.tac]
+>.$
%- curd =< abet
(~(new-event su hen now pki etn) [ship udiff]~:tac)
::
:: rotate web login code
::
%step
%= +>.$
step.own.pki +(step.own.pki)
moz [[hen %pass / %e %code-changed ~] moz]
==
::
:: watch public keys
:: [%public-keys ships=(set ship)]
::
%public-keys
%- curd =< abet
(~(public-keys ~(feed su hen now pki etn) hen) ships.tac)
::
:: seen after breach
:: [%meet our=ship who=ship]
::
%meet
+>.$
::
:: 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.pki tuf.own.pki]
?< =(fak.own.pki ?=(^ tuf.own.pki))
+>.$(moz [[hen %give %turf tuf.own.pki] moz])
::
:: learn of kernel upgrade
:: [%vega ~]
::
%vega
+>.$::
:: in response to memory pressure
:: [%trim p=@ud]
::
%trim
+>.$
::
:: watch private keys
:: [%private-keys ~]
::
%private-keys
(curd abet:~(private-keys ~(feed su hen now pki etn) hen))
::
:: authenticated remote request
:: [%west p=ship q=path r=*]
::
%plea
=* her ship.tac
=+ ;;(=message-all payload.plea.tac)
?> ?=(%0 -.message-all)
=/ =message +.message-all
?- -.message
::
:: cancel trackers
:: [%nuke whos=(set ship)]
::
%nuke
=. moz [[hen %give %done ~] moz]
$(tac message)
::
:: view ethereum events
:: [%public-keys whos=(set ship)]
::
%public-keys
=. moz [[hen %give %done ~] moz]
$(tac message)
==
==
::
++ take
|= [tea=wire hen=duct hin=sign]
^+ +>
?- hin
[%ames %done *]
?~ error.hin +>.$
~& [%done-bad tag.u.error.hin]
%- (slog tang.u.error.hin)
::TODO fail:et
+>.$
::
[%ames %boon *]
=+ ;; [%public-keys-result =public-keys-result] payload.hin
%- curd =< abet
(public-keys:~(feel su hen now pki etn) pos.zim.pki public-keys-result)
::
[%ames %lost *]
:: TODO: better error handling
::
~| %jael-ames-lost
!!
::
[%behn %wake *]
?^ error.hin
%- %+ slog
leaf+"jael unable to resubscribe, run :azimuth-tracker|listen"
u.error.hin
+>.$
?> ?=([%breach @ ~] tea)
=/ =source-id (slav %ud i.t.tea)
=/ =source (~(got by sources.etn) source-id)
=/ ships (~(get ju ship-sources-reverse.etn) source-id)
%- curd =< abet
(sources:~(feel su hen now pki etn) ships source)
::
[%gall %onto *]
~& [%jael-onto tea hin]
+>.$
::
[%gall %unto *]
?- +>-.hin
%kick ~|([%jael-unexpected-quit tea hin] !!)
%poke-ack
?~ p.p.+>.hin
+>.$
%- (slog leaf+"jael-bad-coup" u.p.p.+>.hin)
+>.$
::
%watch-ack
?~ p.p.+>.hin
+>.$
%- (slog u.p.p.+>.hin)
~|([%jael-unexpected-reap tea hin] +>.$)
::
%fact
?> ?=([@ *] tea)
=* app i.tea
=+ ;;(=udiffs:point q.q.cage.p.+>.hin)
%- curd =< abet
(~(new-event su hen now pki etn) udiffs)
==
==
:: :: ++curd:of
++ curd :: relative moves
|= $: moz=(list move)
pki=state-pki-1
etn=state-eth-node
==
+>(pki pki, etn etn, moz (weld (flop moz) ^moz))
--
:: :: ++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.
::
=| moz=(list move)
=| $: hen=duct
now=@da
state-pki-1
state-eth-node
==
:: moz: moves in reverse order
:: pki: relative urbit state
::
=* pki ->+<
=* etn ->+>
|%
++ this-su .
:: :: ++abet:su
++ abet :: resolve
[(flop moz) pki etn]
:: :: ++exec:su
++ emit
|= =move
+>.$(moz [move moz])
::
++ exec :: mass gift
|= [yen=(set duct) cad=card]
=/ noy ~(tap in yen)
|- ^+ this-su
?~ noy this-su
$(noy t.noy, moz [[i.noy cad] moz])
::
++ emit-peer
|= [app=term =path]
%- emit
:* hen
%pass
[app path]
%g
%deal
[our our]
app
%watch
path
==
::
++ peer
|= [app=term whos=(set ship)]
?: =(~ whos)
(emit-peer app /)
=/ whol=(list ship) ~(tap in whos)
|- ^+ this-su
?~ whol this-su
=. this-su (emit-peer app /(scot %p i.whol))
$(whol t.whol)
::
++ public-keys-give
|= [yen=(set duct) =public-keys-result]
|^
=+ yez=(sort ~(tap in yen) sorter)
|- ^+ this-su
?~ yez this-su
=* d i.yez
=. this-su
?. &(?=([[%ames @ @ *] *] d) !=(%public-keys i.t.i.d))
%- emit
[d %give %public-keys public-keys-result]
%- emit
[d %give %boon %public-keys-result public-keys-result]
$(yez t.yez)
::
:: We want to notify Ames, then Clay, then Gall. This happens to
:: be alphabetical, but this is mostly a coincidence.
::
++ sorter
|= [a=duct b=duct]
?. ?=([[@ *] *] a)
|
?. ?=([[@ *] *] b)
&
(lth (end 3 i.i.a) (end 3 i.i.b))
--
::
++ get-source
|= who=@p
^- source
=/ ship-source (~(get by ship-sources.etn) who)
?^ ship-source
(~(got by sources) u.ship-source)
?: =((clan:title who) %earl)
[%& (^sein:title who)]
(~(got by sources) default-source.etn)
::
++ get-source-id
|= =source
^- [source-id _this-su]
=/ source-reverse (~(get by sources-reverse) source)
?^ source-reverse
[u.source-reverse this-su]
:- top-source-id.etn
%_ this-su
top-source-id.etn +(top-source-id.etn)
sources.etn (~(put by sources) top-source-id.etn source)
sources-reverse.etn (~(put by sources-reverse) source top-source-id.etn)
==
::
++ new-event
|= =udiffs:point
^+ this-su
=/ original-pos pos.zim.pki
|- ^+ this-su
?~ udiffs
this-su
=/ a-point=point (~(gut by pos.zim.pki) ship.i.udiffs *point)
=/ a-diff=(unit diff:point) (udiff-to-diff:point udiff.i.udiffs a-point)
=? this-su ?=(^ a-diff)
(public-keys:feel original-pos %diff ship.i.udiffs u.a-diff)
$(udiffs t.udiffs)
::
++ subscribers-on-ship
|= =ship
^- (set duct)
=/ specific-subs (~(get ju ney.zim) ship)
=/ general-subs=(set duct)
?: ?=(?(%czar %king %duke) (clan:title ship))
nel.zim
~
(~(uni in specific-subs) general-subs)
::
++ feed
|_ :: hen: subscription source
::
hen=duct
::
:: Handle subscription to public-keys
::
++ public-keys
|= whos=(set ship)
?: fak.own.pki
(public-keys:fake whos)
:: Subscribe to parent of moons
::
=. ..feed
=/ moons=(jug ship ship)
%- ~(gas ju *(jug spon=ship who=ship))
%+ murn ~(tap in whos)
|= who=ship
^- (unit [spon=ship child=ship])
?. =(%earl (clan:title who))
~
?: (~(has by ship-sources) who)
~
`[(^sein:title who) who]
=/ moonl=(list [spon=ship ships=(set ship)])
~(tap by moons)
|- ^+ ..feed
?~ moonl
..feed
?: =(our spon.i.moonl)
$(moonl t.moonl)
=. ..feed (sources:feel ships.i.moonl [%& spon.i.moonl])
$(moonl t.moonl)
:: Add to subscriber list
::
=. ney.zim
=/ whol=(list ship) ~(tap in whos)
|- ^- (jug ship duct)
?~ whol
ney.zim
(~(put ju $(whol t.whol)) i.whol hen)
=. yen.zim
%- ~(gas ju yen.zim)
%+ turn ~(tap in whos)
|= who=ship
[hen who]
=? nel.zim ?=(~ whos)
(~(put in nel.zim) hen)
:: Give initial result
::
=/ =public-keys-result
:- %full
?: =(~ whos)
pos.zim
%- my ^- (list (pair ship point))
%+ murn
~(tap in whos)
|= who=ship
^- (unit (pair ship point))
=/ pub (~(get by pos.zim) who)
?~ pub ~
?: =(0 life.u.pub) ~
`[who u.pub]
=. ..feed (public-keys-give (sy hen ~) public-keys-result)
..feed
::
:: Handle subscription to private-keys
::
++ private-keys
%_ ..feed
moz [[hen %give %private-keys [lyf jaw]:own] moz]
yen.own (~(put in yen.own) hen)
==
::
++ fake
?> fak.own.pki
|%
++ public-keys
|= whos=(set ship)
=/ whol=(list ship) ~(tap in whos)
=/ passes
|- ^- (list [who=ship =pass])
?~ whol
~
=/ cub (pit:nu:crub:crypto 512 i.whol)
:- [i.whol pub:ex:cub]
$(whol t.whol)
=/ points=(list (pair ship point))
%+ turn passes
|= [who=ship =pass]
^- [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
--
--
::
++ feel
|%
::
:: Update public-keys
::
++ public-keys
|= [original=(map ship point) =public-keys-result]
^+ ..feel
?: ?=(%full -.public-keys-result)
=/ pointl=(list [who=ship =point])
~(tap by points.public-keys-result)
|- ^+ ..feel
?~ pointl
..feel(pos.zim (~(uni by pos.zim) points.public-keys-result))
:: if changing rift upward and we already had keys for them,
:: then signal a breach
::
=? ..feel
=/ point
(~(get by pos.zim) who.i.pointl)
?& (~(has by original) who.i.pointl)
?=(^ point)
(gth rift.point.i.pointl rift.u.point)
==
=. ..feel
%+ public-keys-give
(subscribers-on-ship who.i.pointl)
[%breach who.i.pointl]
=/ sor (~(get by sources-reverse) %& who.i.pointl)
?~ sor
..feel
:: delay resubscribing because Ames is going to clear any
:: messages we send now.
::
(emit hen %pass /breach/(scot %ud u.sor) %b %wait now)
::
=. ..feel
%+ public-keys-give
(subscribers-on-ship who.i.pointl)
[%full (my i.pointl ~)]
$(pointl t.pointl)
::
?: ?=(%breach -.public-keys-result)
:: we calculate our own breaches based on our local state
::
..feel
=* 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)
:: if changing rift upward and we already had keys for them, then
:: signal a breach
::
=? ..feel
?& (~(has by original) who)
?=(^ maybe-point)
?=(%rift -.a-diff)
(gth to.a-diff rift.point)
==
=. ..feel
%+ public-keys-give
(subscribers-on-ship who)
[%breach who]
=/ sor (~(get by sources-reverse) %& who)
?~ sor
..feel
:: delay resubscribing because Ames is going to clear any
:: messages we send now.
::
(emit hen %pass /breach/(scot %ud u.sor) %b %wait now)
::
=. point
?- -.a-diff
%spon point(sponsor to.a-diff)
%rift point(rift to.a-diff)
%keys
%_ point
life life.to.a-diff
keys
%+ ~(put by keys.point)
life.to.a-diff
[crypto-suite pass]:to.a-diff
==
==
::
=. pos.zim (~(put by pos.zim) who point)
%+ public-keys-give
(subscribers-on-ship who)
?~ maybe-point
[%full (my [who point]~)]
[%diff who a-diff]
::
:: Update private-keys
::
++ private-keys
|= [=life =ring]
^+ ..feel
?: &(=(lyf.own life) =((~(get by jaw.own) life) `ring))
..feel
=. lyf.own life
=. jaw.own (~(put by jaw.own) life ring)
(exec yen.own [%give %private-keys lyf.own jaw.own])
::
:: Change sources for ships
::
++ sources
|= [whos=(set ship) =source]
^+ ..feel
=^ =source-id this-su (get-source-id source)
=. ..feed
?~ whos
..feed(default-source.etn source-id)
=/ whol=(list ship) ~(tap in `(set ship)`whos)
=. ship-sources.etn
|- ^- (map ship ^source-id)
?~ whol
ship-sources.etn
(~(put by $(whol t.whol)) i.whol source-id)
=. ship-sources-reverse.etn
%- ~(gas ju ship-sources-reverse.etn)
(turn whol |=(=ship [source-id ship]))
..feed
::
?: ?=(%& -.source)
%- emit
=/ =message-all [%0 %public-keys whos]
[hen %pass /public-keys %a %plea p.source %j /public-keys message-all]
(peer p.source whos)
--
::
:: No-op
::
++ meet
|= [who=ship =life =pass]
^+ +>
+>.$
--
--
:: ::::
:::: # vane :: interface
:: ::::
::
:: lex: all durable %jael state
::
=| lex=state-1
|= $: :: now: current time
:: eny: unique entropy
:: ski: namespace resolver
::
now=@da
eny=@uvJ
rof=roof
==
^?
|%
:: :: ++call
++ call :: request
|= $: :: hen: cause of this event
:: hic: event data
::
hen=duct
dud=(unit goof)
hic=(hobo task)
==
^- [(list move) _..^$]
?^ dud
~|(%jael-call-dud (mean tang.u.dud))
::
=/ =task ((harden task) hic)
=^ did lex
abet:(~(call of [now eny] lex) hen task)
[did ..^$]
:: :: ++load
++ load :: upgrade
|= old=state-1
^+ ..^$
..^$(lex old)
:: :: ++scry
++ scry :: inspect
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
=* ren car
=* why=shop &/p.bem
=* syd q.bem
=* lot=coin $/r.bem
=* tyl s.bem
::
:: XX review for security, stability, cases other than now
::
?. =(lot [%$ %da now]) ~
?. =(%$ ren) [~ ~]
?: =(tyl /whey)
=/ maz=(list mass)
:~ pki+&+pki.lex
etn+&+etn.lex
==
``mass+!>(maz)
?+ syd
~
::
%step
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
``[%noun !>(step.own.pki.lex)]
::
%code
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
=/ sec (~(got by jaw.own.pki.lex) lyf.own.pki.lex)
=/ sal (add %pass step.own.pki.lex)
``[%noun !>((end 6 (shaf sal (shax sec))))]
::
%life
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have life=1
::
?: fak.own.pki.lex
``[%atom !>(1)]
?: =(u.who p.why)
``[%atom !>(lyf.own.pki.lex)]
=/ pub (~(get by pos.zim.pki.lex) u.who)
?~ pub ~
``[%atom !>(life.u.pub)]
::
%lyfe :: unitized %life
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have life=1
::
?: fak.own.pki.lex
``[%noun !>((some 1))]
?: =(u.who p.why)
``[%noun !>((some lyf.own.pki.lex))]
=/ pub (~(get by pos.zim.pki.lex) u.who)
?~ pub ``[%noun !>(~)]
``[%noun !>((some life.u.pub))]
::
%rift
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have rift=1
::
?: fak.own.pki.lex
``[%atom !>(1)]
=/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ~
``[%atom !>(rift.u.pos)]
::
%ryft :: unitized %rift
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:: fake ships always have rift=1
::
?: fak.own.pki.lex
``[%noun !>((some 1))]
=/ pos (~(get by pos.zim.pki.lex) u.who)
?~ pos ``[%noun !>(~)]
``[%noun !>((some rift.u.pos))]
::
%vein
?. ?=([@ ~] tyl) [~ ~]
?. &(?=(%& -.why) =(p.why our))
[~ ~]
=/ lyf (slaw %ud i.tyl)
?~ lyf [~ ~]
::
?~ r=(~(get by jaw.own.pki.lex) u.lyf)
[~ ~]
::
[~ ~ %noun !>(u.r)]
::
%vile
=* life lyf.own.pki.lex
=/ =seed [our life (~(got by jaw.own.pki.lex) life) ~]
[~ ~ %atom !>((jam seed))]
::
%deed
?. ?=([@ @ ~] tyl) [~ ~]
?. &(?=(%& -.why) =(p.why our))
[~ ~]
=/ who (slaw %p i.tyl)
=/ lyf (slaw %ud i.t.tyl)
?~ who [~ ~]
?~ lyf [~ ~]
::
?: fak.own.pki.lex
=/ cub (pit:nu:crub:crypto 512 u.who)
:^ ~ ~ %noun
!> [1 pub:ex:cub ~]
::
=/ rac (clan:title u.who)
?: ?=(%pawn rac)
?. =(u.who p.why)
[~ ~]
?. =(1 u.lyf)
[~ ~]
=/ sec (~(got by jaw.own.pki.lex) u.lyf)
=/ cub (nol:nu:crub:crypto sec)
=/ sig (sign:as:cub (shaf %self (sham [u.who 1 pub:ex:cub])))
:^ ~ ~ %noun
!> [1 pub:ex:cub `sig]
::
=/ pub (~(get by pos.zim.pki.lex) u.who)
?~ pub
~
?: (gth u.lyf life.u.pub)
~
=/ pas (~(get by keys.u.pub) u.lyf)
?~ pas
~
:^ ~ ~ %noun
!> [u.lyf pass.u.pas ~]
::
%earl
?. ?=([@ @ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
=/ lyf (slaw %ud i.t.tyl)
?~ who [~ ~]
?~ lyf [~ ~]
?: (gth u.lyf lyf.own.pki.lex)
~
?: (lth u.lyf lyf.own.pki.lex)
[~ ~]
:: XX check that who/lyf hasn't been booted
::
=/ sec (~(got by jaw.own.pki.lex) u.lyf)
=/ moon-sec (shaf %earl (sham our u.lyf sec u.who))
=/ cub (pit:nu:crub:crypto 128 moon-sec)
=/ =seed [u.who 1 sec:ex:cub ~]
``[%seed !>(seed)]
::
%sein
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:^ ~ ~ %atom
!> ^- ship
(~(sein of [now eny] lex) u.who)
::
%saxo
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
=/ who (slaw %p i.tyl)
?~ who [~ ~]
:^ ~ ~ %noun
!> ^- (list ship)
(~(saxo of [now eny] lex) u.who)
::
%subscriptions
?. ?=([@ ~] tyl) [~ ~]
?. =([%& our] why)
[~ ~]
:^ ~ ~ %noun
!>([yen ney nel]:zim.pki.lex)
::
%sources
?. ?=(~ tyl) [~ ~]
:^ ~ ~ %noun !>
etn.lex
::
%turf
?. ?=(~ tyl) [~ ~]
[~ ~ %noun !>(tuf.own.pki.lex)]
==
:: :: ++stay
++ stay :: preserve
lex
:: :: ++take
++ take :: accept
|= $: :: tea: order
:: hen: cause
:: hin: result
::
tea=wire
hen=duct
dud=(unit goof)
hin=sign
==
^- [(list move) _..^$]
?^ dud
~|(%jael-take-dud (mean tang.u.dud))
::
=^ did lex abet:(~(take of [now eny] lex) tea hen hin)
[did ..^$]
--
Reference in New Issue View Git Blame Copy Permalink