urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 11:24:21 +03:00
Code Issues Packages Projects Releases Wiki Activity
bb53d5a8ba
shrub/pkg/arvo/lib/btc.hoon
Philip Monk 7f7e033004
Revert "Revert "Merge naive/aggregator into poprox/naive-tests"" 
This reverts commit 2f49dab586.
2021-08-19 16:09:28 -07:00

572 lines
13 KiB
Plaintext
Raw Blame History

:: lib/btc.hoon
::
/- *btc-wallet, json-rpc, bp=btc-provider
/+ bip32, bc=bitcoin
=, secp:crypto
=+ ecc=secp256k1
|%
::
:: Formerly lib/btc-wallet.hoon
::
::
++ defaults
|%
++ max-gap 20
++ confs 6
--
:: +fam: planet parent if s is a moon
::
++ fam
|= [our=ship now=@da s=ship]
^- ship
?. =(%earl (clan:title s)) s
(sein:title our now s)
::
++ num-confs
|= [last-block=@ud =utxo:bc]
?: =(0 height.utxo) 0
(add 1 (sub last-block height.utxo))
::
++ from-xpub
|= $: =xpub:bc
=fprint:bc
scan-to=(unit scon)
max-gap=(unit @ud)
confs=(unit @ud)
==
^- walt
=/ [=bipt =network] (xpub-type:bc xpub)
:* xpub
network
fprint
+6:(from-extended:bip32 (trip xpub))
bipt
*wach
[0 0]
%.n
(fall scan-to *scon)
(fall max-gap max-gap:defaults)
(fall confs confs:defaults)
==
:: +address-coords: find wallet info for the address, if any
::
++ address-coords
|= [a=address ws=(list walt)]
^- (unit [w=walt =chyg =idx])
|^
|- ?~ ws ~
=/ res=(unit [=chyg =idx])
(lookup i.ws)
?^ res `[i.ws chyg.u.res idx.u.res]
$(ws t.ws)
::
++ lookup
|= w=walt
^- (unit [=chyg =idx])
=/ ad=(unit addi) (~(get by wach.w) a)
?~(ad ~ `[chyg.u.ad idx.u.ad])
--
::
++ new-txbu
|= $: w=walt
payee=(unit ship)
=vbytes:bc
is=(list insel)
txos=(list txo)
==
^- txbu
:* xpub.w
payee
vbytes
%+ turn is
|= i=insel
[utxo.i ~ (~(hdkey wad w chyg.i) idx.i)]
txos
~
==
:: txb: transaction builder helpers
::
++ txb
|_ t=txbu
++ value
^- [in=sats out=sats]
:- %+ roll
%+ turn txis.t
|=(=txi value.utxo.txi)
add
(roll (turn txos.t |=(=txo value.txo)) add)
::
++ fee
^- sats:bc
=/ [in=sats out=sats] value
(sub in out)
::
++ vbytes
^- vbytes:bc
%+ add overhead-weight:bc
%+ add
%+ roll
(turn txis.t |=(t=txi (input-weight:bc bipt.hdkey.t)))
add
%+ roll
(turn txos.t |=(t=txo (output-weight:bc (get-bipt:adr:bc address.t))))
add
++ tx-data
|^
^- data:tx:bc
:* (turn txis.t txi-data)
(turn txos.t txo-data)
0 1 `1
==
::
++ txi-data
|= =txi
:* txid.utxo.txi pos.utxo.txi
4^0xffff.ffff ~ ~ value.utxo.txi
==
++ txo-data
|= =txo
:- (to-script-pubkey:adr:bc address.txo)
value.txo
--
::
++ get-txid
^- txid
(get-id:txu:bc tx-data)
::
++ get-rawtx
(basic-encode:txu:bc tx-data)
:: +add-output: append output (usually change) to txos
::
++ add-output
|= =txo
^- txbu
:: todo update vbytes
t(txos (snoc [txos.t] txo))
:: +to-psbt: returns a based 64 PSBT if
:: - all inputs have an associated rawtx
::
++ to-psbt
^- (unit base64:psbt:bc)
=/ ins=(list in:psbt:bc)
%+ murn txis.t
|= =txi
?~ rawtx.txi ~
`[utxo.txi u.rawtx.txi hdkey.txi]
?: (lth (lent ins) (lent txis.t))
~
=/ outs=(list out:psbt:bc)
%+ turn txos.t
|=(=txo [address.txo hk.txo])
`(encode:pbt:bc %.y get-rawtx get-txid ins outs)
--
:: wad: door for processing walts (wallets)
:: parameterized on a walt and it's chyg account
::
++ wad
|_ [w=walt =chyg]
++ pubkey
|= =idx:bc
^- hexb:bc
=/ pk=@ux
%- compress-point:ecc
pub:(derive-public:(~(derive-public bip32 wamp.w) chyg) idx)
[(met 3 pk) pk]
::
++ hdkey
|= =idx:bc
^- hdkey:bc
[fprint.w (~(pubkey wad w chyg) idx) network.w bipt.w chyg idx]
::
++ mk-address
|= =idx:bc
^- address:bc
(from-pubkey:adr:bc bipt.w network.w (pubkey idx))
:: +nixt-address: used to get change addresses
:: - gets the current next available address
:: - doesn't bump nixt-address if it's unused
:: - if used, fall back to gen-address and make a new one
::
++ nixt-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
~| "lib/btc-wallet-store: get-next-address: nixt shouldn't be blank"
=/ =addi (~(got by wach.w) addr)
?. used.addi
[addr nixt-idx w]
gen-address
::
:: +gen-address:
:: - generates the next available address
:: - watches it (using update address)
::
++ gen-address
^- (trel address:bc idx:bc walt)
=/ addr (mk-address nixt-idx)
:* addr
nixt-idx
%+ update-address addr
[%.n chyg nixt-idx *(set utxo:bc)]
==
:: +update-address
:: - insert a new address
:: - if it's used, move "nixt" to the next free address
:: - watch address
::
++ update-address
|= [a=address:bc =addi]
^- walt
?> =(chyg chyg.addi)
?> =(a (mk-address idx.addi))
=? w ?&(used.addi (is-nixt addi))
bump-nixt
w(wach (~(put by wach.w) a addi))
::
++ is-nixt
|= =addi ^- ?
?: ?=(%0 chyg.addi)
=(idx.addi p.nixt.w)
=(idx.addi q.nixt.w)
++ nixt-idx
?:(?=(%0 chyg) p.nixt.w q.nixt.w)
:: +bump-nixt: return wallet with bumped nixt
:: - find next unused address
:: - watches that address
:: - crashes if max-index is passed
::
++ bump-nixt
|^ ^- walt
=/ new-idx=idx:bc +(nixt-idx)
|- ?> (lte new-idx max-index)
=+ addr=(mk-address new-idx)
=/ =addi
%+ ~(gut by wach.w) addr
[%.n chyg new-idx *(set utxo:bc)]
?. used.addi
%= w
nixt (set-nixt new-idx)
wach (~(put by wach.w) addr addi)
==
$(new-idx +(new-idx))
::
++ set-nixt
|= =idx:bc ^- nixt
?:(?=(%0 chyg) [idx q.nixt.w] [p.nixt.w idx])
--
--
:: sut: select utxos
::
++ sut
|_ [w=walt eny=@uvJ last-block=@ud payee=(unit ship) =feyb txos=(list txo)]
++ dust-sats 3
++ dust-threshold
|= output-bipt=bipt:bc
^- vbytes
(mul dust-sats (input-weight:bc output-bipt))
::
++ target-value
^- sats
%+ roll (turn txos |=(=txo value.txo))
|=([a=sats b=sats] (add a b))
::
++ base-weight
^- vbytes
%+ add overhead-weight:bc
%+ roll
%+ turn txos
|=(=txo (output-weight:bc (get-bipt:adr:bc address.txo)))
add
::
++ total-vbytes
|= selected=(list insel)
^- vbytes
%+ add base-weight
(mul (input-weight:bc bipt.w) (lent selected))
:: value of an input after fee
:: 0 if net is <= 0
::
++ net-value
|= val=sats
^- sats
=/ cost (mul (input-weight:bc bipt.w) feyb)
?: (lte val cost) 0
(sub val cost)
::
:: +spendable: whether utxo has enough confs to spend
::
++ spendable
|= =utxo:bc ^- ?
(gte (num-confs last-block utxo) confs.w)
:: +with-change:
:: - choose UTXOs, if there are enough
:: - return txbu and amount of change (if any)
::
++ with-change
^- [tb=(unit txbu) chng=(unit sats)]
=/ tb=(unit txbu) select-utxos
?~ tb [~ ~]
=+ excess=~(fee txb u.tb) :: (inputs - outputs)
=/ new-fee=sats :: cost of this tx + one more output
(mul feyb (add (output-weight:bc bipt.w) vbytes.u.tb))
?. (gth excess new-fee)
[tb ~]
?. (gth (sub excess new-fee) (dust-threshold bipt.w))
[tb ~]
:- tb
`(sub excess new-fee)
:: Uses naive random selection. Should switch to branch-and-bound later.
::
++ select-utxos
|^ ^- (unit txbu)
?. %+ levy txos
|= =txo
%+ gth value.txo
(dust-threshold (get-bipt:adr:bc address.txo))
~|("One or more suggested outputs is dust." !!)
=/ is=(unit (list insel))
%- single-random-draw
%- zing
(turn ~(val by wach.w) to-insels)
?~ is ~
`(new-txbu w payee (total-vbytes u.is) u.is txos)
::
++ to-insels
|= =addi
^- (list insel)
%+ turn ~(tap in utxos.addi)
|=(=utxo:bc [utxo chyg.addi idx.addi])
--
:: single-random-draw
:: randomly choose utxos until target is hit
:: only use an insel if its net-value > 0
::
++ single-random-draw
|= is=(list insel)
^- (unit (list insel))
=/ rng ~(. og eny)
=/ target (add target-value (mul feyb base-weight)) :: add base fees to target
=| [select=(list insel) total=sats:bc]
|-
?: =(~ is) ~
=^ n rng (rads:rng (lent is))
=/ i=insel (snag n is)
?. (spendable utxo.i)
$(is (oust [n 1] is))
=/ net-val (net-value value.utxo.i)
=? select (gth net-val 0)
[i select]
=/ new-total (add total net-val)
?: (gte new-total target) `select
%= $
is (oust [n 1] is)
total new-total
==
::
--
::
::
:: Formerly lib/btc-provider
::
::
++ from-epoch
|= secs=@ud
^- (unit @da)
?: =(0 secs) ~
[~ (add ~1970.1.1 `@dr`(mul secs ~s1))]
::
++ get-request
|= url=@t
^- request:http
[%'GET' url ~ ~]
::
++ post-request
|= [url=@t body=json]
^- request:http
:* %'POST'
url
~[['Content-Type' 'application/json']]
=, html
%- some
%- as-octt:mimes
(en-json body)
==
::
++ gen-request
|= [=host-info:bp ract=action:rpc-types:bp]
^- request:http
%+ rpc-action-to-http
api-url.host-info ract
::
++ rpc
=, dejs:format
|%
++ parse-result
|= res=response:json-rpc
|^ ^- result:rpc-types:bp
~| -.res
?> ?=(%result -.res)
?+ id.res ~|([%unsupported-result id.res] !!)
%get-address-info
[id.res (address-info res.res)]
::
%get-tx-vals
[id.res (tx-vals res.res)]
::
%get-raw-tx
[id.res (raw-tx res.res)]
::
%broadcast-tx
[%broadcast-tx (broadcast-tx res.res)]
::
%get-block-count
[id.res (ni res.res)]
::
%get-block-info
[id.res (block-info res.res)]
==
++ address-info
%- ot
:~ [%address (cu from-cord:adr:bc so)]
[%utxos (as utxo)]
[%used bo]
[%block ni]
==
++ utxo
%- ot
:~ ['tx_pos' ni]
['tx_hash' (cu from-cord:hxb:bc so)]
[%height ni]
[%value ni]
[%recvd (cu from-epoch ni)]
==
++ tx-vals
%- ot
:~ [%included bo]
[%txid (cu from-cord:hxb:bc so)]
[%confs ni]
[%recvd (cu from-epoch ni)]
[%inputs (ar tx-val)]
[%outputs (ar tx-val)]
==
++ tx-val
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%pos ni]
[%address (cu from-cord:adr:bc so)]
[%value ni]
==
++ raw-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%rawtx (cu from-cord:hxb:bc so)]
==
++ broadcast-tx
%- ot
:~ [%txid (cu from-cord:hxb:bc so)]
[%broadcast bo]
[%included bo]
==
++ block-info
%- ot
:~ [%block ni]
[%fee (mu ni)]
[%blockhash (cu from-cord:hxb:bc so)]
[%blockfilter (cu from-cord:hxb:bc so)]
==
--
--
::
++ rpc-action-to-http
|= [endpoint=@t ract=action:rpc-types:bp]
|^ ^- request:http
?- -.ract
%get-address-info
%- get-request
%+ mk-url '/addresses/info/'
(to-cord:adr:bc address.ract)
::
%get-tx-vals
%- get-request
%+ mk-url '/gettxvals/'
(to-cord:hxb:bc txid.ract)
::
%get-raw-tx
%- get-request
%+ mk-url '/getrawtx/'
(to-cord:hxb:bc txid.ract)
::
%broadcast-tx
%- get-request
%+ mk-url '/broadcasttx/'
(to-cord:hxb:bc rawtx.ract)
::
%get-block-count
%- get-request
(mk-url '/getblockcount' '')
::
%get-block-info
%- get-request
(mk-url '/getblockinfo' '')
==
++ mk-url
|= [base=@t params=@t]
%^ cat 3
(cat 3 endpoint base) params
--
:: RPC/HTTP Utilities
::
++ httr-to-rpc-response
|= hit=httr:eyre
^- response:json-rpc
~| hit
=/ jon=json (need (de-json:html q:(need r.hit)))
?. =(%2 (div p.hit 100))
(parse-rpc-error jon)
=, dejs-soft:format
^- response:json-rpc
=; dere
=+ res=((ar dere) jon)
?~ res (need (dere jon))
[%batch u.res]
|= jon=json
^- (unit response:json-rpc)
=/ 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-rpc-error jon)
::
++ get-rpc-response
|= response=client-response:iris
^- response:json-rpc
?> ?=(%finished -.response)
%- httr-to-rpc-response
%+ to-httr:iris
response-header.response
full-file.response
::
++ parse-rpc-error
|= =json
^- response:json-rpc
:- %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)]
== ==
--
Reference in New Issue View Git Blame Copy Permalink