1
0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-12-27 08:52:10 +03:00
urbit/pkg/arvo/lib/vere.hoon
Philip Monk 91b38d4cea
ivory: update preboot validation format
string<->numbers didn't match the json serialization.  This makes
preboot validation succeed.
2021-11-08 20:34:32 -08:00

327 lines
8.9 KiB
Plaintext

:: runtime support code
::
/+ ethereum, azimuth
=> [ethereum=ethereum azimuth=azimuth ..zuse] =>
|%
::
:: |dawn: pre-boot request/response de/serialization and validation
::
++ dawn
=> |%
:: +live: public network state of a ship
::
+$ live (unit [=life breach=?])
--
|%
:: +come:dawn: mine a comet under a star
::
:: Randomly generates comet addresses until we find one whose parent is
:: in the list of supplied stars. Errors if any supplied ship
:: is not a star.
::
++ come
|= [tar=(list ship) eny=@uvJ]
::
=| stars=(set ship)
=. stars
|- ^+ stars
?~ tar stars
::
~| [%come-not-king i.tar]
?> ?=(%king (clan:title i.tar))
$(tar t.tar, stars (~(put in stars) i.tar))
::
|- ^- seed:jael
=/ cub=acru:ames (pit:nu:crub:crypto 512 eny)
=/ who=ship `@`fig:ex:cub
:: disallow 64-bit or smaller addresses
::
?. ?=(%pawn (clan:title who))
$(eny +(eny))
?: (~(has in stars) (^sein:title who))
[who 1 sec:ex:cub ~]
$(eny +(eny))
:: |give:dawn: produce requests for pre-boot validation
::
++ give
|%
:: +czar:give:dawn: Eth RPC for galaxy table
::
++ czar
^- octs
%- as-octt:mimes:html
%- en-json:html
:- %a
%+ turn (gulf 0 255)
|= gal=@
%+ request-to-json
(cat 3 'gal-' (scot %ud gal))
:- 'getPoint'
(~(put by *(map @t json)) 'ship' s+(scot %p gal))
:: +point:give:dawn: Eth RPC for ship's contract state
::
++ point
|= who=ship
^- octs
%- as-octt:mimes:html
%- en-json:html
%+ request-to-json
~.
:- 'getPoint'
(~(put by *(map @t json)) 'ship' s+(scot %p who))
:: +turf:give:dawn: Eth RPC for network domains
::
++ turf
^- octs
%- as-octt:mimes:html
%- en-json:html
%+ request-to-json
'turf'
['getDns' ~]
:: +request-to-json:give:dawn: internally used for request generation
::
::NOTE we could import this from /lib/json/rpc, but adding that as a
:: dependency seems a bit unclean
::
++ request-to-json
|= [id=@t method=@t params=(map @t json)]
^- json
%- pairs:enjs:format
:~ jsonrpc+s+'2.0'
id+s+id
method+s+method
params+o+params
==
--
:: |take:dawn: parse responses for pre-boot validation
::
++ take
=, abi:ethereum
=, rpc:ethereum
=, azimuth
=, dejs-soft:format
|%
:: +czar:take:dawn: parse galaxy table
::
++ czar
|= rep=octs
^- (unit (map ship [=rift =life =pass]))
=/ jon=(unit json) (de-json:html q.rep)
?~ jon
~&([%czar-take-dawn %invalid-json] ~)
=/ res=(unit (list [@t @ud @ud @]))
%. u.jon
=, dejs-soft:format
=- (ar (ot id+so result+(ot network+- ~) ~))
%- ot
:~ :- 'rift' (su dim:ag)
:- 'keys' (ot 'life'^(su dim:ag) ~)
:- 'keys' %+ cu pass-from-eth:azimuth
%- ot
:~ 'crypt'^(cu (lead 32) (su ;~(pfix (jest '0x') hex)))
'auth'^(cu (lead 32) (su ;~(pfix (jest '0x') hex)))
'suite'^(su dim:ag)
==
==
?~ res
~&([%czar-take-dawn %incomplete-json] ~)
:- ~
%+ roll u.res
|= $: [id=@t deet=[=rift =life =pass]]
kyz=(map ship [=rift =life =pass])
==
^+ kyz
?: =(0 life.deet)
kyz
%+ ~(put by kyz)
(slav %ud (rsh [3 4] id))
deet
:: +point:take:dawn: parse ship's contract state
::
++ point
|= [who=ship rep=octs]
^- (unit point:azimuth)
~! *point:azimuth
=/ jon=(unit json) (de-json:html q.rep)
?~ jon
~&([%point-take-dawn %invalid-json] ~)
=- ?~ res
~&([%point-take-dawn %incomplete-json] ~)
=, u.res
%- some
:+ own
?: =(0 life) ~
`[life pass rift sponsor ~] ::NOTE escape unknown ::TODO could be!
?. (gth who 0xffff) ~
`[spawn ~] ::NOTE spawned unknown
^- $= res
%- unit
$: [spawn=@ own=[@ @ @ @]]
[=rift =life =pass sponsor=[? ship]]
==
%. u.jon
=, dejs-soft:format
=- (ot result+- ~)
%- ot
:~ :- 'ownership'
%- ot
|^ :~ 'spawnProxy'^address
'owner'^address
'managementProxy'^address
'votingProxy'^address
'transferProxy'^address
==
::
++ address
(ot 'address'^(cu hex-to-num:ethereum so) ~)
--
::
:- 'network'
%- ot
::TODO dedupe with +czar
:~ 'rift'^(su dim:ag)
'keys'^(ot 'life'^(su dim:ag) ~)
::
:- 'keys'
%+ cu pass-from-eth:azimuth
%- ot
:~ 'crypt'^(cu (lead 32) (su ;~(pfix (jest '0x') hex)))
'auth'^(cu (lead 32) (su ;~(pfix (jest '0x') hex)))
'suite'^(su dim:ag)
==
::
::TODO inconsistent @p string
'sponsor'^(ot 'has'^bo 'who'^ni ~)
::
::TODO escape
::TODO what if escape or sponsor not present? possible?
==
==
:: +turf:take:dawn: parse network domains
::
++ turf
|= rep=octs
^- (unit (list ^turf))
=/ jon=(unit json) (de-json:html q.rep)
?~ jon
~&([%turf-take-dawn %invalid-json] ~)
=/ res=(unit (list @t))
((ot result+(ar so) ~) u.jon)
?~ res
~&([%turf-take-dawn %invalid-response] ~)
:: remove duplicates, parse into turfs
::
=- `doz
%+ roll u.res
|= [dom=@t doh=(set @t) doz=(list ^turf)]
?: (~(has in doh) dom) [doh doz]
:- (~(put in doh) dom)
=/ hot=host:eyre
(rash dom thos:de-purl:html)
?. ?=(%& -.hot) doz
(snoc doz p.hot)
--
:: +veri:dawn: validate keys, life, discontinuity, &c
::
++ veri
|= [=ship =feed:jael =point:azimuth =live]
^- (each seed:jael (lest error=term))
|^ ?@ -.feed
?^ err=(test feed) |+[u.err ~]
&+feed
?> ?=([%1 ~] -.feed)
=| errs=(list term)
|-
?~ kyz.feed
|+?~(errs [%no-key ~] errs)
=/ =seed:jael [who [lyf key ~]:i.kyz]:feed
?~ err=(test seed)
&+seed
=. errs (snoc errs u.err)
$(kyz.feed t.kyz.feed)
::
++ test
|= =seed:jael
^- (unit error=term)
?. =(ship who.seed) `%not-our-key
=/ rac (clan:title who.seed)
=/ cub (nol:nu:crub:crypto key.seed)
?- rac
%pawn
:: a comet address is the fingerprint of the keypair
::
?. =(who.seed `@`fig:ex:cub)
`%key-mismatch
:: a comet can never be breached
::
?^ live
`%already-booted
:: a comet can never be re-keyed
::
?. ?=(%1 lyf.seed)
`%invalid-life
~
::
%earl
~
::
*
:: on-chain ships must be launched
::
?~ net.point
`%not-keyed
=* net u.net.point
:: boot keys must match the contract
::
?. =(pub:ex:cub pass.net)
`%key-mismatch
:: life must match the contract
::
?. =(lyf.seed life.net)
`%life-mismatch
:: the boot life must be greater than and discontinuous with
:: the last seen life (per the sponsor)
::
?: ?& ?=(^ live)
?| ?=(%| breach.u.live)
(lte life.net life.u.live)
== ==
`%already-booted
:: produce the sponsor for vere
::
~? !has.sponsor.net
[%no-sponsorship-guarantees-from who.sponsor.net]
~
==
--
:: +sponsor:dawn: retreive sponsor from point
::
++ sponsor
|= [who=ship =point:azimuth]
^- (each ship error=term)
?- (clan:title who)
%pawn [%& (^sein:title who)]
%earl [%& (^sein:title who)]
%czar [%& (^sein:title who)]
*
?~ net.point
[%| %not-booted]
?. has.sponsor.u.net.point
[%| %no-sponsor]
[%& who.sponsor.u.net.point]
==
--
--
::
=/ pit !>(.)
=> |%
++ load _[~ ..load] :: +4
++ peek _~ :: +22
++ poke _[~ ..poke] :: +23
++ wish :: +10
|= txt=*
q:(slap pit (ream ;;(@t txt)))
--
::
|=(* .(+> +:(poke +<)))