shrub/pkg/bitcoin/app/btc-wallet.hoon

::  btc-wallet
::
::  Scrys
::  x/scanned: (list xpub) of all scanned wallets
::  x/balance/xpub: balance (in sats) of wallet
/-  *btc-wallet, bp=btc-provider, settings
/+  dbug, default-agent, bl=btc, bc=bitcoin, bcu=bitcoin-utils, bip32, agentio
~%  %btc-wallet-top  ..part  ~
|%
+$  card  card:agent:gall
::
++  defaults
  |%
  ++  params
    :*  batch-size=20
        fam-limit=10
        piym-limit=3
    ==
  ++  confs  6
  ++  fee  100
  --
::
+$  versioned-state
    $%  state-0
        state-1
        state-2
        state-3
    ==
::
+$  state-0
  $:  %0
      prov=(unit provider)
      walts=(map xpub:bc walt-0)
      =btc-state
      =history
      curr-xpub=(unit xpub:bc)
      =scans
      =params
      feybs=(map ship sats)
      =piym
      =poym
      ahistorical-txs=(set txid)
  ==
::
+$  base-state
  $:  prov=(unit provider)
      walts=(map xpub:bc walt)
      =btc-state
      =history
      curr-xpub=(unit xpub:bc)
      =scans
      =params
      feybs=(map ship sats)
      =piym
      =poym
      ahistorical-txs=(set txid)
  ==
::
+$  state-1  [%1 base-state]
+$  state-2  [%2 base-state]
+$  state-3  [%3 base-state]
--
=|  state-3
=*  state  -
%-  agent:dbug
^-  agent:gall
=<
~%  %btc-wallet-agent  ..retry-filtered-addrs  ~
|_  =bowl:gall
+*  this      .
    def   ~(. (default-agent this %|) bowl)
    hc    ~(. +> bowl)
    io    ~(. agentio bowl)
    pass  pass:io
::
++  on-init
^-  (quip card _this)
  ~&  >  '%btc-wallet initialized'
  ::
  =/  warning=event:settings   [%put-entry q.byk.bowl %btc-wallet %warning %b %.y]
  =/  currency=event:settings  [%put-entry q.byk.bowl %btc-wallet %currency %s 'USD']
  =/  cards=(list card)
    :~  (poke-our:hc %settings-store %settings-event !>(warning))
        (poke-our:hc %settings-store %settings-event !>(currency))
    ==
  ::
  :-  cards
  %_  this
      state
    :*  %3
        ~
        *(map xpub:bc walt)
        *^btc-state
        *^history
        ~
        *^scans
        params:defaults
        *(map ship sats)
        *^piym
        *^poym
        ~
    ==
  ==
::
++  on-save
  ^-  vase
  !>(state)
::
++  on-load
  |=  old-state=vase
  ^-  (quip card _this)
  ~&  >  '%btc-wallet recompiled'
  =/  ver  !<(versioned-state old-state)
  =|  cards=(list card)
  |-
  ?-  -.ver
      %3
    [(flop cards) this(state ver)]
  ::
      %2
    %_  $
      -.ver  %3
      cards  :_(cards (~(wait pass /migrate-settings) (add now.bowl ~s1)))
    ==
  ::
      %1
    =?  cards  ?=(^ prov.ver)
      :_  cards
      =/  =dock  [host.u.prov.ver %btc-provider]
      =/  wir=wire  /set-provider/(scot %p host.u.prov.ver)
      =/  priv-wire=^wire  (welp wir [%priv ~])
      [%pass priv-wire %agent dock %watch /clients/(scot %p our.bowl)]
    $(-.ver %2)
  ::
      %0
    =/  new-walts=(map xpub:bc walt)
      %-  ~(run by walts.ver)
      |=  old-walt=walt-0
      ^-  walt
      old-walt(wilt +6:wilt.old-walt)
    $(ver [%1 +.ver(walts new-walts)])
  ==
