ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-11-28 11:40:11 +03:00
Code Issues Packages Projects Releases Wiki Activity
1a64774011
urbit/pkg/arvo/app/claz.hoon
Jared Tobin b3901ab42f Add 'pkg/arvo/' from commit 'c20e2a185f131ff3f5d3961829bd7a3fe0f227f8' 
git-subtree-dir: pkg/arvo
git-subtree-mainline: 9c8f40bf6c
git-subtree-split: c20e2a185f
2019-06-28 12:48:05 +08:00

896 lines
21 KiB
Plaintext
Raw Blame History

:: claz: command line azimuth, for the power-user
::
/- sole-sur=sole
/+ sole-lib=sole
::
=, azimuth
=, ethereum
=, rpc
=, key
::
|%
++ state
$: cli=shell
inp=in-progress
==
::
:: state & commands
::
++ shell
$: id=bone
say=sole-share:sole-sur
==
::
++ command
$% [%generate =path =network as=address =batch]
==
::
++ network
$? %main
%ropsten
%fake
[%other id=@]
==
::
++ batch
$~ [%deed '{}']
$% :: %single: execute a single ecliptic function call
::
[%single =call]
:: %deed: deed ships based on json, assumes spawnable
::
[%deed deeds-json=cord]
:: %lock-prep: prepare for lockup by transfering ships to the ceremony address
::
[%lock-prep what=(list ship)]
:: %lock: put ships into lockup for the target address
::
[%lock how=?(%spawn %transfer) what=(list ship) to=address =lockup]
:: %more: multiple batches sequentially
::
[%more batches=(list batch)]
==
::
++ lockup
$% [%linear windup-years=@ud unlock-years=@ud]
[%conditional [b1=@ud b2=@ud b3=@ud] unlock-years-per-batch=@ud]
==
::
++ rights
$: own=address
manage=(unit address)
voting=(unit address)
transfer=(unit address)
spawn=(unit address)
net=(unit [crypt=@ux auth=@ux])
==
::
++ call
$% [%create-galaxy gal=ship to=address]
[%spawn who=ship to=address]
[%configure-keys who=ship crypt=@ auth=@]
[%set-management-proxy who=ship proxy=address]
[%set-voting-proxy who=ship proxy=address]
[%set-spawn-proxy who=ship proxy=address]
[%transfer-ship who=ship to=address]
[%set-transfer-proxy who=ship proxy=address]
[%adopt who=ship]
==
::
:: monadic structures
::
:: in-progress: monad currently in progress
::
++ in-progress
%- unit
$% [%command command=eval-form:eval:null-glad]
==
::
:: null-glad: monad that produces nothing, "just effects"
::
++ null-glad (glad ,~)
::
:: glad-input: ~ for initialization, value for node response
::
++ glad-input (unit response:rpc:jstd)
::
:: glad-output-raw: moves + intermediate monad state/result
::
++ glad-output-raw
|* a=mold
$~ [~ %done *a]
$: moves=(list move)
$= next
$% [%wait ~]
[%cont self=(glad-form-raw a)]
[%fail err=tang]
[%done value=a]
==
==
::
:: glad-form-raw: shape of monad function
::
++ glad-form-raw
|* a=mold
$-(glad-input (glad-output-raw a))
::
:: glad-fail: procudes failure result
::
++ glad-fail
|= err=tang
|= glad-input
[~ %fail err]
::
:: glad: monad object for monads that produce moves at intermediate steps
::
++ glad
|* a=mold
|%
++ output (glad-output-raw a)
++ form (glad-form-raw a)
::
:: pure: produce intermediate result
::
++ pure
|= arg=a
^- form
|= glad-input
[~ %done arg]
::
:: bind: run m-b until it's done. once done, call fun with its result
::
++ bind
|* b=mold
|= [m-b=(glad-form-raw b) fun=$-(b form)]
^- form
|= input=glad-input
=/ b-res=(glad-output-raw b)
(m-b input)
^- output
:- moves.b-res
?- -.next.b-res
%wait [%wait ~]
%cont [%cont ..$(m-b self.next.b-res)]
%fail [%fail err.next.b-res]
%done [%cont (fun value.next.b-res)]
==
::
:: eval: call take with the latest input to kick monad object into action
::
++ eval
|%
+$ eval-form
$: =form
==
::
:: from-form: eval-form from form
::
++ from-form
|= =form
^- eval-form
form
::
:: eval-result: how far +take got
::
+$ eval-result
$% [%next ~]
[%fail err=tang]
[%done value=a]
==
::
:: take: run the monad operations as far as they can go right now
::
++ take
=| moves=(list move)
|= [=eval-form =our=wire =glad-input]
^- [[(list move) =eval-result] _eval-form]
:: run the current function
::
=/ =output (form.eval-form glad-input)
:: add moves
::
=. moves
(weld moves moves.output)
:: case-wise handle next steps
::
?- -.next.output
%wait [[moves %next ~] eval-form]
%fail [[moves %fail err.next.output] eval-form]
%done [[moves %done value.next.output] eval-form]
::
%cont
:: recurse to run continuation (next function in monad),
:: which is always started off with "initialization" input
::
%_ $
form.eval-form self.next.output
glad-input ~
==
==
--
--
::
:: effects
::
++ move (pair bone card)
++ card
$% [%hiss wire ~ mark %hiss hiss:eyre]
[%info wire desk nori:clay]
[%rest wire @da]
[%wait wire @da]
==
::
:: constants
::
++ ecliptic `address`0x6ac0.7b7c.4601.b5ce.11de.8dfe.6335.b871.c7c4.dd4d
--
::
|_ [=bowl:gall state]
++ this .
::
:: entrypoints
::
++ prep
|= old=(unit *)
^- (quip move _this)
[~ ..prep]
::
++ poke-noun
|= =command
^- (quip move _this)
:: create active monad, store in state
::
=. inp
%- some
:- %command
%- from-form:eval:null-glad
(deal-with-command command)
:: kick off monad
::
(take-command-sigh / ~)
::
++ sigh-tang-nonce
|= [=wire =tang]
^- (quip move _this)
=. tang [leaf+"claz failed" tang]
[~ (fail-command tang)]
::
++ sigh-json-rpc-response-command
|= [=wire =response:rpc:jstd]
^- (quip move _this)
(take-command-sigh wire `response)
::
++ take-command-sigh
|= [=wire response=glad-input]
^- (quip move _this)
:: we expect this to be called only if we have an in-progress monad
::
?~ inp
~|(%no-in-progress !!)
:: ?. ?=(%command -.u.inp) ::NOTE mint-vain rn
:: ~|([%unexpected-response -.u.inp] !!)
:: kick in-progress monad with response, updating it with the next callable
:: it spits out
::
=/ m null-glad
=^ r=[moves=(list move) =eval-result:eval:m] command.u.inp
(take:eval:m command.u.inp wire response)
:- moves.r
:: continue depending on the eval result
::
?- -.eval-result.r
:: not done, don't change app state further
::
%next this
:: failed, clean & update app state
::
%fail (fail-command err.eval-result.r)
:: succeeded, finalize & update app state
::
%done (done-command value.eval-result.r)
==
::
:: monadic helpers
::
:: fail-command: handle fail of nonce-fetching monad
::
++ fail-command
|= err=tang
^+ this
~& 'command processing failed'
::TODO error printing
this(inp ~)
::
:: done-command: handle result of nonce-fetching monad
::
++ done-command
|= ~
^+ this
~& %command-done
this(inp ~)
::
:: just-do: emit effects from monad without further processing
::
++ just-do
|= =move
^- form:null-glad
|= glad-input
[[move ~] %done ~]
::
:: get-next-nonce: monad function for fetching a nonce
::
++ get-next-nonce
|= for=address
=/ m (glad ,@ud)
^- form:m
;< =json bind:m
%+ do-request-expect-json-result `'some-id'
^- request
[%eth-get-transaction-count for]
^- form:m
?. ?=(%s -.json)
(glad-fail *tang) ::TODO proper error, "unexpected json"
%- pure:m
(rash p.json ;~(pfix (jest '0x') hex))
::
++ do-request
|= [rid=(unit @t) =request]
%+ do-hiss %json-rpc-response
^- hiss:eyre
%+ json-request
::TODO vary per network
(need (de-purl:html 'http://eth-mainnet.urbit.org:8545'))
(request-to-json rid request)
::
++ do-hiss
|= [=mark =hiss:eyre]
^- form:null-glad
|= glad-input
^- output:null-glad
=- [[[ost.bowl -] ~] %done ~]
::TODO wire in sample?
[%hiss /command ~ %json-rpc-response %hiss hiss]
::
++ expect-response
=/ m (glad response:rpc:jstd)
^- form:m
|= in=glad-input
?~ in [~ %wait ~]
[~ %done u.in]
::
++ do-request-expect-json-result
|= [rid=(unit @) =request]
=/ m (glad json)
;< ~ bind:m
(do-request rid request)
;< =response:rpc:jstd bind:m
expect-response
?. ?=(%result -.response)
(glad-fail *tang) ::TODO make pretty error message
(pure:m res.response)
::
:: transaction generation logic
::
++ deal-with-command
|= =command
=/ m null-glad
^- form:m
;< nonce=@ud bind:m (get-next-nonce as.command)
^- form:m
%- just-do
?- -.command
%generate
%+ write-file-transactions
path.command
(batch-to-transactions nonce [network as batch]:command)
==
::
++ batch-to-transactions
|= [nonce=@ud =network as=address =batch]
^- (list transaction)
?- -.batch
%single [(single nonce network as +.batch) ~]
%deed (deed nonce network as +.batch)
%lock-prep (lock-prep nonce network as +.batch)
%lock (lock nonce network as +.batch)
::
%more
=| txs=(list transaction)
=* batches batches.batch
|-
?~ batches txs
=/ new-txs=(list transaction)
^$(batch i.batches)
%_ $
txs (weld txs new-txs)
nonce (add nonce (lent new-txs))
batches t.batches
==
==
::
++ tape-to-ux
|= t=tape
(scan t zero-ux)
::
++ zero-ux
;~(pfix (jest '0x') hex)
::
++ write-file-transactions
|= [pax=path tox=(list transaction)]
^- move
?> ?=([@ desk @ *] pax)
:* ost.bowl
%info
(weld /write pax)
:: our.bowl
`desk`i.t.pax
=- &+[t.t.t.pax -]~
=/ y .^(arch %cy pax)
?~ fil.y
ins+eth-txs+!>(tox)
mut+eth-txs+!>(tox)
==
::
++ do
::TODO maybe reconsider encode-call interface, if we end up wanting @ux
:: as or more often than we want tapes
|= [=network nonce=@ud to=address dat=$@(@ux tape)]
^- transaction
:* nonce
8.000.000.000 ::TODO global config
600.000 ::TODO global config
to
0
`@`?@(dat dat (tape-to-ux dat))
?- network
%main 0x1
%ropsten 0x3
%fake `@ux``@`1.337
[%other *] id.network
==
==
::
++ single
|= [nonce=@ud =network as=address =call]
^- transaction
=- (do network nonce ecliptic -)
?- -.call
%create-galaxy (create-galaxy:dat +.call)
%spawn (spawn:dat +.call)
%configure-keys (configure-keys:dat +.call)
%set-management-proxy (set-management-proxy:dat +.call)
%set-voting-proxy (set-voting-proxy:dat +.call)
%set-spawn-proxy (set-spawn-proxy:dat +.call)
%transfer-ship (transfer-ship:dat +.call)
%set-transfer-proxy (set-transfer-proxy:dat +.call)
%adopt (adopt:dat +.call)
==
::
++ deed
|= [nonce=@ud =network as=address deeds-json=cord]
^- (list transaction)
=/ deeds=(list [=ship rights])
(parse-registration deeds-json)
::TODO split per spawn proxy
=| txs=(list transaction)
|^ :: $
?~ deeds (flop txs)
=* deed i.deeds
=. txs
?. ?=(%czar (clan:title ship.deed))
%- do-here
(spawn:dat ship.deed as)
~| %galaxy-held-by-ceremony
?> =(0x740d.6d74.1711.163d.3fca.cecf.1f11.b867.9a7c.7964 as)
~& [%assuming-galaxy-owned-by-ceremony ship.deed]
txs
=? txs ?=(^ net.deed)
%- do-here
(configure-keys:dat [ship u.net]:deed)
=? txs ?=(^ manage.deed)
%- do-here
(set-management-proxy:dat [ship u.manage]:deed)
=? txs ?=(^ voting.deed)
%- do-here
(set-voting-proxy:dat [ship u.voting]:deed)
=? txs ?=(^ spawn.deed)
%- do-here
(set-spawn-proxy:dat [ship u.spawn]:deed)
=. txs
%- do-here
(transfer-ship:dat [ship own]:deed)
$(deeds t.deeds)
::
::TODO maybe-do, take dat gat and unit argument
++ do-here
|= dat=tape
:_ txs
(do network (add nonce (lent txs)) ecliptic dat)
--
::
++ parse-registration
|= reg=cord
^- (list [=ship rights])
~| %registration-json-insane
=+ jon=(need (de-json:html reg))
~| %registration-json-invalid
?> ?=(%o -.jon)
=. p.jon (~(del by p.jon) 'idCode')
%+ turn ~(tap by p.jon)
|= [who=@t deed=json]
^- [ship rights]
:- (rash who dum:ag)
?> ?=(%a -.deed)
:: array has contents of:
:: [owner, transfer, spawn, mgmt, delegate, auth_key, crypt_key]
~| [%registration-incomplete deed (lent p.deed)]
?> =(7 (lent p.deed))
=< :* (. 0 %address) :: owner
(. 3 %unit-address) :: management
(. 4 %unit-address) :: voting
(. 1 %unit-address) :: transfer
(. 2 %unit-address) :: spawn
(both (. 6 %key) (. 5 %key)) :: crypt, auth
==
|* [i=@ud what=?(%address %unit-address %key)]
=+ j=(snag i p.deed)
~| [%registration-invalid-value what j]
?> ?=(%s -.j)
%+ rash p.j
=+ adr=;~(pfix (jest '0x') hex)
?- what
%address adr
%unit-address ;~(pose (stag ~ adr) (cold ~ (jest '')))
%key ;~(pose (stag ~ hex) (cold ~ (jest '')))
==
::
++ lock-prep
|= [nonce=@ud =network as=address what=(list ship)]
^- (list transaction)
=| txs=(list transaction)
|^
?~ what (flop txs)
=. txs
%- do-here
(spawn:dat i.what as)
=. txs
%- do-here
%+ transfer-ship:dat i.what
~& %assuming-lockup-done-by-ceremony
0x740d.6d74.1711.163d.3fca.cecf.1f11.b867.9a7c.7964
$(what t.what)
++ do-here
|= dat=tape
:_ txs
(do network (add nonce (lent txs)) ecliptic dat)
--
::
::TODO support distinguishing/switching between usable lockup methods
:: automagically
++ lock
|= $: nonce=@ud
=network
as=address
how=?(%spawn %transfer)
what=(list ship)
to=address
=lockup
==
^- (list transaction)
:: verify lockup sanity
::
~| %invalid-lockup-ships
?> ?| ?=(%linear -.lockup)
=(`@`(lent what) :(add b1.lockup b2.lockup b3.lockup))
==
:: expand galaxies into stars
::
=. what
%- zing
%+ turn what
|= s=ship
^- (list ship)
?. =(%czar (clan:title s)) [s]~
(turn (gulf 1 255) |=(k=@ud (cat 3 s k)))
=/ lockup-contract=address
?- -.lockup
%linear 0x86cd.9cd0.992f.0423.1751.e376.1de4.5cec.ea5d.1801
%conditional 0x8c24.1098.c3d3.498f.e126.1421.633f.d579.86d7.4aea
==
%- flop
=| txs=(list transaction)
^+ txs
|^
:: registration
::
=. txs
%+ do-here lockup-contract
?- -.lockup
%linear (register-linear to (lent what) +.lockup)
%conditional (register-conditional to +.lockup)
==
:: context-dependent setup
::
=. txs
?- how
:: %spawn: set spawn proxy of parents
::
%spawn
~& %assuming-ceremony-controls-parents
=/ parents
=- ~(tap in -)
%+ roll what
|= [s=ship ss=(set ship)]
?> =(%king (clan:title s))
(~(put in ss) (^sein:title s))
|-
?~ parents txs
=. txs
%+ do-here ecliptic
(set-spawn-proxy:dat i.parents lockup-contract)
$(parents t.parents)
::
:: %transfer: set transfer proxy of stars
::
%transfer
~& %assuming-ceremony-controls-stars
|-
?~ what txs
=. txs
%+ do-here ecliptic
(set-transfer-proxy:dat i.what lockup-contract)
$(what t.what)
==
:: depositing
::
|-
?~ what txs
=. txs
%+ do-here lockup-contract
(deposit:dat to i.what)
$(what t.what)
++ do-here
|= [contract=address dat=tape]
:_ txs
(do network (add nonce (lent txs)) contract dat)
--
::
++ register-linear
|= [to=address stars=@ud windup-years=@ud unlock-years=@ud]
%- register-linear:dat
:* to
(mul windup-years yer:yo)
stars
(div (mul unlock-years yer:yo) stars)
1
==
::
++ register-conditional
|= [to=address [b1=@ud b2=@ud b3=@ud] unlock-years-per-batch=@ud]
%- register-conditional:dat
=- [`address`to b1 b2 b3 `@ud`- 1]
(div (mul unlock-years-per-batch yer:yo) :(add b1 b2 b3))
::
:: call data generation
::TODO most of these should later be cleaned and go in ++constitution
::
++ dat
|%
++ enc
|* cal=$-(* call-data)
(cork cal encode-call)
::
++ create-galaxy (enc create-galaxy:cal)
++ spawn (enc spawn:cal)
++ configure-keys (enc configure-keys:cal)
++ set-spawn-proxy (enc set-spawn-proxy:cal)
++ transfer-ship (enc transfer-ship:cal)
++ set-management-proxy (enc set-management-proxy:cal)
++ set-voting-proxy (enc set-voting-proxy:cal)
++ set-transfer-proxy (enc set-transfer-proxy:cal)
++ set-dns-domains (enc set-dns-domains:cal)
++ upgrade-to (enc upgrade-to:cal)
++ transfer-ownership (enc transfer-ownership:cal)
++ adopt (enc adopt:cal)
++ register-linear (enc register-linear:cal)
++ register-conditional (enc register-conditional:cal)
++ deposit (enc deposit:cal)
--
::
++ cal
|%
++ create-galaxy
|= [gal=ship to=address]
^- call-data
?> =(%czar (clan:title gal))
:- 'createGalaxy(uint8,address)'
^- (list data)
:~ [%uint `@`gal]
[%address to]
==
::
++ spawn
|= [who=ship to=address]
^- call-data
?> ?=(?(%king %duke) (clan:title who))
:- 'spawn(uint32,address)'
:~ [%uint `@`who]
[%address to]
==
::
++ configure-keys
|= [who=ship crypt=@ auth=@]
::TODO maybe disable asserts?
?> (lte (met 3 crypt) 32)
?> (lte (met 3 auth) 32)
:- 'configureKeys(uint32,bytes32,bytes32,uint32,bool)'
:~ [%uint `@`who]
[%bytes-n 32^crypt]
[%bytes-n 32^auth]
[%uint 1]
[%bool |]
==
::
++ set-management-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setManagementProxy(uint32,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ set-voting-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setVotingProxy(uint8,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ set-spawn-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setSpawnProxy(uint16,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ transfer-ship
|= [who=ship to=address]
^- call-data
:- 'transferPoint(uint32,address,bool)'
:~ [%uint `@`who]
[%address to]
[%bool |]
==
::
++ set-transfer-proxy
|= [who=ship proxy=address]
^- call-data
:- 'setTransferProxy(uint32,address)'
:~ [%uint `@`who]
[%address proxy]
==
::
++ set-dns-domains
|= [pri=tape sec=tape ter=tape]
^- call-data
:- 'setDnsDomains(string,string,string)'
:~ [%string pri]
[%string sec]
[%string ter]
==
::
++ upgrade-to
|= to=address
^- call-data
:- 'upgradeTo(address)'
:~ [%address to]
==
::
::
++ transfer-ownership :: of contract
|= to=address
^- call-data
:- 'transferOwnership(address)'
:~ [%address to]
==
::
++ adopt
|= who=ship
^- call-data
:- 'adopt(uint32)'
:~ [%uint `@`who]
==
::
::
++ register-linear
|= $: to=address
windup=@ud
stars=@ud
rate=@ud
rate-unit=@ud
==
^- call-data
:- 'register(address,uint256,uint16,uint16,uint256)'
:~ [%address to]
[%uint windup]
[%uint stars]
[%uint rate]
[%uint rate-unit]
==
::
++ register-conditional
|= $: to=address
b1=@ud
b2=@ud
b3=@ud
rate=@ud
rate-unit=@ud
==
^- call-data
:- 'register(address,uint16[],uint16,uint256)'
:~ [%address to]
[%array ~[uint+b1 uint+b2 uint+b3]]
[%uint rate]
[%uint rate-unit]
==
::
++ deposit
|= [to=address star=ship]
^- call-data
:- 'deposit(address,uint16)'
:~ [%address to]
[%uint `@`star]
==
--
::
:: ++ peer-sole
:: |= =path
:: =. id.cli ost.bowl
:: TODO...
:: ::
:: ++ sh
:: |_ she=shell
:: ::
:: :: # %resolve
:: +| %resolve
:: ::
:: ++ sh-done
:: :: stores changes to the cli.
:: ::
:: ^+ +>
:: +>(cli she)
:: ::
:: :: #
:: :: # %emitters
:: :: #
:: :: arms that create outward changes.
:: +| %emitters
:: ::
:: ++ sh-fact
:: :: adds a console effect to ++ta's moves.
:: ::
:: |= fec/sole-effect:sole-sur
:: ^+ +>
:: +>(moves [[id.she %diff %sole-effect fec] moves])
:: ::
:: ++ sh-prod
:: :: show prompt
:: ::
:: :: makes and stores a move to modify the cli
:: :: prompt to display the current audience.
:: ::
:: ^+ .
:: %+ sh-fact %pro
:: :+ & %talk-line
:: ^- tape
:: =/ rew/(pair (pair cord cord) audience)
:: [['[' ']'] active.she]
:: =+ cha=(~(get by bound) q.rew)
:: ?^ cha ~[u.cha ' ']
:: =+ por=~(ar-prom ar q.rew)
:: (weld `tape`[p.p.rew por] `tape`[q.p.rew ' ' ~])
:: ::
:: --
--
Reference in New Issue View Git Blame Copy Permalink