:: btc-bridge.hoon :: Proxy for accessing BTC full node :: /- *btc-bridge, bnh=btc-node-hook /+ dbug, default-agent, base64, lib=btc-node-json |% +$ versioned-state $% state-0 == :: +$ state-0 [%0 =credentials =status] :: +$ card card:agent:gall :: -- %- agent:dbug =| state-0 =* state - ^- agent:gall =< |_ =bowl:gall +* this . def ~(. (default-agent this %|) bowl) hc ~(. +> bowl) :: ++ on-init ^- (quip card _this) ~& > '%btc-bridge initialized successfully' :- ~ this(status [%client connected=%.n host=~]) ++ on-save ^- vase !>(state) ++ on-load |= old-state=vase ^- (quip card _this) ~& > '%btc-bridge recompiled successfully' `this(state !<(versioned-state old-state)) ++ on-poke |= [=mark =vase] ^- (quip card _this) :: Only allow poke from our ship, unless we're a host :: ?> ?|((team:title our.bowl src.bowl) ?=(%host -.status)) =^ cards state ?+ mark (on-poke:def mark vase) %btc-bridge-command (handle-command:hc !<(command vase)) %btc-bridge-rpc-action ~& > !<(rpc-action vase) `state == [cards this] :: ++ on-watch on-watch:def ++ 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 (http-response:hc wire response) == [cards this] :: ++ on-fail on-fail:def -- :: helper core |_ =bowl:gall ++ handle-command |= comm=command ^- (quip card _state) ?- -.comm %become-host :: TODO send a subscription to the node hook; update status in on-agent when ack'd `state(credentials credentials.comm) %connect-as-client :: TODO send a subscription to the btc-bridge host :: update status in on-agent when ack'd by BTC-BRIDGE `state %allow-clients ?+ -.status ~&(>>> 'Only a %host can add clients' `state) %host `state(clients.status (~(uni in clients.status) users.comm)) == == ++ gen-request |= act=btc-node-hook-action:bnh ^- request:http =* user rpc-user.credentials =* pass rpc-password.credentials =* endpoint rpc-url.credentials =/ 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 header-list =, html %- some %- as-octt:mimes (en-json (request-to-json:rpc:jstd body)) == :: ++ handle-action |= act=btc-node-hook-action:bnh ^- (quip card _state) =/ out *outbound-config:iris =/ req=request:http (gen-request act) :_ state [%pass /[(scot %da now.bowl)] %arvo %i %request req out]~ :: ++ 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] [~ state] :: %- handle-btc-response :: (parse-response:btc-rpc:lib rpc-resp) :: --