mirror of
https://github.com/urbit/shrub.git
synced 2024-12-12 10:29:01 +03:00
Restructure Constitution app.
This commit is contained in:
Fang
parent
8af91e2af6
commit
dba3936411
@ -5,13 +5,18 @@
|
||||
=, eyre
|
||||
|%
|
||||
++ state
|
||||
$: ships=registry
|
||||
block=@ud
|
||||
filter=(unit @ud)
|
||||
ships-c=address
|
||||
$: ships=(map @p hull)
|
||||
block=@ud :: last heard
|
||||
filter=(unit @ud) :: our filter id
|
||||
==
|
||||
::
|
||||
++ move [bone card] :: [target side-effect]
|
||||
++ complete-ship
|
||||
$: state=hull
|
||||
history=(list diff-hull) :: newest first
|
||||
keys=(map @ud (pair @ @))
|
||||
==
|
||||
::
|
||||
+= move [bone card] :: [target side-effect]
|
||||
++ card :: side-effect
|
||||
$% [%peer wire gill:gall path]
|
||||
[%hiss wire (unit user:eyre) mark [%hiss hiss]]
|
||||
@ -23,50 +28,129 @@
|
||||
++ prep
|
||||
|= old=(unit *)
|
||||
:: ?~ old
|
||||
init
|
||||
ta-save:ta-init:ta
|
||||
:: [~ ..prep(fid u.old)]
|
||||
::
|
||||
++ init
|
||||
=/ sc=address
|
||||
0xa9c7.9b9c.5e4e.1fdc.69c1.
|
||||
9fc0.6232.64c8.da50.7a22
|
||||
:_ ..init(ships-c sc)
|
||||
=- [ost.bol -]~
|
||||
%+ rpc-req /init
|
||||
%- batch-read-request
|
||||
%+ turn (gulf ~zod ~per) :: ~fes)
|
||||
|= p=@p
|
||||
:+ `(scot %p p) sc
|
||||
['getShipData(uint32)' ~[uint+`@`p]]
|
||||
++ ta
|
||||
|_ $: moves=(list move) :: side-effects
|
||||
reqs=(list (pair (unit @t) request)) :: rpc requests
|
||||
wir=wire :: wire for reqs
|
||||
==
|
||||
+* this .
|
||||
::
|
||||
++ ta-save
|
||||
^- (quip move _+>)
|
||||
=- [[`move`- `(list move)`(flop moves)] ..ta]
|
||||
^- move
|
||||
:- `bone`ost.bol
|
||||
^- card
|
||||
%+ rpc-request:ca wir
|
||||
`json`a+(turn (flop reqs) request-to-json)
|
||||
::
|
||||
++ ta-move
|
||||
|= mov=move
|
||||
%_(+> moves [mov moves])
|
||||
::
|
||||
++ ta-card
|
||||
|= car=card
|
||||
(ta-move [ost.bol car])
|
||||
::
|
||||
++ ta-request
|
||||
|= [id=(unit @t) req=request]
|
||||
%_(+> reqs [[id req] reqs])
|
||||
::
|
||||
++ ta-read
|
||||
|= cal=ships:function
|
||||
=- %+ ta-request `id
|
||||
:+ %eth-call
|
||||
[~ ships:contracts ~ ~ ~ (encode-call dat)]
|
||||
[%label %latest]
|
||||
::TODO probably turn the below into a lib arm
|
||||
^- [id=@t dat=call-data]
|
||||
?- -.cal
|
||||
%ships
|
||||
:- (crip "ships({(scow %p who.cal)})")
|
||||
['ships(uint32)' ~[uint+`@`who.cal]]
|
||||
==
|
||||
::
|
||||
++ ta-read-ships
|
||||
|= who=(list @p)
|
||||
~& [%ta-read-ships ~(key by ships)]
|
||||
%^ spir who this
|
||||
|=([p=@p _this] (ta-read %ships p))
|
||||
::
|
||||
::
|
||||
++ ta-init
|
||||
%- ta-read-ships(wir /init)
|
||||
(gulf ~zod ~per) ::TODO ~fes)
|
||||
::
|
||||
++ ta-init-result
|
||||
|= rep=response:json-rpc
|
||||
^+ this
|
||||
?> ?=(%batch -.rep)
|
||||
=. wir /init
|
||||
%^ spir bas.rep this
|
||||
|= [r=response:json-rpc this=_this]
|
||||
^+ this
|
||||
?< ?=(%batch -.r)
|
||||
~& id.r
|
||||
?: ?=(%error -.r)
|
||||
~& [%rpc-error message.r]
|
||||
this
|
||||
?> ?=(%s -.res.r)
|
||||
=/ hul=hull:eth-noun
|
||||
(decode-results p.res.r hull:eth-type)
|
||||
?. active.hul this
|
||||
=/ who=@p
|
||||
%+ rash id.r
|
||||
(ifix [(jest 'ships(~') (just ')')] fed:ag)
|
||||
=. ships
|
||||
%+ ~(put by ships) who
|
||||
(hull-from-eth hul)
|
||||
~& [%stored ~(key by ships)]
|
||||
(ta-read-ships (kids who))
|
||||
--
|
||||
::
|
||||
++ rpc-req
|
||||
|= [w=wire j=json]
|
||||
^- card
|
||||
:^ %hiss w ~
|
||||
:+ %json-rpc-response %hiss
|
||||
=- (json-request - j)
|
||||
=+ (need (de-purl:html 'http://localhost:8545'))
|
||||
-(p.p |)
|
||||
:: arms for card generation
|
||||
++ ca
|
||||
|%
|
||||
++ rpc-request
|
||||
|= [w=wire j=json]
|
||||
^- card
|
||||
:^ %hiss w ~
|
||||
:+ %json-rpc-response %hiss
|
||||
=- (json-request - j)
|
||||
=+ (need (de-purl:html 'http://localhost:8545'))
|
||||
-(p.p |)
|
||||
--
|
||||
::
|
||||
++ sigh-json-rpc-response-init
|
||||
|= [w=wire rep=response:json-rpc]
|
||||
~& [%res rep]
|
||||
?> ?=(%batch -.rep)
|
||||
=- ~& [%ship-data `(list (pair ship hull))`-]
|
||||
[~ +>.$(ships (~(gas in ships) -))]
|
||||
%+ murn bas.rep
|
||||
::TODO ++parse-ship-data into lib
|
||||
|= r=response:json-rpc
|
||||
^- (unit (pair ship hull))
|
||||
?: ?=(%error -.r) ~ ::TODO retry on error?
|
||||
?> ?=(%result -.r)
|
||||
?> ?=(%s -.res.r)
|
||||
=/ hul=hull:eth-noun
|
||||
(decode-results p.res.r hull:eth-type)
|
||||
:: don't care about latent ships.
|
||||
?. active.hul ~
|
||||
:+ ~ (slav %p id.r)
|
||||
(hull-from-eth hul)
|
||||
++ spir
|
||||
:>
|
||||
:> a: list
|
||||
:> b: state
|
||||
:> c: gate from list-item and state to new state
|
||||
:> produces: new state
|
||||
|* [a=(list) b=* c=_|=(^ +<+)]
|
||||
=> .(c `$-([_?>(?=(^ a) i.a) _b] _b)`c)
|
||||
:> transformed list and updated state
|
||||
|- ^+ b
|
||||
?~ a b
|
||||
$(a t.a, b (c i.a b))
|
||||
::
|
||||
++ kids
|
||||
|= pre=@p
|
||||
^- (list @p)
|
||||
=/ wyd=bloq
|
||||
?+ (clan:title pre) 0
|
||||
%czar 3
|
||||
%king 4
|
||||
%duke 5
|
||||
==
|
||||
%+ turn
|
||||
(gulf 1 (dec (pow 2 (bex wyd))))
|
||||
?: =(~zod pre)
|
||||
|=(a=@p (lsh 3 1 a))
|
||||
|=(a=@p (cat wyd pre a))
|
||||
::
|
||||
::TODO there definitely needs to be a helper function of some kind,
|
||||
:: but is there a way for the type system to be aware of the return
|
||||
@ -96,51 +180,22 @@
|
||||
::
|
||||
++ poke-noun
|
||||
|= a/@
|
||||
=+ ships-c=0xa9c7.9b9c.5e4e.1fdc.69c1.9fc0.6232.64c8.da50.7a22
|
||||
?: =(a 1)
|
||||
%+ send-rpc-req /block
|
||||
(request-to-json `'eth-blocknum' [%eth-block-number ~])
|
||||
?: =(a 2)
|
||||
%+ send-rpc-req /call
|
||||
%- batch-read-request
|
||||
:~ :+ `'ships-of 0x0'
|
||||
ships-c
|
||||
['getOwnedShips(address)' ~[address+0x0]]
|
||||
::
|
||||
:+ `'ship-data 0'
|
||||
ships-c
|
||||
['getShipData(uint32)' ~[uint+0]]
|
||||
==
|
||||
?: =(a 3)
|
||||
~& %making-filter
|
||||
%+ send-rpc-req /new-filter
|
||||
%+ request-to-json `'new-filter'
|
||||
[%eth-new-filter ~ ~ ~[ships-c] ~]
|
||||
?: =(a 4)
|
||||
~& [%asking-filter-update (need filter)]
|
||||
%+ send-rpc-req /filter-update
|
||||
%+ request-to-json `'req-iq'
|
||||
[%eth-get-filter-changes (need filter)]
|
||||
?: =(a 0)
|
||||
~& [%have-ships ~(key by ships)]
|
||||
[~ +>.$]
|
||||
[~ +>.$]
|
||||
::
|
||||
++ send-move
|
||||
|= c/card
|
||||
[[ost.bol c]~ +>.$]
|
||||
::
|
||||
++ send-rpc-req
|
||||
|= [w=wire j=json]
|
||||
%^ send-move %hiss w
|
||||
:^ ~ %json-rpc-response %hiss
|
||||
=- (json-request - j)
|
||||
=+ (need (de-purl:html 'http://localhost:8545'))
|
||||
-(p.p |)
|
||||
::
|
||||
++ sigh-tang
|
||||
|= [w=wire t=tang]
|
||||
~& [%failed-sigh]
|
||||
~& (turn t (cury wash [0 80]))
|
||||
[~ +>.$]
|
||||
::
|
||||
++ sigh-json-rpc-response-init
|
||||
|= [w=wire r=response:json-rpc]
|
||||
~& %got-init-response
|
||||
ta-save:(ta-init-result:ta r)
|
||||
::
|
||||
++ sigh-json-rpc-response
|
||||
|= [w=wire r=response:json-rpc]
|
||||
~& [%rpc-resp w r]
|
||||
|
||||
@ -2,9 +2,7 @@
|
||||
=, ethereum
|
||||
|%
|
||||
::
|
||||
:: shapes
|
||||
::
|
||||
++ registry (map @p hull)
|
||||
:: # shapes
|
||||
::
|
||||
++ hull
|
||||
$: owner=address
|
||||
@ -51,37 +49,64 @@
|
||||
transfer-proxy=address
|
||||
==
|
||||
--
|
||||
::
|
||||
++ function
|
||||
|%
|
||||
++ ships
|
||||
$% [%ships who=@p]
|
||||
==
|
||||
--
|
||||
::
|
||||
:: # diffs
|
||||
::
|
||||
++ diff-hull
|
||||
$% [%full new=hull]
|
||||
[%owner new=address]
|
||||
[%spawn-count ~] :: increments
|
||||
[%keys enc=@ aut=@]
|
||||
[%sponsor new=@p]
|
||||
[%escape new=(unit @p)]
|
||||
[%spawn-proxy new=address]
|
||||
[%transfer-proxy new=address]
|
||||
==
|
||||
::
|
||||
:: constants
|
||||
:: # constants
|
||||
::
|
||||
:: contract addresses
|
||||
++ contracts
|
||||
|%
|
||||
++ ships
|
||||
0xe083.4579.269e.ac6b.eca2.
|
||||
882a.6a21.f6fb.0b1d.7196
|
||||
--
|
||||
::
|
||||
:: hashes of ship event signatures
|
||||
++ ships-events
|
||||
|%
|
||||
::
|
||||
:: ChangedPilot(uint32,address)
|
||||
++ changed-pilot
|
||||
0xb041.b798.8638.1a51.f9c6.29fb.4afc.6ab2.
|
||||
5059.09f4.d12e.168d.0ffc.bcb9.d78c.9179
|
||||
:: Transferred(uint32,address)
|
||||
++ transferred
|
||||
0x9014.bd16.807a.ce11.f497.2993.3667.4031.
|
||||
8029.4d9f.0e4f.42a1.5be6.0d26.5369.171c
|
||||
::
|
||||
:: ChangedStatus(uint32,uint8,uint64)
|
||||
++ changed-status
|
||||
0x7d33.b6e7.2395.c6e3.c518.9773.7331.77c1.
|
||||
5ba8.9ed5.0e0e.30ca.ebaa.3877.9a3e.1a79
|
||||
:: Activated(uint32)
|
||||
++ activated
|
||||
0xe74c.0380.9d07.69e1.b1f7.06cc.8414.258c.
|
||||
d1f3.b6fe.020c.d15d.0165.c210.ba50.3a0f
|
||||
::
|
||||
:: ChangedEscape(uint32,uint32)
|
||||
++ changed-escape
|
||||
0x7de2.bea0.d602.2858.c601.a403.71b6.3de0.
|
||||
2940.cda9.6fef.97e4.318b.65cf.de91.5d79
|
||||
:: EscapeRequested(uint32,uint32)
|
||||
++ escape-requested
|
||||
0xb4d4.850b.8f21.8218.141c.5665.cba3.79e5.
|
||||
3e9b.b015.b51e.8d93.4be7.0210.aead.874a
|
||||
::
|
||||
:: ChangedSponsor(uint32,uint32)
|
||||
++ changed-sponsor
|
||||
0x7941.482b.dede.7ff1.c27c.f2c6.e768.2155.
|
||||
a893.029d.c4a6.c619.8279.28fe.6031.9db4
|
||||
:: EscapeAccepted(uint32,uint32)
|
||||
++ escape-accepted
|
||||
0x7e44.7c9b.1bda.4b17.4b07.96e1.00bf.7f34.
|
||||
ebf3.6dbb.7fe6.6549.0b1b.fce6.246a.9da5
|
||||
::
|
||||
:: ChangedKey(uint32,bytes32,uint256)
|
||||
:: ChangedKeys(uint32,bytes32,bytes32,uint32)
|
||||
++ changed-key
|
||||
0xadc9.fc32.173c.d091.e0d2.ee96.60b4.b67a.
|
||||
586f.eb5a.0a30.e62c.5e9d.cfa3.573d.f8e4
|
||||
0x6a39.f4e0.c935.b557.860d.3df3.9f1f.cb6b.
|
||||
d63c.5a23.2d9e.fc28.5388.2994.f60c.708a
|
||||
--
|
||||
--
|
||||
|
||||
Loading…
Reference in New Issue
Block a user