shrub/pkg/arvo/app/roller.hoon

::  roller: Azimuth L2 roll aggregator
::
::    general flow is as described below, to ensure transactions actually go
::    through once we start sending it out, in the dumbest reasonable way.
::
::    periodic timer fires:
::    if there are no pending l2 txs, do nothing.
::    else kick off tx submission flow:
::    "freeze" pending txs, store alongside nonce, then increment nonce,
::    kick off thread for sending the corresponding l1 tx:
::      if nonce doesn't match on-chain expected nonce, bail.
::      if we can't afford the tx fee, bail.
::      construct, sign, submit the l1 tx.
::    if thread bailed, retry in five minutes.
::    if thread succeeded, retry in five minutes with higher gas price.
::    when retrying, only do so if l2 txs remain in the "frozen" txs group.
::    on %tx diff from naive, remove the matching tx from the frozen group.
::
::TODO  questions:
::  - it's a bit weird how we just assume the raw and tx in raw-tx to match...
::
/-  *dice
/+  azimuth,
    naive,
    dice,
    lib=naive-transactions,
    default-agent,
    ethereum,
    dbug,
    verb
::
|%
+$  app-state
  $:  %3
      ::  pending: the next l2 txs to be sent
      ::  sending: l2 txs awaiting l2 confirmation, ordered by nonce
      ::  finding: sig+raw-tx hash reverse lookup for txs in sending map
      ::  history: status of l2 txs by ethereum address, timestamp sorted
      ::  ship-quota: number of txs submited per ship in the current slice
      ::  allowances: specific no of allowed transactions per given ship
      ::  next-nonce: next l1 nonce to use
      ::  next-batch: when then next l2 batch will be sent
      ::  next-slice: when the global quota will be reset
      ::  pre: predicted l2 state
      ::  own: ownership of azimuth points
      ::  spo: residents and escapees, per sponsor
      ::
      pending=(list pend-tx)
      sending=(tree [l1-tx-pointer send-tx])
      finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
      history=(map address:ethereum (tree hist-tx))
      ship-quota=(map ship @ud)
      allowances=(map ship (unit @ud))
      next-nonce=(unit @ud)
      next-batch=time
      next-slice=time
      pre=^state:naive
      own=owners
      spo=sponsors
    ::
      ::  pk: private key to send the roll
      ::  quota: max numbers of transactions per unit of time (slice)
      ::  slice: unit of time where txs are allowed to be added to pending
      ::  derive: defer derivation of predicted/ownership state
      ::  frequency: time to wait between sending batches (TODO fancier)
      ::  endpoint: ethereum rpc endpoint to use
      ::  contract: ethereum contract address
      ::  chain-id: mainnet, ropsten, local (https://chainid.network/)
      ::  resend-time: time to resend a batch with higher gas prie
      ::  update-rate: frequency to update the roller's predicted state
      ::
      pk=@
      slice=@dr
      quota=@ud
      derive=?
      frequency=@dr
      endpoint=(unit @t)
      contract=@ux
      chain-id=@
      resend-time=@dr
      update-rate=@dr
  ==
::
+$  action
  $%  ::  submit: request to add a l2 tx to the pending queue
      ::
      ::   the address needs to be added so pending txs show up
      ::   in the tx history, but because users can send the wrong
      ::   address, in +apply-tx:predicted-state, we replace the
      ::   given address, with the one used when the message was signed
      ::
      [%submit force=? =address:naive sig=@ tx=part-tx]
      ::  cancel: cancels a pending transaction
      ::
      ::   a signed message ("cancel: 0xkeccak") is used as ownership validation
      ::
      [%cancel sig=@ keccak=@ =l2-tx =ship]
      ::  commit: manually commit a batch of pending txs
      ::
      ::   TODO: maybe pk=(unit @) later
      ::
      [%commit ~]
      ::  config: configure the roller
      ::
      [%config config]
      ::  assign: assign an allowance to a ship for submitting l2 txs
      ::
      [%assign =ship quota=(unit @ud)]
  ==
::
+$  card  card:agent:gall
::
++  lverb  &
--
::  Helpers
::
=>  |%
    ::  TODO  /lib/sys.hoon?
    ::
    ++  sys
      |%
      ++  b
        |%
        ++  wait
          |=  [=wire =time]
          ^-  card
          [%pass wire %arvo %b %wait time]
        --
      --
    ::  TODO  /lib/spider.hoon?
    ::
    ++  spider
      |%
      ++  start-thread
        |=  [=bowl:gall =wire thread=term arg=vase]
        ^-  (list card)
        =/  =beak    byk.bowl(r da+now.bowl)
        =/  tid=@ta  (rap 3 thread '--' (scot %uv eny.bowl) ~)
        =/  args     [~ `tid beak thread arg]
        :~  [%pass wire %agent [our.bowl %spider] %watch /thread-result/[tid]]
            [%pass wire %agent [our.bowl %spider] %poke %spider-start !>(args)]
        ==
      ::
      ++  leave
        |=  [agent=@p =path]
        ^-  card
        [%pass path %agent [agent %spider] %leave ~]
      --
    ::
    ++  get-l1-address
      |=  [=tx:naive nas=^state:naive]
      ^-  (unit address:ethereum)
      ?~  point=(get:orp:dice points.nas ship.from.tx)  ~
      =<  `address
      (proxy-from-point:naive proxy.from.tx u.point)
    ::
    ++  timer
      |%
      ::  +set-roller: %wait until next whole frequency
      ::
      ++  set-roller
        |=  [frequency=@dr now=@da]
        ^-  [=card =time]
        =+  time=(mul +((div now frequency)) frequency)
        [(wait:b:sys /timer time) time]
      ::  +set-roller: %wait until next whole :slice
      ::
      ++  set-quota
        |=  [slice=@dr now=@da]
        ^-  [=card =time]
        =+  time=(mul +((div now slice)) slice)
        [(wait:b:sys /quota-timer time) time]
      --
    ::  TODO: move address to state?
    ::
    ++  get-address
      |=  pk=@
      ^-  address:ethereum
      (address-from-prv:key:ethereum pk)
    --
::  Cards
::
=>  |%
    ++  emit
      |=  updates=(list update)
      =|  cards=(list card)
      |-  ^-  (list card)
      ?~  updates  (flop cards)
      =*  up  i.updates
      =/  [address=@t last-owner=(unit @t)]
        ?-    -.up
            %tx
          :_  ~
          (scot %ux address.pend-tx.up)
        ::
            %point
        :-  (scot %ux address.to.up)
        ?~(from.up ~ `(scot %ux address.u.from.up))
        ==
      =.  cards
        %+  welp
          ^-  (list card)
          ?-  -.i.updates
              %tx
            [%give %fact ~[/txs/[address]] tx+!>(up)]~
          ::
              %point
            =/  =cage  point+!>(up)
            %+  weld
              [%give %fact ~[/points/[address]] cage]~
            ?~  last-owner  ~
            [%give %fact ~[/points/[u.last-owner]] cage]~
          ==
        cards
      ::
      $(updates t.updates)
    --
::
=|  app-state
=*  state  -
::
%-  agent:dbug
%+  verb  |
^-  agent:gall
::
=<
  |_  =bowl:gall
  +*  this  .
      do    ~(. +> bowl)
      def   ~(. (default-agent this %|) bowl)
  ::
  ++  on-init
    ^-  (quip card _this)
    =:  frequency    ~h1
        quota        25
        slice        ~d7
        resend-time  ~m5
        update-rate  ~m5
        contract     naive:local-contracts:azimuth
        chain-id     chain-id:local-contracts:azimuth
      ==
    =^  card-1  next-batch  (set-roller:timer frequency now.bowl)
    =^  card-2  next-slice  (set-quota:timer slice now.bowl)
    :_  this
    :~  card-1
        card-2
        [%pass /azimuth-events %agent [our.bowl %azimuth] %watch /event]
    ==
  ::
  ++  on-save  !>(state)
  ++  on-load
    |=  old=vase
    ^-  (quip card _this)
    =|  cards=(list card)
    |^
    =+  !<(old-state=app-states old)
    =?  cards  ?=(%0 -.old-state)
      [card:(set-quota:timer slice now.bowl)]~
    =?  old-state  ?=(%0 -.old-state)
      ^-  state-1
      =|  ship-quota=(map ship @ud)
      =/  [slice=@dr quota=@ud resend-time=@dr update-rate=@dr]
        [~d7 7 ~m5 ~m1]
      =,  old-state
      :*  %1
          pending  sending  finding  history
          ship-quota  next-nonce  next-batch
          pre  own  pk  slice  quota  derive
          frequency  endpoint  contract  chain-id
          resend-time  update-rate
      ==
    =?  old-state  ?=(%1 -.old-state)
      ^-  state-2
      =|  spo=(map ship [residents=(set ship) requests=(set ship)])
      =,  old-state
      :*  %2
          pending  sending  finding  history
          ship-quota  next-nonce  next-batch
          pre  own  spo  pk  slice  quota  derive
          frequency  endpoint  contract  chain-id
          resend-time  update-rate
      ==
    =?  old-state  ?=(%2 -.old-state)
      ^-  app-state
      =,  old-state
      =|  allowances=(map ship (unit @ud))
      =/  next-slice=time  (mul +((div now.bowl slice)) slice)
      :*  %3
          pending  sending  finding  history
          ship-quota  allowances
          next-nonce  next-batch  next-slice
          pre  own  spo  pk  slice  quota  derive
          frequency  endpoint  contract  chain-id
          resend-time  update-rate
      ==
    ?>  ?=(%3 -.old-state)
    [cards this(state old-state)]
    ::
    ++  app-states  $%(state-0 state-1 state-2 app-state)
    ++  state-0
      $:  %0
          pending=(list pend-tx)
          sending=(tree [l1-tx-pointer send-tx])
          finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
          history=(map address:ethereum (tree hist-tx))
          next-nonce=(unit @ud)
          next-batch=time
          pre=^state:naive
          own=owners
          derive=?
          pk=@
          frequency=@dr
          endpoint=(unit @t)
          contract=@ux
          chain-id=@
      ==
    ::
    ++  state-1
      $:  %1
          pending=(list pend-tx)
          sending=(tree [l1-tx-pointer send-tx])
          finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
          history=(map address:ethereum (tree hist-tx))
          ship-quota=(map ship @ud)
          next-nonce=(unit @ud)
          next-batch=time
          pre=^state:naive
          own=owners
          pk=@
          slice=@dr
          quota=@ud
          derive=?
          frequency=@dr
          endpoint=(unit @t)
          contract=@ux
          chain-id=@
          resend-time=@dr
          update-rate=@dr
      ==
    ::
    ++  state-2
      $:  %2
          pending=(list pend-tx)
          sending=(tree [l1-tx-pointer send-tx])
          finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
          history=(map address:ethereum (tree hist-tx))
          ship-quota=(map ship @ud)
          next-nonce=(unit @ud)
          next-batch=time
          pre=^state:naive
          own=owners
          spo=sponsors
          pk=@
          slice=@dr
          quota=@ud
          derive=?
          frequency=@dr
          endpoint=(unit @t)
          contract=@ux
          chain-id=@
          resend-time=@dr
          update-rate=@dr
      ==
    --
  ::
  ++  on-poke
    |=  [=mark =vase]
    ^-  (quip card _this)
    =^  cards  state
      ?+    mark  (on-poke:def mark vase)
          %roller-action
        =+  !<(poke=action vase)
        (on-action:do poke)
      ==
    [cards this]
  ::  +on-peek: scry paths
  ::
  ::    /x/pending                     ->  %noun  (list pend-tx)
  ::    /x/pending/[~ship]             ->  %noun  (list pend-tx)
  ::    /x/pending/[0xadd.ress]        ->  %noun  (list pend-tx)
  ::    /x/tx/[0xke.ccak]/status       ->  %noun  tx-status
  ::    /x/history/[0xadd.ress]        ->  %noun  (list hist-tx)
  ::    /x/nonce/[~ship]/[proxy]       ->  %noun  (unit @)
  ::    /x/spawned/[~star]             ->  %noun  (list ship)
  ::    /x/unspawned/[~star]           ->  %noun  (list ship)
  ::    /x/sponsored/[~point]          ->  %noun  [(list ship) (list ship)]
  ::    /x/next-batch                  ->  %atom  time
  ::    /x/next-slice                  ->  %atom  time
  ::    /x/point/[~ship]               ->  %noun  point:naive
  ::    /x/ships/[0xadd.ress]          ->  %noun  (list ship)
  ::    /x/config                      ->  %noun  config
  ::    /x/chain-id                    ->  %atom  @
  ::    /x/owned/[0xadd.ress]          ->  %noun  (list ship)
  ::    /x/transfers/[0xadd.ress]      ->  %noun  (list ship)
  ::    /x/manager/[0xadd.ress]        ->  %noun  (list ship)
  ::    /x/voting/[0xadd.ress]         ->  %noun  (list ship)
  ::    /x/spawning/[0xadd.ress]       ->  %noun  (list ship)
  ::    /x/predicted                   ->  %noun  state:naive
  ::    /x/quota                       ->  %atom  @ud
  ::    /x/slice                       ->  %atom  @dr
  ::    /x/over-quota/[~ship]          ->  %atom  ?
  ::    /x/ship-quota/[~ship]          ->  %atom  @ud
  ::    /x/allowances                  ->  %noun  (map @p (unit @ud))
  ::    /x/allowance/[~ship]           ->  %noun  (unit @ud)
  ::    /x/ready                       ->  %atom  ?
  ::
  ++  on-peek
    |=  =path
    ^-  (unit (unit cage))
    ?+  path  ~
      [%x %pending ~]         ``noun+!>(pending)
      [%x %pending @ ~]       (pending-by:on-peek:do i.t.t.path)
      [%x %tx @ %status ~]    (status:on-peek:do i.t.t.path)
      [%x %pending-tx @ ~]    (transaction:on-peek:do i.t.t.path)
      [%x %history @ ~]       (history:on-peek:do i.t.t.path)
      [%x %nonce @ @ ~]       (nonce:on-peek:do i.t.t.path i.t.t.t.path)
      [%x %spawned @ ~]       (spawned:on-peek:do i.t.t.path)
      [%x %unspawned @ ~]     (unspawned:on-peek:do i.t.t.path)
      [%x %sponsored @ ~]     (sponsored:on-peek:do i.t.t.path)
      [%x %next-batch ~]      ``atom+!>(next-batch)
      [%x %next-slice ~]      ``atom+!>(next-slice)
      [%x %point @ ~]         (point:on-peek:do i.t.t.path)
      [%x %ships @ ~]         (ships:on-peek:do i.t.t.path)
      [%x %config ~]          config:on-peek:do
      [%x %chain-id ~]        ``atom+!>(chain-id)
      [%x %owned @ ~]         (points-proxy:on-peek:do %own i.t.t.path)
      [%x %transfers @ ~]     (points-proxy:on-peek:do %transfer i.t.t.path)
      [%x %manager @ ~]       (points-proxy:on-peek:do %manage i.t.t.path)
      [%x %voting @ ~]        (points-proxy:on-peek:do %vote i.t.t.path)
      [%x %spawning @ ~]      (points-proxy:on-peek:do %spawn i.t.t.path)
      [%x %predicted ~]       ``noun+!>(pre)
      [%x %quota ~]           ``atom+!>(quota)
      [%x %slice ~]           ``atom+!>(slice)
      [%x %over-quota @ ~]    (over-quota:on-peek:do i.t.t.path)
      [%x %ship-quota @ ~]    (ship-quota:on-peek:do i.t.t.path)
      [%x %allowances ~]      ``noun+!>(allowances)
      [%x %allowance @ ~]     (allowance:on-peek:do i.t.t.path)
      [%x %ready ~]           ``atom+!>(?=(^ points.pre))
    ==
  ::
  ++  on-arvo
    |=  [=wire =sign-arvo]
    ^-  (quip card _this)
    ?+    wire  (on-arvo:def wire sign-arvo)
        [%timer ~]
      ?+  +<.sign-arvo  (on-arvo:def wire sign-arvo)
        %wake  =^(cards state on-timer:do [cards this])
      ==
        [%quota-timer ~]
      ?+  +<.sign-arvo  (on-arvo:def wire sign-arvo)
        %wake  =^(cards state on-quota-timer:do [cards this])
      ==
    ::
        [%predict ~]
      ?+    +<.sign-arvo  (on-arvo:def wire sign-arvo)
          %wake
        =^  effects  state
          (predicted-state canonical):do
        [(emit effects) this(derive &)]
      ==
    ::
        [%resend @ @ ~]
      =/  [address=@ux nonce=@ud]
        [(slav %ux i.t.wire) (rash i.t.t.wire dem)]
      ?+  +<.sign-arvo  (on-arvo:def wire sign-arvo)
        %wake  [(send-roll:do address nonce) this]
      ==
    ==
  ::
  ++  on-fail
    |=  [=term =tang]
    ::TODO  if crashed during timer, set new timer? how to detect?
    (on-fail:def term tang)
  ::
  ++  on-watch
    |=  =path
    ^-  (quip card _this)
    :_  this
    |^
    ?+  path  (on-watch:def path)
        [%txs @ ~]      ?>(?=(^ (slaw %ux i.t.path)) ~)
        [%points @ ~]   ?>(?=(^ (slaw %ux i.t.path)) ~)
        [%connect @ ~]  [%give %fact ~ (init i.t.path)]~
    ==
    ::
    ++  init
      |=  wat=@t
      ^-  cage
      :-  %roller-data
      !>  ^-  roller-data
      ?~  addr=(slaw %ux wat)  !!
      =/  [=owners =sponsors =points:naive]
       (give-points u.addr)
      =/  txs=(tree hist-tx)   (give-history u.addr)
      [chain-id points txs owners sponsors]
    ::
    ++  give-points
      |=  =address:ethereum
      ^-  [owners sponsors points:naive]
      =/  controlled=(list [proxy:naive ship])
        (controlled-ships:dice address own)
      %+  roll  controlled
      |=  [[=proxy:naive =ship] =owners =sponsors =points:naive]
      =/  sponsoring  (~(get by spo.state) ship)
      :+  (~(put ju owners) [proxy address] ship)
        ::
        ?~  sponsoring  sponsors
        (~(put by sponsors) ship u.sponsoring)
      ::
      %+  put:orp:dice  points
      [ship (need (get:orp:dice points.pre ship))]
    ::
    ++  give-history
      |=  =address:ethereum
      ^-  (tree hist-tx)
      ?~  hist=(~(get by history) address)
        ~
      u.hist
    --
  ::
  ++  on-leave  on-leave:def
  ::
  ++  on-agent
    |=  [=wire =sign:agent:gall]
    ^-  (quip card _this)
    |^
    ?+  wire  (on-agent:def wire sign)
      [%send @ @ *]         (send-batch i.t.wire i.t.t.wire sign)
      [%azimuth-events ~]   (azimuth-event sign)
      [%nonce ~]            (nonce sign)
      [%refresh-nonce @ ~]  (refresh i.t.wire sign)
    ==
    ::
    ++  send-batch
      |=  [address=@t nonce=@t =sign:agent:gall]
      ^-  (quip card _this)
      =/  [address=@ux nonce=@ud]
        [(slav %ux address) (rash nonce dem)]
      ?-  -.sign
          %poke-ack
        ?~  p.sign
          %-  (slog leaf+"Send batch thread started successfully" ~)
          [~ this]
        %-  (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
        :_  this
        [(leave:spider:do our.bowl wire)]~
      ::
          %watch-ack
        ?~  p.sign
          [~ this]
        =/  =tank  leaf+"{(trip dap.bowl)} couldn't start listen to thread"
        %-  (slog tank u.p.sign)
        [~ this]
      ::
          %kick
        [~ this]
      ::
          %fact
        ?+  p.cage.sign  (on-agent:def wire sign)
            %thread-fail
          =+  !<([=term =tang] q.cage.sign)
          %-  (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
          =^  cards  state
            (on-batch-result:do address nonce %.n^[%error 'thread failed'])
          [cards this]
        ::
            %thread-done
          =+   !<(result=(each @ud [term @t]) q.cage.sign)
          =^  cards  state
            (on-batch-result:do address nonce result)
          [cards this]
        ==
      ==
    ::
    ++  azimuth-event
      |=  =sign:agent:gall
      ^-  (quip card _this)
      ?+  -.sign  [~ this]
          %watch-ack
        ?~  p.sign  [~ this]
        =/  =tank  leaf+"{(trip dap.bowl)} couldn't start listen to %azimuth"
        %-  (slog tank u.p.sign)
        [~ this]
      ::
          %fact
        ?+  p.cage.sign  (on-agent:def wire sign)
            %naive-diffs
          =+   !<(=diff:naive q.cage.sign)
          =^  cards  state
            (on-naive-diff:do diff)
          [cards this]
        ::
            %naive-state
          ~&  >  %received-azimuth-state
          =+  !<([nas=^state:naive =indices] q.cage.sign)
          =^  effects  state
            (predicted-state:do nas indices)
          [(emit effects) this]
        ==
      ==
    ::
    ++  nonce
      |=  =sign:agent:gall
      ^-  (quip card _this)
      ?-  -.sign
          %poke-ack
        ?~  p.sign
          %-  (slog leaf+"Nonce thread started successfully" ~)
          [~ this]
        %-  (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
        :_  this
        [(leave:spider:do our.bowl wire)]~
      ::
          %watch-ack
        ?~  p.sign
          [~ this]
        =/  =tank  leaf+"{(trip dap.bowl)} couldn't start listen to thread"
        %-  (slog tank u.p.sign)
        [~ this]
      ::
          %kick
        [~ this]
      ::
          %fact
        ?+  p.cage.sign  (on-agent:def wire sign)
            %thread-fail
          =+  !<([=term =tang] q.cage.sign)
          %-  (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
          [~ this]
        ::
            %thread-done
          =+   !<(nonce=@ud q.cage.sign)
          [~ this(next-nonce `nonce)]
        ==
      ==
    ::
    ++  refresh
      |=  [nonce=@t =sign:agent:gall]
      ^-  (quip card _this)
      =/  failed-nonce=@ud  (rash nonce dem)
      ?-  -.sign
          %poke-ack
        ?~  p.sign
          %-  (slog leaf+"Refresh Nonce thread started successfully" ~)
          [~ this]
        %-  (slog leaf+"{(trip dap.bowl)} couldn't start thread" u.p.sign)
        :_  this
        [(leave:spider:do our.bowl wire)]~
      ::
          %watch-ack
        ?~  p.sign
          [~ this]
        =/  =tank  leaf+"{(trip dap.bowl)} couldn't start listen to thread"
        %-  (slog tank u.p.sign)
        [~ this]
      ::
          %kick
        [~ this]
      ::
          %fact
        ?+  p.cage.sign  (on-agent:def wire sign)
            %thread-fail
          =+  !<([=term =tang] q.cage.sign)
          %-  (slog leaf+"{(trip dap.bowl)} failed" leaf+<term> tang)
          [~ this]
        ::
            %thread-done
          =+   !<(nonce=@ud q.cage.sign)
          =^  cards  state
            (on-out-of-sync:do nonce failed-nonce)
          [cards this]
        ==
      ==
    --
  --
::
|_  =bowl:gall
::  +canonical: current naive, ownership, and sponsorship state
::
++  canonical
  |^  nas^own^spo
  ::
  ++  nas
    .^  ^state:naive
      %gx
      (scot %p our.bowl)
      %azimuth
      (scot %da now.bowl)
      /nas/noun
    ==
  ::
  ++  own
    .^  owners
      %gx
      (scot %p our.bowl)
      %azimuth
      (scot %da now.bowl)
      /own/noun
    ==
  ::
  ++  spo
    .^  sponsors
      %gx
      (scot %p our.bowl)
      %azimuth
      (scot %da now.bowl)
      /spo/noun
    ==
  --
::  +predicted-state
::
::    derives predicted state from applying pending & sending txs to
::    the provided naive state, discarding invalid txs in the process
::
++  predicted-state
  |=  [nas=^state:naive =indices]
  ^-  (quip update _state)
  =:  pre  nas
      own  own.indices
      spo  spo.indices
    ==
  |^
  =^  [nes=_sending updates-1=(list update)]  state
    apply-sending
  =^  [nep=_pending updates-2=(list update)]  state
    apply-pending
  :-  (welp updates-1 updates-2)
  state(sending nes, pending nep)
  ::
  ++  apply-pending
    (apply-txs pending %pending next-nonce.state)
  ::
  ++  apply-sending
    =|  ups=(list update)
    =/  valid=_sending  ~
    =+  sorted=(tap:ors:dice sending)
    |-  ^+  [[valid ups] state]
    ?~  sorted  [[valid ups] state]
    ::
    =*  key  key.i.sorted
    =*  val  val.i.sorted
    =+  txs=(turn txs.val |=(=raw-tx:naive [| 0x0 *time raw-tx]))
    =^  [new-valid=_txs nups=_ups]  state
      (apply-txs txs %sending `nonce.key)
    ::  we only hear updates for this nonce if it has been sent
    ::
    =.  valid  ::=?  valid  sent.val
      %^  put:ors:dice  valid
        key
      ::  TODO: too much functional hackery?
      val(txs (turn new-valid (cork tail (cork tail tail))))
    $(sorted t.sorted, ups (welp ups nups))
  ::
  ++  apply-txs
    |=  [txs=(list pend-tx) type=?(%pending %sending) nonce=(unit @ud)]
    =/  valid=_txs  ~
    =|  updates=(list update)
    |-  ^+  [[valid updates] state]
    ?~  txs
      :_  state
      [(flop valid) (flop updates)]
    ::
    =*  tx       i.txs
    =*  raw-tx   raw-tx.i.txs
    =*  ship     ship.from.tx.raw-tx.i.txs
    =/  =keccak  (hash-raw-tx:lib raw-tx)
    =^  [gud=? up-1=_updates]  state
      (try-apply pre force.tx raw-tx)
    =/  =roll-tx  [ship type keccak (l2-tx +<.tx.raw-tx)]
    =?  valid     gud  [tx valid]
    =^  up-2  history
      ?:  gud  [~ history]
      =.  time.tx
        ?:  ?=(%pending type)  time.tx
        =+  wer=(~(got by finding) keccak)
        ?>(?=(^ wer) time.wer)
      (update-history:dice history [tx]~ %failed)
    =?  finding  !gud  (~(put by finding) keccak %failed)
    =.  updates  :(welp up-2 up-1 updates)
    $(txs t.txs)
  --
::  +try-apply: maybe apply the given l2 tx to the naive state
::
++  try-apply
  |=  [nas=^state:naive force=? =raw-tx:naive]
  ^-  [[? ups=(list update)] _state]
  =/  [success=? updates=(list update) predicted=_nas =indices]
    (apply-raw-tx:dice force chain-id raw-tx nas own spo)
  =:  pre  predicted
      own  own.indices
      spo  spo.indices
    ==
  [[success updates] state]
::
++  on-action
  |=  =action
  ^-  (quip card _state)
  =+  local=(team:title our.bowl src.bowl)
  |^
  ?-  -.action
    %commit  ?>(local on-timer)
    %config  ?>(local (on-config +.action))
    %assign  ?>(local `state(allowances (~(put by allowances) +.action)))
    %cancel  (cancel-tx +.action)
  ::
      %submit
    ::  TODO: return [~ state] instead of crashing
    ::  if naive state hasn't being retrieved yet?
    ::
    ?>  ?=(^ points.pre)
    %-  take-tx
    :*  force.action
        address.action
        now.bowl
        sig.action
        (part-tx-to-full tx.action)
    ==
  ==
  ::
  ++  part-tx-to-full
    |=  =part-tx
    ^-  [octs tx:naive]
    ?-    -.part-tx
        %raw
      ?~  batch=(parse-raw-tx:naive 0 q.raw.part-tx)
        ~?  lverb  [dap.bowl %parse-failed]
        ::  TODO: maybe return a unit if parsing fails?
        ::
        !!
      [raw tx]:-.u.batch
    ::
      %don  [(gen-tx-octs:lib +.part-tx) +.part-tx]
      %ful  +.part-tx
    ==
  --
::
++  on-config
  |=  =config
  ^-  (quip card _state)
  ?-  -.config
    %frequency    [~ state(frequency frequency.config)]
    %resend-time  [~ state(resend-time time.config)]
    %update-rate  [~ state(update-rate rate.config)]
    %slice        [~ state(slice slice.config)]
    %quota        [~ state(quota quota.config)]
  ::
      %endpoint
    :-  ~
    =/  [contract=@ux chain-id=@]
      =<  [naive chain-id]
      =,  azimuth
      ?-  net.config
        %mainnet  mainnet-contracts
        %ropsten  ropsten-contracts
        %local    local-contracts
        %default  contracts
      ==
    %_  state
      contract   contract
      chain-id   chain-id
      endpoint   `endpoint.config
    ==
  ::
      %setkey
    =?  pk.config  =((end [3 2] pk.config) '0x')
      (rsh [3 2] pk.config)
    ?~  pk=(de:base16:mimes:html pk.config)
      `state
    [(get-nonce q.u.pk /nonce) state(pk q.u.pk)]
  ==
::  +cancel-tx: cancel a pending transaction
::
++  cancel-tx
  |=  [sig=@ =keccak =l2-tx =ship]
  ^-  (quip card _state)
  ?^  status=(~(get by finding) keccak)
    ~?  lverb  [dap.bowl %tx-not-pending status+u.status]
    [~ state]
  ::  "cancel: 0x1234abcd"
  ::
  =/  message=octs
    %:  cad:naive  3
      8^'cancel: '
    ::
      =;  hash=@t
        (met 3 hash)^hash
      (crip "0x{((x-co:co 65) keccak)}")
    ::
      ~
    ==
  ?~  addr=(verify-sig:lib sig message)
    ~?  lverb  [dap.bowl %cancel-sig-fail]
    [~ state]
  =^  time  pending
    =|  nep=(list pend-tx)
    |-  ^-  [(unit time) _nep]
    ?~  pending  [~ (flop nep)]
    ?:  =(keccak (hash-raw-tx:lib raw-tx.i.pending))
      [`time.i.pending (weld (flop nep) t.pending)]
    $(pending t.pending, nep [i.pending nep])
  ?~  time
    ~?  lverb  [dap.bowl %weird-tx-not-pending]
    [~ state]
  :-  ~
  %_    state
      history
    =+  txs=(~(got by history) u.addr)
    =.  txs  +:(del:orh:dice txs u.time)
    %+  ~(put by history)  u.addr
    %^  put:orh:dice  txs
      u.time
    [ship %cancelled keccak l2-tx]
  ==
::  +take-tx: accept submitted l2 tx into the :pending list
::
++  take-tx
  |=  =pend-tx
  ^-  (quip card _state)
  =*  ship  ship.from.tx.raw-tx.pend-tx
  =/  [exceeded=? next-quota=@]  (quota-exceeded ship)
  ?:  exceeded  [~ state]
  =/  sign-address=(unit @ux)
    (extract-address:lib raw-tx.pend-tx pre chain-id)
  =?  address.pend-tx  ?=(^ sign-address)
    (need sign-address)
  =^  [gud=? cards-1=(list update)]  state
    (try-apply pre [force raw-tx]:pend-tx)
  =^  cards-2  history
    (update-history:dice history [pend-tx]~ ?:(gud %pending %failed))
  ?.  gud
    :_  state
    ::  %point and (%failed) %tx updates
    ::
    (emit cards-1)
  =:  pending     (snoc pending pend-tx)
      ship-quota  (~(put by ship-quota) ship next-quota)
    ==
  ::  toggle derivation
  ::
  :_  state(derive ?:(derive | derive))
  ;:  welp
    (emit cards-1)  :: %point updates
    (emit cards-2)  :: %tx updates
  ::
    ?.  derive  ~
    ::  defer updating predicted state from canonical
    ::
    [(wait:b:sys /predict (add update-rate now.bowl))]~
  ==
::  +on-timer: every :frequency, freeze :pending txs roll and start sending it
::
++  on-timer
  ^-  (quip card _state)
  =^  updates-1  state
    (predicted-state canonical)
  =^  cards  state
    ?:  =(~ pending)  [~ state]
    ?~  next-nonce
      ~?  lverb  [dap.bowl %missing-roller-nonce]  [~ state]
    ::  this guarantees that next-nonce is only incremented
    ::  when the thread that's sending the previous batch
    ::  has come back and confirms that it was sent to L1
    ::
    ?:  out-of-sync
      ::  this would postpone sending the batch for a whole "frequency"
      ::  TODO: set up a timer to retry this in ~mX ?
      ::
      ~?  lverb  [dap.bowl %nonce-out-sync]  [~ state]
    =/  nonce=@ud  u.next-nonce
    =^  updates-2  history  (update-history:dice history pending %sending)
    =/  =address:ethereum   (get-address pk)
    =:  pending     ~
        derive      &
        next-nonce  `+(u.next-nonce)
      ::
          sending
        %^  put:ors:dice  sending
          [address nonce]
        [0 | (turn pending (cork tail (cork tail tail)))]
      ::
          finding
        %-  ~(gas by finding)
        %+  turn  pending
        |=  pend-tx
        (hash-raw-tx:lib raw-tx)^[time address nonce]
      ==
    :_  state
    ;:  welp
      (emit updates-1)
      (emit updates-2)
      (send-roll address nonce)
    ==
  =^  card  next-batch  (set-roller:timer frequency now.bowl)
  [[card cards] state]
::  +on-quota-timer: resets tx quota for all ships
::
++  on-quota-timer
  ^-  (quip card _state)
  =^  card  next-slice  (set-quota:timer slice now.bowl)
  :-  [card]~
  state(ship-quota *(map ship @ud))
::  +get-nonce: retrieves the latest nonce
::
++  get-nonce
  |=  [pk=@ =wire]
  ^-  (list card)
  ?~  endpoint  ~?(lverb [dap.bowl %no-endpoint] ~)
  (start-thread:spider bowl wire [%roller-nonce !>([u.endpoint pk])])
::
++  quota-exceeded
  |=  =ship
  ^-  [exceeded=? next-quota=@ud]
  =/  quota=(unit @ud)         (~(get by ship-quota) ship)
  =/  allow=(unit (unit @ud))  (~(get by allowances) ship)
  ?~  quota
    :_  1
    ?~  allow  |
    ?~(u.allow | =(u.u.allow 0))
  :_  +(u.quota)
  ?~  allow
    (gte u.quota quota.state)
  ::  ship has been whitelisted ("?~ u.allow" means no quota restrictions)
  ::
  ?~(u.allow | (gte u.quota u.u.allow))
::  +out-of-sync: checks if the previous nonce has been sent
::
++  out-of-sync
  ^-  ?
  ?~  newest-batch=(ram:ors:dice sending)  |
  !=(sent.val.u.newest-batch &)
::  +on-out-of-sync: handles a mismatch between current and expected l1 nonce
::
++  on-out-of-sync
  |=  [nonce=@ud failed-nonce=@ud]
  =/  =address:ethereum   (get-address pk)
  ::  we only care about nonces >= than the one that failed
  ::
  =/  failed-sending=(list [l1-tx-pointer send-tx])
    %-  tap:ors:dice
    ::  (range exclusive)
    ::
    (lot:ors:dice sending [`[address (dec failed-nonce)] ~])
  =/  confirmed-sending=_sending
    (lot:ors:dice sending [~ `[address failed-nonce]])
  =/  [nes=_sending nif=_finding sih=_history]
    %-  tail
    %+  roll  failed-sending
    |=  $:  [p=l1-tx-pointer q=send-tx]
            new-nonce=_nonce
            sending=_confirmed-sending
            finding=_finding
            history=_history
        ==
    |^
    =*  nonce  nonce.p
    =*  txs    txs.q
    ::  TODO: this shouldn't be needed
    ?:  (lth nonce.p failed-nonce)
      ~&  ["weird case" nonce+nonce.p]
      [new-nonce sending finding history]
    :+  +(new-nonce)
      fix-sending
    process-l2-txs
    ::
    ++  fix-sending
      (put:ors:dice sending [p(nonce new-nonce) q(sent %.n)])
    ::
    ++  process-l2-txs
      %+  roll  txs.q
      |=  [=raw-tx:naive nif=_finding sih=_history]
      =/  =keccak  (hash-raw-tx:lib raw-tx)
      |^
      ?~  val=(~(get by nif) keccak)
        [nif sih]
      ?.  ?=(^ u.val)  [nif sih]
      :-  (fix-finding u.val)
      (fix-history time.u.val address.u.val)
      ::
      ++  fix-finding
        |=  val=[time l1-tx-pointer]
        ^+  nif
        (~(put by nif) keccak val(nonce.+ new-nonce))
      ::
      ++  fix-history
        |=  [=time =address:ethereum]
        ^+  sih
        =*  ship      ship.from.tx.raw-tx
        =/  l2-tx     (l2-tx +<.tx.raw-tx)
        =/  =roll-tx  [ship %sending keccak l2-tx]
        =+  txs=(~(got by sih) address)
        =.  txs  +:(del:orh:dice txs time)
        %+  ~(put by sih)  address
        (put:orh:dice txs [time roll-tx])
      --
    --
  =:  sending     nes
      finding     nif
      history     sih
      next-nonce  `+(nonce)
    ==
  [(send-roll address nonce) state]
::  +send-roll: start thread to submit roll from :sending to l1
::
++  send-roll
  |=  [=address:ethereum =nonce:naive]
  ^-  (list card)
  ::  if this nonce isn't in the sending queue anymore, it's done
  ::
  ?.  (has:ors:dice sending [address nonce])
    ~?  lverb  [dap.bowl %done-sending [address nonce]]
    ~
  ?~  endpoint
    ~?  lverb  [dap.bowl %no-endpoint]
    ~
  ::  start the thread, passing in the l2 txs to use
  ::  TODO  should go ahead and set resend timer in case thread hangs, or nah?
  ::
  %^    start-thread:spider
      bowl
    /send/(scot %ux address)/(scot %ud nonce)
  :-  %roller-send
  !>  ^-  rpc-send-roll
  :*  u.endpoint
      contract
      chain-id
      pk
      nonce
    ::
      =<  [next-gas-price txs]
      (got:ors:dice sending [address nonce])
  ==
::  +on-batch-result: await resend after thread success or failure
::
++  on-batch-result
  |=  [=address:ethereum nonce=@ud result=(each @ud [term @t])]
  ^-  (quip card _state)
  ::  print error if there was one
  ::
  ~?  ?=(%| -.result)  [dap.bowl %send-error +.p.result]
  =/  =send-tx  (got:ors:dice sending [address nonce])
  =?  sending  ?=(%& -.result)
    %^  put:ors:dice  sending
      [address nonce]
    ::  update gas price for this tx in state
    ::  and set it as sent to L1
    ::
    send-tx(next-gas-price p.result, sent &)
  :_  state
  ?:  ?|  ?=(%& -.result)
        ::  a general error shouldn't innitiate
        ::  the out-of-sync nonce thread
        ::
          ?=([%| %error *] result)
        ::  this accounts for a resend with higher gas
        ::  for a previous nonce, so we shouldn't start
        ::  the out-of-sync nonce thread
        ::
          ?&  sent.send-tx
              ?=([%| %not-sent *] result)
      ==  ==
    :_  ~
    ::  resend the l1 tx in five minutes
    ::
    %+  wait:b:sys
      /resend/(scot %ux address)/(scot %ud nonce)
    (add resend-time now.bowl)
  ::  TODO: this only accounts for the case where the nonce is out of sync,
  ::  reaching this because of lower funds needs to be addressed manually
  ::
  ?>  ?=(%not-sent -.p.result)
  (get-nonce pk.state /refresh-nonce/(scot %ud nonce))
::  +on-naive-diff: process l2 tx confirmations
::
++  on-naive-diff
  |=  =diff:naive
  ^-  (quip card _state)
  ?.  |(?=(%point -.diff) ?=(%tx -.diff))
    [~ state]
  =;  [cards=(list card) =_state]
    :_  state(derive ?:(derive | derive))
    %+  weld  cards
    ?.  derive  ~
    ::  defer updating state from canonical
    ::
    [(wait:b:sys /predict (add update-rate now.bowl))]~
  ::
  ?:  ?=(%point -.diff)  [~ state]
  ?>  ?=(%tx -.diff)
  =/  =keccak  (hash-raw-tx:lib raw-tx.diff)
  ?~  wer=(~(get by finding) keccak)
    ::  tx not submitted by this roller
    ::
    [~ state]
  ?@  u.wer
    ~?  &(?=(%confirmed u.wer) ?=(~ err.diff))
      [dap.bowl %weird-double-confirm from.tx.raw-tx.diff]
    [~ state]
  =*  nonce       nonce.u.wer
  =*  tx-address  address.u.wer
  =*  ship        ship.from.tx.raw-tx.diff
  =*  time        time.u.wer
  =*  tx          tx.raw-tx.diff
  =/  l2-tx       (l2-tx +<.tx)
  ::  remove the tx from the sending map
  ::
  =.  sending
    =/  =address:ethereum   (get-address pk)
    ?~  sen=(get:ors:dice sending [address nonce])
      ~?  lverb  [dap.bowl %weird-double-remove nonce+nonce]
      sending
    ?~  nin=(find [raw-tx.diff]~ txs.u.sen)
      ~?  lverb  [dap.bowl %weird-unknown nonce+nonce]
      sending
    =.  txs.u.sen  (oust [u.nin 1] txs.u.sen)
    ?~  txs.u.sen
      ~?  lverb
       [dap.bowl %done-with-nonce [address nonce]]
      =^  *  sending
        (del:ors:dice sending [address nonce])
      sending
    ^+  sending
    (put:ors:dice sending [address nonce] u.sen)
  ::  update the finding map with the new status
  ::
  =.  finding
    %+  ~(put by finding)  keccak
    ?~  err.diff  %confirmed
    ::  if we kept the forced flag around for longer, we could notify of
    ::  unexpected tx failures here. would that be useful? probably not?
    ::  ~?  !forced  [dap.bowl %aggregated-tx-failed-anyway err.diff]
    %failed
  ::
  =^  updates  history
    %^    update-history:dice
        history
    [| tx-address time raw-tx.diff]~
  ?~(err.diff %confirmed %failed)
  [(emit updates) state]
::
++  on-peek
  |%
  ++  pending-by
    |=  wat=@t
    ?~  who=(slaw %p wat)
      ::  by-address
      ::
      ?~  wer=(slaw %ux wat)
        [~ ~]
      =;  pending=(list pend-tx)
        ``noun+!>(pending)
      %+  skim  pending
      |=  pend-tx
      ::  TODO: use this instead? =(u.wer address)
      ::
      ?~  addr=(get-l1-address tx.raw-tx pre)  |
      =(u.wer u.addr)
    ::  by-ship
    ::
    =;  pending=(list pend-tx)
      ``noun+!>(pending)
    %+  skim  pending
    |=  pend-tx
    =(u.who ship.from.tx.raw-tx)
  ::
  ++  status
    |=  wat=@t
    ?~  keccak=(slaw %ux wat)
      [~ ~]
    :+  ~  ~
    :-  %noun
    !>  ^-  tx-status
    ?^  status=(~(get by finding) u.keccak)
      ?@  u.status  [u.status ~]
      [%sending `+.u.status]
    :: TODO: potentially slow!
    =;  known=?
      [?:(known %pending %unknown) ~]
    %+  lien  pending
    |=  pend-tx
    =(u.keccak (hash-raw-tx:lib raw-tx))
  ::
  ++  transaction
    |=  wat=@t
    ?~  keccak=(slaw %ux wat)
      [~ ~]
    :+  ~  ~
    :-  %noun
    !>  ^-  (unit pend-tx)
    :: TODO: potentially slow!
    |-
    ?~  pending  ~
    =*  tx  i.pending
    ?:  =(u.keccak (hash-tx:lib raw.raw-tx.tx))
      `tx
    $(pending t.pending)
  ::
  ++  history
    |=  wat=@t
    :+  ~  ~
    :-  %noun
    !>  ^-  (list hist-tx)
    ?~  addr=(slaw %ux wat)  ~
    ?~  hist=(~(get by ^history) u.addr)  ~
    (tap:orh:dice u.hist)
  ::
  ++  nonce
    |=  [who=@t proxy=@t]
    ?~  who=(slaw %p who)
      [~ ~]
    ?.  ?=(proxy:naive proxy)
      [~ ~]
    :+  ~  ~
    :-  %noun
    !>  ^-  (unit @)
    ?~  point=(get:orp:dice points.pre u.who)
      ~
    =<  `nonce
    (proxy-from-point:naive proxy u.point)
  ::
  ++  spawned
    |=  wat=@t
    :+  ~  ~
    :-  %noun
    !>  ^-  (list @p)
    ?~  star=(slaw %p wat)  ~
    =;  range
      (turn range head)
    ::  range exclusive [star first-moon-last-planet]
    ::
    %-  tap:orp:dice
    (lot:orp:dice points.pre [`u.star `(cat 3 u.star 0x1.ffff)])
  ::
  ++  unspawned
    |=  wat=@t
    :+  ~  ~
    :-  %noun
    !>  ^-  (list @p)
    ?~  star=(slaw %p wat)  ~
    =/  spawned=(set @p)
      =;  points
        (~(gas in *(set @p)) (turn points head))
      %-  tap:orp:dice
      (lot:orp:dice points.pre [`u.star `(cat 3 u.star 0x1.ffff)])
    =/  children=(list @p)
      (turn (gulf 0x1 0xffff) |=(a=@ (cat 3 u.star a)))
    %+  murn  children
    |=  =ship
    ?:  (~(has in spawned) ship)  ~
    `ship
  ::
  ++  sponsored
    |=  wat=@t
    :+  ~  ~
    :-  %noun
    !>  ^-  [(list ship) (list ship)]
    ?~  who=(slaw %p wat)  [~ ~]
    ?~  sponsor=(~(get by spo) u.who)
      [~ ~]
    :-  ~(tap in residents.u.sponsor)
    ~(tap in requests.u.sponsor)
  ::
  ++  point
    |=  wat=@t
    ?~  ship=(rush wat ;~(pfix sig fed:ag))
      ``noun+!>(*(unit point:naive))
    ``noun+!>((get:orp:dice points.pre u.ship))
  ::
  ++  ships
    |=  wat=@t
    :+  ~  ~
    :-  %noun
    !>  ^-  (list ship)
    ?~  addr=(slaw %ux wat)  ~
    (turn (controlled-ships:dice u.addr own) tail)
  ::
  ++  config
    :+  ~  ~
    :-  %noun
    !>  ^-  roller-config
    :*  next-batch
        frequency
        resend-time
        update-rate
        contract
        chain-id
        slice
        quota
    ==
  ::
  ++  points-proxy
    |=  [=proxy:naive wat=@t]
    :+  ~  ~
    :-  %noun
    !>  ^-  (list ship)
    ?~  addr=(slaw %ux wat)
      ~
    ~(tap in (~(get ju own) [proxy u.addr]))
  ::
  ++  over-quota
    |=  wat=@t
    ?~  who=(slaw %p wat)  [~ ~]
    =/  [exceeded=? *]  (quota-exceeded u.who)
    ``atom+!>(exceeded)
  ::
  ++  ship-quota
    |=  wat=@t
    ?~  who=(slaw %p wat)  [~ ~]
    =/  [exceeded=? next-quota=@ud]  (quota-exceeded u.who)
    :+  ~  ~
    :-  %atom
    !>  ^-  @ud
    ?:  exceeded  0
    (sub quota.state (dec next-quota))
  ::
  ++  allowance
    |=  wat=@t
    ?~  who=(slaw %p wat)  [~ ~]
    :+  ~  ~
    :-  %noun
    !>  ^-  (unit @ud)
    ?^  allow=(~(get by allowances) u.who)
      u.allow
    `quota.state
  --
--