(impl-trait .registry-trait-vpv-15.registry-trait)
(use-trait sorted-vaults-trait .sorted-vaults-trait-vpv-15.sorted-vaults-trait)
(define-constant ERR_MODE_PAUSED (err u200))
(define-constant ERR_MODE_RECOVERY (err u201))
(define-constant ERR_VAULT_RATIO_THRESHOLD (err u202))
(define-constant ERR_GLOBAL_RATIO_THRESHOLD (err u203))
(define-constant ERR_LIST_OVERFLOW (err u204))
(define-constant ERR_VAULT_NOT_FOUND (err u205))
(define-constant ERR_LIST_LENGTH (err u206))
(define-constant ERR_INVALID_LIST (err u207))
(define-constant ERR_INVALID_SORT (err u208))
(define-constant ERR_SLICE (err u209))
(define-constant ERR_VAULT_HEALTHY (err u210))
(define-constant ERR_PROVIDER_NOT_FOUND (err u211))
(define-constant ERR_ORACLE_PRICE_NOT_FOUND (err u212))
(define-constant ERR_PROTOCOL_DATA (err u213))
(define-constant ERR_INVALID_EPOCH (err u214))
(define-constant ERR_NO_KEEPER (err u215))
(define-constant ERR_AUTH (err u216))
(define-constant ERR_NO_ADMIN (err u217))
(define-constant ERR_MODE_MAINTENANCE (err u218))
(define-constant ERR_BASE_RATE (err u219))
(define-constant ERR_ACCRUED_INTEREST (err u220))
(define-constant ERR_INVALID_VALUE (err u221))
(define-constant ERR_REDEEM_UNHEALTHY (err u222))
(define-constant ERR_STAKES (err u223))
(define-constant ERR_PRODUCT_ZERO (err u224))
(define-constant ERR_MIN_POOL_BALANCE (err u225))
(define-constant contract-deployer tx-sender)
(define-constant PROTOCOL_STATE_NORMAL u0)
(define-constant PROTOCOL_STATE_PAUSED u1)
(define-constant PROTOCOL_STATE_MAINTENANCE u2)
(define-constant half-day u72)
(define-constant full-day (* half-day u2))
(define-constant year (* full-day u365))
(define-constant PRECISION u8)
(define-constant ONE_FULL_UNIT u100000000)
;; precision
(define-constant STABILITY_PRECISION u10000000000000000)
;; (define-constant STABILITY_PRECISION ONE_FULL_UNIT)
;; Scaling factor constants for stability product to avoid precision loss
;; Similar to Liquity's StabilityPool implementation
(define-constant SCALE_FACTOR u10000) ;; 1e4
(define-constant MAX_SCALE u8) ;; max scaling operations before a provider's balance is zeroed out
(define-constant MIN_TIMELOCK_DELAY u1)
(define-data-var vault-collateral-ratio-threshold uint u110000000)
(define-data-var vault-recovery-ratio-threshold uint u150000000)
(define-data-var global-collateral-ratio-threshold uint u125000000)
(define-data-var alpha uint (/ ONE_FULL_UNIT u2))
(define-data-var delta uint u94000000)
(define-data-var block-decay-rates (list 500 uint) (list u100000000 u98974042 u97958611 u96953597 u95958894 u94974397 u94000000
u93035600 u92081094 u91136381 u90201361 u89275933 u88360000 u87453464 u86556229
u85668198 u84789279 u83919377 u83058400 u82206256 u81362855 u80528107 u79701922
u78884215 u78074896 u77273881 u76481084 u75696420 u74919807 u74151162 u73390402
u72637448 u71892219 u71154635 u70424619 u69702092 u68986978 u68279201 u67578685
u66885357 u66199141 u65519966 u64847759 u64182449 u63523964 u62872235 u62227193
u61588768 u60956894 u60331502 u59712526 u59099901 u58493561 u57893442 u57299480
u56711612 u56129775 u55553907 u54983948 u54419836 u53861511 u53308915 u52761988
u52220673 u51684911 u51154646 u50629821 u50110380 u49596269 u49087432 u48583816
u48085367 u47592031 u47103757 u46620493 u46142186 u45668787 u45200245 u44736510
u44277532 u43823263 u43373655 u42928660 u42488230 u42052319 u41620880 u41193868
u40771236 u40352940 u39938936 u39529180 u39123627 u38722235 u38324962 u37931764
u37542600 u37157429 u36776210 u36398901 u36025464 u35655858 u35290044 u34927983
u34569637 u34214967 u33863936 u33516507 u33172642 u32832304 u32495459 u32162069
u31832100 u31505516 u31182283 u30862366 u30545731 u30232345 u29922174 u29615185
u29311346 u29010624 u28712987 u28418404 u28126844 u27838274 u27552665 u27269987
u26990208 u26713300 u26439233 u26167978 u25899505 u25633787 u25370796 u25110502
u24852879 u24597899 u24345535 u24095760 u23848548 u23603872 u23361706 u23122025
u22884803 u22650015 u22417635 u22187640 u21960004 u21734704 u21511715 u21291014
u21072577 u20856381 u20642404 u20430621 u20221012 u20013553 u19808222 u19604998
u19403859 u19204784 u19007751 u18812740 u18619729 u18428699 u18239628 u18052497
u17867286 u17683975 u17502545 u17322977 u17145250 u16969347 u16795249 u16622937
u16452393 u16283598 u16116535 u15951186 u15787534 u15625561 u15465249 u15306582
u15149543 u14994115 u14840282 u14688027 u14537334 u14388187 u14240571 u14094468
u13949865 u13806745 u13665094 u13524896 u13386136 u13248800 u13112873 u12978341
u12845188 u12713402 u12582968 u12453872 u12326101 u12199640 u12074477 u11950598
u11827990 u11706640 u11586535 u11467662 u11350008 u11233562 u11118311 u11004241
u10891343 u10779602 u10669008 u10559548 u10451212 u10343987 u10237862 u10132826
u10028867 u9925976 u9824139 u9723348 u9623590 u9524856 u9427135 u9330417
u9234691 u9139947 u9046175 u8953365 u8861507 u8770592 u8680609 u8591550
u8503404 u8416163 u8329817 u8244356 u8159773 u8076057 u7993200 u7911193
u7830028 u7749695 u7670187 u7591494 u7513608 u7436522 u7360226 u7284713
u7209975 u7136004 u7062792 u6990330 u6918613 u6847631 u6777377 u6707844
u6639024 u6570911 u6503496 u6436773 u6370734 u6305373 u6240683 u6176656
u6113286 u6050566 u5988490 u5927051 u5866242 u5806057 u5746489 u5687532
u5629181 u5571428 u5514267 u5457693 u5401700 u5346280 u5291430 u5237142
u5183411 u5130232 u5077598 u5025504 u4973944 u4922914 u4872407 u4822418
u4772942 u4723973 u4675507 u4627539 u4580062 u4533073 u4486565 u4440535
u4394977 u4349886 u4305258 u4261088 u4217371 u4174103 u4131278 u4088893
u4046943 u4005423 u3964329 u3923657 u3883402 u3843560 u3804126 u3765098
u3726469 u3688237 u3650398 u3612946 u3575879 u3539192 u3502881 u3466943
u3431374 u3396169 u3361326 u3326840 u3292708 u3258927 u3225491 u3192399
u3159646 u3127230 u3095146 u3063391 u3031962 u3000855 u2970068 u2939596
u2909437 u2879587 u2850044 u2820804 u2791864 u2763220 u2734871 u2706812
u2679041 u2651556 u2624352 u2597427 u2570779 u2544403 u2518299 u2492462
u2466891 u2441581 u2416532 u2391739 u2367201 u2342915 u2318877 u2295087
u2271540 u2248235 u2225169 u2202340 u2179745 u2157381 u2135248 u2113341
u2091659 u2070199 u2048960 u2027938 u2007133 u1986540 u1966159 u1945987
u1926022 u1906262 u1886705 u1867348 u1848190 u1829228 u1810461 u1791886
u1773502 u1755307 u1737298 u1719474 u1701833 u1684373 u1667092 u1649989
u1633060 u1616306 u1599723 u1583311 u1567067 u1550989 u1535077 u1519328
u1503740 u1488312 u1473043 u1457930 u1442972 u1428168 u1413516 u1399013
u1384660 u1370454 u1356394 u1342478 u1328705 u1315073 u1301581 u1288227
u1275010 u1261929 u1248982 u1236168 u1223486 u1210933 u1198510 u1186213
u1174043 u0))
(define-data-var max-hours-decay uint u72)
(define-data-var max-blocks-decay uint (* (var-get blocks-per-hour) (var-get max-hours-decay)))
(define-data-var max-decay uint u0)
(define-data-var blocks-per-hour uint u6)
(define-data-var hours-per-epoch uint u1)
(define-data-var min-borrow-fee uint u0)
(define-data-var max-borrow-fee uint (/ ONE_FULL_UNIT u20))
(define-data-var min-redeem-fee uint (/ ONE_FULL_UNIT u200))
(define-data-var max-redeem-fee uint ONE_FULL_UNIT)
(define-data-var timelock-delay uint u1)
(define-data-var min-redeem-amount uint (* u100 ONE_FULL_UNIT))
(define-data-var vault-loan-minimum uint (* u1000 ONE_FULL_UNIT))
(define-data-var vault-interest-minimum uint u0)
(define-data-var vault-interest-maximum uint ONE_FULL_UNIT)
(define-data-var global-collateral-cap uint (* u500000 ONE_FULL_UNIT))
(define-data-var protocol-fee-destination principal 'SP3W2WCEXT1H9TGB5K7V2XHNGBTBXTEB2FGZEZSD8)
(define-data-var min-stability-provider-balance uint (* u1000 ONE_FULL_UNIT))
(define-data-var epoch-genesis uint burn-block-height)
(define-data-var oracle-stale-threshold-seconds uint u300)
(define-data-var oracle-allowable-price-deviation uint u500000)
(define-data-var max-vaults-to-redeem uint u10)
(define-data-var protocol-redistribution-params {
total-stakes: uint,
total-stakes-snapshot: uint,
total-collateral-snapshot: uint,
total-sbtc-rewards-per-unit: uint,
total-bsd-rewards-per-unit: uint,
} {
total-stakes: u0,
total-stakes-snapshot: u0,
total-collateral-snapshot: u0,
total-sbtc-rewards-per-unit: u0,
total-bsd-rewards-per-unit: u0,
})
(define-data-var aggregate-debt-and-collateral {
debt-bsd: uint,
collateral-sbtc: uint,
} {
debt-bsd: u0,
collateral-sbtc: u0,
})
(define-data-var protocol-state uint PROTOCOL_STATE_NORMAL)
(define-data-var created-vaults uint u0)
(define-data-var base-rate uint u0)
(define-data-var last-redeem-height uint u0)
(define-data-var stability-pool {
aggregate-bsd: uint,
aggregate-sbtc: uint,
active: (list 1000 principal),
product: uint,
scale: uint,
} {
aggregate-bsd: u0,
aggregate-sbtc: u0,
active: (list),
product: STABILITY_PRECISION,
scale: u0,
})
(define-data-var last-processed-epoch uint u0)
(define-map vault
uint
{
borrower: principal,
created-height: uint,
borrowed-bsd: uint,
collateral-sbtc: uint,
protocol-debt-bsd: uint,
protocol-collateral-sbtc: uint,
interest-rate: uint,
last-interest-accrued: uint,
future-interest-rate: uint,
future-interest-epoch: uint,
interest-rate-delegate: principal,
stake: uint,
vault-sbtc-rewards-snapshot: uint,
vault-bsd-rewards-snapshot: uint,
}
)
(define-map vaults-per-principal
principal
(list 50 uint)
)
(define-map stability-pool-providers
principal
{
liquidity-staked: uint,
sum_t: uint,
product_t: uint,
scale_t: uint,
}
)
;; store the sum with the scale it belongs to
(define-map scale-to-sum
uint
uint
)
(map-set scale-to-sum u0 u0)
(define-map scale-to-sum-scaled
uint
bool
)
(map-set scale-to-sum-scaled u0 false)
;; get-scale-to-sum
(define-read-only (get-scale-to-sum (scale uint))
(ok (map-get? scale-to-sum scale))
)
(define-read-only (get-is-paused)
(ok (is-eq PROTOCOL_STATE_PAUSED (var-get protocol-state)))
)
(define-read-only (get-is-maintenance)
(ok (is-eq PROTOCOL_STATE_MAINTENANCE (var-get protocol-state)))
)
(define-read-only (get-protocol-fee-destination)
(ok (var-get protocol-fee-destination))
)
(define-read-only (get-stability-pool-data)
(ok (var-get stability-pool))
)
(define-read-only (get-decay-rates)
(ok (var-get block-decay-rates))
)
(define-read-only (get-stability-pool-provider (principal principal))
(ok (map-get? stability-pool-providers principal))
)
(define-read-only (get-provider-calculated-balance (principal principal))
(ok (unwrap! (calculate-compounded-deposit principal) ERR_PROVIDER_NOT_FOUND))
)
(define-public (get-active-vaults (sorted-vaults <sorted-vaults-trait>))
(ok (get total-vaults
(unwrap-panic (contract-call? sorted-vaults get-vaults-summary))
))
)
(define-read-only (get-aggregate-debt-and-collateral)
(ok (var-get aggregate-debt-and-collateral))
)
(define-read-only (get-vaults-by-principal (principal principal))
(ok (map-get? vaults-per-principal principal))
)
(define-read-only (get-vault (vault-id uint))
(ok (map-get? vault vault-id))
)
(define-read-only (calculate-collateral-ratio
(debt uint)
(collateral uint)
(sbtc-price uint)
)
(let (
(vault-collateral-in-bsd (mul-to-fixed-precision sbtc-price PRECISION collateral))
(vault-collateral-ratio (div-to-fixed-precision vault-collateral-in-bsd PRECISION
(if (is-eq u0 debt)
u1
debt
)))
)
(ok vault-collateral-ratio)
)
)
(define-read-only (get-vault-compounded-info
(vault-id uint)
(sbtc-price uint)
)
(let (
(vault-info (unwrap-panic (get-vault vault-id)))
(vault-debt (unwrap-panic (get borrowed-bsd vault-info)))
(vault-collateral (unwrap-panic (get collateral-sbtc vault-info)))
(vault-protocol-shares (unwrap-panic (get-vault-protocol-shares vault-id)))
(vault-calc-protocol-debt (get calculated-protocol-debt vault-protocol-shares))
(vault-calc-protocol-collateral (get calculated-protocol-collateral vault-protocol-shares))
(vault-attr-protocol-debt (get attributed-protocol-debt vault-protocol-shares))
(vault-attr-protocol-collateral (get attributed-protocol-collateral vault-protocol-shares))
(vault-total-debt-minus-accrual (+ vault-debt vault-calc-protocol-debt vault-attr-protocol-debt))
(accrued-interest (unwrap-panic (get-vault-accrued-interest vault-id vault-total-debt-minus-accrual)))
(vault-total-debt (+ vault-debt accrued-interest vault-calc-protocol-debt
vault-attr-protocol-debt
))
(vault-total-collateral (+ vault-collateral vault-calc-protocol-collateral
vault-attr-protocol-collateral
))
(vault-collateral-in-bsd (mul-to-fixed-precision sbtc-price PRECISION vault-total-collateral))
(vault-collateral-ratio (unwrap-panic (calculate-collateral-ratio vault-total-debt vault-total-collateral
sbtc-price
)))
)
(ok {
vault-total-debt: vault-total-debt,
vault-total-collateral: vault-total-collateral,
vault-debt: (+ vault-debt accrued-interest),
vault-collateral: vault-collateral,
vault-protocol-debt: vault-attr-protocol-debt,
vault-protocol-collateral: vault-attr-protocol-collateral,
vault-protocol-debt-calculated: vault-calc-protocol-debt,
vault-protocol-collateral-calculated: vault-calc-protocol-collateral,
vault-collateral-ratio: vault-collateral-ratio,
calculated-block: burn-block-height,
vault-accrued-interest: accrued-interest,
vault-info: {
borrower: (unwrap-panic (get borrower vault-info)),
created-height: (unwrap-panic (get created-height vault-info)),
borrowed-bsd: (unwrap-panic (get borrowed-bsd vault-info)),
collateral-sbtc: (unwrap-panic (get collateral-sbtc vault-info)),
protocol-debt-bsd: (unwrap-panic (get protocol-debt-bsd vault-info)),
protocol-collateral-sbtc: (unwrap-panic (get protocol-collateral-sbtc vault-info)),
interest-rate: (unwrap-panic (get interest-rate vault-info)),
last-interest-accrued: (unwrap-panic (get last-interest-accrued vault-info)),
future-interest-rate: (unwrap-panic (get future-interest-rate vault-info)),
future-interest-epoch: (unwrap-panic (get future-interest-epoch vault-info)),
interest-rate-delegate: (unwrap-panic (get interest-rate-delegate vault-info)),
},
})
)
)
(define-read-only (get-vault-protocol-shares (vault-id uint))
(match (map-get? vault vault-id)
current-vault (let (
(vault-collateral (get collateral-sbtc current-vault))
(vault-protocol-debt (get protocol-debt-bsd current-vault))
(vault-protocol-collateral (get protocol-collateral-sbtc current-vault))
(redistribution-params (unwrap-panic (get-redistribution-params)))
(stake (get stake current-vault))
(vault-sbtc-rewards-snapshot (get vault-sbtc-rewards-snapshot current-vault))
(vault-bsd-rewards-snapshot (get vault-bsd-rewards-snapshot current-vault))
(total-sbtc-rewards-per-unit (get total-sbtc-rewards-per-unit redistribution-params))
(total-bsd-rewards-per-unit (get total-bsd-rewards-per-unit redistribution-params))
(calculated-collateral (mul stake (- total-sbtc-rewards-per-unit vault-sbtc-rewards-snapshot)))
(calculated-bsd (mul stake (- total-bsd-rewards-per-unit vault-bsd-rewards-snapshot)))
)
(ok {
calculated-protocol-debt: calculated-bsd,
calculated-protocol-collateral: calculated-collateral,
attributed-protocol-debt: vault-protocol-debt,
attributed-protocol-collateral: vault-protocol-collateral,
})
)
(ok {
calculated-protocol-debt: u0,
calculated-protocol-collateral: u0,
attributed-protocol-debt: u0,
attributed-protocol-collateral: u0,
})
)
)
(define-read-only (get-base-rate)
(ok (var-get base-rate))
)
(define-read-only (calculate-redeem-fee-rate (bsd-amount uint))
(let (
(current-aggregate-bsd-loans (get debt-bsd (var-get aggregate-debt-and-collateral)))
(valid-ratio (asserts!
(and
(> current-aggregate-bsd-loans u0)
(> bsd-amount u0)
(>= current-aggregate-bsd-loans bsd-amount)
)
ERR_INVALID_VALUE
))
(ratio (div-to-fixed-precision bsd-amount PRECISION current-aggregate-bsd-loans))
(alpha-times-ratio (mul-to-fixed-precision
(get alpha (unwrap! (get-base-rate-constants) ERR_BASE_RATE))
PRECISION ratio
))
(decayed-base-rate (get-decayed-base-rate))
(calc-fee-rate (+ decayed-base-rate alpha-times-ratio))
(final-fee-rate (if (< calc-fee-rate (var-get min-redeem-fee))
(var-get min-redeem-fee)
(if (> calc-fee-rate (var-get max-redeem-fee))
(var-get max-redeem-fee)
calc-fee-rate
)
))
)
(ok final-fee-rate)
)
)
(define-read-only (get-borrow-fee-rate (recovery-mode bool))
(let (
(decayed-base-rate (get-decayed-base-rate))
(final-fee-rate (if (< decayed-base-rate (var-get min-borrow-fee))
(var-get min-borrow-fee)
(if (> decayed-base-rate (var-get max-borrow-fee))
(var-get max-borrow-fee)
decayed-base-rate
)
))
)
(if recovery-mode
(ok u0)
(ok final-fee-rate)
)
)
)
(define-read-only (get-base-rate-constants)
(ok {
alpha: (var-get alpha),
delta: (var-get delta),
})
)
(define-read-only (get-redistribution-params)
(ok (var-get protocol-redistribution-params))
)
(define-public (set-processed-epoch (new-epoch uint))
(let ((keeper (unwrap-panic (contract-call? .controller-vpv-15 is-keeper tx-sender))))
(asserts! keeper ERR_AUTH)
(asserts! (<= new-epoch (get-current-epoch)) ERR_INVALID_EPOCH)
(var-set last-processed-epoch new-epoch)
(ok true)
)
)
(define-public (set-protocol-state (new-state uint))
(begin
(try! (contract-call? .controller-vpv-15 is-admin tx-sender))
(asserts!
(or
(is-eq new-state PROTOCOL_STATE_NORMAL)
(is-eq new-state PROTOCOL_STATE_PAUSED)
(is-eq new-state PROTOCOL_STATE_MAINTENANCE)
)
ERR_INVALID_VALUE
)
(var-set protocol-state new-state)
(ok true)
)
)
(define-public (hot-pause)
(begin
(try! (contract-call? .controller-vpv-15 is-hot-pause-caller tx-sender))
(var-set protocol-state PROTOCOL_STATE_PAUSED)
(ok true)
)
)
(define-public (set-decay-parameters
(new-max-hours-decay uint)
(new-block-decay-rates (list 500 uint))
)
(begin
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(asserts!
(is-eq (len new-block-decay-rates)
(+ u1 (* new-max-hours-decay (var-get blocks-per-hour)))
)
ERR_INVALID_VALUE
)
(var-set max-hours-decay new-max-hours-decay)
(var-set block-decay-rates new-block-decay-rates)
(ok true)
)
)
(define-public (set-borrow-parameters
(new-min-borrow-fee (optional uint))
(new-max-borrow-fee (optional uint))
(new-loan-minimum (optional uint))
)
(begin
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(match new-min-borrow-fee
min-borrow-fee-value (var-set min-borrow-fee min-borrow-fee-value)
false
)
(match new-max-borrow-fee
max-borrow-fee-value (var-set max-borrow-fee max-borrow-fee-value)
false
)
(match new-loan-minimum
loan-minimum-value (var-set vault-loan-minimum loan-minimum-value)
false
)
;; Validate that max-borrow-fee > min-borrow-fee after updates
(asserts! (> (var-get max-borrow-fee) (var-get min-borrow-fee))
ERR_INVALID_VALUE
)
(ok true)
)
)
(define-public (set-redeem-parameters
(new-min-redeem-fee (optional uint))
(new-max-redeem-fee (optional uint))
(new-alpha (optional uint))
(new-min-redeem-amount (optional uint))
(new-max-vaults-to-redeem (optional uint))
)
(begin
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(match new-min-redeem-fee
min-redeem-fee-value (var-set min-redeem-fee min-redeem-fee-value)
false
)
(match new-max-redeem-fee
max-redeem-fee-value (var-set max-redeem-fee max-redeem-fee-value)
false
)
(match new-alpha
alpha-value (var-set alpha alpha-value)
false
)
(match new-min-redeem-amount
min-redeem-amount-value (var-set min-redeem-amount min-redeem-amount-value)
false
)
(match new-max-vaults-to-redeem
max-vaults-to-redeem-value (var-set max-vaults-to-redeem max-vaults-to-redeem-value)
false
)
;; Validate constraints after updates
(asserts! (> (var-get max-redeem-fee) (var-get min-redeem-fee))
ERR_INVALID_VALUE
)
(asserts! (> (var-get max-vaults-to-redeem) u0) ERR_INVALID_VALUE)
(ok true)
)
)
(define-public (set-vault-parameters
(new-interest-minimum (optional uint))
(new-interest-maximum (optional uint))
(new-vault-collateral-ratio-threshold (optional uint))
(new-vault-recovery-ratio-threshold (optional uint))
)
(begin
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(match new-interest-minimum
interest-minimum-value (var-set vault-interest-minimum interest-minimum-value)
false
)
(match new-interest-maximum
interest-maximum-value (var-set vault-interest-maximum interest-maximum-value)
false
)
(match new-vault-collateral-ratio-threshold
vault-collateral-ratio-threshold-value (var-set vault-collateral-ratio-threshold
vault-collateral-ratio-threshold-value
)
false
)
(match new-vault-recovery-ratio-threshold
vault-recovery-ratio-threshold-value (var-set vault-recovery-ratio-threshold
vault-recovery-ratio-threshold-value
)
false
)
;; Validate constraints after updates
(asserts!
(> (var-get vault-recovery-ratio-threshold)
(var-get vault-collateral-ratio-threshold)
)
ERR_INVALID_VALUE
)
(ok true)
)
)
(define-public (set-global-parameters
(new-global-collateral-ratio-threshold (optional uint))
(new-global-collateral-cap (optional uint))
(new-protocol-fee-destination (optional principal))
(new-min-stability-provider-balance (optional uint))
(new-epoch-genesis (optional uint))
(new-hours-per-epoch (optional uint))
(new-oracle-stale-threshold-seconds (optional uint))
(new-oracle-allowable-price-deviation (optional uint))
(new-timelock-delay (optional uint))
)
(begin
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(match new-global-collateral-ratio-threshold
global-collateral-ratio-threshold-value (var-set global-collateral-ratio-threshold
global-collateral-ratio-threshold-value
)
false
)
(match new-global-collateral-cap
global-collateral-cap-value (var-set global-collateral-cap global-collateral-cap-value)
false
)
(match new-protocol-fee-destination
protocol-fee-destination-value (var-set protocol-fee-destination protocol-fee-destination-value)
false
)
(match new-min-stability-provider-balance
min-stability-provider-balance-value (var-set min-stability-provider-balance
min-stability-provider-balance-value
)
false
)
(match new-epoch-genesis
epoch-genesis-value (var-set epoch-genesis epoch-genesis-value)
false
)
(match new-hours-per-epoch
hours-per-epoch-value (var-set hours-per-epoch hours-per-epoch-value)
false
)
(match new-oracle-stale-threshold-seconds
oracle-stale-threshold-seconds-value (var-set oracle-stale-threshold-seconds
oracle-stale-threshold-seconds-value
)
false
)
(match new-oracle-allowable-price-deviation
oracle-allowable-price-deviation-value (var-set oracle-allowable-price-deviation
oracle-allowable-price-deviation-value
)
false
)
(match new-timelock-delay
timelock-delay-value (var-set timelock-delay timelock-delay-value)
false
)
;; Validate constraints after updates
(asserts! (> (var-get global-collateral-ratio-threshold) ONE_FULL_UNIT)
ERR_INVALID_VALUE
)
(asserts! (>= (var-get timelock-delay) MIN_TIMELOCK_DELAY) ERR_INVALID_VALUE)
(ok true)
)
)
(define-read-only (get-last-processed-epoch)
(var-get last-processed-epoch)
)
(define-read-only (get-oracle-stale-threshold-seconds)
(ok (var-get oracle-stale-threshold-seconds))
)
(define-read-only (get-oracle-allowable-price-deviation)
(ok (var-get oracle-allowable-price-deviation))
)
(define-read-only (get-timelock-delay)
(ok (var-get timelock-delay))
)
(define-read-only (get-vault-protocol-info (sbtc-price uint))
(let (
(aggregate-amounts (var-get aggregate-debt-and-collateral))
(total-debt-bsd (get debt-bsd aggregate-amounts))
(total-collateral-in-sbtc (get collateral-sbtc aggregate-amounts))
(total-collateral-in-bsd (mul-to-fixed-precision total-collateral-in-sbtc PRECISION sbtc-price))
(global-threshold (var-get global-collateral-ratio-threshold))
(denominator (if (is-eq u0 total-debt-bsd)
u1
total-debt-bsd
))
(global-ratio (div-to-fixed-precision total-collateral-in-bsd PRECISION denominator))
(recovery-mode (< global-ratio global-threshold))
)
(ok {
current-oracle-price-sbtc: sbtc-price,
total-bsd-loans: (get debt-bsd (var-get aggregate-debt-and-collateral)),
total-sbtc-collateral: (get collateral-sbtc (var-get aggregate-debt-and-collateral)),
total-collateral-in-bsd: total-collateral-in-bsd,
recovery-mode: recovery-mode,
latest-vault-id: (var-get created-vaults),
is-paused: (is-eq PROTOCOL_STATE_PAUSED (var-get protocol-state)),
is-maintenance: (is-eq PROTOCOL_STATE_MAINTENANCE (var-get protocol-state)),
vault-threshold: (var-get vault-collateral-ratio-threshold),
recovery-threshold: (var-get vault-recovery-ratio-threshold),
global-collateral-cap: (var-get global-collateral-cap),
protocol-fee-destination: (var-get protocol-fee-destination),
vault-loan-minimum: (var-get vault-loan-minimum),
vault-interest-minimum: (var-get vault-interest-minimum),
vault-interest-maximum: (var-get vault-interest-maximum),
oracle-stale-threshold-seconds: (var-get oracle-stale-threshold-seconds),
oracle-allowable-price-deviation: (var-get oracle-allowable-price-deviation),
borrow-fee-rate: (unwrap-panic (get-borrow-fee-rate recovery-mode)),
})
)
)
(define-public (get-protocol-data
(sbtc-price uint)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(aggregate-amounts (var-get aggregate-debt-and-collateral))
(total-debt-bsd (get debt-bsd aggregate-amounts))
(total-collateral-in-sbtc (get collateral-sbtc aggregate-amounts))
(total-collateral-in-bsd (mul-to-fixed-precision total-collateral-in-sbtc PRECISION sbtc-price))
(global-threshold (var-get global-collateral-ratio-threshold))
(denominator (if (is-eq u0 total-debt-bsd)
u1
total-debt-bsd
))
(global-ratio (div-to-fixed-precision total-collateral-in-bsd PRECISION denominator))
(recovery-mode (< global-ratio global-threshold))
)
(ok (merge {
current-oracle-price-sbtc: sbtc-price,
global-ratio: global-ratio,
recovery-mode: recovery-mode,
total-collateral-in-bsd: total-collateral-in-bsd,
}
(unwrap-panic (get-protocol-attributes sorted-vaults))
))
)
)
(define-public (get-protocol-attributes (sorted-vaults <sorted-vaults-trait>))
(ok {
total-bsd-loans: (get debt-bsd (var-get aggregate-debt-and-collateral)),
total-sbtc-collateral: (get collateral-sbtc (var-get aggregate-debt-and-collateral)),
active-vaults: (get total-vaults
(unwrap-panic (contract-call? sorted-vaults get-vaults-summary))
),
created-vaults: (var-get created-vaults),
is-paused: (is-eq PROTOCOL_STATE_PAUSED (var-get protocol-state)),
is-maintenance: (is-eq PROTOCOL_STATE_MAINTENANCE (var-get protocol-state)),
base-rate: (var-get base-rate),
last-redeem-height: (var-get last-redeem-height),
vault-threshold: (var-get vault-collateral-ratio-threshold),
recovery-threshold: (var-get vault-recovery-ratio-threshold),
global-threshold: (var-get global-collateral-ratio-threshold),
global-collateral-cap: (var-get global-collateral-cap),
protocol-fee-destination: (var-get protocol-fee-destination),
epoch-genesis: (var-get epoch-genesis),
alpha: (var-get alpha),
delta: (var-get delta),
min-borrow-fee: (var-get min-borrow-fee),
max-borrow-fee: (var-get max-borrow-fee),
min-redeem-fee: (var-get min-redeem-fee),
max-redeem-fee: (var-get max-redeem-fee),
min-redeem-amount: (var-get min-redeem-amount),
max-vaults-to-redeem: (var-get max-vaults-to-redeem),
min-stability-provider-balance: (var-get min-stability-provider-balance),
max-decay: (var-get max-decay),
max-hours-decay: (var-get max-hours-decay),
blocks-per-hour: (var-get blocks-per-hour),
vault-loan-minimum: (var-get vault-loan-minimum),
vault-interest-minimum: (var-get vault-interest-minimum),
vault-interest-maximum: (var-get vault-interest-maximum),
hours-per-epoch: (var-get hours-per-epoch),
oracle-stale-threshold-seconds: (var-get oracle-stale-threshold-seconds),
oracle-allowable-price-deviation: (var-get oracle-allowable-price-deviation),
timelock-delay: (var-get timelock-delay),
})
)
(define-public (new-vault
(borrower principal)
(collateral-sbtc uint)
(loan-bsd uint)
(interest-rate uint)
(hint (optional uint))
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(current-vault-id (var-get created-vaults))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-epoch (get-current-epoch))
(next-epoch (+ current-epoch u1))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(map-set vaults-per-principal tx-sender
(unwrap!
(as-max-len?
(append (default-to (list) (map-get? vaults-per-principal tx-sender))
current-vault-id
)
u50
)
ERR_LIST_OVERFLOW
))
(map-set vault current-vault-id {
borrower: tx-sender,
created-height: burn-block-height,
borrowed-bsd: loan-bsd,
collateral-sbtc: collateral-sbtc,
protocol-debt-bsd: u0,
protocol-collateral-sbtc: u0,
interest-rate: interest-rate,
last-interest-accrued: burn-block-height,
future-interest-rate: interest-rate,
future-interest-epoch: next-epoch,
interest-rate-delegate: tx-sender,
stake: u0,
vault-sbtc-rewards-snapshot: u0,
vault-bsd-rewards-snapshot: u0,
})
(var-set aggregate-debt-and-collateral {
debt-bsd: (+ (get debt-bsd current-aggregate) loan-bsd),
collateral-sbtc: (+ (get collateral-sbtc current-aggregate) collateral-sbtc),
})
;; add to redeemable vaults
(try! (contract-call? sorted-vaults insert current-vault-id interest-rate hint))
(if (> current-vault-id u0)
(try! (update-stake-and-total-stakes current-vault-id collateral-sbtc))
(initialize-total-stakes current-vault-id collateral-sbtc)
)
(ok (var-set created-vaults (+ current-vault-id u1)))
)
)
(define-public (mint-loan
(vault-id uint)
(borrow-bsd uint)
(sbtc-price uint)
)
(let (
(attributed (attribute-protocol-balances vault-id))
(vault-balances (unwrap-panic (get-vault-compounded-info vault-id sbtc-price)))
(vault-debt (get vault-debt vault-balances))
(vault-collateral (get vault-collateral vault-balances))
(vault-protocol-collateral (get vault-protocol-collateral vault-balances))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-aggregate-bsd (get debt-bsd current-aggregate))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ vault-collateral vault-protocol-collateral)
))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge (var-get aggregate-debt-and-collateral) { debt-bsd: (+ current-aggregate-bsd borrow-bsd) })
)
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) { borrowed-bsd: (+ vault-debt borrow-bsd) })
)
(ok true)
)
)
(define-public (repay-loan
(vault-id uint)
(repay-amount uint)
(sbtc-price uint)
)
(let (
(attributed (attribute-protocol-balances vault-id))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-aggregate-bsd (get debt-bsd current-aggregate))
(vault-balances (unwrap-panic (get-vault-compounded-info vault-id sbtc-price)))
(vault-debt (get vault-debt vault-balances))
(vault-protocol-debt (get vault-protocol-debt vault-balances))
(vault-collateral (get vault-collateral vault-balances))
(vault-protocol-collateral (get vault-protocol-collateral vault-balances))
(new-vault-debt (if (> repay-amount vault-debt)
u0
(- vault-debt repay-amount)
))
(new-protocol-debt (if (is-eq new-vault-debt u0)
(- vault-protocol-debt (- repay-amount vault-debt))
vault-protocol-debt
))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ vault-collateral vault-protocol-collateral)
))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge current-aggregate { debt-bsd: (- current-aggregate-bsd repay-amount) })
)
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) {
borrowed-bsd: new-vault-debt,
protocol-debt-bsd: new-protocol-debt,
})
)
(ok true)
)
)
(define-public (add-collateral
(vault-id uint)
(add-amount uint)
(sbtc-price uint)
)
(let (
(attributed (attribute-protocol-balances vault-id))
(vault-balances (unwrap-panic (get-vault-compounded-info vault-id sbtc-price)))
(vault-collateral (get vault-collateral vault-balances))
(vault-protocol-collateral (get vault-protocol-collateral vault-balances))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-aggregate-sbtc (get collateral-sbtc current-aggregate))
(new-vault-collateral (+ vault-collateral vault-protocol-collateral add-amount))
(processed-stakes (update-stake-and-total-stakes vault-id new-vault-collateral))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge current-aggregate { collateral-sbtc: (+ current-aggregate-sbtc add-amount) })
)
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) { collateral-sbtc: (+ vault-collateral add-amount) })
)
(ok true)
)
)
(define-public (remove-collateral
(vault-id uint)
(remove-amount uint)
(sbtc-price uint)
)
(let (
(attributed (attribute-protocol-balances vault-id))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-aggregate-sbtc (get collateral-sbtc current-aggregate))
(vault-balances (unwrap-panic (get-vault-compounded-info vault-id sbtc-price)))
(vault-collateral (get vault-collateral vault-balances))
(vault-protocol-collateral (get vault-protocol-collateral vault-balances))
(new-vault-collateral (if (> remove-amount vault-collateral)
u0
(- vault-collateral remove-amount)
))
(new-protocol-collateral (if (is-eq new-vault-collateral u0)
(- vault-protocol-collateral (- remove-amount vault-collateral))
vault-protocol-collateral
))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ new-vault-collateral new-protocol-collateral)
))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge current-aggregate { collateral-sbtc: (- current-aggregate-sbtc remove-amount) })
)
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) {
collateral-sbtc: new-vault-collateral,
protocol-collateral-sbtc: new-protocol-collateral,
})
)
(ok true)
)
)
(define-public (close-vault
(vault-id uint)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(current-vault (unwrap! (map-get? vault vault-id) ERR_VAULT_NOT_FOUND))
(borrower (get borrower current-vault))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(map-delete vault vault-id)
(try! (contract-call? sorted-vaults remove vault-id))
(map-set vaults-per-principal borrower
(get new-list
(try! (fold remove-vault-id-from-principal-list
(unwrap!
(as-max-len?
(default-to (list) (map-get? vaults-per-principal borrower)) u50
)
ERR_LIST_OVERFLOW
)
(ok {
found: false,
compare-uint: vault-id,
new-list: (list),
})
))
))
(ok true)
)
)
(define-public (accrue-interest (vault-id uint))
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(current-aggregate (var-get aggregate-debt-and-collateral))
(vault-balances (unwrap-panic (get-vault-protocol-shares vault-id)))
(vault-debt (get borrowed-bsd current-vault))
(vault-protocol-debt (get attributed-protocol-debt vault-balances))
(vault-protocol-calculated-debt (get calculated-protocol-debt vault-balances))
(vault-total-debt-minus-accrual (+ vault-debt vault-protocol-debt vault-protocol-calculated-debt))
(accrued-interest (unwrap-panic (get-vault-accrued-interest vault-id vault-total-debt-minus-accrual)))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(print { accrue-interest-event: {
vault-id: vault-id,
accrued-interest: accrued-interest,
} })
(map-set vault vault-id
(merge current-vault {
borrowed-bsd: (+ vault-debt accrued-interest),
last-interest-accrued: burn-block-height,
})
)
(ok (var-set aggregate-debt-and-collateral
(merge current-aggregate { debt-bsd: (+ (get debt-bsd current-aggregate) accrued-interest) })
))
)
)
(define-read-only (get-vault-accrued-interest
(vault-id uint)
(vault-total-debt uint)
)
(match (map-get? vault vault-id)
current-vault (let (
(vault-interest-rate (get interest-rate current-vault))
(vault-last-interest-accrued (get last-interest-accrued current-vault))
(blocks-to-accrue (- burn-block-height vault-last-interest-accrued))
)
(ok (/
(*
(mul-to-fixed-precision vault-total-debt PRECISION vault-interest-rate)
blocks-to-accrue
)
year
))
)
(ok u0)
)
)
(define-public (update-interest-rate
(vault-id uint)
(new-interest-rate uint)
)
(let ((current-vault (unwrap! (map-get? vault vault-id) ERR_VAULT_NOT_FOUND)))
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(ok (map-set vault vault-id
(merge current-vault { future-interest-rate: new-interest-rate })
))
)
)
(define-public (update-delegate
(vault-id uint)
(new-rate-delegate principal)
)
(let ((current-vault (unwrap-panic (map-get? vault vault-id))))
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(ok (map-set vault vault-id
(merge current-vault { interest-rate-delegate: new-rate-delegate })
))
)
)
(define-public (update-epoch-rate
(vault-id uint)
(hint (optional uint))
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(current-vault (unwrap! (map-get? vault vault-id) ERR_VAULT_NOT_FOUND))
(future-interest-rate (get future-interest-rate current-vault))
(future-interest-epoch (get future-interest-epoch current-vault))
(current-epoch (get-current-epoch))
(next-epoch (+ current-epoch u1))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(if (<= future-interest-epoch current-epoch)
(begin
(map-set vault vault-id
(merge current-vault {
interest-rate: future-interest-rate,
future-interest-epoch: next-epoch,
})
)
(try! (contract-call? sorted-vaults reinsert vault-id future-interest-rate hint))
(ok true)
)
(ok false)
)
)
)
;; add-liquidity
(define-public (add-liquidity
(amount uint)
(provider principal)
)
(let (
(current-provider (map-get? stability-pool-providers provider))
(current-stability-pool (var-get stability-pool))
;; needed for snapshot
(current-product (get product current-stability-pool))
(current-scale (get scale current-stability-pool))
(current-sum (unwrap-panic (map-get? scale-to-sum current-scale)))
(increased-aggregate-bsd (+ (get aggregate-bsd current-stability-pool) amount))
(current-aggregate-sbtc (get aggregate-sbtc current-stability-pool))
)
;; Check that caller is protocol-caller
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
;; Different paths for new provider & existing provider
(ok (match current-provider
existing-provider (let (
(calculated-rewards (unwrap-panic (calculate-provider-rewards provider)))
(compounded-deposit (unwrap-panic (calculate-compounded-deposit provider)))
(decreased-aggregate-sbtc (- current-aggregate-sbtc calculated-rewards))
)
(print { add-liquidity-event: {
aggregate-bsd: increased-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
product: current-product,
sum: current-sum,
calculated-rewards: calculated-rewards,
compounded-deposit: compounded-deposit,
added-amount: amount,
} })
;; Update existing provider map entry
(map-set stability-pool-providers tx-sender {
liquidity-staked: (+ compounded-deposit amount),
product_t: current-product,
sum_t: current-sum,
scale_t: current-scale,
})
;; Update stability pool aggregate
(var-set stability-pool {
aggregate-bsd: increased-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
active: (get active current-stability-pool),
product: (get product current-stability-pool),
scale: (get scale current-stability-pool),
})
)
(begin
(print { add-liquidity-event: {
aggregate-bsd: increased-aggregate-bsd,
aggregate-sbtc: current-aggregate-sbtc,
product: current-product,
sum: current-sum,
calculated-rewards: u0,
compounded-deposit: amount,
added-amount: amount,
} })
;; Create new provider map entry
(map-set stability-pool-providers tx-sender {
liquidity-staked: amount,
product_t: current-product,
sum_t: current-sum,
scale_t: current-scale,
})
;; Update stability pool aggregate & add provider to active list
(var-set stability-pool {
aggregate-bsd: increased-aggregate-bsd,
aggregate-sbtc: current-aggregate-sbtc,
active: (unwrap!
(as-max-len? (append (get active current-stability-pool) provider)
u1000
)
ERR_LIST_OVERFLOW
),
product: (get product current-stability-pool),
scale: (get scale current-stability-pool),
})
)
))
)
)
(define-public (remove-liquidity
(amount uint)
(provider principal)
)
(let (
(current-stability-pool (var-get stability-pool))
(current-provider (unwrap-panic (map-get? stability-pool-providers provider)))
(aggregate-bsd (get aggregate-bsd current-stability-pool))
(decreased-aggregate-bsd (- aggregate-bsd amount))
;; enforce minimum bsd in stability pool
(valid-min-pool-balance (asserts! (> decreased-aggregate-bsd u0) ERR_MIN_POOL_BALANCE))
;; needed for snapshot
(current-product (get product current-stability-pool))
(current-scale (get scale current-stability-pool))
(current-sum (unwrap-panic (map-get? scale-to-sum current-scale)))
(calculated-rewards (unwrap-panic (calculate-provider-rewards provider)))
(compounded-deposit (unwrap-panic (calculate-compounded-deposit provider)))
(decreased-aggregate-sbtc (- (get aggregate-sbtc current-stability-pool) calculated-rewards))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
;; Update stability pool aggregate
(var-set stability-pool
(merge current-stability-pool {
aggregate-bsd: decreased-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
})
)
(print { withdraw-liquidity-event: {
aggregate-bsd: decreased-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
product: current-product,
sum: current-sum,
calculated-rewards: calculated-rewards,
compounded-deposit: compounded-deposit,
removal-amount: amount,
} })
(ok (if (is-eq amount compounded-deposit)
(begin
(print { remove-provider-event: { provider: provider } })
(map-delete stability-pool-providers provider)
;; Remove provider from active list
(var-set stability-pool
(merge current-stability-pool {
aggregate-bsd: decreased-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
active: (get new-list
(try! (fold remove-principal-from-list
(get active current-stability-pool)
(ok {
compare-principal: provider,
new-list: (list),
})
))
),
})
)
)
(map-set stability-pool-providers provider {
liquidity-staked: (- compounded-deposit amount),
product_t: current-product,
sum_t: current-sum,
scale_t: current-scale,
})
))
)
)
(define-public (claim-rewards (provider principal))
(let (
(current-provider (unwrap! (map-get? stability-pool-providers provider)
ERR_PROVIDER_NOT_FOUND
))
(current-stability-pool (var-get stability-pool))
(current-product (get product current-stability-pool))
(current-scale (get scale current-stability-pool))
(provider-scale (get scale_t current-provider))
(current-sum (unwrap-panic (map-get? scale-to-sum provider-scale)))
(current-aggregate-bsd (get aggregate-bsd current-stability-pool))
(current-aggregate-sbtc (get aggregate-sbtc current-stability-pool))
(calculated-rewards (unwrap-panic (calculate-provider-rewards provider)))
(compounded-deposit (unwrap-panic (calculate-compounded-deposit provider)))
(decreased-aggregate-sbtc (- current-aggregate-sbtc calculated-rewards))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(if (is-eq compounded-deposit u0)
(begin
(map-delete stability-pool-providers provider)
;; Remove provider from active list
(ok (var-set stability-pool
(merge current-stability-pool {
aggregate-bsd: current-aggregate-bsd,
aggregate-sbtc: decreased-aggregate-sbtc,
active: (get new-list
(try! (fold remove-principal-from-list
(get active current-stability-pool)
(ok {
compare-principal: provider,
new-list: (list),
})
))
),
})
))
)
(begin
(map-set stability-pool-providers provider {
liquidity-staked: compounded-deposit,
product_t: current-product,
sum_t: current-sum,
scale_t: current-scale,
})
;; Update stability pool aggregate
(ok (var-set stability-pool
(merge current-stability-pool { aggregate-sbtc: decreased-aggregate-sbtc })
))
)
)
)
)
(define-private (delete-vault
(vault-id uint)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(vault-info (unwrap-panic (map-get? vault vault-id)))
(borrower (get borrower vault-info))
)
(map-set vaults-per-principal borrower
(get new-list
(try! (fold remove-vault-id-from-principal-list
(unwrap!
(as-max-len?
(default-to (list) (map-get? vaults-per-principal borrower)) u50
)
ERR_LIST_OVERFLOW
)
(ok {
found: false,
compare-uint: vault-id,
new-list: (list),
})
))
))
(try! (contract-call? sorted-vaults remove vault-id))
(ok (map-delete vault vault-id))
)
)
(define-private (fully-redeem-vault
(vault-id uint)
(helper-tuple (response {
price: uint,
total-redeem-fee: uint,
total-bsd-redeemed: uint,
}
uint
))
)
(match helper-tuple
ok-tuple (let (
(updated-balances (attribute-protocol-balances vault-id))
(aggregate-balances (var-get aggregate-debt-and-collateral))
(aggregate-bsd (get debt-bsd aggregate-balances))
(aggregate-sbtc (get collateral-sbtc aggregate-balances))
(accrued (accrue-interest vault-id))
(updated-vault (unwrap-panic (map-get? vault vault-id)))
(vault-debt (get borrowed-bsd updated-vault))
(vault-protocol-debt (get protocol-debt-bsd updated-vault))
(vault-total-debt (+ vault-debt vault-protocol-debt))
(vault-collateral (get collateral-sbtc updated-vault))
(vault-protocol-collateral (get protocol-collateral-sbtc updated-vault))
(vault-total-collateral (+ vault-collateral vault-protocol-collateral))
(redeemed-bsd-in-sbtc (div-to-fixed-precision vault-total-debt PRECISION (get price ok-tuple)))
(vault-share (div-to-fixed-precision vault-total-debt PRECISION
(get total-bsd-redeemed ok-tuple)
))
(dividend (mul-to-fixed-precision vault-total-debt PRECISION
(get total-redeem-fee ok-tuple)
))
(redeem-fee-credit (div-round-down dividend (get total-bsd-redeemed ok-tuple)))
(new-vault-collateral (if (> redeemed-bsd-in-sbtc vault-collateral)
u0
(- vault-collateral redeemed-bsd-in-sbtc)
))
(new-protocol-collateral (if (is-eq new-vault-collateral u0)
(- vault-protocol-collateral (- redeemed-bsd-in-sbtc vault-collateral))
vault-protocol-collateral
))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ new-vault-collateral new-protocol-collateral redeem-fee-credit)
))
)
(print {
redeem-vault-event: {
vault-id: vault-id,
redeemed-collateral: redeemed-bsd-in-sbtc,
bsd-redeemed: vault-total-debt,
redeem-fee-credit: redeem-fee-credit,
partial: false,
vault-share: vault-share,
vault-total-debt: vault-total-debt,
vault-total-collateral: vault-total-collateral,
aggregate-debt: (get debt-bsd aggregate-balances),
aggregate-collateral: (get collateral-sbtc aggregate-balances),
total-bsd-redeemed: (get total-bsd-redeemed ok-tuple),
sbtc-price: (get price ok-tuple),
rate: (get interest-rate updated-vault),
},
})
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) {
borrowed-bsd: u0,
protocol-debt-bsd: u0,
collateral-sbtc: (+ new-vault-collateral redeem-fee-credit),
protocol-collateral-sbtc: new-protocol-collateral,
})
)
(ok {
price: (get price ok-tuple),
total-redeem-fee: (get total-redeem-fee ok-tuple),
total-bsd-redeemed: (get total-bsd-redeemed ok-tuple),
})
)
err-resp (err err-resp)
)
)
(define-private (get-decay-rate (elapsed-blocks uint))
(if (> elapsed-blocks (var-get max-blocks-decay))
(var-get max-decay)
(unwrap-panic (element-at (var-get block-decay-rates) elapsed-blocks))
)
)
(define-private (get-blocks-since-last-redeem)
(- burn-block-height (var-get last-redeem-height))
)
(define-read-only (get-current-epoch)
(let (
(blocks-per-epoch (* (var-get blocks-per-hour) (var-get hours-per-epoch)))
(genesis (var-get epoch-genesis))
(blocks-elapsed (- burn-block-height genesis))
(current-epoch (/ blocks-elapsed blocks-per-epoch))
)
current-epoch
)
)
(define-read-only (get-decayed-base-rate)
(let (
(elapsed-blocks (get-blocks-since-last-redeem))
(decay-rate (get-decay-rate elapsed-blocks))
(decayed-base-rate (mul-to-fixed-precision decay-rate u8 (var-get base-rate)))
)
decayed-base-rate
)
)
(define-read-only (calculate-provider-rewards (provider principal))
(let (
(current-provider (unwrap! (map-get? stability-pool-providers provider)
ERR_PROVIDER_NOT_FOUND
))
(current-provider-bsd (get liquidity-staked current-provider))
(provider-product (get product_t current-provider))
(provider-scale (get scale_t current-provider))
(provider-sum (get sum_t current-provider))
(deposit-sum (unwrap-panic (map-get? scale-to-sum provider-scale)))
(is-first-scaled (default-to false (map-get? scale-to-sum-scaled (+ provider-scale u1))))
(is-second-scaled (default-to false (map-get? scale-to-sum-scaled (+ provider-scale u2))))
(initial-gain (- deposit-sum provider-sum))
(first-scale-sum (default-to u0 (map-get? scale-to-sum (+ provider-scale u1))))
(first-scale-gain (/ first-scale-sum
(pow SCALE_FACTOR (if is-first-scaled
u1
u0
))
))
(second-scale-sum (default-to u0 (map-get? scale-to-sum (+ provider-scale u2))))
(second-scale-gain (/ second-scale-sum
(pow SCALE_FACTOR
(if is-second-scaled
u2
u0
))
))
(normalized-gain (+ first-scale-gain second-scale-gain initial-gain))
(calculated-rewards (/ (* current-provider-bsd normalized-gain) provider-product))
(current-stability-pool (var-get stability-pool))
(providers (get active current-stability-pool))
(aggregate-sbtc (get aggregate-sbtc current-stability-pool))
(is-last-provider (and (is-eq (len providers) u1) (is-eq provider (unwrap-panic (element-at providers u0)))))
(adjusted-rewards (if (> calculated-rewards aggregate-sbtc)
aggregate-sbtc
calculated-rewards
))
)
(ok adjusted-rewards)
)
)
(define-read-only (calculate-compounded-deposit (provider principal))
(let (
(current-provider (unwrap! (map-get? stability-pool-providers provider)
ERR_PROVIDER_NOT_FOUND
))
(current-stability-pool (var-get stability-pool))
(current-stability-pool-bsd (get aggregate-bsd current-stability-pool))
(is-last-provider (is-eq (len (get active current-stability-pool)) u1))
(current-product (get product current-stability-pool))
(current-provider-bsd (get liquidity-staked current-provider))
(current-provider-product (get product_t current-provider))
(provider-scale (get scale_t current-provider))
(current-scale (get scale current-stability-pool))
;; Calculate scale difference
(scale-difference (- current-scale provider-scale))
;; compoundedDeposit = initialDeposit * P / snapshots.P / SCALE_FACTOR ** scaleDiff;
;; Calculate compounded deposit based on scale difference
(calculated-deposit (/ (/ (* current-provider-bsd current-product) current-provider-product)
(pow SCALE_FACTOR scale-difference)
))
(adjusted-deposit (if (<= scale-difference MAX_SCALE)
calculated-deposit
u0
))
)
(ok adjusted-deposit)
)
)
(define-private (remove-vault-id-from-principal-list
(list-uint uint)
(helper-tuple-response (response {
found: bool,
compare-uint: uint,
new-list: (list 50 uint),
}
uint
))
)
(match helper-tuple-response
helper-tuple (let (
(current-found (get found helper-tuple))
(current-compare-uint (get compare-uint helper-tuple))
(current-new-list (get new-list helper-tuple))
)
(if (is-eq current-found true)
(ok (merge helper-tuple { new-list: (unwrap! (as-max-len? (append current-new-list list-uint) u50)
ERR_LIST_OVERFLOW
) }
))
(if (is-eq current-compare-uint list-uint)
(ok (merge helper-tuple { found: true }))
(ok (merge helper-tuple { new-list: (unwrap! (as-max-len? (append current-new-list list-uint) u50)
ERR_LIST_OVERFLOW
) }
))
)
)
)
err-resp (err err-resp)
)
)
(define-private (remove-principal-from-list
(list-principal principal)
(helper-tuple-response (response {
compare-principal: principal,
new-list: (list 1000 principal),
}
uint
))
)
(match helper-tuple-response
helper-tuple (let (
(current-compare-principal (get compare-principal helper-tuple))
(current-new-list (get new-list helper-tuple))
)
;; Only append if this principal is NOT the one we want to remove
(if (is-eq list-principal current-compare-principal)
;; Skip this principal (don't append to new-list)
(ok helper-tuple)
;; Keep this principal (append to new-list)
(ok (merge helper-tuple { new-list: (unwrap! (as-max-len? (append current-new-list list-principal) u1000)
ERR_LIST_OVERFLOW
) }
))
)
)
err-response
ERR_LIST_OVERFLOW
)
)
(define-private (attribute-protocol-balances (vault-id uint))
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(protocol-debt (get protocol-debt-bsd current-vault))
(protocol-collateral (get protocol-collateral-sbtc current-vault))
(calc-protocol-share (unwrap-panic (get-vault-protocol-shares vault-id)))
(calc-protocol-debt-add (get calculated-protocol-debt calc-protocol-share))
(calc-protocol-collateral-add (get calculated-protocol-collateral calc-protocol-share))
(global-redistribution-params (var-get protocol-redistribution-params))
(total-sbtc-rewards-per-unit (get total-sbtc-rewards-per-unit global-redistribution-params))
(total-bsd-rewards-per-unit (get total-bsd-rewards-per-unit global-redistribution-params))
(new-protocol-debt (+ protocol-debt calc-protocol-debt-add))
(new-protocol-collateral (+ protocol-collateral calc-protocol-collateral-add))
)
(map-set vault vault-id
(merge current-vault {
protocol-debt-bsd: new-protocol-debt,
protocol-collateral-sbtc: new-protocol-collateral,
})
)
)
)
(define-public (unwind-vault
(vault-id uint)
(sbtc-price uint)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(borrower (get borrower current-vault))
(current-aggregate (var-get aggregate-debt-and-collateral))
(vault-balances (unwrap-panic (get-vault-compounded-info vault-id sbtc-price)))
(vault-total-collateral (get vault-total-collateral vault-balances))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge current-aggregate { collateral-sbtc: (- (get collateral-sbtc current-aggregate) vault-total-collateral) })
)
(remove-stake vault-id)
(ok (try! (delete-vault vault-id sorted-vaults)))
)
)
(define-public (unwind-provider (provider principal))
(let (
(current-stability-pool (var-get stability-pool))
(aggregate-sbtc (get aggregate-sbtc current-stability-pool))
(rewards (unwrap-panic (calculate-provider-rewards provider)))
(decreased-aggregate-sbtc (- aggregate-sbtc rewards))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(map-delete stability-pool-providers provider)
(ok (var-set stability-pool {
active: (get new-list
(try! (fold remove-principal-from-list (get active current-stability-pool)
(ok {
compare-principal: provider,
new-list: (list),
})
))
),
aggregate-sbtc: decreased-aggregate-sbtc,
aggregate-bsd: (get aggregate-bsd current-stability-pool),
product: (get product current-stability-pool),
scale: (get scale current-stability-pool),
}))
)
)
(define-public (liquidation-update-provider-distribution
(vault-id uint)
(liquidated-stability-bsd uint)
(liquidated-stability-sbtc uint)
(delete bool)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(total-bsd (get debt-bsd (var-get aggregate-debt-and-collateral)))
(total-sbtc (get collateral-sbtc (var-get aggregate-debt-and-collateral)))
(current-stability-pool (var-get stability-pool))
(current-stability-pool-bsd (get aggregate-bsd current-stability-pool))
(current-stability-pool-sbtc (get aggregate-sbtc current-stability-pool))
(current-product (get product current-stability-pool))
(current-scale (get scale current-stability-pool))
;; sum
(current-scale-prev-sum (unwrap-panic (map-get? scale-to-sum current-scale)))
(current-liquidation-sum (/ (* current-product liquidated-stability-sbtc) current-stability-pool-bsd))
(current-scale-new-sum (+ current-scale-prev-sum current-liquidation-sum))
;; product
(new-product (/
(* current-product
(- current-stability-pool-bsd liquidated-stability-bsd)
)
current-stability-pool-bsd
))
;; Verify that product is greater than zero
(product-gt-zero (asserts! (> new-product u0) ERR_PRODUCT_ZERO))
;; scale product
(scaled-values (if (< new-product (/ STABILITY_PRECISION SCALE_FACTOR))
(let (
;; First scaling
(first-scaled-product (* new-product SCALE_FACTOR))
(first-scale-increment u1)
;; Check if still too small after first scaling
(needs-second-scale (< first-scaled-product (/ STABILITY_PRECISION SCALE_FACTOR)))
;; Second scaling if needed
(second-scaled-product (if needs-second-scale
(* first-scaled-product SCALE_FACTOR)
first-scaled-product
))
(second-scale-increment (if needs-second-scale
u1
u0
))
;; Total scale increment
(total-scale-increment (+ first-scale-increment second-scale-increment))
)
(print { scale-event: {
new-product: new-product,
first-scaled: first-scaled-product,
second-scaled: second-scaled-product,
total-scale-increment: total-scale-increment,
} })
;; Update current-scale
(var-set stability-pool
(merge (var-get stability-pool) { scale: (+ current-scale total-scale-increment) })
)
;; Return the final scaled product and sum
{
product: second-scaled-product,
total-scale-increment: total-scale-increment,
}
)
{
product: new-product,
total-scale-increment: u0,
}
))
)
;; check that caller is protocol-caller
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge (var-get aggregate-debt-and-collateral) {
debt-bsd: (- total-bsd liquidated-stability-bsd),
collateral-sbtc: (- total-sbtc liquidated-stability-sbtc),
})
)
(var-set stability-pool
(merge (var-get stability-pool) {
aggregate-bsd: (- current-stability-pool-bsd liquidated-stability-bsd),
aggregate-sbtc: (+ current-stability-pool-sbtc liquidated-stability-sbtc),
product: (get product scaled-values),
})
)
(if (is-eq (get total-scale-increment scaled-values) u0)
(begin
(map-set scale-to-sum-scaled (get scale (var-get stability-pool)) true)
(map-set scale-to-sum (get scale (var-get stability-pool))
current-scale-new-sum
)
)
(map-set scale-to-sum (get scale (var-get stability-pool))
current-liquidation-sum
)
)
(if (is-eq delete true)
(begin
(remove-stake vault-id)
(close-vault vault-id sorted-vaults)
)
(ok true)
)
)
)
(define-public (liquidation-update-vault-redistribution
(vault-id uint)
(liquidated-redistribution-bsd uint)
(liquidated-redistribution-sbtc uint)
(delete bool)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(total-bsd (get debt-bsd (var-get aggregate-debt-and-collateral)))
(total-sbtc (get collateral-sbtc (var-get aggregate-debt-and-collateral)))
)
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(print {
redistribution-event: {
vault-id: vault-id,
redistribution-amount-bsd: liquidated-redistribution-bsd,
redistribution-amount-sbtc: liquidated-redistribution-sbtc,
aggregate-bsd: total-bsd,
aggregate-sbtc: total-sbtc,
},
})
(if (is-eq delete true)
(begin
(remove-stake vault-id)
(redistribute-debt-and-collateral liquidated-redistribution-bsd
liquidated-redistribution-sbtc
)
(update-snapshots total-sbtc)
(close-vault vault-id sorted-vaults)
)
(ok true)
)
)
)
(define-public (update-redemptions
(vaults (list 65000 uint))
(total-bsd-redeemed uint)
(total-sbtc-transferred uint)
(partial-bsd-redeemed uint)
(new-base-rate uint)
(total-redeem-fee uint)
(bsd-to-sbtc-price uint)
)
(let (
(vaults-len (len vaults))
(current-aggregate (var-get aggregate-debt-and-collateral))
(current-aggregate-bsd-debt (get debt-bsd current-aggregate))
(decreased-aggregate-bsd-debt (- current-aggregate-bsd-debt total-bsd-redeemed))
(current-aggregate-sbtc-collateral (get collateral-sbtc current-aggregate))
(decreased-aggregate-sbtc-collateral (- current-aggregate-sbtc-collateral total-sbtc-transferred))
)
(print {
redemption-event: {
vaults: vaults,
total-bsd-redeemed: total-bsd-redeemed,
total-sbtc-transferred: total-sbtc-transferred,
partial-bsd-redeemed: partial-bsd-redeemed,
new-base-rate: new-base-rate,
total-redeem-fee: total-redeem-fee,
sbtc-price: bsd-to-sbtc-price,
},
})
(try! (contract-call? .controller-vpv-15 is-protocol-caller contract-caller))
(var-set aggregate-debt-and-collateral
(merge (var-get aggregate-debt-and-collateral) {
debt-bsd: decreased-aggregate-bsd-debt,
collateral-sbtc: decreased-aggregate-sbtc-collateral,
})
)
(if (is-eq vaults-len u1)
(let (
(vault-id (unwrap-panic (element-at? vaults u0)))
(current-vault (unwrap-panic (map-get? vault vault-id)))
(accrued (accrue-interest vault-id))
(updated-balances (attribute-protocol-balances vault-id))
(updated-vault (unwrap-panic (map-get? vault vault-id)))
(vault-debt (get borrowed-bsd updated-vault))
(vault-collateral (get collateral-sbtc updated-vault))
(vault-protocol-debt (get protocol-debt-bsd updated-vault))
(vault-protocol-collateral (get protocol-collateral-sbtc updated-vault))
(redeemed-bsd-in-sbtc (div-to-fixed-precision partial-bsd-redeemed PRECISION
bsd-to-sbtc-price
))
(new-vault-debt (if (> partial-bsd-redeemed vault-debt)
u0
(- vault-debt partial-bsd-redeemed)
))
(new-protocol-debt (if (is-eq new-vault-debt u0)
(- vault-protocol-debt (- partial-bsd-redeemed vault-debt))
vault-protocol-debt
))
(new-vault-collateral (if (> redeemed-bsd-in-sbtc vault-collateral)
u0
(- vault-collateral redeemed-bsd-in-sbtc)
))
(new-protocol-collateral (if (is-eq new-vault-collateral u0)
(- vault-protocol-collateral
(- redeemed-bsd-in-sbtc vault-collateral)
)
vault-protocol-collateral
))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ new-vault-collateral new-protocol-collateral total-redeem-fee)
))
)
(print {
redeem-vault-event: {
vault-id: vault-id,
redeemed-collateral: redeemed-bsd-in-sbtc,
bsd-redeemed: partial-bsd-redeemed,
redeem-fee-credit: total-redeem-fee,
sbtc-price: bsd-to-sbtc-price,
rate: (get interest-rate updated-vault),
},
})
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) {
borrowed-bsd: new-vault-debt,
protocol-debt-bsd: new-protocol-debt,
collateral-sbtc: (+ new-vault-collateral total-redeem-fee),
protocol-collateral-sbtc: new-protocol-collateral,
})
)
)
(let (
(fully-redeemed-vaults (unwrap! (slice? vaults u0 (- (len vaults) u1)) ERR_SLICE))
(vault-id (unwrap-panic (element-at? vaults (- (len vaults) u1))))
(accrued (accrue-interest vault-id))
(current-vault (unwrap-panic (map-get? vault vault-id)))
(redeemed-bsd-in-sbtc (div-to-fixed-precision partial-bsd-redeemed PRECISION
bsd-to-sbtc-price
))
(dividend (mul-to-fixed-precision partial-bsd-redeemed PRECISION total-redeem-fee))
(redeem-fee-credit (div-round-down dividend total-bsd-redeemed))
(updated-balances (attribute-protocol-balances vault-id))
(updated-vault (unwrap-panic (map-get? vault vault-id)))
(vault-debt (get borrowed-bsd updated-vault))
(vault-protocol-debt (get protocol-debt-bsd updated-vault))
(vault-collateral (get collateral-sbtc updated-vault))
(vault-protocol-collateral (get protocol-collateral-sbtc updated-vault))
(new-vault-debt (if (> partial-bsd-redeemed vault-debt)
u0
(- vault-debt partial-bsd-redeemed)
))
(new-protocol-debt (if (is-eq new-vault-debt u0)
(- vault-protocol-debt (- partial-bsd-redeemed vault-debt))
vault-protocol-debt
))
(new-vault-collateral (if (> redeemed-bsd-in-sbtc vault-collateral)
u0
(- vault-collateral redeemed-bsd-in-sbtc)
))
(new-protocol-collateral (if (is-eq new-vault-collateral u0)
(- vault-protocol-collateral
(- redeemed-bsd-in-sbtc vault-collateral)
)
vault-protocol-collateral
))
(processed-stakes (update-stake-and-total-stakes vault-id
(+ new-vault-collateral new-protocol-collateral redeem-fee-credit)
))
)
(map-set vault vault-id
(merge (unwrap-panic (map-get? vault vault-id)) {
borrowed-bsd: new-vault-debt,
protocol-debt-bsd: new-protocol-debt,
collateral-sbtc: (+ new-vault-collateral redeem-fee-credit),
protocol-collateral-sbtc: new-protocol-collateral,
})
)
(print {
redeem-vault-event: {
vault-id: vault-id,
redeemed-collateral: redeemed-bsd-in-sbtc,
bsd-redeemed: partial-bsd-redeemed,
redeem-fee-credit: redeem-fee-credit,
sbtc-price: bsd-to-sbtc-price,
rate: (get interest-rate updated-vault),
},
})
(try! (fold fully-redeem-vault fully-redeemed-vaults
(ok {
price: bsd-to-sbtc-price,
total-redeem-fee: total-redeem-fee,
total-bsd-redeemed: total-bsd-redeemed,
})
))
true
)
)
(var-set last-redeem-height burn-block-height)
(ok (var-set base-rate new-base-rate))
)
)
(define-public (get-redemption-batch-info
(sbtc-price uint)
(sorted-vaults <sorted-vaults-trait>)
)
(let (
(sorted-vaults-summary (unwrap-panic (contract-call? sorted-vaults get-vaults-summary)))
(sorted-vaults-count (get total-vaults sorted-vaults-summary))
(max-vault-count (var-get max-vaults-to-redeem))
(vault-count (if (< sorted-vaults-count max-vault-count)
sorted-vaults-count
max-vault-count
))
(healthy-cr (var-get vault-collateral-ratio-threshold))
)
(if (is-eq vault-count u0)
(ok {
vaults: (list),
total-redeem-value: u0,
})
(let (
(sorted-vault-1-id (unwrap-panic (get first-vault-id sorted-vaults-summary)))
(vault-1-info (unwrap-panic (get-vault-compounded-info sorted-vault-1-id sbtc-price)))
(vault-1-bsd (get vault-total-debt vault-1-info))
(vault-1-cr (get vault-collateral-ratio vault-1-info))
(vault-1-healthy (asserts! (>= vault-1-cr healthy-cr) ERR_REDEEM_UNHEALTHY))
)
(if (is-eq vault-count u1)
(ok {
vaults: (list sorted-vault-1-id),
total-redeem-value: vault-1-bsd,
})
(let (
(sorted-vault-2-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-1-id)
))))
(vault-2-info (unwrap-panic (get-vault-compounded-info sorted-vault-2-id sbtc-price)))
(vault-2-bsd (get vault-total-debt vault-2-info))
(vault-2-cr (get vault-collateral-ratio vault-2-info))
(vault-2-healthy (asserts! (>= vault-2-cr healthy-cr) ERR_REDEEM_UNHEALTHY))
)
(if (is-eq vault-count u2)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd),
})
(let (
(sorted-vault-3-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-2-id)
))))
(vault-3-info (unwrap-panic (get-vault-compounded-info sorted-vault-3-id sbtc-price)))
(vault-3-bsd (get vault-total-debt vault-3-info))
(vault-3-cr (get vault-collateral-ratio vault-3-info))
(vault-3-healthy (asserts! (>= vault-3-cr healthy-cr) ERR_REDEEM_UNHEALTHY))
)
(if (is-eq vault-count u3)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id sorted-vault-3-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd),
})
(let (
(sorted-vault-4-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-3-id)
))))
(vault-4-info (unwrap-panic (get-vault-compounded-info sorted-vault-4-id sbtc-price)))
(vault-4-bsd (get vault-total-debt vault-4-info))
(vault-4-cr (get vault-collateral-ratio vault-4-info))
(vault-4-healthy (asserts! (>= vault-4-cr healthy-cr) ERR_REDEEM_UNHEALTHY))
)
(if (is-eq vault-count u4)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id
sorted-vault-3-id sorted-vault-4-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd vault-4-bsd),
})
(let (
(sorted-vault-5-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-4-id)
))))
(vault-5-info (unwrap-panic (get-vault-compounded-info sorted-vault-5-id sbtc-price)))
(vault-5-bsd (get vault-total-debt vault-5-info))
(vault-5-cr (get vault-collateral-ratio vault-5-info))
(vault-5-healthy (asserts! (>= vault-5-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u5)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id
sorted-vault-3-id sorted-vault-4-id
sorted-vault-5-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd vault-4-bsd
vault-5-bsd
),
})
(let (
(sorted-vault-6-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-5-id)
))))
(vault-6-info (unwrap-panic (get-vault-compounded-info sorted-vault-6-id
sbtc-price
)))
(vault-6-bsd (get vault-total-debt vault-6-info))
(vault-6-cr (get vault-collateral-ratio vault-6-info))
(vault-6-healthy (asserts! (>= vault-6-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u6)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id
sorted-vault-3-id sorted-vault-4-id
sorted-vault-5-id sorted-vault-6-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd
vault-4-bsd vault-5-bsd vault-6-bsd
),
})
(let (
(sorted-vault-7-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults get-next-vault-id
(some sorted-vault-6-id)
))))
(vault-7-info (unwrap-panic (get-vault-compounded-info sorted-vault-7-id
sbtc-price
)))
(vault-7-bsd (get vault-total-debt vault-7-info))
(vault-7-cr (get vault-collateral-ratio vault-7-info))
(vault-7-healthy (asserts! (>= vault-7-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u7)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id
sorted-vault-3-id sorted-vault-4-id
sorted-vault-5-id sorted-vault-6-id
sorted-vault-7-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd
vault-4-bsd vault-5-bsd vault-6-bsd
vault-7-bsd
),
})
(let (
(sorted-vault-8-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults
get-next-vault-id
(some sorted-vault-7-id)
))))
(vault-8-info (unwrap-panic (get-vault-compounded-info
sorted-vault-8-id sbtc-price
)))
(vault-8-bsd (get vault-total-debt vault-8-info))
(vault-8-cr (get vault-collateral-ratio vault-8-info))
(vault-8-healthy (asserts! (>= vault-8-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u8)
(ok {
vaults: (list sorted-vault-1-id sorted-vault-2-id
sorted-vault-3-id sorted-vault-4-id
sorted-vault-5-id sorted-vault-6-id
sorted-vault-7-id sorted-vault-8-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd vault-3-bsd
vault-4-bsd vault-5-bsd vault-6-bsd
vault-7-bsd vault-8-bsd
),
})
(let (
(sorted-vault-9-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults
get-next-vault-id
(some sorted-vault-8-id)
))))
(vault-9-info (unwrap-panic (get-vault-compounded-info
sorted-vault-9-id sbtc-price
)))
(vault-9-bsd (get vault-total-debt vault-9-info))
(vault-9-cr (get vault-collateral-ratio
vault-9-info
))
(vault-9-healthy (asserts! (>= vault-9-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u9)
(ok {
vaults: (list sorted-vault-1-id
sorted-vault-2-id sorted-vault-3-id
sorted-vault-4-id sorted-vault-5-id
sorted-vault-6-id sorted-vault-7-id
sorted-vault-8-id sorted-vault-9-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd
vault-3-bsd vault-4-bsd
vault-5-bsd vault-6-bsd
vault-7-bsd vault-8-bsd
vault-9-bsd
),
})
(let (
(sorted-vault-10-id (unwrap-panic (unwrap-panic (contract-call? sorted-vaults
get-next-vault-id
(some sorted-vault-9-id)
))))
(vault-10-info (unwrap-panic (get-vault-compounded-info
sorted-vault-10-id sbtc-price
)))
(vault-10-bsd (get vault-total-debt vault-10-info))
(vault-10-cr (get vault-collateral-ratio
vault-10-info
))
(vault-10-healthy (asserts!
(>= vault-10-cr healthy-cr)
ERR_REDEEM_UNHEALTHY
))
)
(if (is-eq vault-count u10)
(ok {
vaults: (list sorted-vault-1-id
sorted-vault-2-id
sorted-vault-3-id
sorted-vault-4-id
sorted-vault-5-id
sorted-vault-6-id
sorted-vault-7-id
sorted-vault-8-id
sorted-vault-9-id
sorted-vault-10-id),
total-redeem-value: (+ vault-1-bsd vault-2-bsd
vault-3-bsd vault-4-bsd
vault-5-bsd vault-6-bsd
vault-7-bsd vault-8-bsd
vault-9-bsd vault-10-bsd
),
})
(ok {
vaults: (list),
total-redeem-value: u0,
})
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
)
(define-private (compute-new-stake (vault-collateral uint))
(let (
(redistribution-params (var-get protocol-redistribution-params))
(total-collateral-snapshot (get total-collateral-snapshot redistribution-params))
(total-stakes-snapshot (get total-stakes-snapshot redistribution-params))
)
(if (is-eq total-collateral-snapshot u0)
(ok vault-collateral)
(if (is-eq total-stakes-snapshot u0)
(err ERR_STAKES)
(let ((stake (div (mul vault-collateral total-stakes-snapshot)
total-collateral-snapshot
)))
(ok stake)
)
)
)
)
)
(define-private (initialize-total-stakes
(vault-id uint)
(vault-collateral uint)
)
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(redistribution-params (var-get protocol-redistribution-params))
)
(var-set protocol-redistribution-params
(merge redistribution-params { total-stakes: vault-collateral })
)
(map-set vault vault-id (merge current-vault { stake: vault-collateral }))
)
)
(define-private (remove-stake (vault-id uint))
(let (
(current-vault (unwrap-panic (map-get? vault vault-id)))
(redistribution-params (var-get protocol-redistribution-params))
(total-stakes (get total-stakes redistribution-params))
(vault-stake (get stake current-vault))
(new-total-stakes (- total-stakes vault-stake))
)
(var-set protocol-redistribution-params
(merge redistribution-params { total-stakes: new-total-stakes })
)
)
)
(define-private (update-stake-and-total-stakes
(vault-id uint)
(vault-collateral uint)
)
(let (
(current-vault (unwrap! (map-get? vault vault-id) ERR_VAULT_NOT_FOUND))
(old-stake (get stake current-vault))
(new-stake (unwrap-panic (compute-new-stake vault-collateral)))
(redistribution-params (var-get protocol-redistribution-params))
(total-stakes (get total-stakes redistribution-params))
(total-sbtc-rewards-per-unit (get total-sbtc-rewards-per-unit redistribution-params))
(total-bsd-rewards-per-unit (get total-bsd-rewards-per-unit redistribution-params))
(new-total-stakes (+ (- total-stakes old-stake) new-stake))
(new-vault-sbtc-rewards-checkpoint total-sbtc-rewards-per-unit)
(new-vault-bsd-rewards-checkpoint total-bsd-rewards-per-unit)
)
(begin
(map-set vault vault-id
(merge current-vault {
stake: new-stake,
vault-sbtc-rewards-snapshot: new-vault-sbtc-rewards-checkpoint,
vault-bsd-rewards-snapshot: new-vault-bsd-rewards-checkpoint,
})
)
(ok (var-set protocol-redistribution-params
(merge redistribution-params { total-stakes: new-total-stakes })
))
)
)
)
(define-private (update-snapshots (total-collateral uint))
(let (
(redistribution-params (var-get protocol-redistribution-params))
(total-stakes (get total-stakes redistribution-params))
(new-total-stakes-snapshot total-stakes)
(new-total-collateral-snapshot total-collateral)
)
(begin
(var-set protocol-redistribution-params
(merge redistribution-params {
total-stakes-snapshot: new-total-stakes-snapshot,
total-collateral-snapshot: new-total-collateral-snapshot,
})
)
)
)
)
(define-private (redistribute-debt-and-collateral
(liquidated-debt uint)
(liquidated-collateral uint)
)
(let (
(redistribution-params (var-get protocol-redistribution-params))
(total-sbtc-rewards-per-unit (get total-sbtc-rewards-per-unit redistribution-params))
(total-bsd-rewards-per-unit (get total-bsd-rewards-per-unit redistribution-params))
(total-stakes (get total-stakes redistribution-params))
(liquidation-sbtc-rewards (/ (div-round-down (* liquidated-collateral ONE_FULL_UNIT) total-stakes)
ONE_FULL_UNIT
))
(liquidation-bsd-rewards (/ (div (* liquidated-debt ONE_FULL_UNIT) total-stakes) ONE_FULL_UNIT))
(new-total-sbtc-rewards-per-unit (+ total-sbtc-rewards-per-unit liquidation-sbtc-rewards))
(new-total-bsd-rewards-per-unit (+ total-bsd-rewards-per-unit liquidation-bsd-rewards))
)
(var-set protocol-redistribution-params
(merge redistribution-params {
total-sbtc-rewards-per-unit: new-total-sbtc-rewards-per-unit,
total-bsd-rewards-per-unit: new-total-bsd-rewards-per-unit,
})
)
)
)
(define-read-only (div
(x uint)
(y uint)
)
(/ (+ (* x ONE_FULL_UNIT) (/ y u2)) y)
)
(define-read-only (div-round-down
(x uint)
(y uint)
)
(/ (* x ONE_FULL_UNIT) y)
)
(define-read-only (div-round-up
(x uint)
(y uint)
)
(/ (+ (* x ONE_FULL_UNIT) (- y u1)) y)
)
(define-read-only (mul
(x uint)
(y uint)
)
(/ (+ (* x y) (/ ONE_FULL_UNIT u2)) ONE_FULL_UNIT)
)
(define-read-only (div-to-fixed-precision
(a uint)
(decimals-a uint)
(b-fixed uint)
)
(if (> decimals-a PRECISION)
(div (/ a (pow u10 (- decimals-a PRECISION))) b-fixed)
(div (* a (pow u10 (- PRECISION decimals-a))) b-fixed)
)
)
(define-read-only (mul-to-fixed-precision
(a uint)
(decimals-a uint)
(b-fixed uint)
)
(if (> decimals-a PRECISION)
(mul (/ a (pow u10 (- decimals-a PRECISION))) b-fixed)
(mul (* a (pow u10 (- PRECISION decimals-a))) b-fixed)
)
)
(define-read-only (mul-perc
(a uint)
(decimals-a uint)
(b-fixed uint)
)
(if (> decimals-a PRECISION)
(begin
(* (mul (/ a (pow u10 (- decimals-a PRECISION))) b-fixed)
(pow u10 (- decimals-a PRECISION))
)
)
(begin
(/ (mul (* a (pow u10 (- PRECISION decimals-a))) b-fixed)
(pow u10 (- PRECISION decimals-a))
)
)
)
)