mirror of
https://github.com/urbit/shrub.git
synced 2024-12-29 23:23:52 +03:00
419 lines
11 KiB
Plaintext
419 lines
11 KiB
Plaintext
:: btc-node-hook: send JSON rpc requests to bitcoin full node
|
|
:: and poke the responses into the btc-node-store
|
|
::
|
|
/- *btc-node-hook, *btc-node-store
|
|
/+ default-agent, base64, lib=btc-node-json, verb, dbug
|
|
::
|
|
=> |%
|
|
+$ card card:agent:gall
|
|
+$ versioned-state
|
|
$% [%0 state-zero]
|
|
==
|
|
::
|
|
+$ state-zero
|
|
$: user=@t
|
|
pass=@t
|
|
endpoint=@t
|
|
watched-calls=(set term)
|
|
==
|
|
--
|
|
::
|
|
=| state-zero
|
|
=* state -
|
|
:: Main
|
|
::
|
|
%- agent:dbug
|
|
%+ verb |
|
|
^- agent:gall
|
|
=< |_ =bowl:gall
|
|
+* this .
|
|
btc-core +>
|
|
bc ~(. btc-core bowl)
|
|
def ~(. (default-agent this %|) bowl)
|
|
::
|
|
++ on-init
|
|
^- (quip card _this)
|
|
[~ this(user '', pass '', endpoint '', watched-calls *(set term))]
|
|
::
|
|
++ on-save !>(state)
|
|
++ on-load
|
|
|= old=vase
|
|
`this(state !<(state-zero old))
|
|
::
|
|
++ on-poke
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
?> (team:title our.bowl src.bowl)
|
|
=^ cards state
|
|
?+ mark (on-poke:def mark vase)
|
|
%btc-node-hook-action
|
|
(handle-action:bc !<(btc-node-hook-action vase))
|
|
::
|
|
%btc-node-hook-command
|
|
(handle-command:bc !<(btc-node-hook-command vase))
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-watch
|
|
|= pax=path
|
|
^- (quip card _this)
|
|
:: We restrict access to the local ship and its moons,
|
|
:: because we handle permissioning at higher-level agents.
|
|
::
|
|
?> (team:title our.bowl src.bowl)
|
|
?+ pax (on-watch:def pax)
|
|
[%responses ~]
|
|
`this
|
|
==
|
|
++ on-leave on-leave:def
|
|
++ on-peek on-peek:def
|
|
++ on-agent on-agent:def
|
|
++ on-arvo
|
|
|= [=wire =sign-arvo]
|
|
^- (quip card _this)
|
|
=* response client-response.sign-arvo
|
|
=^ cards state
|
|
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
|
|
%http-response
|
|
?. ?=([%ping *] wire)
|
|
(http-response:bc wire response)
|
|
(broadcast-status:bc response)
|
|
==
|
|
[cards this]
|
|
::
|
|
++ on-fail on-fail:def
|
|
--
|
|
::
|
|
|_ =bowl:gall
|
|
:: Create an HTTP request to the BTC RPC endpoint
|
|
::
|
|
++ gen-request
|
|
|= act=btc-node-hook-action
|
|
^- request:http
|
|
=/ body=request:rpc:jstd
|
|
(request-to-rpc:btc-rpc:lib act)
|
|
=/ =header-list:http
|
|
:~ ['Content-Type' 'application/json']
|
|
:- 'Authorization'
|
|
;: (cury cat 3)
|
|
'Basic '
|
|
%- ~(en base64 | &)
|
|
(as-octs:mimes:html :((cury cat 3) user ':' pass))
|
|
== ==
|
|
:* %'POST'
|
|
(endpoint-url act)
|
|
header-list
|
|
=, html
|
|
%- some
|
|
%- as-octt:mimes
|
|
(en-json (request-to-json:rpc:jstd body))
|
|
==
|
|
::
|
|
++ handle-action
|
|
|= act=btc-node-hook-action
|
|
^- (quip card _state)
|
|
=/ out *outbound-config:iris
|
|
=/ req=request:http
|
|
(gen-request act)
|
|
:_ state
|
|
[%pass /[(scot %da now.bowl)] %arvo %i %request req out]~
|
|
::
|
|
++ handle-command
|
|
|= comm=btc-node-hook-command
|
|
^- (quip card _state)
|
|
?+ -.comm ~| [%unsupported-hook-command -.comm] !!
|
|
%credentials
|
|
:_ state(endpoint url.comm, user user.comm, pass pass.comm)
|
|
[%pass / %arvo %d %flog [%text "credentials updated..."]]~
|
|
::
|
|
%watch
|
|
~& > "Watching {<call.comm>}"
|
|
`state(watched-calls (~(put in watched-calls) call.comm))
|
|
::
|
|
%unwatch
|
|
~& > "Unwatching {<call.comm>}"
|
|
`state(watched-calls (~(del in watched-calls) call.comm))
|
|
:: Use a dummy call to `%uptime` to see whether the server is connected
|
|
::
|
|
%ping
|
|
ping-rpc
|
|
==
|
|
::
|
|
++ ping-rpc
|
|
^- (quip card _state)
|
|
=/ out *outbound-config:iris
|
|
=/ req=request:http
|
|
(gen-request (btc-node-hook-action [%uptime ~]))
|
|
:_ state
|
|
[%pass /ping/[(scot %da now.bowl)] %arvo %i %request req out]~
|
|
::
|
|
++ broadcast-status
|
|
|= response=client-response:iris
|
|
^- (quip card _state)
|
|
?. ?=(%finished -.response)
|
|
[~ state]
|
|
=* status status-code.response-header.response
|
|
:_ state
|
|
[%give %fact ~[/responses] %btc-node-hook-response !>([%status =(status 200) status])]~
|
|
::
|
|
++ httr-to-rpc-response
|
|
|= hit=httr:eyre
|
|
^- response:rpc:jstd
|
|
~| hit
|
|
=/ jon=json (need (de-json:html q:(need r.hit)))
|
|
?. =(%2 (div p.hit 100))
|
|
(parse-error jon)
|
|
=, dejs-soft:format
|
|
^- response:rpc:jstd
|
|
=; dere
|
|
=+ res=((ar dere) jon)
|
|
?~ res (need (dere jon))
|
|
[%batch u.res]
|
|
|= jon=json
|
|
^- (unit response:rpc:jstd)
|
|
=/ res=[id=(unit @t) res=(unit json) err=(unit json)]
|
|
%. jon
|
|
=, dejs:format
|
|
=- (ou -)
|
|
:~ ['id' (uf ~ (mu so))]
|
|
['result' (uf ~ (mu same))]
|
|
['error' (uf ~ (mu same))]
|
|
==
|
|
?: ?=([^ * ~] res)
|
|
`[%result [u.id.res ?~(res.res ~ u.res.res)]]
|
|
~| jon
|
|
`(parse-error jon)
|
|
::
|
|
++ parse-error
|
|
|= =json
|
|
^- response:rpc:jstd
|
|
:- %error
|
|
?~ json ['' '' '']
|
|
%. json
|
|
=, dejs:format
|
|
=- (ou -)
|
|
:~ =- ['id' (uf '' (cu - (mu so)))]
|
|
|*(a=(unit) ?~(a '' u.a))
|
|
:- 'error'
|
|
=- (uf ['' ''] -)
|
|
=- (cu |*(a=(unit) ?~(a ['' ''] u.a)) (mu (ou -)))
|
|
:~ ['code' (uf '' no)]
|
|
['message' (uf '' so)]
|
|
== ==
|
|
::
|
|
++ http-response
|
|
|= [=wire response=client-response:iris]
|
|
^- (quip card _state)
|
|
?. ?=(%finished -.response)
|
|
[~ state]
|
|
=* status status-code.response-header.response
|
|
=/ rpc-resp=response:rpc:jstd
|
|
%- httr-to-rpc-response
|
|
%+ to-httr:iris
|
|
response-header.response
|
|
full-file.response
|
|
?. ?=([%result *] rpc-resp)
|
|
~& [%error +.rpc-resp]
|
|
[~ state]
|
|
%- handle-btc-response
|
|
(parse-response:btc-rpc:lib rpc-resp)
|
|
::
|
|
++ handle-btc-response
|
|
|= btc-resp=btc-node-hook-response
|
|
^- (quip card _state)
|
|
:_ state
|
|
:: If the head term is a type of call we are watching, then
|
|
:: broadcast it to subscribers on the response path
|
|
::
|
|
=/ broadcast-response=(list card)
|
|
?: (~(has in watched-calls) -.btc-resp)
|
|
~[[%give %fact ~[/responses] %btc-node-hook-response !>(btc-resp)]]
|
|
~
|
|
%+ weld
|
|
broadcast-response
|
|
^- (list card)
|
|
?+ -.btc-resp
|
|
:: By default we just print all RPC responses that are not
|
|
:: considered here explicitly for proper format printing or
|
|
:: for being passed on to the store app.
|
|
::
|
|
~&(btc-resp ~)
|
|
::
|
|
:: %abandon-transaction
|
|
:: %abort-rescan
|
|
:: %add-multisig-address
|
|
:: %backup-wallet
|
|
:: %bump-fee
|
|
%create-wallet
|
|
=/ btc-store-req=btc-node-store-action
|
|
:+ %add-wallet name.btc-resp
|
|
?:(=('' warning.btc-resp) ~ (some warning.btc-resp))
|
|
[(btc-node-store-poke /store btc-store-req)]~
|
|
::
|
|
:: %dump-privkey
|
|
:: %dump-wallet
|
|
:: %encrypt-wallet
|
|
:: %get-addresses-by-label
|
|
::
|
|
%get-address-info
|
|
~&([%address-info +.btc-resp] ~)
|
|
::
|
|
%get-balance
|
|
~&([%amount (trip +.btc-resp)] ~)
|
|
::
|
|
:: %get-balance
|
|
:: %get-new-address
|
|
:: %get-raw-change-address
|
|
:: %get-received-by-address
|
|
:: %get-received-by-label
|
|
:: %get-transaction
|
|
:: %get-unconfirmed-balance
|
|
::
|
|
%get-wallet-info
|
|
^- (list card)
|
|
=/ btc-store-req=btc-node-store-action
|
|
[%update-wallet wallet-name.btc-resp +>:btc-resp]
|
|
[(btc-node-store-poke /update btc-store-req)]~
|
|
::
|
|
:: %import-address
|
|
:: %import-multi
|
|
:: %import-privkey
|
|
:: %import-pruned-funds
|
|
:: %import-pubkey
|
|
:: %import-wallet
|
|
:: %key-pool-refill
|
|
:: %list-address-groupings
|
|
:: %list-labels
|
|
:: %list-lock-unspent
|
|
:: %list-received-by-address
|
|
:: %list-received-by-label
|
|
:: %lists-in-ceblock
|
|
::
|
|
%list-transactions
|
|
~&([%transactions +.btc-resp] ~)
|
|
::
|
|
:: %list-unspent
|
|
:: %list-wallet-dir
|
|
::
|
|
%list-wallets
|
|
^- (list card)
|
|
:~ (btc-node-store-poke /list-wallets [%list-wallets ~])
|
|
:* %pass / %arvo %d %flog
|
|
%text "remote-wallets={<`wain`wallets.btc-resp>}"
|
|
== ==
|
|
::
|
|
%load-wallet
|
|
[(btc-node-store-poke /load [%load-wallet name.btc-resp])]~
|
|
::
|
|
:: %lock-unspent
|
|
:: %remove-pruned-funds
|
|
:: %rescan-blockchain
|
|
:: %send-many
|
|
:: %send-to-address
|
|
:: %set-hd-seed
|
|
:: %set-label
|
|
:: %set-tx-fee
|
|
:: %sign-message
|
|
:: %sign-raw-transaction-with-wallet
|
|
:: %unload-wallet
|
|
:: %wallet-create-fundedpsbt
|
|
:: %wallet-lock
|
|
:: %wallet-passphrase
|
|
:: %wallet-passphrase-change
|
|
:: %wallet-process-psbt
|
|
==
|
|
::
|
|
++ btc-node-store-poke
|
|
|= [=wire act=btc-node-store-action]
|
|
^- card
|
|
:* %pass
|
|
wire
|
|
%agent
|
|
[our.bowl %btc-node-store]
|
|
%poke
|
|
[%btc-node-store-action !>(act)]
|
|
==
|
|
::
|
|
++ default-wallet
|
|
.^ @t
|
|
%gx
|
|
(scot %p our.bowl)
|
|
%btc-node-store
|
|
(scot %da now.bowl)
|
|
/default-wallet/noun
|
|
==
|
|
::
|
|
++ n-wallets
|
|
.^ @ud
|
|
%gx
|
|
(scot %p our.bowl)
|
|
%btc-node-store
|
|
(scot %da now.bowl)
|
|
/n-wallets/noun
|
|
==
|
|
::
|
|
++ endpoint-url
|
|
|= [act=btc-node-hook-action]
|
|
^- @t
|
|
?. ?| ?=(%abandon-transaction -.act)
|
|
?=(%abort-rescan -.act)
|
|
?=(%add-multisig-address -.act)
|
|
?=(%backup-wallet -.act)
|
|
?=(%bump-fee -.act)
|
|
?=(%dump-privkey -.act)
|
|
?=(%dump-wallet -.act)
|
|
?=(%encrypt-wallet -.act)
|
|
?=(%fund-raw-transaction -.act)
|
|
?=(%get-balance -.act)
|
|
?=(%get-balances -.act)
|
|
?=(%get-addresses-by-label -.act)
|
|
?=(%get-address-info -.act)
|
|
?=(%get-new-address -.act)
|
|
?=(%get-raw-change-address -.act)
|
|
?=(%get-received-by-address -.act)
|
|
?=(%get-received-by-label -.act)
|
|
?=(%get-transaction -.act)
|
|
?=(%get-unconfirmed-balance -.act)
|
|
?=(%get-wallet-info -.act)
|
|
?=(%import-address -.act)
|
|
?=(%import-multi -.act)
|
|
?=(%import-privkey -.act)
|
|
?=(%import-pruned-funds -.act)
|
|
?=(%import-pubkey -.act)
|
|
?=(%import-wallet -.act)
|
|
?=(%key-pool-refill -.act)
|
|
?=(%list-address-groupings -.act)
|
|
?=(%list-labels -.act)
|
|
?=(%list-lock-unspent -.act)
|
|
?=(%list-received-by-address -.act)
|
|
?=(%list-received-by-label -.act)
|
|
?=(%lists-in-ceblock -.act)
|
|
?=(%list-transactions -.act)
|
|
?=(%list-unspent -.act)
|
|
?=(%lock-unspent -.act)
|
|
?=(%remove-pruned-funds -.act)
|
|
?=(%rescan-blockchain -.act)
|
|
?=(%send-many -.act)
|
|
?=(%send-to-address -.act)
|
|
?=(%set-hd-seed -.act)
|
|
?=(%set-label -.act)
|
|
?=(%set-tx-fee -.act)
|
|
?=(%sign-message -.act)
|
|
?=(%sign-raw-transaction-with-wallet -.act)
|
|
?=(%wallet-create-fundedpsbt -.act)
|
|
?=(%wallet-lock -.act)
|
|
?=(%wallet-passphrase -.act)
|
|
?=(%wallet-passphrase-change -.act)
|
|
?=(%wallet-process-psbt -.act)
|
|
==
|
|
endpoint
|
|
;: (cury cat 3)
|
|
endpoint
|
|
'wallet/'
|
|
::
|
|
?: ?=([?(%dump-wallet %import-wallet) filename=@t] act)
|
|
filename.act
|
|
default-wallet
|
|
==
|
|
--
|