Branch data Line data Source code
1 : : ;; Title: BME024 CPMM Categorical Market Predictions
2 : : ;; Synopsis:
3 : : ;; Implements CPMM binary and categorical prediciton markets.
4 : : ;; Description:
5 : : ;; Market creation allows a new binary or categorical market to be set up.
6 : : ;; Off chain market data is verifiable via the markets data hash.
7 : : ;; Markets run in a specific token (stx, sbtc, bmg etc) and the market token has
8 : : ;; to be enabled by the DAO.
9 : : ;; Market creation can be gated via market proof and a market creator can
10 : : ;; set their own fee up to a max fee amount determined by the DAO.
11 : : ;; Anyone with the required token can buy shares. Resolution process begins via a call gated
12 : : ;; to the DAO controlled resolution agent address. The resolution can be challenged by anyone with a stake in the market
13 : : ;; If a challenge is made the dispute resolution process begins which requires a DAO vote
14 : : ;; to resolve - the outcome of the vote resolve the market and sets the outcome.
15 : : ;; If the dispute window passes without challenge or once the vote concludes the market is fully
16 : : ;; resolved and claims can then be made.
17 : : ;; Optional hedge strategy - the execute-hedge strategy can be run during market cool down period. The execute-hedge
18 : : ;; function will call the market specific hedge strategy if supplied or the default startegy otherwise.
19 : : ;; The hedge strategy can be switched off by the dao.
20 : :
21 : : (use-trait ft-token 'SP2AKWJYC7BNY18W1XXKPGP0YVEK63QJG4793Z2D4.sip-010-trait-ft-standard.sip-010-trait)
22 : : (impl-trait .prediction-market-trait.prediction-market-trait)
23 : : (use-trait hedge-trait .hedge-trait.hedge-trait)
24 : : (use-trait ft-velar-token 'SP2AKWJYC7BNY18W1XXKPGP0YVEK63QJG4793Z2D4.sip-010-trait-ft-standard.sip-010-trait)
25 : : (impl-trait 'SP3JP0N1ZXGASRJ0F7QAHWFPGTVK9T2XNXDB908Z.extension-trait.extension-trait)
26 : :
27 : : ;; ---------------- CONSTANTS & TYPES ----------------
28 : : ;; Market Types (1 => categorical market)
29 : : (define-constant MARKET_TYPE u1)
30 : : (define-constant DEFAULT_MARKET_DURATION u144) ;; ~1 day in Bitcoin blocks
31 : : (define-constant DEFAULT_COOL_DOWN_PERIOD u144) ;; ~1 day in Bitcoin blocks
32 : : (define-constant SCALE u1000000)
33 : :
34 : : (define-constant RESOLUTION_OPEN u0)
35 : : (define-constant RESOLUTION_RESOLVING u1)
36 : : (define-constant RESOLUTION_DISPUTED u2)
37 : : (define-constant RESOLUTION_RESOLVED u3)
38 : :
39 : : (define-constant err-unauthorised (err u10000))
40 : : (define-constant err-invalid-market-type (err u10001))
41 : : (define-constant err-amount-too-low (err u10002))
42 : : (define-constant err-wrong-market-type (err u10003))
43 : : (define-constant err-already-concluded (err u10004))
44 : : (define-constant err-market-not-found (err u10005))
45 : : (define-constant err-user-not-winner-or-claimed (err u10006))
46 : : (define-constant err-user-not-staked (err u10008))
47 : : (define-constant err-market-not-concluded (err u10009))
48 : : (define-constant err-insufficient-balance (err u10011))
49 : : (define-constant err-insufficient-contract-balance (err u10012))
50 : : (define-constant err-user-share-is-zero (err u10013))
51 : : (define-constant err-disputer-must-have-stake (err u10015))
52 : : (define-constant err-dispute-window-elapsed (err u10016))
53 : : (define-constant err-market-not-resolving (err u10017))
54 : : (define-constant err-market-not-open (err u10018))
55 : : (define-constant err-dispute-window-not-elapsed (err u10019))
56 : : (define-constant err-market-wrong-state (err u10020))
57 : : (define-constant err-invalid-token (err u10021))
58 : : (define-constant err-max-market-fee-bips-exceeded (err u10022))
59 : : (define-constant err-category-not-found (err u10023))
60 : : (define-constant err-too-few-categories (err u10024))
61 : : (define-constant err-element-expected (err u10025))
62 : : (define-constant err-winning-stake-not-zero (err u10026))
63 : : (define-constant err-losing-stake-is-zero (err u10027))
64 : : (define-constant err-amount-too-high (err u10029))
65 : : (define-constant err-fee-too-high (err u10030))
66 : : (define-constant err-slippage-too-high (err u10031))
67 : : (define-constant err-seed-amount-not-divisible (err u10032))
68 : : (define-constant err-overbuy (err u10034))
69 : : (define-constant err-token-not-configured (err u10035))
70 : : (define-constant err-seed-too-small (err u10036))
71 : : (define-constant err-already-hedged (err u10037))
72 : : (define-constant err-hedging-disabled (err u10038))
73 : : (define-constant err-hedge-unauthorised (err u10100))
74 : : (define-constant err-hedge-window (err u10101))
75 : : (define-constant err-hedge-already (err u10102))
76 : : (define-constant err-hedge-bad-prediction (err u10103))
77 : : (define-constant err-hedge-bad-token (err u10104))
78 : : (define-constant err-hedge-exec-mismatch (err u10105))
79 : : (define-constant err-insufficient-liquidity (err u11041))
80 : : (define-constant err-arithmetic (err u11043))
81 : :
82 : : (define-constant marketplace .bme040-0-shares-marketplace)
83 : : (define-constant MIN_POOL u1)
84 : :
85 : :
86 : : (define-data-var market-counter uint u0)
87 : : (define-data-var dispute-window-length uint u144)
88 : : (define-data-var dev-fee-bips uint u100)
89 : : (define-data-var market-fee-bips-max uint u1000)
90 : : (define-data-var dev-fund principal tx-sender)
91 : : (define-data-var resolution-agent principal tx-sender)
92 : : (define-data-var dao-treasury principal tx-sender)
93 : : (define-data-var creation-gated bool true)
94 : : (define-data-var resolution-timeout uint u1000) ;; 1000 blocks (~9 days)
95 : : (define-data-var default-hedge-executor principal .bme032-0-scalar-strategy-hedge)
96 : : (define-data-var hedging-enabled bool true)
97 : :
98 : : ;; Data structure for each Market
99 : : ;; outcome: winning category
100 : : (define-map markets
101 : : uint
102 : : {
103 : : market-data-hash: (buff 32),
104 : : token: principal,
105 : : treasury: principal,
106 : : creator: principal,
107 : : market-fee-bips: uint,
108 : : resolution-state: uint, ;; "open", "resolving", "disputed", "concluded"
109 : : resolution-burn-height: uint,
110 : : categories: (list 10 (string-ascii 64)), ;; List of available categories
111 : : stakes: (list 10 uint), ;; Total staked per category - shares
112 : : stake-tokens: (list 10 uint), ;; Total staked per category - tokens
113 : : outcome: (optional uint),
114 : : concluded: bool,
115 : : market-start: uint,
116 : : market-duration: uint,
117 : : cool-down-period: uint,
118 : : hedge-executor: (optional principal),
119 : : hedged: bool,
120 : : }
121 : : )
122 : : ;; defines the minimum liquidity a market creator needs to provide
123 : : (define-map token-minimum-seed {token: principal} uint)
124 : :
125 : : ;; tracks the amount of shares the user owns per market / category
126 : : (define-map stake-balances
127 : : { market-id: uint, user: principal }
128 : : (list 10 uint)
129 : : )
130 : : ;; tracks the cost of shares to the user per market / category
131 : : (define-map token-balances
132 : : { market-id: uint, user: principal }
133 : : (list 10 uint)
134 : : )
135 : : (define-map allowed-tokens principal bool)
136 : :
137 : : ;; ---------------- access control ----------------
138 : 421 : (define-public (is-dao-or-extension)
139 [ + ][ + + ]: 6831 : (ok (asserts! (or (is-eq tx-sender .bigmarket-dao) (contract-call? .bigmarket-dao is-extension contract-caller)) err-unauthorised))
140 : : )
141 : :
142 : : ;; ---------------- getters / setters ----------------
143 : 421 : (define-public (set-allowed-token (token principal) (enabled bool))
144 : 1684 : (begin
145 : 1684 : (try! (is-dao-or-extension))
146 : 1684 : (print {event: "allowed-token", token: token, enabled: enabled})
147 : 1684 : (ok (map-set allowed-tokens token enabled))
148 : : )
149 : : )
150 : 244 : (define-read-only (is-allowed-token (token principal))
151 : 377 : (default-to false (map-get? allowed-tokens token))
152 : : )
153 : :
154 : 421 : (define-public (set-dispute-window-length (length uint))
155 : 434 : (begin
156 : 434 : (try! (is-dao-or-extension))
157 : 434 : (var-set dispute-window-length length)
158 : 434 : (ok true)
159 : : )
160 : : )
161 : :
162 : 421 : (define-public (set-default-hedge-executor (p principal))
163 : 437 : (begin
164 : 437 : (try! (is-dao-or-extension))
165 : 437 : (var-set default-hedge-executor p)
166 : 437 : (print {event: "default-hedge-executor", default-hedge-executor: p})
167 : 437 : (ok true)
168 : : )
169 : : )
170 : :
171 : 3 : (define-public (set-hedging-enabled (enabled bool))
172 : 3 : (begin
173 : 3 : (try! (is-dao-or-extension))
174 : 3 : (var-set hedging-enabled enabled)
175 : 3 : (ok enabled)
176 : : )
177 : : )
178 : 4 : (define-read-only (is-hedging-enabled) (var-get hedging-enabled))
179 : :
180 : 421 : (define-public (set-creation-gated (gated bool))
181 : 437 : (begin
182 : 437 : (try! (is-dao-or-extension))
183 : 437 : (var-set creation-gated gated)
184 : 437 : (ok true)
185 : : )
186 : : )
187 : :
188 : 421 : (define-public (set-resolution-agent (new-agent principal))
189 : 434 : (begin
190 : 434 : (try! (is-dao-or-extension))
191 : 434 : (var-set resolution-agent new-agent)
192 : 434 : (ok true)
193 : : )
194 : : )
195 : :
196 : 421 : (define-public (set-dev-fee-bips (new-fee uint))
197 : 427 : (begin
198 [ - ]: 427 : (asserts! (<= new-fee u1000) err-max-market-fee-bips-exceeded)
199 : 427 : (try! (is-dao-or-extension))
200 : 427 : (var-set dev-fee-bips new-fee)
201 : 427 : (ok true)
202 : : )
203 : : )
204 : :
205 : 421 : (define-public (set-market-fee-bips-max (new-fee uint))
206 : 427 : (begin
207 [ - ]: 427 : (asserts! (<= new-fee u1000) err-max-market-fee-bips-exceeded)
208 : 427 : (try! (is-dao-or-extension))
209 : 427 : (var-set market-fee-bips-max new-fee)
210 : 427 : (ok true)
211 : : )
212 : : )
213 : :
214 : 421 : (define-public (set-token-minimum-seed (token principal) (min uint))
215 : 1684 : (begin
216 : 1684 : (try! (is-dao-or-extension))
217 : 1684 : (map-set token-minimum-seed {token: token} min)
218 : 1684 : (ok true)
219 : : )
220 : : )
221 : :
222 : 1 : (define-read-only (get-token-minimum-seed (seed-token principal))
223 : 2 : (ok (map-get? token-minimum-seed {token: seed-token}))
224 : : )
225 : :
226 : 421 : (define-public (set-dev-fund (new-dev-fund principal))
227 : 421 : (begin
228 : 421 : (try! (is-dao-or-extension))
229 : 421 : (var-set dev-fund new-dev-fund)
230 : 421 : (ok true)
231 : : )
232 : : )
233 : :
234 : 421 : (define-public (set-dao-treasury (new-dao-treasury principal))
235 : 421 : (begin
236 : 421 : (try! (is-dao-or-extension))
237 : 421 : (var-set dao-treasury new-dao-treasury)
238 : 421 : (ok true)
239 : : )
240 : : )
241 : :
242 : 43 : (define-read-only (get-market-data (market-id uint))
243 : 110 : (map-get? markets market-id)
244 : : )
245 : :
246 : 7 : (define-read-only (get-stake-balances (market-id uint) (user principal))
247 : 17 : (ok (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? stake-balances {market-id: market-id, user: user})))
248 : : )
249 : :
250 : 3 : (define-read-only (get-token-balances (market-id uint) (user principal))
251 : 5 : (ok (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? token-balances {market-id: market-id, user: user})))
252 : : )
253 : :
254 : : ;; ---------------- public functions ----------------
255 : :
256 : 257 : (define-public (create-market
257 : : (categories (list 10 (string-ascii 64)))
258 : : (fee-bips (optional uint))
259 : : (token <ft-token>)
260 : : (market-data-hash (buff 32))
261 : : (proof (list 10 (tuple (position bool) (hash (buff 32)))))
262 : : (treasury principal)
263 : : (market-duration (optional uint))
264 : : (cool-down-period (optional uint))
265 : : (seed-amount uint)
266 : : (hedge-executor (optional principal))
267 : : )
268 : 382 : (let (
269 : 382 : (creator tx-sender)
270 : 382 : (new-id (var-get market-counter))
271 : 382 : (market-fee-bips (default-to u0 fee-bips))
272 : 382 : (market-duration-final (default-to DEFAULT_MARKET_DURATION market-duration))
273 : 382 : (cool-down-final (default-to DEFAULT_COOL_DOWN_PERIOD cool-down-period))
274 : 382 : (current-block burn-block-height)
275 : 382 : (num-categories (len categories))
276 : : ;; NOTE: seed is evenly divided with rounding error discarded
277 : 382 : (seed (/ (* seed-amount SCALE) (* num-categories SCALE)))
278 : 382 : (user-stake-list (list seed seed seed seed seed seed seed seed seed seed))
279 : 382 : (share-list (zero-after-n user-stake-list num-categories))
280 : : )
281 [ - ]: 382 : (asserts! (> market-duration-final u10) err-market-not-found)
282 [ - ]: 382 : (asserts! (> cool-down-final u10) err-market-not-found)
283 : :
284 [ + ]: 382 : (asserts! (> (len categories) u1) err-too-few-categories)
285 [ + ]: 370 : (asserts! (<= market-fee-bips (var-get market-fee-bips-max)) err-max-market-fee-bips-exceeded)
286 : : ;; ensure the trading token is allowed
287 [ - ]: 369 : (asserts! (is-allowed-token (contract-of token)) err-invalid-token)
288 : :
289 : : ;; ensure enough liquidity
290 [ - ]: 369 : (asserts! (>= seed-amount (unwrap! (map-get? token-minimum-seed {token: (contract-of token)}) err-token-not-configured)) err-seed-too-small)
291 : : ;; liquidity floor guards (for CPMM safety)
292 [ - ]: 369 : (asserts! (>= seed MIN_POOL) err-insufficient-liquidity)
293 [ - ]: 369 : (asserts! (>= seed-amount (* num-categories MIN_POOL)) err-insufficient-liquidity) ;; avoid rounding below floor
294 : :
295 : : ;; Transfer single winning portion of seed to market contract to fund claims
296 : 369 : (try! (contract-call? token transfer seed-amount tx-sender (as-contract tx-sender) none))
297 : :
298 : : ;; ensure the user is allowed to create if gating by merkle proof is required
299 [ + + ]: 369 : (if (var-get creation-gated) (try! (as-contract (contract-call? .bme022-0-market-gating can-access-by-account creator proof))) true)
300 : :
301 : : ;; dao is assigned the seed liquidity - share and tokens 1:1 at kick off
302 : 366 : (map-set stake-balances {market-id: new-id, user: (var-get dao-treasury)} share-list)
303 : 366 : (map-set token-balances {market-id: new-id, user: (var-get dao-treasury)} share-list)
304 : :
305 : 366 : (map-set markets
306 : 366 : new-id
307 : : {
308 : 366 : market-data-hash: market-data-hash,
309 : 366 : token: (contract-of token),
310 : 366 : treasury: treasury,
311 : 366 : creator: creator,
312 : 366 : market-fee-bips: market-fee-bips,
313 : 366 : resolution-state: RESOLUTION_OPEN,
314 : 366 : resolution-burn-height: u0,
315 : 366 : categories: categories,
316 : 366 : stakes: share-list,
317 : 366 : stake-tokens: share-list, ;; they start out the same
318 : 366 : outcome: none,
319 : 366 : concluded: false,
320 : 366 : market-start: current-block,
321 : 366 : market-duration: market-duration-final,
322 : 366 : cool-down-period: cool-down-final,
323 : 366 : hedge-executor: hedge-executor,
324 : 366 : hedged: false,
325 : : }
326 : : )
327 : 366 : (var-set market-counter (+ new-id u1))
328 : 366 : (try! (contract-call? .bme030-0-reputation-token mint tx-sender u2 u8))
329 : 366 : (print {event: "create-market", market-id: new-id, categories: categories, market-fee-bips: market-fee-bips, token: token, market-data-hash: market-data-hash, creator: tx-sender, seed-amount: seed-amount})
330 : 366 : (ok new-id)
331 : : )
332 : : )
333 : :
334 : : ;; Read-only: get current price to buy `amount` shares in a category
335 : 1 : (define-read-only (get-share-cost (market-id uint) (index uint) (amount-shares uint))
336 : 1 : (let (
337 : 1 : (market-data (unwrap-panic (map-get? markets market-id)))
338 : 1 : (stake-list (get stakes market-data))
339 : 1 : (selected-pool (unwrap-panic (element-at? stake-list index)))
340 : 1 : (total-pool (fold + stake-list u0))
341 : 1 : (other-pool (- total-pool selected-pool))
342 [ + - ]: 1 : (max-purchase (if (> other-pool MIN_POOL) (- other-pool MIN_POOL) u0))
343 : 1 : (cost (unwrap! (cpmm-cost selected-pool other-pool amount-shares) err-arithmetic))
344 : : )
345 : 1 : (ok { cost: cost, max-purchase: max-purchase })
346 : : )
347 : : )
348 : :
349 : : ;; Compute the token cost to buy `amount-shares` from `selected-pool`,
350 : : ;; given the rest-of-market liquidity `other-pool`.
351 : 191 : (define-private (cpmm-cost (selected-pool uint) (other-pool uint) (amount-shares uint))
352 : 468 : (begin
353 : : ;; Both pools must have liquidity
354 [ - ]: 468 : (asserts! (> selected-pool u0) err-insufficient-liquidity)
355 [ - ]: 468 : (asserts! (> other-pool u0) err-insufficient-liquidity)
356 : :
357 : : ;; You cannot buy so much that the counter-pool hits 0 or below MIN_POOL
358 : 468 : (let (
359 [ + - ]: 468 : (max-purchase (if (> other-pool MIN_POOL) (- other-pool MIN_POOL) u0))
360 : : )
361 [ - ]: 468 : (asserts! (<= amount-shares max-purchase) err-overbuy)
362 : :
363 : 468 : (let (
364 : 468 : (new-y (- other-pool amount-shares))
365 : 468 : (numerator (* selected-pool other-pool))
366 : 468 : (new-x (/ (* numerator SCALE) new-y))
367 : 468 : (cost (/ (- new-x (* selected-pool SCALE)) SCALE))
368 : : )
369 : 468 : (ok cost)
370 : : )
371 : : )
372 : : )
373 : : )
374 : :
375 : : ;; Read-only: get current price to buy `amount` shares in a category
376 : 1 : (define-read-only (get-max-shares (market-id uint) (index uint) (total-cost uint))
377 : 1 : (let (
378 : 1 : (fee-scaled (/ (* (* total-cost (var-get dev-fee-bips)) SCALE) u10000))
379 : 1 : (fee (/ fee-scaled SCALE))
380 [ + - ]: 1 : (cost-of-shares (if (> total-cost fee) (- total-cost fee) u0))
381 : 1 : (market-data (unwrap-panic (map-get? markets market-id)))
382 : 1 : (stake-list (get stakes market-data))
383 : 1 : (selected-pool (unwrap-panic (element-at? stake-list index)))
384 : 1 : (total-pool (fold + stake-list u0))
385 : 1 : (other-pool (- total-pool selected-pool))
386 [ + - ]: 1 : (max-by-floor (if (> other-pool MIN_POOL) (- other-pool MIN_POOL) u0))
387 : 1 : (shares (unwrap! (cpmm-shares selected-pool other-pool cost-of-shares) err-arithmetic))
388 [ - + ]: 1 : (shares-clamped (if (> shares max-by-floor) max-by-floor shares))
389 : : )
390 : 1 : (ok { shares: shares-clamped, fee: fee, cost-of-shares: cost-of-shares })
391 : : )
392 : : )
393 : : ;; Inverse: given a token `cost`, how many shares can be bought safely?
394 : 191 : (define-private (cpmm-shares (selected-pool uint) (other-pool uint) (cost uint))
395 : 463 : (begin
396 [ - ]: 463 : (asserts! (> selected-pool u0) err-insufficient-liquidity)
397 [ - ]: 463 : (asserts! (> other-pool u0) err-insufficient-liquidity)
398 : :
399 : 463 : (if (is-eq cost u0)
400 [ - ]: 0 : (ok u0)
401 [ + ]: 463 : (let (
402 : 463 : (denom (+ selected-pool cost)) ;; > selected-pool, non-zero
403 : 463 : (numerator (* selected-pool other-pool))
404 : 463 : (new-y (/ (* numerator SCALE) denom))
405 : 463 : (raw-shares (if (> (* other-pool SCALE) new-y)
406 [ + ]: 463 : (/ (- (* other-pool SCALE) new-y) SCALE)
407 [ - ]: 0 : u0))
408 : : ;; Enforce floor: clamp to keep MIN_POOL on the other side
409 [ + - ]: 463 : (max-by-floor (if (> other-pool MIN_POOL) (- other-pool MIN_POOL) u0))
410 [ - + ]: 463 : (shares (if (> raw-shares max-by-floor) max-by-floor raw-shares))
411 : : )
412 : 463 : (ok shares)
413 : : )
414 : : )
415 : : )
416 : : )
417 : : ;; Predict category with CPMM pricing
418 : 203 : (define-public (predict-category (market-id uint) (min-shares uint) (category (string-ascii 64)) (token <ft-token>) (max-cost uint))
419 : 474 : (let (
420 : 474 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
421 : 474 : (categories (get categories md))
422 : 474 : (index (unwrap! (index-of? categories category) err-category-not-found))
423 : 462 : (stake-tokens-list (get stake-tokens md))
424 : 462 : (selected-token-pool (unwrap! (element-at? stake-tokens-list index) err-category-not-found))
425 : 462 : (stake-list (get stakes md))
426 : 462 : (selected-pool (unwrap! (element-at? stake-list index) err-category-not-found))
427 : 462 : (total-pool (fold + stake-list u0))
428 : 462 : (other-pool (- total-pool selected-pool))
429 : 462 : (sender-balance (unwrap! (contract-call? token get-balance tx-sender) err-insufficient-balance))
430 : 462 : (fee (/ (* max-cost (var-get dev-fee-bips)) u10000))
431 [ + - ]: 462 : (cost-of-shares (if (> max-cost fee) (- max-cost fee) u0))
432 [ + - ]: 462 : (max-by-floor (if (> other-pool MIN_POOL) (- other-pool MIN_POOL) u0))
433 : 462 : (amount-shares (unwrap! (cpmm-shares selected-pool other-pool cost-of-shares) err-insufficient-balance))
434 : 462 : (max-cost-of-shares (unwrap! (cpmm-cost selected-pool other-pool max-by-floor) err-overbuy))
435 [ + - ]: 462 : (max-purchase (if (> other-pool u0) (- other-pool u1) u0))
436 : 462 : (market-end (+ (get market-start md) (get market-duration md)))
437 : : )
438 : : ;; Validate token and market state
439 [ - ]: 462 : (asserts! (< index (len categories)) err-category-not-found)
440 [ - ]: 462 : (asserts! (is-eq (get token md) (contract-of token)) err-invalid-token)
441 [ - ]: 462 : (asserts! (not (get concluded md)) err-market-not-concluded)
442 [ + ]: 462 : (asserts! (is-eq (get resolution-state md) RESOLUTION_OPEN) err-market-not-open)
443 [ - ]: 461 : (asserts! (>= max-cost u100) err-amount-too-low)
444 [ - ]: 461 : (asserts! (>= sender-balance max-cost) err-insufficient-balance)
445 [ - ]: 461 : (asserts! (<= max-cost u50000000000000) err-amount-too-high)
446 [ - ]: 461 : (asserts! (< burn-block-height market-end) err-market-not-open)
447 : : ;; ensure the user cannot overpay for shares - this can skew liquidity in other pools
448 [ - ]: 461 : (asserts! (<= cost-of-shares max-cost-of-shares) err-overbuy)
449 [ - ]: 461 : (asserts! (< amount-shares other-pool) err-overbuy)
450 [ + ]: 461 : (asserts! (>= amount-shares min-shares) err-slippage-too-high)
451 [ - ]: 459 : (asserts! (> other-pool u0) err-insufficient-liquidity)
452 [ - ]: 459 : (asserts! (<= amount-shares max-by-floor) err-overbuy)
453 : :
454 : : ;; --- Token Transfers ---
455 : 459 : (try! (contract-call? token transfer cost-of-shares tx-sender (as-contract tx-sender) none))
456 : 459 : (if (> fee u0)
457 [ + ]: 459 : (try! (contract-call? token transfer fee tx-sender (var-get dev-fund) none))
458 [ - ]: 0 : true
459 : : )
460 : :
461 : : ;; --- Update Market State ---
462 : 446 : (let (
463 : 446 : (updated-stakes (unwrap! (replace-at? stake-list index (+ selected-pool amount-shares)) err-category-not-found))
464 : 446 : (updated-token-stakes (unwrap! (replace-at? stake-tokens-list index (+ selected-token-pool cost-of-shares)) err-category-not-found))
465 : : )
466 : 446 : (map-set markets market-id (merge md {stakes: updated-stakes, stake-tokens: updated-token-stakes}))
467 : : )
468 : :
469 : : ;; --- Update User Balances ---
470 : 446 : (let (
471 : 446 : (current-token-balances (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? token-balances {market-id: market-id, user: tx-sender})))
472 : 446 : (token-current (unwrap! (element-at? current-token-balances index) err-category-not-found))
473 : 446 : (user-token-updated (unwrap! (replace-at? current-token-balances index (+ token-current cost-of-shares)) err-category-not-found))
474 : :
475 : 446 : (current-stake-balances (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? stake-balances {market-id: market-id, user: tx-sender})))
476 : 446 : (user-current (unwrap! (element-at? current-stake-balances index) err-category-not-found))
477 : 446 : (user-stake-updated (unwrap! (replace-at? current-stake-balances index (+ user-current amount-shares)) err-category-not-found))
478 : : )
479 : 446 : (map-set stake-balances {market-id: market-id, user: tx-sender} user-stake-updated)
480 : 446 : (map-set token-balances {market-id: market-id, user: tx-sender} user-token-updated)
481 : 446 : (print {event: "market-stake", market-id: market-id, index: index, amount: amount-shares, cost: cost-of-shares, fee: fee, voter: tx-sender, max-cost: max-cost})
482 : 446 : (ok index)
483 : : )
484 : : )
485 : : )
486 : :
487 : : ;; Resolve a market invoked by ai-agent.
488 : 130 : (define-public (resolve-market (market-id uint) (category (string-ascii 64)))
489 : 136 : (let (
490 : 136 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
491 : 134 : (final-index (unwrap! (index-of? (get categories md) category) err-category-not-found))
492 : 134 : (market-end (+ (get market-start md) (get market-duration md)))
493 : 134 : (market-close (+ market-end (get cool-down-period md)))
494 : : )
495 [ + ][ + + ]: 134 : (asserts! (or (is-eq tx-sender (var-get resolution-agent)) (is-eq tx-sender (get creator md))) err-unauthorised)
496 [ - ]: 130 : (asserts! (>= burn-block-height market-close) err-market-wrong-state)
497 [ + ]: 130 : (asserts! (is-eq (get resolution-state md) RESOLUTION_OPEN) err-market-wrong-state)
498 : :
499 : 129 : (map-set markets market-id
500 : 129 : (merge md
501 : 129 : { outcome: (some final-index), resolution-state: RESOLUTION_RESOLVING, resolution-burn-height: burn-block-height }
502 : : )
503 : : )
504 : 129 : (print {event: "resolve-market", market-id: market-id, outcome: final-index, resolver: tx-sender, resolution-state: RESOLUTION_RESOLVING, resolution-burn-height: burn-block-height})
505 : 129 : (ok final-index)
506 : : )
507 : : )
508 : :
509 : 6 : (define-public (execute-hedge
510 : : (market-id uint)
511 : : (hedge-executor <hedge-trait>)
512 : : (token0 <ft-velar-token>) (token1 <ft-velar-token>)
513 : : (token-in <ft-velar-token>) (token-out <ft-velar-token>))
514 : :
515 : 6 : (let (
516 : 6 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
517 : 6 : (market-end (+ (get market-start md) (get market-duration md)))
518 : 6 : (cool-end (+ market-end (get cool-down-period md)))
519 : 6 : (hedged (get hedged md))
520 : 6 : (stored-hexec (default-to (var-get default-hedge-executor) (get hedge-executor md)))
521 : 6 : (cats (get categories md))
522 : 6 : (stakes (get stakes md))
523 : 6 : (predicted (get-biggest-pool-index stakes))
524 : : )
525 : :
526 : : ;; 0) Feature flag
527 [ + ]: 6 : (asserts! (var-get hedging-enabled) err-hedging-disabled)
528 : :
529 : : ;; 1) Auth: restrict who can trigger the hedge (DAO or resolution-agent)
530 : 5 : (asserts!
531 [ + ]: 5 : (or (is-eq tx-sender (var-get resolution-agent))
532 [ + ]: 1 : (unwrap! (is-dao-or-extension) err-hedge-unauthorised))
533 [ - ]: 0 : err-hedge-unauthorised)
534 : :
535 : : ;; 2) Executor authenticity: the provided contract must match stored one exactly
536 [ - ]: 4 : (asserts! (is-eq (contract-of hedge-executor) stored-hexec) err-hedge-exec-mismatch)
537 : :
538 : : ;; 3) Time window: only during cool-down window
539 [ + ]: 4 : (asserts! (>= burn-block-height market-end) err-hedge-window)
540 [ + ]: 3 : (asserts! (< burn-block-height cool-end) err-hedge-window)
541 : :
542 : : ;; 4) Market must be unresolved + not already hedged
543 [ - ]: 2 : (asserts! (not (get concluded md)) err-market-wrong-state)
544 [ - ]: 2 : (asserts! (not hedged) err-hedge-already)
545 : :
546 : : ;; 5) Validate predicted index against categories length
547 : 2 : (asserts! (< (get index (fold find-max-helper stakes { max-val: u0, index: u0, current-index: u0 }))
548 : 2 : (len cats))
549 [ - ]: 0 : err-hedge-bad-prediction)
550 : :
551 : : ;; 6) Validate all tokens are allowed & consistent
552 [ - ]: 2 : (asserts! (is-allowed-token (contract-of token0)) err-hedge-bad-token)
553 [ - ]: 2 : (asserts! (is-allowed-token (contract-of token1)) err-hedge-bad-token)
554 [ - ]: 2 : (asserts! (is-allowed-token (contract-of token-in)) err-hedge-bad-token)
555 [ - ]: 2 : (asserts! (is-allowed-token (contract-of token-out)) err-hedge-bad-token)
556 : : ;; (optional) require token-in/out to be among token0/token1
557 : 2 : (asserts!
558 [ + ][ + ]: 2 : (or (and (is-eq (contract-of token-in) (contract-of token0))
559 [ + ]: 2 : (is-eq (contract-of token-out) (contract-of token1)))
560 [ - ][ - ]: 0 : (and (is-eq (contract-of token-in) (contract-of token1))
561 [ - ]: 0 : (is-eq (contract-of token-out) (contract-of token0))))
562 [ - ]: 0 : err-hedge-bad-token)
563 : :
564 : : ;; 7) Reentrancy/race guard: set hedged=true before external call.
565 : : ;; If the call fails, state reverts automatically.
566 : 2 : (map-set markets market-id (merge md { hedged: true }))
567 : 2 : (print {event: "hedge-start", market-id: market-id, predicted: predicted, executor: stored-hexec})
568 : :
569 : : ;; 8) Execute the hedge via the whitelisted strategy
570 : 2 : (try! (contract-call? hedge-executor perform-custom-hedge market-id predicted))
571 : :
572 : 1 : (print {event: "hedge-done", market-id: market-id, predicted: predicted})
573 : 1 : (ok predicted)
574 : : )
575 : : )
576 : :
577 : 91 : (define-public (resolve-market-undisputed (market-id uint))
578 : 97 : (let (
579 : 97 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
580 : : )
581 [ + ]: 97 : (asserts! (> burn-block-height (+ (get resolution-burn-height md) (var-get dispute-window-length))) err-dispute-window-not-elapsed)
582 [ - ]: 82 : (asserts! (is-eq (get resolution-state md) RESOLUTION_RESOLVING) err-market-not-open)
583 : :
584 : 82 : (map-set markets market-id
585 : 82 : (merge md
586 : 82 : { concluded: true, resolution-state: RESOLUTION_RESOLVED, resolution-burn-height: burn-block-height }
587 : : )
588 : : )
589 : 82 : (print {event: "resolve-market-undisputed", market-id: market-id, resolution-burn-height: burn-block-height, resolution-state: RESOLUTION_RESOLVED})
590 : 82 : (ok true)
591 : : )
592 : : )
593 : :
594 : : ;; concludes a market that has been disputed. This method has to be called at least
595 : : ;; dispute-window-length blocks after the dispute was raised - the voting window.
596 : : ;; a proposal with 0 votes will close the market with the outcome false
597 : 4 : (define-public (resolve-market-vote (market-id uint) (outcome uint))
598 : 6 : (let (
599 : 6 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
600 : : )
601 : 6 : (try! (is-dao-or-extension))
602 [ - ]: 6 : (asserts! (< outcome (len (get categories md))) err-market-not-found)
603 [ + ][ + + ]: 6 : (asserts! (or (is-eq (get resolution-state md) RESOLUTION_DISPUTED) (is-eq (get resolution-state md) RESOLUTION_RESOLVING)) err-market-wrong-state)
604 : :
605 : 5 : (map-set markets market-id
606 : 5 : (merge md
607 : 5 : { concluded: true, outcome: (some outcome), resolution-state: RESOLUTION_RESOLVED }
608 : : )
609 : : )
610 : 5 : (print {event: "resolve-market-vote", market-id: market-id, resolver: contract-caller, outcome: outcome, resolution-state: RESOLUTION_RESOLVED})
611 : 5 : (ok true)
612 : : )
613 : : )
614 : :
615 : : ;; Allows a user with a stake in market to contest the resolution
616 : : ;; the call is made via the voting contract 'create-market-vote' function
617 : 11 : (define-public (dispute-resolution (market-id uint) (disputer principal) (num-categories uint))
618 : 11 : (let (
619 : 11 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
620 : : ;; ensure user has a stake
621 : 11 : (stake-data (unwrap! (map-get? stake-balances { market-id: market-id, user: disputer }) err-disputer-must-have-stake))
622 : : )
623 : : ;; user call create-market-vote in the voting contract to start a dispute
624 : 10 : (try! (is-dao-or-extension))
625 : :
626 [ - ]: 9 : (asserts! (is-eq num-categories (len (get categories md))) err-too-few-categories)
627 : : ;; prevent market getting locked in unresolved state
628 [ - ]: 9 : (asserts! (<= burn-block-height (+ (get resolution-burn-height md) (var-get dispute-window-length))) err-dispute-window-elapsed)
629 : :
630 [ - ]: 9 : (asserts! (is-eq (get resolution-state md) RESOLUTION_RESOLVING) err-market-not-resolving)
631 : :
632 : 9 : (map-set markets market-id
633 : 9 : (merge md { resolution-state: RESOLUTION_DISPUTED }))
634 : 9 : (print {event: "dispute-resolution", market-id: market-id, disputer: disputer, resolution-state: RESOLUTION_DISPUTED})
635 : 9 : (ok true)
636 : : )
637 : : )
638 : 0 : (define-public (force-resolve-market (market-id uint))
639 : 0 : (let (
640 : 0 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
641 : 0 : (elapsed (- burn-block-height (get resolution-burn-height md)))
642 : : )
643 : 0 : (begin
644 [ - ]: 0 : (asserts! (> elapsed (var-get resolution-timeout)) err-market-wrong-state)
645 [ - ]: 0 : (asserts! (is-eq (get resolution-state md) RESOLUTION_DISPUTED) err-market-wrong-state)
646 : :
647 : 0 : (map-set markets market-id
648 : 0 : (merge md { resolution-state: RESOLUTION_RESOLVED, concluded: true })
649 : : )
650 : 0 : (print {event: "force-resolve", market-id: market-id, resolution-state: RESOLUTION_RESOLVED})
651 : 0 : (ok true)
652 : : ))
653 : : )
654 : :
655 : : ;; Proportional payout with market fee only
656 : 63 : (define-public (claim-winnings (market-id uint) (token <ft-token>))
657 : 105 : (let (
658 : 105 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
659 : 102 : (index-won (unwrap! (get outcome md) err-market-not-concluded))
660 : 97 : (marketfee-bips (get market-fee-bips md))
661 : 97 : (treasury (get treasury md))
662 : 97 : (original-sender tx-sender)
663 : :
664 : : ;; user may have acquired shares via p2p and so have no entry under token-balances
665 : 97 : (user-token-list (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? token-balances {market-id: market-id, user: tx-sender})))
666 : 97 : (user-tokens (unwrap! (element-at? user-token-list index-won) err-user-not-staked))
667 : :
668 : 97 : (user-stake-list (unwrap! (map-get? stake-balances {market-id: market-id, user: tx-sender}) err-user-not-staked))
669 : 85 : (user-shares (unwrap! (element-at? user-stake-list index-won) err-user-not-staked))
670 : :
671 : 85 : (stake-list (get stakes md))
672 : 85 : (winning-pool (unwrap! (element-at? stake-list index-won) err-market-not-concluded))
673 : 85 : (total-share-pool (fold + stake-list u0))
674 : :
675 : 85 : (staked-tokens (get stake-tokens md))
676 : 85 : (total-token-pool (fold + staked-tokens u0))
677 : :
678 : : ;; CPMM Payout: the proportion of the total tokens staked to the shares won
679 : 85 : (gross-refund-scaled (if (> winning-pool u0)
680 [ + ]: 85 : (/ (* (* user-shares total-token-pool) SCALE) winning-pool)
681 [ - ]: 0 : u0))
682 : 85 : (gross-refund (/ gross-refund-scaled SCALE))
683 : :
684 : 85 : (marketfee (/ (* gross-refund marketfee-bips) u10000))
685 : 85 : (net-refund (- gross-refund marketfee))
686 : : )
687 : : ;; Check resolved and non zero payout
688 [ + ]: 85 : (asserts! (is-eq (get resolution-state md) RESOLUTION_RESOLVED) err-market-not-concluded)
689 [ - ]: 83 : (asserts! (get concluded md) err-market-not-concluded)
690 [ + ]: 83 : (asserts! (> user-shares u0) err-user-not-winner-or-claimed)
691 [ - ]: 61 : (asserts! (> winning-pool u0) err-amount-too-low)
692 [ - ]: 61 : (asserts! (> net-refund u0) err-user-share-is-zero)
693 : :
694 : : ;; Transfer winnings and market fee
695 : 61 : (as-contract
696 : 61 : (begin
697 : 61 : (if (> marketfee u0)
698 [ + ]: 3 : (try! (contract-call? token transfer marketfee tx-sender treasury none))
699 [ + ]: 58 : true
700 : : )
701 : 61 : (try! (contract-call? token transfer net-refund tx-sender original-sender none))
702 : : )
703 : : )
704 : :
705 : : ;; Zero out stake
706 : 61 : (map-set token-balances {market-id: market-id, user: tx-sender} (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0))
707 : 61 : (map-set stake-balances {market-id: market-id, user: tx-sender} (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0))
708 : 61 : (try! (contract-call? .bme030-0-reputation-token mint tx-sender u1 u10))
709 : 61 : (print {event: "claim-winnings", market-id: market-id, index-won: index-won, claimer: tx-sender, user-tokens: user-tokens, user-shares: user-shares, refund: net-refund, marketfee: marketfee, winning-pool: winning-pool, total-pool: total-share-pool})
710 : 61 : (ok net-refund)
711 : : )
712 : : )
713 : :
714 : 1 : (define-read-only (get-expected-payout (market-id uint) (index uint) (user principal))
715 : 1 : (let (
716 : 1 : (md (unwrap-panic (map-get? markets market-id)))
717 : :
718 : 1 : (token-pool (fold + (get stake-tokens md) u0))
719 : :
720 : 1 : (user-shares-list (unwrap-panic (map-get? stake-balances {market-id: market-id, user: user})))
721 : 1 : (user-shares (unwrap-panic (element-at? user-shares-list index)))
722 : :
723 : 1 : (winning-shares-pool (unwrap-panic (element-at? (get stakes md) index)))
724 : :
725 : 1 : (marketfee-bips (get market-fee-bips md))
726 [ + - ]: 1 : (gross-refund (if (> winning-shares-pool u0) (/ (* user-shares token-pool) winning-shares-pool) u0))
727 : 1 : (marketfee (/ (* gross-refund marketfee-bips) u10000))
728 : 1 : (net-refund (- gross-refund marketfee))
729 : : )
730 [ + - - ]: 1 : (if (and (> user-shares u0) (> winning-shares-pool u0) (> net-refund u0))
731 [ - ]: 0 : (ok { net-refund: net-refund, marketfee: marketfee-bips })
732 [ + ]: 1 : (err u1) ;; not eligible or payout = 0
733 : : )
734 : : )
735 : : )
736 : :
737 : : ;; marketplace transfer function to move shares - dao extension callable
738 : : ;; note - an automated dao function that fulfils orders functions as a 'sell-shares' feature
739 : 5 : (define-public (transfer-shares
740 : : (market-id uint)
741 : : (outcome uint)
742 : : (seller principal)
743 : : (buyer principal)
744 : : (amount uint)
745 : : (token <ft-token>)
746 : : )
747 : 5 : (let (
748 : 5 : (md (unwrap! (map-get? markets market-id) err-market-not-found))
749 : 5 : (stake-list (get stakes md))
750 : 5 : (market-token (get token md))
751 : 5 : (selected-pool (unwrap! (element-at? stake-list outcome) err-category-not-found))
752 : 5 : (other-pools (- (fold + stake-list u0) selected-pool))
753 : :
754 : : ;; Pricing
755 : 5 : (price (unwrap! (cpmm-cost selected-pool other-pools amount) err-overbuy))
756 : 5 : (marketfee-bips (get market-fee-bips md))
757 : 5 : (treasury (get treasury md))
758 : 5 : (fee (/ (* price marketfee-bips) u10000))
759 : 5 : (net-price (- price fee))
760 : 5 : (reduced-fee (/ fee u2))
761 : :
762 : : ;; Share balances
763 : 5 : (seller-balances (unwrap! (map-get? stake-balances {market-id: market-id, user: seller}) err-user-not-staked))
764 : 5 : (seller-shares (unwrap! (element-at? seller-balances outcome) err-user-not-staked))
765 : 5 : (buyer-balances (default-to (list u0 u0 u0 u0 u0 u0 u0 u0 u0 u0) (map-get? stake-balances {market-id: market-id, user: buyer})))
766 : 5 : (buyer-shares (unwrap! (element-at? buyer-balances outcome) err-category-not-found))
767 : : )
768 : : ;; dao extension callable only
769 : 5 : (try! (is-dao-or-extension))
770 : : ;; Ensure seller has enough shares
771 [ + ]: 5 : (asserts! (>= seller-shares amount) err-user-share-is-zero)
772 [ - ]: 4 : (asserts! (is-eq market-token (contract-of token)) err-invalid-token)
773 [ - ]: 4 : (asserts! (is-eq (get resolution-state md) RESOLUTION_OPEN) err-market-wrong-state)
774 : :
775 : : ;; Perform share transfer
776 : : ;; Note: we do not update `stakes` here because total pool liquidity remains unchanged.
777 : 4 : (let (
778 : 4 : (buyer-updated (unwrap! (replace-at? buyer-balances outcome (+ buyer-shares amount)) err-category-not-found))
779 : 4 : (seller-updated (unwrap! (replace-at? seller-balances outcome (- seller-shares amount)) err-category-not-found))
780 : : )
781 : : ;; Update state
782 : 4 : (map-set stake-balances {market-id: market-id, user: buyer} buyer-updated)
783 : 4 : (map-set stake-balances {market-id: market-id, user: seller} seller-updated)
784 : :
785 : : ;; Transfer cost and fee from buyer to seller
786 : 4 : (begin
787 : 4 : (if (> reduced-fee u0)
788 : : ;; buyer pays reduced fee as p2p incentive
789 [ - ]: 0 : (try! (contract-call? token transfer reduced-fee buyer treasury none))
790 [ + ]: 4 : true
791 : : )
792 : 4 : (try! (contract-call? token transfer net-price buyer seller none))
793 : : )
794 : 4 : (print {event: "transfer-shares", market-id: market-id, outcome: outcome, buyer: buyer, seller: seller, amount: amount, price: net-price, fee: fee })
795 : 4 : (ok price)
796 : : )
797 : : )
798 : : )
799 : :
800 : : ;; Helper function to create a list with zeros after index N
801 : 257 : (define-private (zero-after-n (original-list (list 10 uint)) (n uint))
802 : 382 : (let (
803 [ + - ]: 382 : (element-0 (if (<= u0 n) (unwrap-panic (element-at? original-list u0)) u0))
804 [ + + ]: 382 : (element-1 (if (< u1 n) (unwrap-panic (element-at? original-list u1)) u0))
805 [ + + ]: 382 : (element-2 (if (< u2 n) (unwrap-panic (element-at? original-list u2)) u0))
806 [ - + ]: 382 : (element-3 (if (< u3 n) (unwrap-panic (element-at? original-list u3)) u0))
807 [ - + ]: 382 : (element-4 (if (< u4 n) (unwrap-panic (element-at? original-list u4)) u0))
808 [ - + ]: 382 : (element-5 (if (< u5 n) (unwrap-panic (element-at? original-list u5)) u0))
809 [ - + ]: 382 : (element-6 (if (< u6 n) (unwrap-panic (element-at? original-list u6)) u0))
810 [ - + ]: 382 : (element-7 (if (< u7 n) (unwrap-panic (element-at? original-list u7)) u0))
811 [ - + ]: 382 : (element-8 (if (< u8 n) (unwrap-panic (element-at? original-list u8)) u0))
812 [ - + ]: 382 : (element-9 (if (< u9 n) (unwrap-panic (element-at? original-list u9)) u0))
813 : : )
814 : 382 : (list element-0 element-1 element-2 element-3 element-4 element-5 element-6 element-7 element-8 element-9)
815 : : )
816 : : )
817 : :
818 : 6 : (define-private (get-biggest-pool-index (lst (list 10 uint)))
819 : 6 : (get index
820 : 6 : (fold find-max-helper
821 : 6 : lst
822 : 6 : { max-val: u0, index: u0, current-index: u0 }))
823 : : )
824 : :
825 : 6 : (define-private (find-max-helper (val uint) (state { max-val: uint, index: uint, current-index: uint }))
826 : : {
827 [ + + ]: 80 : max-val: (if (> val (get max-val state)) val (get max-val state)),
828 [ + + ]: 80 : index: (if (> val (get max-val state)) (get current-index state) (get index state)),
829 : 80 : current-index: (+ (get current-index state) u1)
830 : : }
831 : : )
832 : :
833 : : ;; --- Extension callback
834 : :
835 : 1 : (define-public (callback (sender principal) (memo (buff 34)))
836 : 1 : (ok true)
837 : : )
|
