urbit/app/btc-node-hook.hoon
2021-05-26 18:30:11 -07:00

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
==
--