RevIssuer.rho

/**
 * RevIssuerKit lets us make [ERTP][]-style purses containing REV.
 *
 * Each REV vault contains an ERTP-style purse, but there is
 * no way to access it from outside the current REVVault contract.
 * We use REVAddress!("fromUnforgeable") to wrap a REVVault in
 * an ERTP-style purse for use in higher-order contracts and such.
 *
 * Since this is possible, the REVVault contract should just have
 * a method to access to the purse behind a REVVault made with
 * "fromUnforgeable". But the current version does not, so we
 * must waste some execution cost on this wrapper.
 *
 * [ERTP]: https://agoric.com/documentation/ertp/guide/
 */
new log(`rho:rchain:deployId`),
RevIssuerKit,
insertArbitrary(`rho:registry:insertArbitrary`),
lookup(`rho:registry:lookup`), vCh,
REVAddress(`rho:rev:address`)
in {
  lookup!(`rho:rchain:revVault`, *vCh) | for (@(_, *RevVault) <- vCh) {
    // Test the contract before inserting into the registry.
    new kitCh, pCh,
    fromCh, toCh, pubKeyCh,
    vaultCh, targetVaultCh, revVaultkeyCh,
    DeployerIdOps(`rho:rchain:deployerId:ops`),
    deployerId(`rho:rchain:deployerId`)
    in {
      RevIssuerKit!(*kitCh) | for (@{"issuer": *issuer, ..._} <- kitCh) {
        log!(["got issuer"]) |
        issuer!("makeEmptyPurse", *pCh) | for (purse <- pCh) {
          log!(["got purse"]) |
          DeployerIdOps!("pubKeyBytes", *deployerId, *pubKeyCh) |
          for (@deployerPubKey <- pubKeyCh) {
            log!(["got deployer public key", deployerPubKey]) |
            purse!("getAddress", *toCh) |
            REVAddress!("fromPublicKey", deployerPubKey, *fromCh) |
            for (@from <- fromCh; @to <- toCh) {
              log!(["got from", from, "to", to]) |
              RevVault!("findOrCreate", from, *vaultCh) |
              // make sure the target vault it created and the transfer would be done
              RevVault!("findOrCreate", to, *targetVaultCh) |
              RevVault!("deployerAuthKey", *deployerId, *revVaultkeyCh) |
              for (@(true, vault) <- vaultCh ; key <- revVaultkeyCh ; @(true, _) <- targetVaultCh) {
                log!(["Beginning transfer of ", 100, "REVlette from", from, "to", to]) |

                new resultCh in {
                  @vault!("transfer", to, 100 /*amount*/, *key, *resultCh) |
                  for (@result <- resultCh) {
                    log!(("Finished transfer of ", 100, "REV to", to, "result was:", result)) |
                    purse!("withdraw", 50, *resultCh) | for (@(ok, *p2) <- resultCh) {
                      log!(["withdraw ok?", ok]) |
                      purse!("deposit", *p2, *resultCh) | for (@(ok, x) <- resultCh) {
                        log!(["deposit ok?", (ok, x)]) |
                        new kCh, iCh in {
                          insertArbitrary!(bundle+{*RevIssuerKit}, *kCh) |
                          insertArbitrary!(bundle+{*issuer}, *iCh) |
                          for (@kUri <- kCh; @iUri <- iCh) {
                            log!(["tests passed; inserted RevIssuerKit at", kUri, "REV issuer at", iUri])
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          }
        }
      }
    } |

    /**
     * Make an ERTP-style Issuer Kit for REV
     *
     * TODO: amountMath, brand?
     */
    contract RevIssuerKit(ret) = {
      new issuer, makePurseKit in {

        // The corresponding mint is the REV mint; clearly we don't have that to give out.
        ret!({"mint": Nil, "issuer": bundle+{*issuer}}) |

        /**
         * The issue has only the ability to make an empty purse.
         * Feel free to share it widely. In fact, unless others have
         * and the issuer, they have no way to create purses of their
         * own and hence no reason to believe purses you send are
         * of any value.
         *
         * TODO: review issuer API; add claim, ...?
         */
        contract issuer(@"makeEmptyPurse", ret) = {
          new kitCh in {
            makePurseKit!(*kitCh) | for (@{"purse": *purse, ..._} <- kitCh) {
              ret!(bundle+{*purse}) // already bundled, but... it's a good habit.
            }
          }
        } |

        /**
         * makePurseKit is closely held. Purses from this issuer trust each other
         * based on their ability to demonstrate they have it in scope using a
         * form of "sealed dispatch".
         */
        contract makePurseKit(kitRet) = {
          new un, // un is closely held! It enables withdrawal from this purse's vault.
              purse, addrCh, balCh, vaultCh in {
            balCh!(0) |
            REVAddress!("fromUnforgeable", *un, *addrCh) | for (@purseAddr <- addrCh) {
              RevVault!("findOrCreate", purseAddr, *vaultCh) | for (@(true, *vault) <- vaultCh) {
                // log!(["new purse addr", purseAddr]) |
                // Return purse and address in one round trip.
                kitRet!({"purse": bundle+{*purse}, "address": purseAddr}) |

                /**
                 * getAddress facilitates normal REV transfers into this purse.
                 *
                 * WARNING: only trust getAddress on purses you trust (for example,
                 *          a purse you created using a trusted issuer), not
                 *          from alleged payments!
                 */
                contract purse(@"getAddress", ret) = { ret!(purseAddr) } |

                // TODO: upgrade to getCurrentAmount
                contract purse(@"getBalance", ret) = { for (@balance <<- balCh) { ret!(balance) } } |

                /**
                 * Get a key etc. to withdraw from this purse.
                 *
                 * @param sealedDispatch - provides evidence that the
                 *        caller has makePurseKit but protects the caller from
                 *        disclosing it to potential attackers by bundling it
                 *        with a fresh return channel.
                 * @returns an unforgeableAuthKey along with a corresponding seal
                 *          as well as this purse's vault, address, and balance.
                 */
                contract purse(@"getKey", @sealedDispatch, ret) = {
                  // log!(["getKey seal", sealedDispatch.toByteArray(), {bundle0{(*makePurseKit, *ret)}}.toByteArray()]) |
                  if (sealedDispatch == {bundle0{(*makePurseKit, *ret)}}) {
                    new keyCh in {
                      RevVault!("unforgeableAuthKey", *un, *keyCh) |
                      for (@balance <<- balCh) {
                        for (@key <- keyCh) {
                          // log!(["unforgeableAuthKey", key, "balance", balance]) |
                          ret!((true, {"key": key, "seal": bundle0{(*makePurseKit, key)},
                                       "vault": *vault,
                                       "address": purseAddr, "balance": balance }))
                        }
                      }
                    }
                  } else {
                    ret!((false, "bad sealedDispatch"))
                  }
                } |

                // TODO: optAmount
                contract purse(@"deposit", allegedPayment, ret) = {
                  // log!("deposit...") |
                  new keyCh, amtCh, pAddrCh, pvCh, txCh in {
                    // Ask alleged payment for a key using sealed dispatch (see above).
                    allegedPayment!("getKey", bundle0{(*makePurseKit, *keyCh)}, *keyCh) |
                    for (@(true, {"key": pmtAuthKey, "seal": seal,
                                  "vault": *pmtVault,
                                  "address": pmtAddr, "balance": amount }) <- keyCh) {
                      // log!(["got key for add", pmtAddr,
                      //      "seal", seal.toByteArray(), {bundle0{(*makePurseKit, pmtAuthKey)}}.toByteArray()]) |
                      // Check the seal before trusting the alleged payment vault's transfer method.
                      if (seal == {bundle0{(*makePurseKit, pmtAuthKey)}}) {
                        pmtVault!("transfer", purseAddr, amount, pmtAuthKey, *txCh) |
                        for (@(ok, x) <- txCh; @balance <- balCh) {
                          // log!(["deposit transfer result", (ok, x)]) |
                          ret!((ok, x)) |
                          match ok {
                            // RevVault transfer already checked for overflow
                            true => balCh!(balance + amount)
                            false => balCh!(balance)
                          }
                        }
                      } else {
                        ret!((false, "bad seal"))
                      }
                    }
                  }
                } |

                /**
                 * Get deposit-only facet
                 */
                contract purse(@"getDepositFacet", ret) = {
                  new depositFacet in {
                    ret!(*depositFacet) |
                    contract depositFacet(@"receive", allegedPayment, ret) = {
                      purse!("deposit", *allegedPayment, *ret)
                    }
                  }
                } |

                /**
                 * Withdraw purse
                 *
                 * TODO: distinguish purses from payments to avoid hazzards.
                 */
                contract purse(@"withdraw", @amount, ret) = {
                  // log!(["withdraw", amount, "from", purseAddr]) |
                  new pCh, keyCh, txCh in {
                    makePurseKit!(*pCh) |
                    for (@{"purse": *withdrawal, "address": wAddr, ..._} <- pCh) {
                      // log!(["withrawal purse addr", wAddr]) |
                      RevVault!("unforgeableAuthKey", *un, *keyCh) | for (authKey <- keyCh) {
                        // log!(["withrawal authKey", *authKey]) |
                        vault!("transfer", wAddr, amount, *authKey, *txCh) |
                        for (@(ok, x) <- txCh; @balance <- balCh) {
                          // log!(["withrawal transfer", (ok, x), balance]) |
                          match ok {
                            true => {
                              // RevVault transfer already checked for underflow
                              balCh!(balance - amount) |
                              ret!((true, *withdrawal))
                            }
                            false => {
                              ret!((false, x)) |
                              balCh!(balance)
                            }
                          }
                        }
                      }
                    }
                  }
                } |

                /**
                * Withdraw to REVAddress
                */
                contract purse(@"withdrawTo", @{ amount /\ Int }, @{ destRevAddr /\ String }, ret) = {
                  new keyCh, txCh in {
                    RevVault!("unforgeableAuthKey", *un, *keyCh) | for (authKey <- keyCh) {
                      vault!("transfer", destRevAddr, amount, *authKey, *txCh) |
                      for (@(ok, x) <- txCh; @balance <- balCh) {
                        match ok {
                          true => {
                            balCh!(balance - amount) |
                            ret!((true, x))
                          }
                          false => {
                            ret!((false, x)) |
                            balCh!(balance)
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          }
        }
      }
    }
  }
}