mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-12 22:46:11 +03:00
btc-provider: refactor to clean up lexical scope and code style
This commit is contained in:
Logan Allen
parent
cd400dfa69
commit
515372d319
@ -11,21 +11,21 @@
|
||||
::
|
||||
/- *bitcoin, json-rpc, *btc-provider
|
||||
/+ dbug, default-agent, bl=btc, groupl=group, resource
|
||||
~% %btc-provider-top ..part ~
|
||||
|%
|
||||
+$ card card:agent:gall
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
==
|
||||
::
|
||||
+$ state-0 [%0 =host-info =whitelist]
|
||||
::
|
||||
+$ card card:agent:gall
|
||||
::
|
||||
--
|
||||
%- agent:dbug
|
||||
=| state-0
|
||||
=* state -
|
||||
^- agent:gall
|
||||
=<
|
||||
~% %btc-provider-agent ..send-status ~
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
@ -55,16 +55,110 @@
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
^- (quip card _this)
|
||||
|^
|
||||
?> ?|((team:title our.bowl src.bowl) (is-client:hc src.bowl))
|
||||
=^ cards state
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%btc-provider-command
|
||||
?> (team:title our.bowl src.bowl)
|
||||
(handle-command:hc !<(command vase))
|
||||
(handle-command !<(command vase))
|
||||
%btc-provider-action
|
||||
(handle-action:hc !<(action vase))
|
||||
(handle-action !<(action vase))
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ handle-command
|
||||
|= comm=command
|
||||
^- (quip card _state)
|
||||
?- -.comm
|
||||
%set-credentials
|
||||
:- :~ do-ping:hc
|
||||
(start-ping-timer:hc ~s30)
|
||||
==
|
||||
%_ state
|
||||
host-info
|
||||
[api-url.comm connected=%.n network.comm block=0 clients=*(set ship)]
|
||||
==
|
||||
::
|
||||
%add-whitelist
|
||||
?- -.wt.comm
|
||||
%public
|
||||
`state(public.whitelist %.y)
|
||||
::
|
||||
%kids
|
||||
`state(kids.whitelist %.y)
|
||||
::
|
||||
%users
|
||||
`state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
|
||||
::
|
||||
%groups
|
||||
`state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
|
||||
==
|
||||
::
|
||||
%remove-whitelist
|
||||
=. state
|
||||
?- -.wt.comm
|
||||
%public
|
||||
state(public.whitelist %.n)
|
||||
::
|
||||
%kids
|
||||
state(kids.whitelist %.n)
|
||||
::
|
||||
%users
|
||||
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
|
||||
::
|
||||
%groups
|
||||
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
|
||||
==
|
||||
clean-client-list
|
||||
==
|
||||
::
|
||||
:: +clean-client-list: remove clients who are no longer whitelisted
|
||||
:: called after a whitelist change
|
||||
::
|
||||
++ clean-client-list
|
||||
^- (quip card _state)
|
||||
=/ to-kick=(set ship)
|
||||
%- silt
|
||||
%+ murn ~(tap in clients.host-info)
|
||||
|= c=ship ^- (unit ship)
|
||||
?:((is-whitelisted:hc c) ~ `c)
|
||||
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
|
||||
%+ turn ~(tap in to-kick)
|
||||
|=(c=ship [%give %kick ~[/clients] `c])
|
||||
::
|
||||
:: if not connected, only %ping action is allowed
|
||||
::
|
||||
++ handle-action
|
||||
|= act=action
|
||||
^- (quip card _state)
|
||||
?. ?|(connected.host-info ?=(%ping -.act))
|
||||
~& >>> "Not connected to RPC"
|
||||
[~[(send-update:hc [%| %not-connected 500])] state]
|
||||
:_ state
|
||||
:_ ~
|
||||
%+ req-card act
|
||||
^- action:rpc-types
|
||||
?- -.act
|
||||
%address-info [%get-address-info address.act]
|
||||
%tx-info [%get-tx-vals txid.act]
|
||||
%raw-tx [%get-raw-tx txid.act]
|
||||
%broadcast-tx [%broadcast-tx rawtx.act]
|
||||
%ping [%get-block-info ~]
|
||||
%block-info [%get-block-info block.act]
|
||||
==
|
||||
::
|
||||
++ req-card
|
||||
|= [act=action ract=action:rpc-types]
|
||||
=/ req=request:http
|
||||
(gen-request:bl host-info ract)
|
||||
[%pass (rpc-wire act) %arvo %i %request req *outbound-config:iris]
|
||||
::
|
||||
++ rpc-wire
|
||||
|= act=action
|
||||
^- wire
|
||||
/[-.act]/[(scot %ux (cut 3 [0 20] eny.bowl))]
|
||||
--
|
||||
::
|
||||
++ on-watch
|
||||
|= pax=path
|
||||
@ -92,6 +186,7 @@
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire =sign-arvo]
|
||||
|^
|
||||
^- (quip card _this)
|
||||
:: check for connectivity every 30 seconds
|
||||
::
|
||||
@ -103,9 +198,83 @@
|
||||
=^ cards state
|
||||
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
|
||||
%http-response
|
||||
(handle-rpc-response:hc wire client-response.sign-arvo)
|
||||
(handle-rpc-response wire client-response.sign-arvo)
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
:: Handles HTTP responses from RPC servers. Parses for errors,
|
||||
:: then handles response. For actions that require collating multiple
|
||||
:: RPC calls, uses req-card to call out to RPC again if more
|
||||
:: information is required.
|
||||
++ handle-rpc-response
|
||||
|= [=wire response=client-response:iris]
|
||||
^- (quip card _state)
|
||||
?. ?=(%finished -.response) `state
|
||||
=* status status-code.response-header.response
|
||||
:: handle error types: connection errors, RPC errors (in order)
|
||||
::
|
||||
=^ conn-err state
|
||||
(connection-error status)
|
||||
?^ conn-err
|
||||
:_ state(connected.host-info %.n)
|
||||
:~ (send-status:hc [%disconnected ~])
|
||||
(send-update:hc [%| u.conn-err])
|
||||
==
|
||||
::
|
||||
%+ handle-rpc-result wire
|
||||
%- parse-result:rpc:bl
|
||||
(get-rpc-response:bl response)
|
||||
::
|
||||
++ handle-rpc-result
|
||||
|= [=wire r=result:rpc-types]
|
||||
^- (quip card _state)
|
||||
?+ -.wire ~|("Unexpected HTTP response" !!)
|
||||
%address-info
|
||||
?> ?=([%get-address-info *] r)
|
||||
:_ state
|
||||
~[(send-update:hc [%.y %address-info +.r])]
|
||||
::
|
||||
%tx-info
|
||||
?> ?=([%get-tx-vals *] r)
|
||||
:_ state
|
||||
~[(send-update:hc [%.y %tx-info +.r])]
|
||||
::
|
||||
%raw-tx
|
||||
?> ?=([%get-raw-tx *] r)
|
||||
:_ state
|
||||
~[(send-update:hc [%.y %raw-tx +.r])]
|
||||
::
|
||||
%broadcast-tx
|
||||
?> ?=([%broadcast-tx *] r)
|
||||
:_ state
|
||||
~[(send-update:hc [%.y %broadcast-tx +.r])]
|
||||
::
|
||||
%ping
|
||||
?> ?=([%get-block-info *] r)
|
||||
:_ state(connected.host-info %.y, block.host-info block.r)
|
||||
:_ ~
|
||||
%- send-status:hc
|
||||
?: =(block.host-info block.r)
|
||||
[%connected network.host-info block.r fee.r]
|
||||
[%new-block network.host-info block.r fee.r blockhash.r blockfilter.r]
|
||||
::
|
||||
%block-info
|
||||
?> ?=([%get-block-info *] r)
|
||||
:_ state
|
||||
~[(send-update:hc [%.y %block-info network.host-info +.r])]
|
||||
==
|
||||
::
|
||||
++ connection-error
|
||||
|= status=@ud
|
||||
^- [(unit error) _state]
|
||||
?+ status [`[%rpc-error ~] state]
|
||||
%200 [~ state]
|
||||
%400 [`[%bad-request status] state]
|
||||
%401 [`[%no-auth status] state(connected.host-info %.n)]
|
||||
%502 [`[%not-connected status] state(connected.host-info %.n)]
|
||||
%504 [`[%not-connected status] state(connected.host-info %.n)]
|
||||
==
|
||||
--
|
||||
::
|
||||
++ on-peek
|
||||
|= pax=path
|
||||
@ -115,7 +284,7 @@
|
||||
``noun+!>((is-whitelisted:hc (ship (slav %p +>-.pax))))
|
||||
::
|
||||
[%x %is-client @t ~]
|
||||
``noun+!>((is-client (ship (slav %p +>-.pax))))
|
||||
``noun+!>((is-client:hc (ship (slav %p +>-.pax))))
|
||||
==
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
@ -123,176 +292,8 @@
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
:: helper core
|
||||
~% %btc-provider-helper ..card ~
|
||||
|_ =bowl:gall
|
||||
++ handle-command
|
||||
|= comm=command
|
||||
^- (quip card _state)
|
||||
?- -.comm
|
||||
%set-credentials
|
||||
:- :~ do-ping
|
||||
(start-ping-timer ~s30)
|
||||
==
|
||||
%= state
|
||||
host-info
|
||||
[api-url.comm connected=%.n network.comm block=0 clients=*(set ship)]
|
||||
==
|
||||
::
|
||||
%add-whitelist
|
||||
?- -.wt.comm
|
||||
%public
|
||||
`state(public.whitelist %.y)
|
||||
::
|
||||
%kids
|
||||
`state(kids.whitelist %.y)
|
||||
::
|
||||
%users
|
||||
`state(users.whitelist (~(uni in users.whitelist) users.wt.comm))
|
||||
::
|
||||
%groups
|
||||
`state(groups.whitelist (~(uni in groups.whitelist) groups.wt.comm))
|
||||
==
|
||||
::
|
||||
%remove-whitelist
|
||||
=. state
|
||||
?- -.wt.comm
|
||||
%public
|
||||
state(public.whitelist %.n)
|
||||
::
|
||||
%kids
|
||||
state(kids.whitelist %.n)
|
||||
::
|
||||
%users
|
||||
state(users.whitelist (~(dif in users.whitelist) users.wt.comm))
|
||||
::
|
||||
%groups
|
||||
state(groups.whitelist (~(dif in groups.whitelist) groups.wt.comm))
|
||||
==
|
||||
clean-client-list
|
||||
==
|
||||
:: if not connected, only %ping action is allowed
|
||||
::
|
||||
++ handle-action
|
||||
|= act=action
|
||||
^- (quip card _state)
|
||||
?. ?|(connected.host-info ?=(%ping -.act))
|
||||
~& >>> "Not connected to RPC"
|
||||
[~[(send-update [%| %not-connected 500])] state]
|
||||
::
|
||||
=/ ract=action:rpc-types
|
||||
?- -.act :: ~|("Invalid action" !!)
|
||||
%address-info
|
||||
[%get-address-info address.act]
|
||||
::
|
||||
%tx-info
|
||||
[%get-tx-vals txid.act]
|
||||
::
|
||||
%raw-tx
|
||||
[%get-raw-tx txid.act]
|
||||
::
|
||||
%broadcast-tx
|
||||
[%broadcast-tx rawtx.act]
|
||||
::
|
||||
%ping
|
||||
[%get-block-info ~]
|
||||
::
|
||||
%block-info
|
||||
[%get-block-info block.act]
|
||||
==
|
||||
[~[(req-card act ract)] state]
|
||||
::
|
||||
++ req-card
|
||||
|= [act=action ract=action:rpc-types]
|
||||
=| out=outbound-config:iris
|
||||
=/ req=request:http
|
||||
(gen-request:bl host-info ract)
|
||||
[%pass (rpc-wire act) %arvo %i %request req out]
|
||||
:: wire structure: /action-tas/now
|
||||
::
|
||||
++ rpc-wire
|
||||
|= act=action ^- wire
|
||||
/[-.act]/[(scot %ux (cut 3 [0 20] eny.bowl))]
|
||||
::
|
||||
++ kick-client
|
||||
|= client=ship
|
||||
^- (quip card _state)
|
||||
~& >>> "dropping client {<client>}"
|
||||
:- ~[[%give %kick ~[/clients] `client]]
|
||||
state(clients.host-info (~(dif in clients.host-info) (silt ~[client])))
|
||||
::
|
||||
:: Handles HTTP responses from RPC servers. Parses for errors, then handles response.
|
||||
:: For actions that require collating multiple RPC calls, uses req-card to call out
|
||||
:: to RPC again if more information is required.
|
||||
::
|
||||
++ handle-rpc-response
|
||||
|= [=wire response=client-response:iris]
|
||||
^- (quip card _state)
|
||||
?. ?=(%finished -.response) `state
|
||||
=* status status-code.response-header.response
|
||||
:: handle error types: connection errors, RPC errors (in order)
|
||||
::
|
||||
=^ conn-err state
|
||||
(connection-error status)
|
||||
?^ conn-err
|
||||
:_ state(connected.host-info %.n)
|
||||
~[(send-status [%disconnected ~]) (send-update [%| u.conn-err])]
|
||||
::
|
||||
%+ handle-rpc-result wire
|
||||
%- parse-result:rpc:bl
|
||||
(get-rpc-response:bl response)
|
||||
::
|
||||
++ connection-error
|
||||
|= status=@ud
|
||||
^- [(unit error) _state]
|
||||
?+ status [`[%rpc-error ~] state]
|
||||
%200
|
||||
[~ state]
|
||||
%400
|
||||
[`[%bad-request status] state]
|
||||
%401
|
||||
[`[%no-auth status] state(connected.host-info %.n)]
|
||||
%502
|
||||
[`[%not-connected status] state(connected.host-info %.n)]
|
||||
%504
|
||||
[`[%not-connected status] state(connected.host-info %.n)]
|
||||
==
|
||||
::
|
||||
++ handle-rpc-result
|
||||
|= [=wire r=result:rpc-types]
|
||||
^- (quip card _state)
|
||||
?+ -.wire ~|("Unexpected HTTP response" !!)
|
||||
%address-info
|
||||
?> ?=([%get-address-info *] r)
|
||||
:_ state
|
||||
~[(send-update [%.y %address-info +.r])]
|
||||
::
|
||||
%tx-info
|
||||
?> ?=([%get-tx-vals *] r)
|
||||
:_ state
|
||||
~[(send-update [%.y %tx-info +.r])]
|
||||
::
|
||||
%raw-tx
|
||||
?> ?=([%get-raw-tx *] r)
|
||||
:_ state
|
||||
~[(send-update [%.y %raw-tx +.r])]
|
||||
::
|
||||
%broadcast-tx
|
||||
?> ?=([%broadcast-tx *] r)
|
||||
:_ state
|
||||
~[(send-update [%.y %broadcast-tx +.r])]
|
||||
::
|
||||
%ping
|
||||
?> ?=([%get-block-info *] r)
|
||||
:_ state(connected.host-info %.y, block.host-info block.r)
|
||||
?: =(block.host-info block.r)
|
||||
~[(send-status [%connected network.host-info block.r fee.r])]
|
||||
~[(send-status [%new-block network.host-info block.r fee.r blockhash.r blockfilter.r])]
|
||||
::
|
||||
%block-info
|
||||
?> ?=([%get-block-info *] r)
|
||||
:_ state
|
||||
~[(send-update [%.y %block-info network.host-info +.r])]
|
||||
==
|
||||
::
|
||||
++ send-status
|
||||
|= =status ^- card
|
||||
%- ?: ?=(%new-block -.status)
|
||||
@ -330,19 +331,6 @@
|
||||
$(gs t.gs)
|
||||
:: .^((unit group:g) %gx ;:(weld /=group-store=/groups p /noun))
|
||||
--
|
||||
:: +clean-client-list: remove clients who are no longer whitelisted
|
||||
:: called after a whitelist change
|
||||
::
|
||||
++ clean-client-list
|
||||
^- (quip card _state)
|
||||
=/ to-kick=(set ship)
|
||||
%- silt
|
||||
%+ murn ~(tap in clients.host-info)
|
||||
|= c=ship ^- (unit ship)
|
||||
?:((is-whitelisted c) ~ `c)
|
||||
:_ state(clients.host-info (~(dif in clients.host-info) to-kick))
|
||||
%+ turn ~(tap in to-kick)
|
||||
|=(c=ship [%give %kick ~[/clients] `c])
|
||||
::
|
||||
++ is-client
|
||||
|= user=ship ^- ?
|
||||
|
||||
Loading…
Reference in New Issue
Block a user