urbit/arvo/jael.hoon

437 lines
16 KiB
Plaintext
Raw Normal View History

2016-04-08 20:08:05 +03:00
:: %jael, secret
::
:::: /hoon/jael
::
!? 164
2016-08-08 00:47:51 +03:00
!: ::
|= pit/vase
2016-04-08 20:08:05 +03:00
=> =~
:: private structures :: ::
:::: :: ::
:: :: ::
2016-08-08 00:47:51 +03:00
|%
++ jael-state :: all crypto state
$: ver/$0 :: %jael version
2016-08-31 01:23:00 +03:00
nav/jael-objective :: all universal state
2016-09-06 20:56:36 +03:00
:: nix/jael-subjective :: all derived state
2016-04-08 20:08:05 +03:00
== ::
2016-08-31 01:23:00 +03:00
++ jael-objective :: all universal state
$: urb/jael-urbit :: all urbit state
2016-09-06 20:56:36 +03:00
web/(map (list @ta) jael-web-domain) :: all web state
2016-04-08 20:08:05 +03:00
== ::
2016-09-06 20:56:36 +03:00
++ jael-web-domain :: per foreign app
$: sec/(map @t jael-web-app) :: client per api key
usr/(map @ta jael-web-user) :: direct user info
2016-04-08 20:08:05 +03:00
== ::
2016-09-06 20:56:36 +03:00
++ jael-web-app :: local app
2016-08-31 01:23:00 +03:00
$: key/(unit (pair @da @)) :: API key
2016-09-06 20:56:36 +03:00
tok/(map @t (pair @da @)) :: token by username
2016-04-08 20:08:05 +03:00
== ::
2016-09-06 20:56:36 +03:00
++ jael-web-user :: per-user secrets
2016-08-31 01:23:00 +03:00
$: pas/(unit @t) :: password
2016-09-06 20:56:36 +03:00
dey/(unit @t) :: display name
2016-08-25 08:05:26 +03:00
== ::
2016-08-31 01:23:00 +03:00
++ jael-urbit :: objective urbit
$: pub/gree :: all public state
pry/(map ship jael-ship) :: all private state
2016-08-08 00:47:51 +03:00
== ::
2016-08-31 01:23:00 +03:00
++ jael-ship :: objective by ship
2016-09-06 20:56:36 +03:00
$: rel/(map ship jael-friend) :: relationships
2016-08-31 01:23:00 +03:00
own/(map life ring) :: private keys
2016-09-06 20:56:36 +03:00
vew/(set duct) :: watchers
== ::
++ jael-friend :: relationship
2016-09-07 20:33:42 +03:00
$: luf/(unit life) :: life as known to
2016-09-06 20:56:36 +03:00
lab/(nap jael-right) :: promises to
vow/(set duct) :: watchers
2016-08-08 00:47:51 +03:00
== ::
2016-09-07 20:33:42 +03:00
++ jael-inference :: learning result
$% {$hard p/ship} :: rough update to
{$meet p/ship} :: first contact with
{$soft p/ship} :: soft update to
{$sign p/ship q/gree} :: return signature
==
2016-08-31 01:23:00 +03:00
++ jael-right :: urbit commitment
$% {$block p/pile} :: address block
{$email p/(set @ta)} :: email addresses
{$entry p/(map hand (pair @da code))} :: symmetric keys
{$final p/(map ship @uvG)} :: tickets
{$fungi p/(map term @ud)} :: fungibles
2016-09-07 20:36:06 +03:00
{$lived p/life} :: PKI commitment
2016-08-31 01:23:00 +03:00
== ::
++ jael-task :: operations on
2016-09-07 20:36:06 +03:00
$% {$give p/ship q/(nap jael-right)} :: add rights
2016-08-31 01:23:00 +03:00
{$line p/ship q/@da r/code} :: outbound symkey
{$link p/ship q/@da r/code} :: inbound symkey
{$meet p/gree} :: integrate truth
{$over p/ship q/jael-task} :: mirror operation
2016-09-06 20:56:36 +03:00
{$pall p/ship q/life} :: our life acked
{$ring p/? q/(map chip (pair @ta @t)) r/ring} :: update private key
2016-09-07 20:36:06 +03:00
{$take p/ship q/(nap jael-right)} :: subtract rights
2016-09-06 20:56:36 +03:00
{$vain $~} :: watch self
{$vest $~} :: watch assets
2016-08-31 01:23:00 +03:00
{$view p/ship} :: watch urbit
2016-09-06 20:56:36 +03:00
{$vile p/(list @ta)} :: watch website
2016-08-31 01:23:00 +03:00
{$west p/ship q/path r/*} :: remote request
2016-09-05 02:35:37 +03:00
{$wink p/@ta q/@t r/(unit (pair @da @))} :: set API key
2016-09-06 20:56:36 +03:00
{$wonk p/@ta q/@t r/@t s/(unit (pair @da @))} :: set API token
== ::
++ jael-report-them :: report on neighbor
$: gur/grue :: certificate
lab/(nap jael-right) :: our promises to
own/(nap jael-right) :: our promises from
== ::
++ jael-report-self :: report on self
$: gur/grue :: certificate
war/(map life ring) :: private keys
== ::
++ jael-report-cash :: neighbors/assets
$: has/(map ship (nap jael-right)) ::
2016-08-31 01:23:00 +03:00
== ::
2016-09-06 20:56:36 +03:00
++ jael-report-paid :: asset diff
$: dif/(list (trel ship ? (nap jael-right))) :: who, +/-, what
== ::
:: ::
2016-08-31 01:23:00 +03:00
++ jael-gift :: output
2016-09-06 20:56:36 +03:00
$? {$cash jael-report-cash} :: asset dump
{$clue jael-report-them} :: channel dump
{$paid jael-report-paid} :: asset update
{$self jael-report-self} :: self dump
{$well jael-web-domain} :: service update
2016-08-31 01:23:00 +03:00
== ::
++ jael-message :: p2p message
2016-09-06 20:56:36 +03:00
$% {$hail p/(nap jael-right)} :: re/set rights
2016-08-31 01:23:00 +03:00
{$ping $~} :: ping
2016-09-06 20:56:36 +03:00
{$seed p/gree} :: propagate
2016-08-31 01:23:00 +03:00
== ::
++ jael-action :: pki change
$: why/?($hear $make) :: &=import, |=export
gut/(list jael-change) :: new information
== ::
++ jael-change :: pki delta
$% {$step p/ship q/life r/lace} :: new deed
{$sure p/ship q/life r/mind s/@} :: new signature
== ::
2016-09-07 20:36:06 +03:00
++ jael-effect :: propagation effect
$% {$cold p/ship q/life} :: breach to life
{$helo p/ship} :: intro neighbor
{$sign p/ship q/life} :: added signature
2016-09-08 19:29:38 +03:00
{$stir p/ship q/life} :: updated signature
2016-09-07 20:36:06 +03:00
{$sure p/ship q/life} :: signature confirmed
{$warm p/ship q/life} :: advance to life
{$yell p/gree} :: propagate
== ::
++ mile
$
2016-09-08 19:29:38 +03:00
++ meet :: merge worlds
2016-09-07 20:36:06 +03:00
|= {via/@p new/gree old/gree}
^- (list jael-action)
|^ =+ wen=(~(tap by new))
|- ^- (list jael-action)
?~ wen ~
(weld (boat i.wen) $(wen t.wen))
2016-09-07 20:36:06 +03:00
:: ::
++ boat :: merge per ship
|= {who/ship gur/grue}
^- (list jael-action)
2016-09-08 19:29:38 +03:00
=+ rug=((bond |.(*grue)) (~(get by old) who))
?: =(gur rug) [~ rug]
=+ :* num=1
end=(max p.gur p.rug)
==
=| $: pre/(unit lace)
fex/(list jael-effect)
gum/(list (pair life lace))
==
=- [(flop p) `grue`[end (~(gas by *(map life lace)) q]]
|- ^+ [p=fex q=gum]
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
:: lives are 1 through n
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
?: (gth num end) [fex gum]
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
:: `lod` is the old deed, `wan` the new deed
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
=+ :- lod=(~(get by q.rug) num)
wan=(~(get by q.gur) num)
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
:: build a new deed and continue with it
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
=- $(num +(num), fex p, pre `q, gum :_(gum [num q]))
^- (pair (list jael-effect) lace)
::
:: if no new information, do nothing
::
?: |(?=($~ wan) =(wan lod))
?> ?=(^ lod)
[fex u.lod]]
::
:: hash new data and check parent validity
2016-09-08 19:29:38 +03:00
::
=+ ash=(sham dat.u.wan)
=+ def=(sein who)
=+ mir=(clan who)
?> ?: |(=(num 1) =(%earl mir) =(%pawn mir))
::
:: comets and moons must stay with default parent
::
=(def dad.dat.u.wan)
::
:: other ships may migrate to parent of same rank
::
=((clan def) (clan dad.dat.u.wan))
::
:: if we have an old deed at this life, merge them
::
2016-09-08 19:29:38 +03:00
?: ?=(^ lod)
::
:: deed data must be identical
::
?> =(dat.u.wan dat.u.lod)
::
:: replace fresher signatures, add new ones
::
=+ sow=`(list (trel ship life @))`(~(tap by syg.u.wan))
|- ^- (pair (list jael-effect) lace)
?~ sow [fex u.lod]
=+ ect=(~(get by u.lod) p.i.sow)
::
:: ignore obsolete or equal signature
::
?. |(?=(~ ect) (gth q.i.sow p.u.ect))
$(sow t.sow)
::
:: merge new, or newer, signature
::
?> (good [p.i.sow q.i.sow] ash r.i.sow)
%= $
sow t.sow
fex [stir+who fex]
u.lod (~(put by u.lod) p.i.sow [q r]:i.sow)
==
::
:: non-initial deeds must be signed by previous
2016-09-08 19:29:38 +03:00
::
?> ?| ?=($~ pre)
=+ laz=(~(got by syg.u.wan) who)
?> =(p.laz (dec num))
=(ash (need (sure:as:(com:nu:crub pub.dat.u.pre) *code q.laz)))
==
::
:: check the parent has signed, if necessary
::
?> ?| ::
:: no parent signature for existing, non-moon urbits
::
?& ?=(^ pre)
=(dad.dat.u.pre dad.dat.u.wan)
!=(%earl mir)
==
::
:: public keys for galaxies are hardcoded
::
?& =(%czar mir)
?=(~ pre)
=(pub.dat.u.wan (zeno who))
==
::
:: no parent signature if we got this deed from the parent
::
=(via dad.dat.u.wan)
::
:: valid parent signature required
::
=+ par=(~(got by syg.u.wan) dad.dat.u.wan)
(good [dad.dat.u.wan p.par] ash q.par)
==
::
:: if we don't need to add a signature, report the new deed
::
?. =(~ (~(get by syg.u.wan) dad.dat.u.wan))
[
::
:: new deed for a new ship
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
?: (lth who 256)
::
:: initial galaxy public key must match hardcode
::
?> =(pub.dat.u.wan (zeno who))
2016-09-07 20:36:06 +03:00
::
2016-09-08 19:29:38 +03:00
:: initial parent is predefined
::
?> =(dad.dat.u.wan (sein who))
?> ?| =(via dad.dat.u.wan)
=+ par=
2016-09-08 19:29:38 +03:00
==
2016-09-07 20:36:06 +03:00
:: ::
++ look :: get public key
|= myn/mind
2016-09-08 19:29:38 +03:00
^- @
::
:: first galaxy key is hardcoded
::
?: &((lth who.myn 256) =(1 lyf.myn))
(zeno who.myn)
::
:: cascade search over old and new, new first
::
|^ (need ((bond |.((find myn))) (find(old new) myn)))
2016-09-07 20:36:06 +03:00
++ find
^- (unit @)
%+ biff (~(get by old) who.myn)
|= gur/grue
2016-09-08 19:29:38 +03:00
::
:: crash if this life is revoked
::
?> =(p.gur lyf.myn)
2016-09-07 20:36:06 +03:00
%+ biff (~(get by q.gur) lyf.myn)
2016-09-08 19:29:38 +03:00
|=(lace `pub.dat)
2016-09-07 20:36:06 +03:00
--
2016-09-08 19:29:38 +03:00
:: ::
++ good :: verify signature
2016-09-07 20:36:06 +03:00
|= {myn/mind ash/@ val/@}
2016-09-08 19:29:38 +03:00
^- ?
?>(=(ash (need (sure:as:(com:nu:crub (look myn)) *code val))) &)
2016-09-07 20:36:06 +03:00
--
2016-08-31 01:23:00 +03:00
++ move {p/duct q/{$gift jael-gift}} :: local move
2016-08-08 00:47:51 +03:00
-- ::
. == ::
=| lex/jael-state :: kernel state
2016-04-09 01:25:40 +03:00
|= {now/@da eny/@ ski/sley} :: current invocation
2016-08-08 00:47:51 +03:00
=< |% :: vane interface
++ call :: request
|= $: hen/duct
2016-08-31 01:23:00 +03:00
hic/(hypo (hobo jael-task))
2016-08-08 00:47:51 +03:00
==
2016-08-31 01:23:00 +03:00
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard jael-task) p.q.hic)))
2016-08-08 00:47:51 +03:00
^- {p/(list move) q/_..^$}
2016-09-06 20:56:36 +03:00
=^ did lex (^call hen q.hic)
[did ..^$]
2016-08-08 00:47:51 +03:00
::
++ doze :: sleep
|= {now/@da hen/duct}
^- (unit @da)
~
::
++ load :: upgrade
|= old/jael-state
^+ ..^$
~& %jael-reload
..^$(lex old)
::
++ scry
2016-09-05 02:35:37 +03:00
|= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path}
2016-08-08 00:47:51 +03:00
^- (unit (unit cage))
!!
::
++ stay lex
++ take :: accept response
|= {tea/wire hen/duct hin/(hypo sign-arvo)}
^- {p/(list move) q/_..^$}
[~ ..^$]
--
|%
2016-09-06 20:56:36 +03:00
++ call
|= {hen/duct tac/jael-task}
^- {(list move) jael-state}
?+ -.tac !!
$give
=< abet
=< abet
(give:(unto:(from our) p.tac) q.tac)
::
$link
=* ryt `jael-right`[%entry [[(shaf %hand r.tac) q.tac r.tac] ~ ~]]
=< abet
=< abet
(give:(unto:(from our) p.tac) `(nap jael-right)`[ryt ~ ~])
::
$line
=* ryt `jael-right`[%entry [[(shaf %hand r.tac) q.tac r.tac] ~ ~]]
2016-09-06 22:53:02 +03:00
=< abet
=< abet
(give:(unto:(from p.tac) our) `(nap jael-right)`[ryt ~ ~])
2016-09-06 23:29:09 +03:00
::
2016-09-07 20:33:42 +03:00
$meet
=^ fur pub.urb.nav.lex (~(meet da pub.urb.nav.lex) p.tac)
[~ lex]
::
$over
$(our p.tac, tac q.tac)
::
$pall
=< abet
=< abet
(pall:(unto:(from our) p.tac) q.tac)
2016-09-06 20:56:36 +03:00
==
::
2016-09-07 20:33:42 +03:00
++ meld
|= {new/gree old/gree}
=+
=< work
|% ++ abet
++ work
=+ wen=(~(tap by new))
|- ^- {(list jael-inference
++
=+ wen=(~(tap by new))
|- ^- {gree gree}
?~ wen [~ old]
=+ mor=$(wen t.wen)
++ da :: pedigree core
|_ {via/ship ped/gree}
++ meet
|= new/gree
=+ wen=(~(tap by new))
|- ^- {(list jael-inference) gree}
?~ wen [~ ped]
=+ mor=$(wen t.wen)
--
::
2016-09-06 20:56:36 +03:00
++ from
|= rex/ship
=+ :* nex=*(list move)
((bond |.(*jael-ship)) (~(get by pry.urb.nav.lex) rex))
==
|%
++ abet
^- {(list move) jael-state}
:- (flop nex)
lex(pry.urb.nav (~(put by pry.urb.nav.lex) rex `jael-ship`+<+))
::
++ unto
|= pal/ship
=+ ((bond |.(*jael-friend)) (~(get by rel) pal))
|%
++ abet :: resolve
..unto(rel (~(put by rel) pal `jael-friend`+<))
::
++ give
|= lab/(nap jael-right)
^+ +>
!!
2016-09-07 20:33:42 +03:00
::
++ pall
|= lyf/life
?> |(?=($~ luf) =(u.luf lyf) =(
+>(luf `lyf)
%= +>
luf
?~ luf `lyf
?: =(u.luf
==
2016-09-06 20:56:36 +03:00
--
--
2016-04-08 20:08:05 +03:00
--