::
++  on-poke
  ~/  %on-poke
  |=  [=mark =vase]
  ^-  (quip card _this)
  |^
  =^  cards  state
    ?+  mark  (on-poke:def mark vase)
      ::
        %noun
      ?>  =(our.bowl src.bowl)
      (handle-noun q.vase)
      ::
        %btc-wallet-command
      ?>  =(our.bowl src.bowl)
      (handle-command !<(command vase))
      ::
        %btc-wallet-action
      ?<  =(our.bowl src.bowl)
      (handle-action !<(action vase))
      ::
        %btc-wallet-internal
      ?>  =(our.bowl src.bowl)
      (handle-internal !<(internal vase))
    ==
  [cards this]
  ::
  ++  handle-noun
    |=  non=*
    ?>  ?=(%migrate-settings non)
    :_  state
    ^-  (list card)
    =/  bas=path  /(scot %p our.bowl)/settings-store/(scot %da now.bowl)
    ?.  .^(? %gu bas)
      ~&  [dap.bowl %settings-store-mia]
      ~
    ?.  .^(? %gx (weld bas /has-bucket/landscape/btc-wallet/noun))
      ~
    =/  dat
      .^(data:settings %gx (weld bas /bucket/landscape/btc-wallet/noun))
    ?>  ?=(%bucket -.dat)
    |^  :-  =/  del=event:settings  [%del-bucket %landscape %btc-wallet]
            (poke-our:hc %settings-store %settings-event !>(del))
        (murn ~(tap by bucket.dat) copy-if-missing)
    ::
    ++  copy-if-missing
      |=  [=key:settings =val:settings]
      ^-  (unit card)
      =/  hav=?
        .^(? %gx (weld bas /has-entry/[q.byk.bowl]/btc-wallet/[key]/noun))
      ?:  hav  ~
      ~&  [dap.bowl %importing-previous-setting key]
      =/  put=event:settings  [%put-entry q.byk.bowl %btc-wallet key val]
      `(poke-our:hc %settings-store %settings-event !>(put))
    --
  ::
  ++  handle-command
    |=  comm=command
    ^-  (quip card _state)
    ?>  (team:title our.bowl src.bowl)
    ?-  -.comm
        %set-provider
      |^
      ?~  provider.comm
        ?~  prov  `state
        :_  state(prov ~)
        %-  zing
        :~  (leave-provider host.u.prov)
            (give-update:hc %change-provider ~)^~
        ==
      :_  state(prov `[u.provider.comm %.n])
      ?~  prov
        (watch-provider:hc u.provider.comm)
      %-  zing
      :~  (leave-provider host.u.prov)
          (watch-provider:hc u.provider.comm)
          (give-update:hc %change-provider `[u.provider.comm %.n])^~
      ==
      ::
      ++  leave-provider
        |=  who=@p
        ^-  (list card)
        =/  wir=wire  /set-provider/(scot %p who)
        =/  priv-wir=wire  (welp wir %priv^~)
        :+  [%pass wir %agent who^%btc-provider %leave ~]
          [%pass priv-wir %agent who^%btc-provider %leave ~]
        ~
      --
    ::
        %check-provider
      =/  pax  /permitted/(scot %p provider.comm)
      :_  state
      [%pass pax %agent [provider.comm %btc-provider] %watch pax]~
    ::
        %check-payee
      =/  pax  /check-payee/(scot %p payee.comm)
      :_  state
      [%pass pax %agent [payee.comm %btc-wallet] %watch pax]~
    ::
        %set-current-wallet
      (set-curr-xpub:hc xpub.comm)
    ::
        %add-wallet
      |^
      ?~  (~(has by walts) xpub.comm)
        ((slog ~[leaf+"xpub already in wallet"]) `state)
      =/  w=walt  (from-xpub:bl +.comm)
      =.  walts  (~(put by walts) xpub.comm w)
      =^  c1  state  (init-batches xpub.comm (dec max-gap.w))
      =^  c2  state  (set-curr-xpub:hc xpub.comm)
      [(weld c1 c2) state]
      ::
      ++  init-batches
        |=  [=xpub:bc endpoint=idx]
        ^-  (quip card _state)
        =/  b=batch
          [(silt (gulf 0 endpoint)) endpoint %.n]
        =^  cards0  state  (req-scan:hc b xpub %0)
        =^  cards1  state  (req-scan:hc b xpub %1)
        :_  state
        [(scan-progress:hc xpub) (weld cards0 cards1)]
      --
    ::
        %delete-wallet
      =*  cw  curr-xpub.state
      =?  cw  ?&(?=(^ cw) =(u.cw xpub.comm))
        ~
      =.  scans    (~(del by scans) [xpub.comm %0])
      =:    scans  (~(del by scans) [xpub.comm %1])
            walts  (~(del by walts) xpub.comm)
            history
          %-  ~(rep by history)
          |=  [[=txid =hest] out=_history]
          ?:  =(xpub.hest xpub.comm)
            (~(del by out) txid)
          out
        ==
      [[give-initial:hc]~ state]
    ::
        %init-payment-external
      ?:  is-broadcasting:hc
        %-  (slog ~[leaf+"broadcasting a transaction"])
        [[(give-update:hc %error %tx-being-signed)]~ state]
      ?~  curr-xpub
        ~|("btc-wallet: no curr-xpub set" !!)
      ?:  (is-dust:hc value.comm address.comm)
        %-  (slog ~[leaf+"sending dust"])
        [[(give-update:hc %error %no-dust)]~ state]
      ::
      ~|  "no wallet with xpub"
      =/  wal  (~(got by walts) u.curr-xpub)
      ~|  "wallet not scanned yet"
      ?>  scanned.wal
      =/  [tb=(unit txbu) chng=(unit sats)]
        %~  with-change  sut:bl
        :*  wal  eny.bowl
            block.btc-state  ~
            feyb.comm  ~[[address.comm value.comm ~]]
        ==
      ?~  tb
        %-  %-  slog
          ~[leaf+"insufficient balance or not enough confirmed balance"]
        [[(give-update:hc %error %insufficient-balance)]~ state]
      =^  tb=(unit txbu)  state
        ?~  chng  `state
        =/  [addr=address =idx w=walt]
          ~(nixt-address wad:bl wal %1)
        :_  state(walts (~(put by walts) u.curr-xpub w))
        `(~(add-output txb:bl u.tb) addr u.chng `(~(hdkey wad:bl w %1) idx))
      =/  po=^poym
        ?~(tb [~ ~] [tb note.comm])
      :_  state(poym po)
      ?~  tb  ~
      %+  turn  txis.u.tb
      |=(=txi (poke-provider:hc %raw-tx txid.utxo.txi))
    ::
    ::  overwrites any payment being built in poym
    ::
        %init-payment
      ?:  =(src.bowl payee.comm)
        %-  (slog ~[leaf+"can't pay ourselves"])
        [[(give-update:hc %error %cant-pay-ourselves)]~ state]
      ?:  ?=(%pawn (clan:title payee.comm))
        %-  (slog ~[leaf+"no comets"])
        [[(give-update:hc %error %no-comets)]~ state]
      ?:  is-broadcasting:hc
        %-  (slog ~[leaf+"broadcasting a transaction"])
        [[(give-update:hc %error %tx-being-signed)]~ state]
      =:  poym   `note.comm
          feybs  (~(put by feybs) payee.comm feyb.comm)
        ==
      :_  state
       ~[(poke-peer:hc payee.comm [%gen-pay-address value.comm note.comm])]
    ::
        %broadcast-tx
      ?~  prov  ~|("Provider not connected" !!)
      =+  signed=(from-cord:hxb:bcu txhex.comm)
      =/  tx-match=?
        ?~  txbu.poym  %.n
        =((get-id:txu:bc (decode:txu:bc signed)) ~(get-txid txb:bl u.txbu.poym))
      :-  ?.  tx-match
            %-  (slog leaf+"txid didn't match txid in wallet")
            [(give-update:hc %error %broadcast-fail)]~
          ~[(poke-provider:hc [%broadcast-tx signed])]
      ?.  tx-match  state
      ?~  txbu.poym  state
      state(signed-tx.u.txbu.poym `signed)
    ::
        %gen-new-address
      ?~  curr-xpub
        ~|("btc-wallet: no curr-xpub set" !!)
      ~|  "no wallet with xpub"
      =/  wal  (~(got by walts) u.curr-xpub)
      ~|  "wallet not scanned yet"
      ?>  scanned.wal
      =/  [addr=address =idx w=walt]
        ~(gen-address wad:bl wal %0)
      :_  state(walts (~(put by walts) u.curr-xpub w))
      [(give-update:hc %new-address addr)]~
    ==
  ::
  ++  handle-action
    |=  act=action
    ^-  (quip card _state)
    ?-  -.act
      ::  comets can't pay (could spam address requests)
      ::  reuses payment address for ship if ship in piym already
      ::
        %gen-pay-address
      ~|  "no comets"
      ?<  ?=(%pawn (clan:title src.bowl))
      ?~  curr-xpub
        ~|("btc-wallet: no curr-xpub set" !!)
      |^
      =^  cards  state  reuse-address
      ?^  cards
        ::  if cards returned, means we already have an address
        [cards state]
      =+  f=(fam:bl our.bowl now.bowl src.bowl)
      =+  n=(~(gut by num-fam.piym) f 0)
      ?:  (gte n fam-limit.params)
        ~|("More than {<fam-limit.params>} addresses for moons + planet" !!)
      =.  num-fam.piym  (~(put by num-fam.piym) f +(n))
      =^  a=address  state
        (generate-address u.curr-xpub %0)
      :-  ~[(poke-peer:hc src.bowl [%give-pay-address a value.act])]
      %_  state
          ps.piym
        %+  ~(put by ps.piym)  src.bowl
        `[u.curr-xpub a src.bowl value.act note.act]
      ==
      ::
      ++  generate-address
        |=  [=xpub:bc =chyg]
        ~|  "no wallet with xpub"
        =/  wal=walt  (~(got by walts) xpub)
        ~|  "wallet not scanned yet"
        ?>  scanned.wal
        =/  [addr=address =idx w=walt]
          ~(gen-address wad:bl wal chyg)
        [addr state(walts (~(put by walts) xpub w))]
      ::
      ++  reuse-address
        ^-  (quip card _state)
        =*  payer  src.bowl
        =+  p=(~(get by ps.piym) payer)
        ?~  p  `state
        ?^  pend.u.p
          ~|("%gen-address: {<payer>} already has pending payment to us" !!)
        =+  newp=u.p(value value.act)
        :_  state(ps.piym (~(put by ps.piym) payer newp))
        ~[(poke-peer:hc payer [%give-pay-address address.newp value.act])]
      --
      ::
        %give-pay-address
      ~|  "Can't pay ourselves"
      ?<  =(src.bowl our.bowl)
      ~|  "Broadcasting a transaction"
      ?<  is-broadcasting:hc
      ?~  curr-xpub
        ~|("btc-wallet-hook: no curr-xpub set" !!)
      ?:  (is-dust:hc value.act address.act)
        %-  (slog ~[leaf+"sending dust"])
        [[(give-update:hc %error %no-dust)]~ state]
      ::
      =/  feyb
        %+  ~(gut by feybs)
          src.bowl
        ?~(fee.btc-state fee:defaults u.fee.btc-state)
      |^
      =^  tb=(unit txbu)  state
        (generate-txbu u.curr-xpub `src.bowl feyb ~[[address.act value.act ~]])
      =/  po=^poym
        ?~(tb [~ ~] [tb note.poym])
      :_  state(poym po)
      ?~  tb  [(give-update:hc %error %insufficient-balance)]~
      %+  turn  txis.u.tb
      |=(=txi (poke-provider:hc [%raw-tx txid.utxo.txi]))
      ::
      ++  generate-txbu
        |=  [=xpub:bc payee=(unit ship) feyb=sats txos=(list txo)]
        ^-  [(unit txbu) _state]
        ~|  "no wallet with xpub"
        =/  wal  (~(got by walts) xpub)
        ~|  "wallet not scanned yet"
        ?>  scanned.wal
        =/  [tb=(unit txbu) chng=(unit sats)]
          %~  with-change  sut:bl
          [wal eny.bowl block.btc-state payee feyb txos]
        ?~  tb
          %-  %-  slog
            ~[leaf+"insufficient balance or not enough confirmed balance"]
          [tb state]
        ::  if no change, return txbu; else add change output to txbu
        ::
        ?~  chng  [tb state]
        =/  [addr=address =idx w=walt]
          ~(nixt-address wad:bl wal %1)
        :_  state(walts (~(put by walts) xpub w))
        `(~(add-output txb:bl u.tb) addr u.chng `(~(hdkey wad:bl w %1) idx))
      --
      ::
      ::  %expect-payment
      ::  - check that payment is in piym
      ::  - replace pend.payment with incoming txid (lock)
      ::  - add txid to pend.piym
      ::  - request tx-info from provider
      ::
        %expect-payment
      |^
      ~|  "%expect-payment: matching payment not in piym"
      =/  pay  (~(got by ps.piym) src.bowl)
      ?>  (piym-matches pay)
      :_  (update-pend-piym txid.act pay(pend `txid.act))
      ?~  prov  ~
      ~[(poke-provider:hc [%tx-info txid.act])]
      ::
      ++  piym-matches
        |=  p=payment
        ?&  =(payer.p src.bowl)
            =(value.p value.act)
        ==
      ::
      ++  update-pend-piym
        |=  [txid=hexb p=payment]
        ^-  _state
        ?~  pend.p  ~|("update-pend-piym: no pending payment" !!)
        %=  state
            ps.piym  (~(put by ps.piym) payer.p p)
            pend.piym  (~(put by pend.piym) txid p)
        ==
      --
    ==
  ::
  ++  handle-internal
    |=  intr=internal
    ^-  (quip card _state)
    ?-    -.intr
        %add-poym-raw-txi
      |^
      ?>  =(src.bowl our.bowl)
      ?~  txbu.poym  `state
      =.  txis.u.txbu.poym
        (update-poym-txis txis.u.txbu.poym +.intr)
      :_  state
      =+  pb=~(to-psbt txb:bl u.txbu.poym)
      ?~  pb  ~
      =+  vb=~(vbytes txb:bl u.txbu.poym)
      =+  fee=~(fee txb:bl u.txbu.poym)
      ~&  >>  "{<vb>} vbytes, {<(div fee vb)>} sats/byte, {<fee>} sats fee"
      %-  (slog [%leaf "PSBT: {<u.pb>}"]~)
      [(give-update:hc [%psbt u.pb fee])]~
      ::    update outgoing payment with a rawtx, if the txid is in poym's txis
      ::
      ++  update-poym-txis
        |=  [txis=(list txi) txid=hexb rawtx=hexb]
        ^-  (list txi)
        =|  i=@
        |-  ?:  (gte i (lent txis))  txis
        =/  ith=txi  (snag i txis)
        =?  txis  =(txid txid.utxo.ith)
         (snap txis i `txi`ith(rawtx `rawtx))
        $(i +(i))
      --
    ::
    ::  delete an incoming/outgoing payment when we see it included in a tx
    ::
        %close-pym
      ?>  =(src.bowl our.bowl)
      |^
      =^  cards  state
        ?.  included.ti.intr
          `state
        ?:  (~(has by pend.piym) txid.ti.intr)
          (piym-to-history ti.intr)
        ?:  (poym-has-txid txid.ti.intr)
          (poym-to-history ti.intr)
        `state
      =^  cards2  state
        (handle-tx-info:hc ti.intr)
      :_  state
      (weld cards cards2)
      ::
      ++  poym-has-txid
        |=  txid=hexb
        ^-  ?
        ?~  txbu.poym  %.n
        ?~  signed-tx.u.txbu.poym  %.n
        =(txid (get-id:txu:bc (decode:txu:bc u.signed-tx.u.txbu.poym)))
      ::   - checks whether poym has a signed tx
      ::   - checks whether the txid matches that signed tx, if not, skip
      ::   - clears poym
      ::   - returns card that adds hest to history
      ::
      ++  poym-to-history
        |=  ti=info:tx
        ^-  (quip card _state)
        |^
        ?~  txbu.poym  `state
        ?~  signed-tx.u.txbu.poym  `state
        ?.  (poym-has-txid txid.ti)
          `state
        =+  vout=(get-vout txos.u.txbu.poym)
        ?~  vout
          ~|("poym-to-history: poym should always have an output" !!)
        =/  new-hest=hest
          %:  mk-hest
              ti        xpub.u.txbu.poym
              our.bowl  payee.u.txbu.poym
              u.vout    note.poym
          ==
        :-  [(give-update:hc %new-tx new-hest)]~
        %=  state
          poym     [~ ~]
          history  (~(put by history) txid.ti new-hest)
        ==
        ::
        ++  get-vout
          |=  txos=(list txo)
          ^-  (unit @ud)
          =|  idx=@ud
          |-  ?~  txos  ~
          ?~  hk.i.txos  `idx
          $(idx +(idx), txos t.txos)
        --
      ::   - checks whether txid in pend.piym
      ::   - checks whether ti has a matching value output to piym
      ::   - if no match found, just deletes pend.piym with this tx
      ::     stops peer from spamming txids
      ::   - returns card that adds hest to history
      ::
      ++  piym-to-history
        |=  ti=info:tx
        |^  ^-  (quip card _state)
        =+  pay=(~(get by pend.piym) txid.ti)
        ?~  pay  `state
        ::  if no matching output in piym,
        ::  delete from pend.piym to stop DDOS of txids
        ::
        =+  vout=(get-vout value.u.pay)
        ?~  vout
          `(del-pend-piym txid.ti)
        =/  new-hest
          (mk-hest ti xpub.u.pay payer.u.pay `our.bowl u.vout note.u.pay)
        =.  state  (del-all-piym txid.ti payer.u.pay)
        :-  [(give-update:hc %new-tx new-hest)]~
        %_  state
          history  (~(put by history) txid.ti new-hest)
        ==
        ::
        ++  get-vout
          |=  value=sats
          ^-  (unit @ud)
          =|  idx=@ud
          =+  os=outputs.ti
          |-  ?~  os  ~
          ?:  =(value.i.os value)
            `idx
          $(os t.os, idx +(idx))
        ::
        ++  del-pend-piym
          |=  txid=hexb
          ^-  _state
          state(pend.piym (~(del by pend.piym) txid.ti))
        ::
        ++  del-all-piym
          |=  [txid=hexb payer=ship]
          ^-  _state
          =+  nf=(~(gut by num-fam.piym) payer 1)
          %=  state
              pend.piym     (~(del by pend.piym) txid)
              ps.piym       (~(del by ps.piym) payer)
              num-fam.piym  (~(put by num-fam.piym) payer (dec nf))
          ==
        --
      ::
      ++  mk-hest
        |=  $:  ti=info:tx
                =xpub:bc
                payer=ship
                payee=(unit ship)
                vout=@ud
                note=(unit @t)
            ==
        ^-  hest
        :*  xpub
            txid.ti
            confs.ti
            recvd.ti
            (turn inputs.ti |=(i=val:tx [i `payer]))
            %+  turn  outputs.ti
              |=  o=val:tx
              ?:  =(pos.o vout)
                ::  check whether this is the output that went to payee
                [o payee]
              [o `payer]
            note
         ==
      --
    ::
        %fail-broadcast-tx
      ?>  =(src.bowl our.bowl)
      ~&  >>>  "%fail-broadcast-tx"
      :_  state(poym [~ ~])
      [(give-update:hc %error %broadcast-fail)]~
    ::
        %succeed-broadcast-tx
      ?>  =(src.bowl our.bowl)
      ~&  >  "%succeed-broadcast-tx"
      :_  state
      :-  (give-update:hc %broadcast-success ~)
      ?~  prov  ~
      :-  (poke-provider:hc [%tx-info txid.intr])
      ?~  txbu.poym  ~
      ?~  payee.u.txbu.poym  ~
      :_  ~
      %-  poke-peer:hc
      :*  u.payee.u.txbu.poym
          %expect-payment
          txid.intr
          value:(snag 0 txos.u.txbu.poym)
      ==
    ==
  --
::
++  on-agent
  ~/  %on-agent
  |=  [=wire =sign:agent:gall]
  ^-  (quip card _this)
  |^
  ?+    -.sign  (on-agent:def wire sign)
      %watch-ack
    ?~  p.sign  `this
    %-  (slog leaf+"connection rejected by provider ({<src.bowl>})" u.p.sign)
    `this
  ::
      %kick
    ?~  prov  `this
    ?.  ?&  ?=(%set-provider -.wire)
            =(host.u.prov src.bowl)
        ==
      `this
    :_  this(prov [~ src.bowl %.n])
    %-  zing
    :~  (watch-provider:hc src.bowl)
        (give-update:hc %change-provider `[src.bowl %.n])^~
    ==
  ::
      %fact
    =^  cards  state
      ?+  p.cage.sign  `state
          %btc-provider-status
        (handle-provider-status !<(status:bp q.cage.sign))
      ::
          %btc-provider-update
        (handle-provider-update !<(update:bp q.cage.sign))
      ::
          %json
        ?+  wire  `state
            [%check-payee @ ~]
          =/  who  (slav %p i.t.wire)
          :_  state
          :~  [%give %fact ~[/all] cage.sign]
              [%pass wire %agent [who %btc-wallet] %leave ~]
          ==
        ::
            [%permitted @ ~]
          =/  who  (slav %p i.t.wire)
          :_  state
          :~  [%give %fact ~[/all] cage.sign]
              [%pass wire %agent [who %btc-provider] %leave ~]
          ==
        ==
      ==
    [cards this]
  ==
  ::
  ::  +handle-provider-status: handle connectivity updates from provider
  ::    - retry pend.piym on any %connected event, since we're checking mempool
  ::    - if status is %connected, retry all pending address lookups
  ::      - only retry all if previously disconnected
  ::    - if block is updated, retry all address reqs
  ::    - if provider's network doesn't match network in our state, leave
  ::
  ++  handle-provider-status
    |=  s=status:bp
    ^-  (quip card _state)
    =^  cards  state
      ?~  prov  `state
      ?.  =(host.u.prov src.bowl)  `state
      ?-  -.s
          %new-block
        %:  on-connected
          u.prov        network.s
          block.s       fee.s
          `blockhash.s  `blockfilter.s
        ==
      ::
          %connected
        (on-connected u.prov network.s block.s fee.s ~ ~)
      ::
          %disconnected
        `state(prov `u.prov(connected %.n))
      ==
    :_  state
    :+  (give-update:hc %btc-state btc-state)
      (give-update:hc %change-provider prov)
    cards
  ::
  ++  on-connected
    |=  $:  p=provider
            net=network
            block=@ud
            fee=(unit sats)
            blockhash=(unit hexb)
            blockfilter=(unit hexb)
        ==
    ^-  (quip card _state)
    |^
    ::  request block-info for missing blocks
    ::  if blockhash or blockfilter are ~ request block-info for current block
    ::
    =|  blocks=(list @ud)
    =/  gap  (sub block block.btc-state)
    =?  blocks  (gth gap 1)
      (gulf +(block.btc-state) (dec block))
    =?  blocks  ?&((gth gap 0) ?|(?=(~ blockhash) ?=(~ blockfilter)))
      (snoc blocks block)
    =?  blocks  (gth gap 50)  ~
    :_  %_  state
          prov       `p(connected %.y)
          btc-state  [block fee now.bowl]
        ==
    %-  zing
    :~  retry-ahistorical-txs
        (retry-pend-piym net)
        (retry-block-info blocks)
      ::
        ?.  ?|(!connected.p (gth gap 0))
          ~
        %-  zing
        :~  (retry-poym net)
            (retry-txs net)
            (retry-scans net)
        ==
      ::
        ?.  ?&(?=(^ blockhash) ?=(^ blockfilter) (gth gap 0))
          ~
        (retry-filtered-addrs:hc net u.blockhash u.blockfilter)
      ::
        ?.  (gth gap 50)
          ~
        (retry-addrs net)
    ==
    ::
    ++  retry-ahistorical-txs
      ^-  (list card)
      %+  turn  ~(tap in ahistorical-txs)
      |=  =txid
      (poke-provider:hc [%tx-info txid])
    ::
    ::  +retry-pend-piym: check whether txids in pend-piym are in mempool
    ::
    ++  retry-pend-piym
      |=  =network
      ^-  (list card)
      %+  murn  ~(tap by pend.piym)
      |=  [=txid p=payment]
      =/  w  (~(get by walts) xpub.p)
      ?~  w  ~
      ?.  =(network network.u.w)  ~
      `(poke-provider:hc [%tx-info txid])
    ::
    ++  retry-block-info
      |=  blocks=(list @ud)
      %+  turn  blocks
      |=  block=@ud
      (poke-provider:hc %block-info `block)
    ::
    ++  retry-poym
      |=  =network
      ^-  (list card)
      ?~  txbu.poym  ~
      =/  w  (~(get by walts) xpub.u.txbu.poym)
      ?~  w  ~
      ?.  =(network network.u.w)  ~
      %+  weld
        ?~  signed-tx.u.txbu.poym  ~
        ~[(poke-provider:hc [%broadcast-tx u.signed-tx.u.txbu.poym])]
      %+  turn  txis.u.txbu.poym
      |=  =txi
      (poke-provider:hc [%raw-tx ~(get-txid txb:bl u.txbu.poym)])
    ::
    ::  +retry-txs: get info on txs without enough confirmations
    ::
    ++  retry-txs
      |=  =network
      ^-  (list card)
      %+  murn  ~(tap by history)
      |=  [=txid =hest]
      =/  w  (~(get by walts) xpub.hest)
      ?~  w  ~
      ?.  =(network network.u.w)  ~
      ?:  (gte confs.hest confs.u.w)  ~
      `(poke-provider:hc [%tx-info txid])
    ::
    ++  retry-scans
      |=  =network
      ^-  (list card)
      %-  zing
      %+  murn  ~(tap by scans)
      |=  [[=xpub:bc =chyg] =batch]
      =/  w  (~(get by walts) xpub)
      ?~  w  ~
      ?.  =(network network.u.w)     ~
      `-:(req-scan:hc batch xpub chyg)
    ::
    ::  +retry-addrs: get info on addresses with unconfirmed UTXOs
    ::
    ++  retry-addrs
      |=  =network
      ^-  (list card)
      %-  zing
      %+  murn  ~(val by walts)
      |=  w=walt
      ?.  =(network network.w)  ~
      ^-  (unit (list card))
      :-  ~
      %+  turn  ~(tap by wach.w)
      |=  [a=address *]
      (poke-provider:hc [%address-info a])
    --
  ::
  ++  handle-provider-update
    |=  upd=update:bp
    ^-  (quip card _state)
    |^
    ?:  =(~ prov)  `state
    ?.  =(host:(need prov) src.bowl)  `state
    ?.  ?=(%.y -.upd)  `state
    ?-  -.p.upd
        %address-info
      ::  located in the helper in Scan Logic to keep all of that unified
      ::
      (handle-address-info address.p.upd utxos.p.upd used.p.upd)
    ::
        %tx-info
      ::  TODO: why do we get a nest-fail when using =^ ?
      =^  cards=(list card)  state
        (handle-tx-info:hc info.p.upd)
      :_  state
      :_  cards
      (poke-internal:hc [%close-pym info.p.upd])
    ::
        %raw-tx
      :_  state
      ~[(poke-internal:hc [%add-poym-raw-txi +.p.upd])]
    ::
        %broadcast-tx
      :_  state
      ?~  txbu.poym  ~
      ?.  =(~(get-txid txb:bl u.txbu.poym) txid.p.upd)
        ~
      ?:  ?|(broadcast.p.upd included.p.upd)
        ~[(poke-internal:hc [%succeed-broadcast-tx txid.p.upd])]
      :~  (poke-internal:hc [%fail-broadcast-tx txid.p.upd])
          (give-update:hc %cancel-tx txid.p.upd)
      ==
    ::
        %block-info
      :_  state
      %^  retry-filtered-addrs:hc
          network.p.upd
        blockhash.p.upd
      blockfilter.p.upd
    ==
    ::
    ::  Scan Logic
    ::
    ::  Algorithm
    ::  Initiate a batch for each chyg, with max-gap idxs in it
    ::  Watch all of the addresses made from idxs
    ::  Request info on all addresses from provider
    ::  When an %address-info comes back:
    ::    - remove that idx from todo.batch
    ::    - run check-scan to check whether that chyg is done
    ::    - if it isn't, refill it with max-gap idxs to scan
    ::
    ::  +handle-address-info: updates scans and wallet with address info
    ::
    ++  handle-address-info
      |=  [=address utxos=(set utxo) used=?]
      ^-  (quip card _state)
      =/  ac  (address-coords:bl address ~(val by walts))
      ?~  ac
        `state
      =/  [w=walt =chyg =idx]  u.ac
      =.  walts
        %+  ~(put by walts)  xpub.w
        %+  ~(update-address wad:bl w chyg)
          address
       [used chyg idx utxos]
      ::  if transactions haven't made it into history, request transaction info
      ::
      =^  cards=(list card)  ahistorical-txs
        %+  roll  ~(tap in utxos)
        |=  [u=utxo cad=(list card) ah=(set txid)]
        ^-  [(list card) (set txid)]
        ?:  (~(has by history) txid.u)
          [cad ah]
        :-  [(poke-provider:hc [%tx-info txid.u]) cad]
        (~(put by ah) txid.u)
      ::  if the wallet+chyg is being scanned, update the scan batch
      ::
      =/  b  (~(get by scans) [xpub.w chyg])
      ?~  b
        [cards state]
      =.  scans
       (del-scanned u.b(has-used ?|(used has-used.u.b)) xpub.w chyg idx)
      ?:  empty:(scan-status xpub.w chyg)
        =^  scan-cards=(list card)  state
          (check-scan xpub.w)
        [(weld scan-cards cards) state]
      ::
      [cards state]
    ::
    ::  +del-scanned: delete scanned idxs
    ::
    ++  del-scanned
      |=  [b=batch =xpub:bc =chyg to-delete=idx]
      ^-  ^scans
      %+  ~(put by scans)  [xpub chyg]
      b(todo (~(del in todo.b) to-delete))
    ::
    ++  scan-status
      |=  [=xpub:bc =chyg]
      ^-  [empty=? done=?]
      =/  b=batch  (~(got by scans) [xpub chyg])
      =/  empty=?  =(0 ~(wyt in todo.b))
      :-  empty
      ?&(empty ?!(has-used.b))
    ::  +check-scan: initiate a scan if one hasn't started
    ::               check status of scan if one is running
    ::
    ++  check-scan
      |=  =xpub:bc
      ^-  (quip card _state)
      =/  s0  (scan-status xpub %0)
      =/  s1  (scan-status xpub %1)
      ?:  ?&(empty.s0 done.s0 empty.s1 done.s1)
        (end-scan xpub)
      =^  cards0=(list card)  state
        (bump-batch xpub %0)
      =^  cards1=(list card)  state
        (bump-batch xpub %1)
      :_  state
      [(scan-progress:hc xpub) (weld cards0 cards1)]
    ::
    ::  delete the xpub from scans and set wallet to scanned
    ::
    ++  end-scan
      |=  [=xpub:bc]
      ^-  (quip card _state)
      =/  w=walt  (~(got by walts) xpub)
      =.  scans  (~(del by scans) [xpub %0])
      =:  scans  (~(del by scans) [xpub %1])
          walts  (~(put by walts) xpub w(scanned %.y))
        ==
      %-  (slog ~[leaf+"Scanned xpub {<xpub>}"])
      =^  cards  state
        (set-curr-xpub:hc xpub)
      [[(give-update:hc [%scan-progress ~ ~]) cards] state]
    ::
    ::  +bump-batch
    ::  if the batch is done but the wallet isn't done scanning,
    ::  returns new address requests and updated batch
    ::
    ++  bump-batch
      |=  [=xpub:bc =chyg]
      ^-  (quip card _state)
      =/  b=batch  (~(got by scans) xpub chyg)
      =/  s  (scan-status xpub chyg)
      ?.  ?&(empty.s ?!(done.s))
        `state
      =/  w=walt  (~(got by walts) xpub)
      =/  newb=batch
        :+  (silt (gulf +(endpoint.b) (add endpoint.b max-gap.w)))
          (add endpoint.b max-gap.w)
        %.n
      (req-scan:hc newb xpub chyg)
    --
  --
::
++  on-peek
  ~/  %on-peek
  |=  pax=path
  ^-  (unit (unit cage))
  ?+  pax  (on-peek:def pax)
      [%x %configured ~]
    =/  provider=json
      ?~  prov  ~
      [%s (scot %p host.u.prov)]
    =/  result=json
      %-  pairs:enjs:format
      :~  [%provider provider]
          [%'hasWallet' b+?=(^ walts)]
      ==
    ``json+!>(result)
  ::
      [%x %scanned ~]
    ``noun+!>(scanned-wallets:hc)
  ::
      [%x %balance @ ~]
    ``noun+!>((balance:hc (xpub:bc +>-.pax)))
  ==
::
++  on-watch
  ~/  %on-watch
  |=  =path
  ^-  (quip card _this)
  ?+  path  (on-watch:def path)
      [%check-payee @ ~]
    =/  who  (slav %p i.t.path)
    ?>  =(who our.bowl)
    =/  response=json
      %+  frond:enjs:format  'checkPayee'
      %-  pairs:enjs:format
      :~  ['hasWallet' b+?=(^ curr-xpub)]
          ['payee' (ship:enjs:format our.bowl)]
      ==
    :_  this
    [%give %fact ~ %json !>(response)]~
  ::
      [%all ~]
    ?>  (team:title our.bowl src.bowl)
    :_  this
    [give-initial:hc]~
  ==
::
++  on-leave  on-leave:def
++  on-arvo
  |=  [=wire sign=sign-arvo]
  ^-  (quip card _this)
  ?.  ?=([%migrate-settings ~] wire)  (on-arvo:def wire sign)
  ?>  ?=([%behn *] sign)
  (on-poke %noun !>(%migrate-settings))
++  on-fail   on-fail:def
--
~%  %btc-wallet-helper  ..card  ~
|_  =bowl:gall
::
++  retry-filtered-addrs
  ~/  %retry-filtered-addrs
  |=  [=network blockhash=hexb blockfilter=hexb]
  ^-  (list card)
  %-  zing
  %+  murn  ~(val by walts)
  |=  w=walt
  ^-  (unit (list card))
  ?.  =(network network.w)  ~
  :-  ~
  %+  turn
    %~  tap  in
    %^  all-match:bip-b158:bc
        blockfilter
      blockhash
    %+  turn  ~(tap by wach.w)
    |=  [a=address *]
    [a (to-script-pubkey:adr:bc a)]
  |=  [a=address spk=hexb]
  ^-  card
  (poke-provider [%address-info a])
::
++  handle-tx-info
  ~/  %handle-tx-info
  |=  ti=info:tx
  ^-  (quip card _state)
  |^
  =/  h  (~(get by history) txid.ti)
  =.  ahistorical-txs  (~(del in ahistorical-txs) txid.ti)
  =/  our-inputs=(set address)
    %-  silt
    %+  skim
      %+  turn  inputs.ti
      |=(=val:tx address.val)
    is-our-address
  =/  our-outputs=(set address)
    %-  silt
    %+  skim
      %+  turn  outputs.ti
      |=(=val:tx address.val)
    is-our-address
  ::  all our addresses in inputs/outputs of tx
  ::
  =/  our-addrs=(set address)
    (~(uni in our-inputs) our-outputs)
  ::
  =/  addr-info-cards=(list card)
    %+  turn  ~(tap in our-addrs)
    |=  a=address
    ^-  card
    (poke-provider [%address-info a])
  ?:  =(0 ~(wyt in our-addrs))  `state
  =/  =xpub
    xpub.w:(need (address-coords:bl (snag 0 ~(tap in our-addrs)) ~(val by walts)))
  ::  addresses in wallets, but tx not in history
  ::
  ?~  h
    =/  new-hest=hest  (mk-hest xpub our-inputs our-outputs)
    =.  history  (~(put by history) txid.ti new-hest)
    :_  state
    :+  (give-update %balance current-balance)
      (give-update %new-tx new-hest)
    addr-info-cards
  ::  tx in history, but not in mempool/blocks
  ::
  ?.  included.ti
    :_  state(history (~(del by history) txid.ti))
    :+  (give-update %balance current-balance)
      (give-update %cancel-tx txid.ti)
    addr-info-cards
  =/  new-hest  u.h(confs confs.ti, recvd recvd.ti)
  =.  history  (~(put by history) txid.ti new-hest)
  :_  state
  :+  (give-update %balance current-balance)
    (give-update %new-tx new-hest)
  addr-info-cards
  ::
  ++  mk-hest
    :: has tx-info
    |=  [=xpub:bc our-inputs=(set address) our-outputs=(set address)]
    ^-  hest
    :*  xpub
        txid.ti
        confs.ti
        recvd.ti
        (turn inputs.ti |=(v=val:tx (is-our-ship our-inputs v)))
        (turn outputs.ti |=(v=val:tx (is-our-ship our-outputs v)))
        ~
    ==
  ::
  ++  is-our-ship
    |=  [as=(set address) v=val:tx]
    ^-  [=val:tx s=(unit ship)]
    [v ?:((~(has in as) address.v) `our.bowl ~)]
  ::
  ++  is-our-address
    |=(a=address ?=(^ (address-coords:bl a ~(val by walts))))
  --
::
++  set-curr-xpub
  |=  =xpub
  ^-  (quip card _state)
  ?~  (find ~[xpub] scanned-wallets)  `state
  =.  curr-xpub  `xpub
  :_  state
  [give-initial]~
::
::  +req-scan
::   - adds addresses in batch to wallet's watch map as un-used addresses
::   - returns provider %address-info request cards
::
++  req-scan
  ~/  %req-scan
  |=  [b=batch =xpub:bc =chyg]
  ^-  (quip card _state)
  =/  w=walt  (~(got by walts) xpub)
  =/  as=(list [address [? ^chyg idx (set utxo)]])
    %+  turn  ~(tap in todo.b)
    |=(=idx [(~(mk-address wad:bl w chyg) idx) [%.n chyg idx *(set utxo)]])
  =.  w
    |-  ?~  as  w
    $(as t.as, w (~(update-address wad:bl w chyg) -.i.as +.i.as))
  :-  (turn as |=([a=address *] (poke-provider [%address-info a])))
  %_    state
      scans
    (~(put by scans) [xpub chyg] b)
  ::
      walts
    (~(put by walts) xpub w)
  ==
::
++  poke-provider
  |=  act=action:bp
  ^-  card
  ?~  prov  ~|("provider not set" !!)
  :*  %pass  /[(scot %da now.bowl)]
      %agent  [host.u.prov %btc-provider]
      %poke   %btc-provider-action  !>([act])
  ==
::
++  poke-peer
  |=  [target=ship act=action]
  ^-  card
  :*  %pass  /[(scot %da now.bowl)]  %agent
      [target %btc-wallet]  %poke
      %btc-wallet-action  !>(act)
  ==
::
++  poke-internal
  |=  intr=internal
  ^-  card
  :*  %pass  /[(scot %da now.bowl)]  %agent
      [our.bowl %btc-wallet]  %poke
      %btc-wallet-internal  !>(intr)
  ==
::
++  poke-our
  |=  [app=term =cage]
  ^-  card
  [%pass / %agent [our.bowl app] %poke cage]
::
++  give-update
  |=  upd=update
  ^-  card
  [%give %fact ~[/all] %btc-wallet-update !>(upd)]
::
++  scan-progress
  |=  [=xpub:bc]
  |^  ^-  card
  %-  give-update
  :+  %scan-progress
  (to-idx (~(gut by scans.state) [xpub %0] *batch))
  (to-idx (~(gut by scans.state) [xpub %1] *batch))
  ++  to-idx
    |=  b=batch
    ^-  (unit idx:bc)
    =/  s=(list idx:bc)
      (sort ~(tap in todo.b) lth)
    ?~  s  ~  `i.s
  --
::
++  watch-provider
  |=  who=@p
  ^-  (list card)
  =/  =dock  [who %btc-provider]
  =/  wir=wire  /set-provider/(scot %p who)
  =/  priv-wire=^wire  (welp wir [%priv ~])
  :+  [%pass wir %agent dock %watch /clients]
    [%pass priv-wire %agent dock %watch /clients/(scot %p our.bowl)]
  ~
::
++  give-initial
  ^-  card
  =^  a=(unit address)  state
    ?~  curr-xpub  `state
    =/  uw=(unit walt)  (~(get by walts) u.curr-xpub)
    ?:  ?|(?=(~ uw) ?!(scanned.u.uw))
      ~|("no wallet with xpub or wallet not scanned yet" !!)
    =/  [addr=address =idx w=walt]
      ~(gen-address wad:bl u.uw %0)
    [`addr state(walts (~(put by walts) u.curr-xpub w))]
  %-  give-update
  ^-  update
  :*  %initial
      prov
      curr-xpub
      current-balance
      current-history
      btc-state
      a
  ==
::
++  current-balance
  ^-  (unit [sats sats])
  ?~  curr-xpub  ~
  (balance u.curr-xpub)
::
++  current-history
  ^-  ^history
  ?~  curr-xpub  ~
  %-  ~(gas by *^history)
  %+  skim  ~(tap by history)
  |=  [txid =hest]
  =(u.curr-xpub xpub.hest)
::
++  balance
  ~/  %balance
  |=  =xpub:bc
  ^-  (unit [sats sats])
  =/  w  (~(get by walts) xpub)
  ?~  w  ~
  =/  values=(list [confirmed=sats unconfirmed=sats])
    %+  turn  ~(val by wach.u.w)
    |=  =addi  ^-  [sats sats]
    %+  roll
      %+  turn  ~(tap by utxos.addi)
      |=  =utxo
      ^-  [sats sats]
      ?:  (~(spendable sut:bl [u.w eny.bowl block.btc-state ~ 0 ~]) utxo)
        [value.utxo 0]
      [0 value.utxo]
    |=  [[a=sats b=sats] out=[p=sats q=sats]]
    [(add a p.out) (add b q.out)]
  :-  ~
  %+  roll  values
  |=  [[a=sats b=sats] out=[p=sats q=sats]]
  [(add a p.out) (add b q.out)]
::
++  is-dust
  |=  [=sats =address]
  ^-  ?
  %+  lth  sats
  (mul 3 (input-weight:bc (get-bipt:adr:bc address)))
::
++  is-broadcasting
  ^-  ?
  ?~  txbu.poym  %.n
  ?=(^ signed-tx.u.txbu.poym)
::
++  scanned-wallets
  ^-  (list xpub:bc)
  %+  murn  ~(tap by walts)
  |=  [=xpub:bc w=walt]
  ^-  (unit xpub:bc)
  ?:(scanned.w `xpub ~)
::
++  gall-scry
  |*  [=mold app=@tas =path]
  .^(mold %gx (weld /(scot %p our.bowl)/[app]/(scot %da now.bowl) path))
--