;;; Distributor: receive and distribute rewards.
(use-trait ft-trait 'SP2AKWJYC7BNY18W1XXKPGP0YVEK63QJG4793Z2D4.sip-010-trait-ft-standard.sip-010-trait)
(impl-trait .farming-receive-trait.farming-receive-trait)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; errors
(define-constant err-check-owner (err u801))
(define-constant err-receive-preconditions (err u802))
(define-constant err-distribute-preconditions (err u803))
(define-constant err-distribute-postconditions (err u804))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; constants
(define-constant REWARD-TOKEN 'SP2ZNGJ85ENDY6QRHQ5P2D4FXKGZWCKTB2T0Z55KS.quiet-confidence)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; auth
(define-data-var owner principal tx-sender)
(define-read-only (get-owner) (var-get owner))
(define-private (check-owner)
(ok (asserts! (is-eq tx-sender (get-owner)) err-check-owner)))
(define-public (set-owner (new-owner principal))
(begin
(try! (check-owner))
(ok (var-set owner new-owner)) ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; accounting
(define-map revenue uint uint) ;;epoch -> cumulative token rewards
(define-read-only (get-revenue-at (epoch uint))
(default-to u0 (map-get? revenue epoch) ))
;; Called by operator.
;; MUST ALWAYS BE ACCOMPANIED BY A CORRECT TRANSFER!
;; Could also store balance and compare to previous but that adds code.
(define-data-var balance uint u0)
(define-read-only (get-balance)
(var-get balance))
(define-private (sync (new-balance uint))
(var-set balance new-balance))
(define-public
(receive
(token <ft-trait>)
(amt uint)
(from principal))
(let ((epoch (contract-call? .farming-wstx-wcha-core current-epoch))
(r (get-revenue-at epoch))
(bal (unwrap-panic
(contract-call?
token get-balance (as-contract tx-sender)))))
(asserts!
(and
(is-eq (contract-of token) REWARD-TOKEN)
;;(> amt u0)
(is-eq from (get-owner))
(>= bal (+ (get-balance) amt))
)
err-receive-preconditions)
(try! (check-owner))
(sync bal)
;; (var-set balance (+ (var-get balance) amt))
(ok (map-set revenue epoch (+ r amt)) )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; claims
(define-map claims
{user: principal, epoch: uint}
uint) ;;block number claimed at
(define-private
(do-claim
(user principal)
(epoch uint))
(map-set claims
{user: user, epoch: epoch}
block-height))
(define-read-only
(has-claimed-epoch
(user principal)
(epoch uint))
(is-some (map-get? claims {user: user, epoch: epoch})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; low level API
(define-private
(do-distribute
(user principal)
(token <ft-trait>)
(amt uint))
(let ((protocol (as-contract tx-sender)))
(ok (if (> amt u0)
(try!
(as-contract
(contract-call?
token transfer amt protocol user none)))
true)) ))
(define-read-only
(calc-distribute
(share {staked: uint, total: uint})
(amt uint))
(if (> (get total share) u0)
(/ (* amt (get staked share)) (get total share))
u0) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; distribute-epoch
(define-private
(distribute-epoch
(user principal)
(token <ft-trait>)
(epoch uint))
(let ((reward (unwrap-panic (get-reward user epoch))))
;; Preconditions
(asserts!
(and
(not (has-claimed-epoch user epoch))
;;(< epoch (current-epoch)) checked by get-share-at
(is-eq (contract-of token) REWARD-TOKEN)
)
err-distribute-preconditions)
;; Update global state
(try! (do-distribute user token (get amt reward)))
;; Update local state
(do-claim user epoch)
;; Postconditions
(ok true)) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; distribute-epochs
(define-private
(distribute-epochs-step
(epoch uint)
(args {user: principal, token: <ft-trait>}))
(let ((res_
(unwrap-panic
(distribute-epoch
(get user args)
(get token args)
epoch)) ))
args))
(define-public
(distribute-epochs
(user principal)
(token <ft-trait>)
(epochs (list 10 uint))) ;;XXX: MAX-EPOCHS
(let ((args {user : user,
token: token})
(res_ (fold distribute-epochs-step epochs args))
(bal (unwrap-panic (contract-call? token get-balance (as-contract tx-sender)))))
(asserts!
(is-eq (contract-of token) REWARD-TOKEN)
err-distribute-preconditions)
;; Update local state
(sync bal)
;; Return
(let ((event
{op : "distribute-epochs",
user : user,
epochs: epochs
}))
(print event)
(ok event) )))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; compute reward epoch list
;; Returns epochs starting at `start-epoch' for which `user' has
;; non-zero rewards.
;; Pagination via GENESIS-EPOCH and `end-epoch'.
(define-read-only
(get-reward
(user principal)
(epoch uint))
(let ((share (try! (contract-call? .farming-wstx-wcha-core get-share-at user epoch)))
(rev (get-revenue-at epoch))
(calc (calc-distribute share rev))
(claimed (default-to u0 (map-get? claims {user: user, epoch: epoch})))
(amt (if (is-eq claimed u0) calc u0)))
(ok {share : share,
rev : rev,
calc : calc,
claimed: claimed,
amt : amt})))
(define-read-only
(get-rewards-step
(epoch uint)
(state {user: principal,
acc : (list 10 ;;XXX: MAX-EPOCHS
{epoch : uint,
reward: uint}) }) )
(let ((reward (unwrap-panic
(get-reward (get user state)
epoch)))
(amt (get amt reward)))
{user: (get user state),
acc : (if (> amt u0)
(unwrap-panic
(as-max-len?
(append (get acc state) {epoch: epoch, reward: amt}) ;;FIXME: reward?
u10))
(get acc state))
}))
(define-read-only
(get-rewards
(user principal)
(start-epoch uint))
(let ((end-epoch (+ start-epoch MAX-EPOCHS)) ;;next
(epochs_ (mkepochs start-epoch))
(reward-epochs (fold get-rewards-step epochs_ {user: user, acc: (list)})))
{reward-epochs: (get acc reward-epochs),
end-epoch : end-epoch} ))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; epochs
(define-constant OFFSETS (list u0 u1 u2 u3 u4 u5 u6 u7 u8 u9))
(define-constant MAX-EPOCHS (len OFFSETS)) ;;10
(define-private
(epochs-step
(i_ uint)
(state {epoch: uint, current: uint, acc: (list 10 uint)})) ;; XXX: MAX-EPOCHS
{epoch: (+ (get epoch state) u1),
current: (get current state),
acc : (if (>= (get epoch state) (get current state))
(get acc state)
(unwrap-panic
(as-max-len?
(append (get acc state) (get epoch state))
u10)))
})
(define-read-only (mkepochs (start-epoch uint))
(let ((current (contract-call? .farming-wstx-wcha-core current-epoch))
(state0 {epoch: start-epoch, current: current, acc: (list)})
(state (fold epochs-step OFFSETS state0)))
(get acc state)))
;;; eof