urbit/arvo/jael.hoon

655 lines
24 KiB
Plaintext
Raw Normal View History

2016-09-13 03:24:21 +03:00
!: :: /van/jael
:: :: %classic
!? 150
|= pit/vase :: XX remove from arvo api
:: ::::
:::: :: 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-13 03:24:21 +03:00
web/(map site 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
2016-09-12 04:07:23 +03:00
$: pug/gree :: all public state
2016-08-31 01:23:00 +03:00
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-13 03:24:21 +03:00
++ jael-gift :: output
$? {$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-right :: urbit commitment
2016-09-12 04:07:23 +03:00
$% {$block p/pile} :: reserved block
2016-08-31 01:23:00 +03:00
{$email p/(set @ta)} :: email addresses
{$entry p/(map hand (pair @da code))} :: symmetric keys
2016-09-12 04:07:23 +03:00
{$final p/(map ship @uvG)} :: ticketed ships
2016-08-31 01:23:00 +03:00
{$fungi p/(map term @ud)} :: fungibles
2016-09-12 04:07:23 +03:00
{$guest $~} :: refugee visa
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
2016-09-12 04:07:23 +03:00
{$meet p/ship q/gree} :: integrate pki from
2016-08-31 01:23:00 +03:00
{$over p/ship q/jael-task} :: mirror operation
2016-09-06 20:56:36 +03:00
{$pall p/ship q/life} :: our life acked
2016-09-12 04:07:23 +03:00
{$step p/lamp} :: 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-13 03:24:21 +03:00
{$vile p/site} :: watch website
2016-08-31 01:23:00 +03:00
{$west p/ship q/path r/*} :: remote request
2016-09-13 03:24:21 +03:00
{$wink p/site q/@t r/(unit bill)} :: set web API key
{$wish p/site q/@t r/(unit @t)} :: set web login
{$wonk p/site q/@t r/@t s/(unit bill)} :: set web API token
2016-09-06 20:56:36 +03:00
== ::
++ 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-09-12 04:07:23 +03:00
++ jael-note :: out request $->
$% {$x $mess p/ship q/path r/*} :: send message
== ::
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-09-12 04:07:23 +03:00
{$ping p/gree} :: propagate
2016-08-31 01:23:00 +03:00
== ::
2016-09-13 03:24:21 +03:00
++ jael-edit :: pki change
$: why/?($hear $make) :: import or create
gut/jael-change :: new information
== ::
2016-09-12 04:07:23 +03:00
++ jael-effect :: objective effect
2016-09-13 03:24:21 +03:00
$% {$kick p/ship} :: ship key update
{$ping p/ship q/gree} :: propagate keys to
{$seat p/site q/@ta} :: webapp key update
{$site p/site} :: website key update
{$slap p/ship q/ship} :: channel key update
2016-09-12 04:07:23 +03:00
== ::
++ 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-13 03:24:21 +03:00
++ jael-move :: output
{p/duct q/(wind jael-note jael-gift)}
--
:: ::::
:::: :: static data
:: ::::
=> |%
:: :: zeno
++ zeno :: boot signatures
|= :: who: galaxy (0-255)
::
who/ship
^- pass
!!
--
:: ::::
:::: :: reactors
:: ::::
=> |%
:: :: oven
++ oven :: general reactor
=| $: $: :: now: current time ::::
:: eny: unique entropy
2016-09-12 04:07:23 +03:00
::
2016-09-13 03:24:21 +03:00
now/@da
eny/@e
2016-09-12 04:07:23 +03:00
==
2016-09-13 03:24:21 +03:00
:: all vane state
2016-09-12 04:07:23 +03:00
::
2016-09-13 03:24:21 +03:00
jael-state
2016-09-12 04:07:23 +03:00
==
::
2016-09-13 03:24:21 +03:00
:: moz: pending actions
:: lex: all durable state
::
2016-09-13 03:24:21 +03:00
=* lex ->+
=| moz/(list jael-move)
2016-09-12 04:07:23 +03:00
|%
2016-09-13 03:24:21 +03:00
:: :: abet:oven
2016-09-12 04:07:23 +03:00
++ abet :: resolve
2016-09-13 03:24:21 +03:00
[(flop moz) lex]
:: :: call:oven
++ call :: invoke
|= $: :: hen: event cause
:: tac: event data
2016-09-12 04:07:23 +03:00
::
2016-09-13 03:24:21 +03:00
hen/duct
tac/jael-task
2016-09-12 04:07:23 +03:00
==
2016-09-13 03:24:21 +03:00
^+ +>
?- -.tac
::
2016-09-13 03:24:21 +03:00
:: add rights
:: {$give p/ship q/(nap jael-right))}
::
2016-09-13 19:41:54 +03:00
$give
abet:(give:~(call ur urb.nav) our [p q]:tac)
2016-09-12 04:07:23 +03:00
::
2016-09-13 03:24:21 +03:00
:: outbound symmetric key
:: {$link p/ship q/@da r/code}
2016-09-12 04:07:23 +03:00
::
2016-09-13 03:24:21 +03:00
$link
=* ryt [%entry [[(shaf %hand r.tac) q.tac r.tac] ~ ~]]
2016-09-13 19:41:54 +03:00
abet:(give:~(call ur urb.nav) our p.tac ryt)
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
:: inbound symmetric key
:: {$line p/ship q/@da r/code}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$line
2016-09-13 19:41:54 +03:00
=* ryt [%entry [[(shaf %hand r.tac) q.tac r.tac] ~ ~]]
abet:(give:~(call ur urb.nav) p.tac our ryt)
:
2016-09-13 03:24:21 +03:00
:: public-key update
:: {$meet p/ship q/gree}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$meet
2016-09-13 19:41:54 +03:00
abet:(meet:~(call ur urb.nav) p.tac q.tac)
::
2016-09-13 19:41:54 +03:00
:: learn as other ship
2016-09-13 03:24:21 +03:00
:: {$over p/ship q/jael-task}
::
2016-09-13 03:24:21 +03:00
$over
$(our p.tac, tac q.tac)
::
2016-09-13 19:41:54 +03:00
:: remote version acknowledgment
2016-09-13 03:24:21 +03:00
:: {$pall p/ship q/life}
::
2016-09-13 03:24:21 +03:00
$pall
2016-09-13 19:41:54 +03:00
abet:(pall:~(call ur urb.urb.nav)
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
:: extend our certificate with a new private key
:: {$step p/lamp}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$step
!!
::
2016-09-13 03:24:21 +03:00
:: remove rights
:: {$take p/ship q/(nap jael-right)}
::
$take
!!
::
2016-09-13 03:24:21 +03:00
:: monitor self
:: {$vain $~}
::
2016-09-13 03:24:21 +03:00
$vain
!!
::
2016-09-13 03:24:21 +03:00
:: monitor assets
:: {$vest $~}
2016-09-07 20:36:06 +03:00
::
2016-09-13 03:24:21 +03:00
$vest
!!
2016-09-07 20:36:06 +03:00
::
2016-09-13 03:24:21 +03:00
:: monitor website
:: {$vile p/site}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$vile
!!
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
:: execute remote request
:: {$west p/ship q/path r/*}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$west
!!
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
:: set/clear web API key
:: {$wink p/site q/@t r/(unit bill)}
2016-09-08 19:29:38 +03:00
::
2016-09-13 03:24:21 +03:00
$wink
!!
2016-09-06 20:56:36 +03:00
::
2016-09-13 03:24:21 +03:00
:: set/clear web password
:: {$wish p/site q/@t r/(unit @t)}
::
$wish
2016-09-06 20:56:36 +03:00
!!
2016-09-07 20:33:42 +03:00
::
2016-09-13 03:24:21 +03:00
:: set/clear web API token
:: {$wonk p/site q/@t r/@t s/(unit bill)}
::
$wonk
!!
2016-09-13 03:24:21 +03:00
==
:: :: emil:oven
++ emil :: effects
|= :: moz: effects in order
::
moz/(list jael-move)
^+(moz (weld (flop moz) ^moz))
:: :: emit:oven
++ emit :: effect
|= :: mov: effect
::
mov/jael-move
^+(moz [mov moz])
:: :: fear:oven
++ fear :: run urbit effects
|= rod/(list jael-effect)
^+ +>
!!
:: :: ur:oven
++ ur :: urbit reactor
=| jael-urbit
::
:: hab: effects in reverse order
:: urb: all urbit state
::
=| hab/(list jael-effect)
=* urb ->
|%
:: :: abet:ur:oven
++ abet :: resolve
[(flop hab) urb]
:: :: from:ur:oven
++ from :: server reactor
|= :: rex: server ship
::
rex/ship
::
:: shy: server state
::
=+ ((bond |.(*jael-ship)) (~(get by pry) rex))
=* shy -
|%
:: :: abet:from:ur:oven
++ abet :: resolve
^+ ..from
..from(pry.urb.nav (~(put by pry) rex shy))
:: :: unto:from:ur:oven
++ unto :: client reactor
|= :: pal: client ship
::
pal/ship
::
:: cly: client state
::
=+ ((bond |.(*jael-friend)) (~(get by rel) pal))
=* cly -
|%
:: :: abet:unto:from:ur:
++ abet :: resolve
^+ ..unto
..unto(rel (~(put by rel) pal cly))
:: :: give:unto:from:ur:
++ give :: credit
|= lab/(nap jael-right)
^+ +>
!!
--
--
:: :: mean:ur:oven
++ mean :: apply merge
|= ved/(list jael-edit)
^+ +>
!!
:: :: meet:ur:oven
++ meet :: calculate merge
|= $: :: via: source of new info
:: new: new pki info
::
via/@p
new/gree
==
^+ +>
|^ ::
:: check new info ship by ship
::
=- (mean -)
=+ (~(tap by new))
|- ^- (list jael-edit)
?~ +< ~
(weld (boat i.+<) $(+< t.+<))
:: ::
++ boat :: merge ships
|= $: :: who: this ship
:: gur: new will for this ship
::
who/ship
gur/grue
==
^- (list jael-edit)
::
:: rug: old will for this ship
::
=+ rug=(fall (~(get by pug) who) *grue)
?: =(gur rug) ~
=+ :* ::
:: num: life counter
:: end: last life in old or new ship
::
num=`life`1
end=(max p.gur p.rug)
==
=| $: :: pre: previous deed
:: fex: edits in reverse order
::
pre/(unit lama)
fex/(list jael-edit)
==
|- ^+ fex
::
:: merge all lives in :%
::
?: (gth num end)
(flop fex)
::
:: lub: deed merge for this life
::
=+ ^= lub
%- bonk
:* who
num
pre
(~(get by q.rug) num)
(~(get by q.gur) num)
==
%= $
num +(num)
pre `p.lub
fex (weld (flop q.lub) fex)
==
:: ::
++ bonk :: merge lives
|= $: :: who: ship we're merging
:: num: life we're merging
:: pre: previous deed
:: lod: old deed
:: wan: new deed
::
who/ship
num/@ud
pre/(unit lama)
lod/(unit lace)
wan/(unit lace)
==
^- $: :: p: next previous deed
:: q: edits in order
::
p/lama
q/(list jael-edit)
==
::
:: if no new information, do nothing
::
?: |(?=($~ wan) =(wan lod))
?> ?=(^ lod)
[dat.u.lod ~]
::
:: ash: hash of deed content
:: def: our default parent
:: dad: our declared parent
:: mir: our rank
::
=/ ash (sham dat.u.wan)
=/ def (sein who)
=* dad dad.doc.dat.u.wan
=/ mir (clan who)
?> ?: |(=(num 1) =(%earl mir) =(%pawn mir))
::
:: comets and moons must stay with default parent
::
=(def dad)
::
:: other ships may migrate to parent of same rank
::
=((clan def) (clan dad))
::
:: if we have an old deed at this life, merge them
::
?: ?=(^ lod)
::
:: use the old deed as the next previous
::
:- dat.u.lod
::
:: deed data must be identical
::
?> =(dat.u.wan dat.u.lod)
::
:: sow: all new signatures
::
=+ sow=`(list (trel ship life @))`(~(tap by syg.u.wan))
|- ^- (list jael-edit)
?~ sow ~
::
:: mor: all further edits
:: och: old signature for this signer
::
=+ mor=$(sow t.sow)
=+ och=(~(get by syg.u.lod) p.i.sow)
::
:: ignore obsolete or equal signature
::
?. |(?=($~ och) (gth q.i.sow p.u.och))
mor
::
:: check and merge new, or newer, signature
::
?> (good [p q]:i.sow ash r.i.sow)
:_(mor [%make %sure who num [p q]:i.sow r.i.sow])
::
:: use the new deed as the next previous
::
:- dat.u.wan
::
:: non-initial deeds must be signed by previous
::
?> ?| ?=($~ pre)
=+ laz=(~(got by syg.u.wan) who)
?> =(p.laz (dec num))
=(ash (need (sure:as:(com:nu:crub pub.u.pre) *code q.laz)))
==
::
:: check the parent has signed, if necessary
::
?> ?| ::
:: no parent signature for existing, non-moon urbits
::
?& ?=(^ pre)
=(dad.doc.u.pre dad)
!=(%earl mir)
==
::
:: public keys for galaxies are hardcoded
::
?& =(%czar mir)
?=($~ pre)
=(pub.dat.u.wan (zeno who))
==
::
:: the deed's secure channel authenticates it
::
=(via who)
::
:: check valid parent signature
::
=+ par=(~(got by syg.u.wan) dad)
(good [dad p.par] ash q.par)
==
:: tep: deed update
::
=/ tep [%hear %step who num u.wan]
::
:: if we don't need to add a signature, report the new deed
::
?: (~(has by syg.u.wan) dad)
[tep ~]
::
:: lyf: life of parent
:: rig: secret key of parent
:: val: new signature
::
=* lyf p:(~(got by pug) dad)
=* rig (~(got by own:(~(got by pry) dad)) lyf)
=* val (sign:as:(nol:nu:crub rig) *@ ash)
[tep [%make %sure who num [dad lyf] val] ~]
:: ::
++ look :: get public key
|= myn/mind
^- @
::
:: first galaxy key is hardcoded
::
?: &((lth who.myn 256) =(1 lyf.myn))
(zeno who.myn)
::
:: cascade search over old and new, new first
::
|^ ((bond |.((need find))) find(pug new))
++ find
^- (unit @)
%+ biff (~(get by pug) who.myn)
|= gur/grue
::
:: crash if this life is revoked
::
?> =(p.gur lyf.myn)
%+ biff (~(get by q.gur) lyf.myn)
|=(lace `pub.dat)
--
:: ::
++ good :: verify signature
|= {myn/mind ash/@ val/@}
^- ?
::
:: XX crypto api needs some adjusting
::
?>(=(ash (need (sure:as:(com:nu:crub (look myn)) *code val))) &)
--
2016-09-06 20:56:36 +03:00
--
2016-09-13 03:24:21 +03:00
:: :: we
++ we :: web reactor
!! ::::
--
--
:: ::::
:::: :: preamble
:: ::::
::
:: lex: all durable %jael state
::
=| lex/jael-state
|= $: ::
:: now: current time
:: eny: unique entropy
:: ski: namespace resolver
::
now/@da
eny/@e
ski/sley
==
:: ::
2016-09-13 03:24:21 +03:00
:::: :: interface
:: ::::
|%
:: :: call
++ call :: request
|= $: :: hen: cause of this event
:: hic: event data
::
hen/duct
hic/(hypo (hobo jael-task))
==
=> .(q.hic ?.(?=($soft -.q.hic) q.hic ((hard jael-task) p.q.hic)))
^- {p/(list jael-move) q/_..^$}
=^ did lex abet:~(call oven [now eny] ~ lex)
[did ..^$]
:: :: doze
++ doze :: await
|= $: :: now: current time
:: hen: cause (XX why we need this?)
::
now/@da
hen/duct
==
^- (unit @da)
~
:: :: load
++ load :: upgrade
|= $: :: old: previous state
::
old/jael-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))
!!
2016-09-13 03:24:21 +03:00
:: :: stay
++ stay :: preserve
lex
:: :: take
++ take :: accept
|= $: :: tea: order
:: hen: cause
:: hin: result
::
tea/wire
hen/duct
hin/(hypo sign-arvo)
==
^- {p/(list jael-move) q/_..^$}
[~ ..^$]
2016-04-08 20:08:05 +03:00
--