:: 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' ni :- 'keys' (ot 'life'^ni ~) :- 'keys' %+ cu pass-from-eth:azimuth %- ot :~ 'crypt'^(cu (lead 32) ni) 'auth'^(cu (lead 32) ni) 'suite'^ni == == ?~ res ~&([%czar-take-dawn %invalid-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'^ni 'keys'^(ot 'life'^ni ~) :: :- 'keys' %+ cu pass-from-eth:azimuth %- ot :~ 'crypt'^(cu (lead 32) ni) 'auth'^(cu (lead 32) ni) 'suite'^ni == :: ::TODO inconsistent @p string 'sponsor'^(ot 'has'^bo 'who'^(su fed:ag) ~) :: ::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 rep] ~) :: 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 +<)))