(use-trait ft-trait 'SP3FBR2AGK5H9QBDH3EEN6DF8EK8JY7RX8QJ5SVTE.sip-010-trait-ft-standard.sip-010-trait)
(impl-trait .pool-trait.pool-trait)
(define-constant err-unauthorized (err u2000))
(define-constant err-deposit-amount-too-small (err u2001))
(define-constant err-pool-balance-too-big (err u2002))
(define-constant err-zero-changes (err u2003))
(define-constant err-zero-d-changes (err u2004))
(define-constant err-not-enough-reserves (err u2005))
(define-constant err-not-initialized (err u2006))
(define-constant err-already-initialized (err u2007))
(define-constant err-wrong-token (err u2008))
(define-constant err-slippage (err u2009))
(define-constant err-not-enough-lp (err u2010))
(define-constant err-low-vusd-balance (err u2011))
(define-constant err-low-token-balance (err u2012))
(define-constant err-deposit-prohibited (err u2013))
(define-constant err-withdraw-prohibited (err u2014))
(define-constant err-swap-prohibited (err u2015))
(define-constant err-too-large (err u2016))
(define-constant err-pool-is-empty (err u2017))
(define-constant err-zero-lp-tokens (err u2018))
(define-constant system-precision u3)
(define-constant max-token-balance u100000000000)
(define-constant a u20)
(define-constant BP u10000)
(define-constant P u48)
(define-data-var owner principal contract-caller)
(define-data-var bridge (optional principal) none)
(define-data-var token-balance uint u0)
(define-data-var vusd-balance uint u0)
(define-data-var balance-ratio-min-bp uint u0)
(define-data-var fee-share-bp uint u0)
(define-data-var reserves uint u0)
(define-data-var d uint u0)
(define-map user-reward-debt
principal
uint
)
(define-data-var admin-fee-share-bp uint u0)
(define-data-var admin-fee-amount uint u0)
(define-data-var acc-reward-per-share-p uint u0)
(define-data-var lp-total-supply uint u0)
(define-map lp-balances
principal
uint
)
(define-data-var token-amount-reduce uint u0)
(define-data-var token-amount-increase uint u0)
(define-data-var token-principal (optional principal) none)
(define-data-var stop-authority principal contract-caller)
(define-data-var can-deposit bool true)
(define-data-var can-withdraw bool true)
(define-data-var can-swap bool true)
(define-public (deposit
(amount uint)
(ft-ref <ft-trait>)
)
(let (
(old-d (var-get d))
(amount-sp (to-system-precision amount))
)
(try! (assert-can-deposit))
(try! (assert-token ft-ref))
(asserts! (> amount-sp u0) err-deposit-amount-too-small)
(try! (contract-call? ft-ref transfer amount contract-caller
(as-contract contract-caller) none
))
(var-set reserves (+ (var-get reserves) amount-sp))
(let (
(tb (var-get token-balance))
(vb (var-get vusd-balance))
(old-balance (+ tb vb))
(is-first-deposit (or (is-eq old-d u0) (is-eq old-balance u0)))
(half (bit-shift-right amount-sp u1))
(new-token-balance (+ tb
(if is-first-deposit
half
(/ (* amount-sp tb) old-balance)
)))
(new-vusd-balance (+ vb
(if is-first-deposit
half
(/ (* amount-sp vb) old-balance)
)))
(new-d (calc-d new-token-balance new-vusd-balance))
(delta (- new-d old-d))
)
(asserts! (> new-token-balance tb) err-zero-lp-tokens)
(asserts! (> new-vusd-balance vb) err-zero-lp-tokens)
(asserts! (< new-token-balance max-token-balance) err-pool-balance-too-big)
(var-set token-balance new-token-balance)
(var-set vusd-balance new-vusd-balance)
(var-set d new-d)
(print {
event: "Deposited",
token: (contract-of ft-ref),
amount: amount,
lpAmount: delta,
})
(try! (deposit-lp ft-ref tx-sender delta))
(ok true)
)
)
)
(define-public (withdraw
(amount-lp uint)
(ft-ref <ft-trait>)
)
(let (
(old-d (var-get d))
(tb (var-get token-balance))
(vb (var-get vusd-balance))
(old-balance (+ tb vb))
(new-token-balance (- tb (/ (* amount-lp tb) old-balance)))
(new-vusd-balance (- vb (/ (* amount-lp vb) old-balance)))
(new-d (calc-d new-token-balance new-vusd-balance))
(transfer-amount (from-system-precision amount-lp))
(caller contract-caller)
)
(try! (assert-can-withdraw))
(try! (assert-token ft-ref))
;; require that balances actually changed
(asserts! (< (+ new-token-balance new-vusd-balance) old-balance)
err-zero-changes
)
;; burn LP tokens
(try! (withdraw-lp ft-ref caller amount-lp))
(asserts! (< new-d old-d) err-zero-d-changes)
;; require that there are enough reserves
(asserts! (<= amount-lp (var-get reserves)) err-not-enough-reserves)
(var-set token-balance new-token-balance)
(var-set vusd-balance new-vusd-balance)
(var-set d new-d)
;; reduce reserves
(var-set reserves (- (var-get reserves) amount-lp))
;; transfer tokens to the sender (convert from system precision)
(try! (as-contract (contract-call? ft-ref transfer transfer-amount contract-caller caller none)))
(print {
event: "Withdrawn",
token: (contract-of ft-ref),
amount: transfer-amount,
lpAmount: amount-lp,
})
(ok true)
)
)
(define-public (init
(token <ft-trait>)
(bridge-address principal)
(fee-share-bp-arg uint)
(balance-ratio-min-bp-arg uint)
)
(let ((decimals (unwrap-panic (contract-call? token get-decimals))))
(asserts! (is-none (var-get token-principal)) err-already-initialized)
(var-set token-principal (some (contract-of token)))
(var-set token-amount-reduce
(if (> decimals system-precision)
(pow u10 (- decimals system-precision))
u0
))
(var-set token-amount-increase
(if (< decimals system-precision)
(pow u10 (- system-precision decimals))
u0
))
(var-set balance-ratio-min-bp balance-ratio-min-bp-arg)
(var-set fee-share-bp fee-share-bp-arg)
(var-set bridge (some bridge-address))
(only-owner)
)
)
(define-read-only (to-system-precision (amount uint))
(let (
(reduce (var-get token-amount-reduce))
(increase (var-get token-amount-increase))
)
(if (> reduce u0)
(/ amount reduce)
(if (> increase u0)
(* amount increase)
amount
)
)
)
)
(define-read-only (from-system-precision (amount uint))
(let (
(reduce (var-get token-amount-reduce))
(increase (var-get token-amount-increase))
)
(if (> reduce u0)
(* amount reduce)
(if (> increase u0)
(/ amount increase)
amount
)
)
)
)
(define-public (swap-to-vusd
(ft-ref <ft-trait>)
(user principal)
(amount uint)
(zero-fee bool)
)
(begin
;; onlyRouter
(try! (only-bridge))
(try! (assert-can-swap))
(try! (assert-token ft-ref))
(asserts! (> (var-get d) u0) err-pool-is-empty)
;; return 0 if amount is 0
(asserts! (not (is-eq amount u0)) (ok u0))
(try! (contract-call? ft-ref transfer amount user (as-contract contract-caller)
none
))
(let (
(old-v (var-get vusd-balance))
(old-t (var-get token-balance))
;; compute fee
(fee0 (if zero-fee
u0
(/ (* amount (var-get fee-share-bp)) BP)
))
;; convert with system precision
(amount-in (to-system-precision (- amount fee0)))
;; incorporate rounding dust into the fee
(fee (- amount (from-system-precision amount-in)))
(new-t (+ old-t amount-in))
(vusd-new (calc-y new-t (var-get d)))
(result (if (> old-v vusd-new)
(- old-v vusd-new)
u0
))
)
;; adjust balances
(var-set token-balance new-t)
(var-set vusd-balance vusd-new)
(var-set reserves (+ (var-get reserves) amount-in))
;; rewards from fee
(unwrap-panic (add-rewards fee))
;; result = max(0, old-v - vusd-new)
(print {
event: "SwappedToVUsd",
sender: user,
token: (contract-of ft-ref),
amount: amount,
vUsdAmount: result,
fee: fee,
})
(try! (assert-balance-ratio))
(ok result)
)
)
)
(define-public (swap-from-vusd
(ft-ref <ft-trait>)
(user principal)
(amount uint)
(receive-amount-min uint)
(zero-fee bool)
)
(begin
;; onlyRouter
(try! (only-bridge))
(try! (assert-can-swap))
(try! (assert-token ft-ref))
(asserts! (> (var-get d) u0) err-pool-is-empty)
;; return 0 if amount is 0
(asserts! (not (is-eq amount u0)) (ok u0))
(let (
(tb0 (var-get token-balance))
(vb0 (var-get vusd-balance))
;; vUsdBalance += amount
(vb1 (+ vb0 amount))
;; newAmount = getY(vUsdBalance)
(new-amount (calc-y vb1 (var-get d)))
;; resultSP/result in system/native precision
(result-sp (if (> tb0 new-amount)
(- tb0 new-amount)
u0
))
(result (from-system-precision result-sp))
(fee-share (var-get fee-share-bp))
(fee (if zero-fee
u0
(/ (* result fee-share) BP)
))
(result-net (- result
(if zero-fee
u0
(/ (* result fee-share) BP)
)))
)
;; require reserves
(asserts! (<= result-sp (var-get reserves)) err-not-enough-reserves)
;; reserves -= resultSP
(var-set reserves (- (var-get reserves) result-sp))
;; update balances
(var-set token-balance new-amount)
(var-set vusd-balance vb1)
;; slippage check
(asserts! (>= result-net receive-amount-min) err-slippage)
;; transfer tokens to user (pool -> user)
(unwrap-panic (as-contract (contract-call? ft-ref transfer result-net tx-sender user none)))
;; add rewards with fee
(unwrap-panic (add-rewards fee))
;; emit-like print (optional)
(print {
event: "SwappedFromVUsd",
user: user,
vUsdAmount: amount,
amount: result-net,
fee: fee,
})
(try! (assert-balance-ratio))
(ok result-net)
)
)
)
;; ============== ADMIN ===============
(define-public (set-owner (new-owner principal))
(begin
(try! (only-owner))
(var-set owner new-owner)
(ok true)
)
)
(define-public (set-fee-share (fee-share-bp_ uint))
(begin
(var-set fee-share-bp fee-share-bp_)
(only-owner)
)
)
(define-public (adjust-total-lp-amount (ft-ref <ft-trait>))
(let (
(total-lp (var-get lp-total-supply))
(d_ (var-get d))
)
(try! (assert-token ft-ref))
(try! (if (> d_ total-lp)
(deposit-lp ft-ref contract-caller (- d_ total-lp))
(ok true)
))
(only-owner)
)
)
(define-public (start-deposit)
(begin
(var-set can-deposit true)
(only-owner)
)
)
(define-public (stop-deposit)
(begin
(var-set can-deposit false)
(only-stop-authority)
)
)
(define-public (start-withdraw)
(begin
(var-set can-withdraw true)
(only-owner)
)
)
(define-public (stop-withdraw)
(begin
(var-set can-withdraw false)
(only-stop-authority)
)
)
(define-public (start-swap)
(begin
(var-set can-swap true)
(only-owner)
)
)
(define-public (stop-swap)
(begin
(var-set can-swap false)
(only-stop-authority)
)
)
(define-public (set-balance-ratio-min-bp (new-balance-ratio-min-bp uint))
(begin
(asserts! (<= new-balance-ratio-min-bp BP) err-too-large)
(var-set balance-ratio-min-bp new-balance-ratio-min-bp)
(only-owner)
)
)
(define-public (set-stop-authority (new-stop-authority principal))
(begin
(var-set stop-authority new-stop-authority)
(only-owner)
)
)
(define-public (set-bridge (new-bridge principal))
(begin
(var-set bridge (some new-bridge))
(only-owner)
)
)
;; =============== ASSERTS ===============
(define-private (assert-balance-ratio)
(let (
(tb (var-get token-balance))
(vb (var-get vusd-balance))
(min-bp (var-get balance-ratio-min-bp))
)
(if (> tb vb)
(asserts! (>= (/ (* vb BP) tb) min-bp) err-low-vusd-balance)
(asserts! (>= (/ (* tb BP) vb) min-bp) err-low-token-balance)
)
(ok true)
)
)
(define-private (assert-token (ft-ref <ft-trait>))
(let ((configured-token (unwrap! (var-get token-principal) err-not-initialized)))
(asserts! (is-eq configured-token (contract-of ft-ref)) err-wrong-token)
(ok true)
)
)
(define-private (assert-can-deposit)
(begin
(asserts! (var-get can-deposit) err-deposit-prohibited)
(ok true)
)
)
(define-private (assert-can-withdraw)
(begin
(asserts! (var-get can-withdraw) err-withdraw-prohibited)
(ok true)
)
)
(define-private (assert-can-swap)
(begin
(asserts! (var-get can-swap) err-swap-prohibited)
(ok true)
)
)
(define-private (only-owner)
(if (is-eq contract-caller (var-get owner))
(ok true)
err-unauthorized
)
)
(define-private (only-stop-authority)
(if (is-eq contract-caller (var-get stop-authority))
(ok true)
err-unauthorized
)
)
(define-private (only-bridge)
(let ((configured-bridge (unwrap! (var-get bridge) err-not-initialized)))
(asserts! (is-eq contract-caller configured-bridge) err-unauthorized)
(ok true)
)
)
(define-public (set-admin-fee-share-bp (new-admin-fee-share-bp uint))
(begin
(asserts! (<= new-admin-fee-share-bp BP) err-too-large)
(var-set admin-fee-share-bp new-admin-fee-share-bp)
(only-owner)
)
)
(define-public (claim-admin-fee (ft-ref <ft-trait>))
(let (
(fee-amount (var-get admin-fee-amount))
(caller contract-caller)
)
(try! (assert-token ft-ref))
(asserts! (> fee-amount u0) (ok true))
(var-set admin-fee-amount u0)
(try! (as-contract (contract-call? ft-ref transfer fee-amount contract-caller caller none)))
(only-owner)
)
)
;; =============== MATH ===============
(define-read-only (calc-d
(x uint)
(y uint)
)
(let (
;; base values
(xy (* x y))
(xpy (+ x y))
(four-a (* u4 a))
(four-a-minus-1 (if (> four-a u1)
(- four-a u1)
u0
))
;; max(4a-1, 0)
;; p = 4xy(4a-1)
(p (* u4 (* xy four-a-minus-1)))
;; B = a^2(x+y)^2 + xy*(4a-1)^3 / 27
(a-sq (* a a))
(xpy-sq (* xpy xpy))
(left (* a-sq xpy-sq))
(fa1-cubed (* four-a-minus-1 (* four-a-minus-1 four-a-minus-1)))
(right (/ (* xy fa1-cubed) u27))
(B (+ left right))
;; u^3 = 8xy * ( a(x+y) + sqrt(B) )
(K (* u8 xy))
(a-times-xpy (* a xpy))
(sqrt-B (sqrti B))
(u-cubed (* K (+ a-times-xpy sqrt-B)))
(u (cbrt u-cubed))
)
;; d = u - p/(3*u)
(if (is-eq u u0)
u0
(let (
(den (* u3 u)) ;; 3*u
(term (/ p den))
)
(if (> u term)
(- u term)
u0
)
)
)
)
)
(define-read-only (calc-y
(x uint)
(d_ uint)
)
(let (
;; common terms
(four-a (* u4 a)) ;; 4a
(den (* four-a x)) ;; 4*a*x (assume a>0, x>0 in normal use)
;; d^3 / (4*a*x)
(d2 (* d_ d_))
(d3 (* d2 d_))
(term-a (/ d3 den)) ;; integer division
;; t = x - d + d/(4a) (compute via sign + absolute value for uint)
(d-over-4a (/ d_ four-a)) ;; d/(4a) (integer division)
(x_plus (+ x d-over-4a)) ;; x + d/(4a)
(t-is-nonneg (>= x_plus d_))
(t-abs (if t-is-nonneg
(- x_plus d_)
(- d_ x_plus)
))
;; |t|
(t-abs2 (* t-abs t-abs)) ;; t^2 = (|t|)^2
;; sqrt argument
(under-root (+ term-a t-abs2))
(root (sqrti under-root)) ;; floor sqrt
;; numerator = root - t (if t>=0) or root + |t| (if t<0)
(numerator (if t-is-nonneg
(if (> root t-abs)
(- root t-abs)
u0
)
(+ root t-abs)
))
)
(/ numerator u2)
)
)
;; =============== REWARD MANAGER ===============
(define-public (claim-rewards (ft-ref <ft-trait>))
(let (
(caller contract-caller)
;; accumulator value
(acc (var-get acc-reward-per-share-p))
;; current user LP balance
(user-lp (default-to u0 (map-get? lp-balances caller)))
;; compute pending only if user had LP before
(rewards (if (> user-lp u0)
(bit-shift-right (* user-lp acc) P)
u0
))
(prev-debt (default-to u0 (map-get? user-reward-debt caller)))
(pending (if (> rewards prev-debt)
(- rewards prev-debt)
u0
))
)
(try! (assert-token ft-ref))
;; pay pending rewards if any
(if (> pending u0)
;; transfer rewards from this contract to `to`
(begin
;; update user reward debt to current accumulator
(map-set user-reward-debt caller rewards)
(print {
event: "RewardsClaimed",
to: caller,
pending: pending,
})
(as-contract (contract-call? ft-ref transfer pending contract-caller caller none))
)
(ok true)
)
)
)
(define-private (deposit-lp
(ft-ref <ft-trait>)
(to principal)
(lp-amount uint)
)
(let (
;; accumulator value
(acc (var-get acc-reward-per-share-p))
;; current user LP balance
(user-lp (default-to u0 (map-get? lp-balances to)))
;; compute pending only if user had LP before
(gross-pending (if (> user-lp u0)
(bit-shift-right (* user-lp acc) P)
u0
))
(prev-debt (default-to u0 (map-get? user-reward-debt to)))
(pending (if (> gross-pending prev-debt)
(- gross-pending prev-debt)
u0
))
;; mint: increase user balance and total supply
(new-user-lp (+ user-lp lp-amount))
(total-supply (+ (var-get lp-total-supply) lp-amount))
)
(try! (assert-token ft-ref))
;; persist LP balance and total supply
(map-set lp-balances to new-user-lp)
(var-set lp-total-supply total-supply)
;; update user reward debt to current accumulator
(map-set user-reward-debt to (bit-shift-right (* new-user-lp acc) P))
;; pay pending rewards if any
(if (> pending u0)
;; transfer rewards from this contract to `to`
(begin
(print {
event: "RewardsClaimed",
to: to,
pending: pending,
})
(try! (as-contract (contract-call? ft-ref transfer pending contract-caller to none)))
)
true
)
;; optional logs
(print {
event: "Deposit",
to: to,
lpAmount: lp-amount,
})
(ok true)
)
)
(define-private (withdraw-lp
(ft-ref <ft-trait>)
(from principal)
(lp-amount uint)
)
(let (
;; current user LP balance
(user-lp (default-to u0 (map-get? lp-balances from)))
)
;; ensure correct token
(try! (assert-token ft-ref))
;; require user-lp >= lp-amount
(asserts! (>= user-lp lp-amount) err-not-enough-lp)
;; compute pending if user had LP
(let (
(acc (var-get acc-reward-per-share-p))
(gross-pending (if (> user-lp u0)
(bit-shift-right (* user-lp acc) P)
u0
))
(prev-debt (default-to u0 (map-get? user-reward-debt from)))
(pending (if (> gross-pending prev-debt)
(- gross-pending prev-debt)
u0
))
;; burn LP: decrease user balance and total supply
(new-user-lp (- user-lp lp-amount))
(new-total-supply (- (var-get lp-total-supply) lp-amount))
)
;; persist balances
(map-set lp-balances from new-user-lp)
(var-set lp-total-supply new-total-supply)
;; update user reward debt to current accumulator
(map-set user-reward-debt from (bit-shift-right (* new-user-lp acc) P))
;; transfer pending rewards if any
(if (> pending u0)
(begin
(print {
event: "RewardsClaimed",
to: from,
pending: pending,
})
(try! (as-contract (contract-call? ft-ref transfer pending contract-caller from none)))
)
true
)
;; emit-like log
(print {
event: "Withdraw",
from: from,
lpAmount: lp-amount,
})
(ok true)
)
)
)
;; _addRewards(rewardAmount):
;; if totalSupply > 0:
;; adminFeeRewards = rewardAmount * adminFeeShareBP / BP
;; rewardAmount -= adminFeeRewards
;; accRewardPerShareP += (rewardAmount << P) / totalSupply
;; adminFeeAmount += adminFeeRewards
(define-private (add-rewards (amount uint))
(let ((supply (var-get lp-total-supply)))
(if (> supply u0)
(let (
(admin-bp (var-get admin-fee-share-bp))
(admin-fee (/ (* amount admin-bp) BP))
(net-reward (- amount admin-fee))
(delta (/ (bit-shift-left net-reward P) supply))
(new-acc (+ (var-get acc-reward-per-share-p) delta))
(new-admin (+ (var-get admin-fee-amount) admin-fee))
)
(begin
(var-set acc-reward-per-share-p new-acc)
(var-set admin-fee-amount new-admin)
(ok true)
)
)
(ok true)
)
)
)
;; ==================== VIEW ====================
(define-read-only (get-token-address)
(ok (unwrap! (var-get token-principal) err-not-initialized))
)
(define-read-only (get-token-balance)
(var-get token-balance)
)
(define-read-only (get-vusd-balance)
(var-get vusd-balance)
)
(define-read-only (get-reserves)
(var-get reserves)
)
(define-read-only (get-d)
(var-get d)
)
(define-read-only (get-lp-balance (user principal))
(default-to u0 (map-get? lp-balances user))
)
(define-read-only (get-owner)
(var-get owner)
)
(define-read-only (get-bridge)
(var-get bridge)
)
(define-read-only (get-user-reward-debt (user principal))
(default-to u0 (map-get? user-reward-debt user))
)
(define-read-only (get-lp-total-supply)
(var-get lp-total-supply)
)
(define-read-only (get-acc-reward-per-share-p)
(var-get acc-reward-per-share-p)
)
(define-read-only (get-admin-fee-amount)
(var-get admin-fee-amount)
)
(define-read-only (get-admin-fee-share-bp)
(var-get admin-fee-share-bp)
)
(define-read-only (get-fee-share-bp)
(var-get fee-share-bp)
)
(define-read-only (get-balance-ratio-min-bp)
(var-get balance-ratio-min-bp)
)
(define-read-only (get-can-deposit)
(var-get can-deposit)
)
(define-read-only (get-can-withdraw)
(var-get can-withdraw)
)
(define-read-only (get-can-swap)
(var-get can-swap)
)
(define-read-only (get-stop-authority)
(var-get stop-authority)
)
(define-read-only (pending-rewards (user principal))
(let (
;; accumulator value
(acc (var-get acc-reward-per-share-p))
;; current user LP balance
(user-lp (default-to u0 (map-get? lp-balances user)))
(prev-debt (default-to u0 (map-get? user-reward-debt user)))
)
(ok (- (bit-shift-right (* user-lp acc) P) prev-debt))
)
)
;; ==================== CUBIC ROOT ====================
(define-private (le-cube?
(x uint)
(n uint)
)
(let ((q (/ n x)))
(<= x (/ q x))
)
)
(define-private (newton-step
(n uint)
(x uint)
)
(let (
(q1 (/ n x))
(q2 (/ q1 x))
)
(/ (+ (bit-shift-left x u1) q2) u3)
)
)
(define-private (refine
(n uint)
(x uint)
)
(let (
(x0 (if (le-cube? x n)
x
(- x u1)
))
(xp (+ x u1))
)
(if (le-cube? xp n)
xp
x0
)
)
)
(define-read-only (cbrt (n uint))
(if (is-eq n u0)
u0
(let (
(k (/ (log2 n) u3))
(x0 (bit-shift-left u1 k))
(x1 (newton-step n x0))
(x2 (newton-step n x1))
(x3 (newton-step n x2))
(x4 (newton-step n x3))
(x5 (newton-step n x4))
(x6 (newton-step n x5))
(x7 (newton-step n x6))
)
(refine n x7)
)
)
)