convex.asset.multi-token.cvx Maven / Gradle / Ivy
Go to download
Show more of this group Show more artifacts with this name
Show all versions of convex-core Show documentation
Show all versions of convex-core Show documentation
Convex core libraries and common utilities
The newest version!
'asset.multi-token
(call *registry*
(register {:description ["An actor that supports multiple mintable tokens"]
:name "Multi-token actor"}))
;;;;;;;;;; Setup
(import convex.asset :as asset-lib)
(import convex.trust :as trust)
;;;;;;;;;; State
;; Internal Token metadata is stored here
;; Map of { id -> [controller supply] ]
(def tokens {})
;; Per-user data is stored in holdings: Map of { id -> [balance offers] }
;; where:
;; balance is a non-negative Integer
;; offers is nil or a map of { address -> offer amount }
;;;;;;;;; Private functions
(defn -qc
^{:doc {:description "Checks a token quantity."}
:private? true}
[q]
(cond (int? q) q ;; base case, quantity should always be an integer
(nil? q) 0
(fail :ARGUMENT "Invalid token quantity")))
(defn -set-balance
[addr id bal]
(let [h (get-holding addr)
orec (get h id) ;; old record
rec (if orec (assoc orec 0 bal) [bal nil])]
(set-holding addr (assoc h id rec))))
(defn -get-balance
[addr id]
(let [h (get-holding addr)
rec (get h id)]
(if rec (nth rec 0) 0)))
;;;;;;;;;; Public API
(defn create
^{:callable true
:doc {:description "Creates a new token and returns its id. Caller will be controller of token. Returns ID."
:signature [{:params []}
{:params [actor]}]}}
([id]
(or (keyword? id) (fail "Token ID must be a keyword"))
(if (contains-key? tokens id) (fail "Token already exists!"))
(set! tokens (assoc tokens id [*caller* 0]))
id))
;;; Trust / control SPI
(defn change-control
^{:callable true}
[controller]
(or (callable? controller) (fail :ARGUMENT "controller must be a callable value"))
(let [trec (or (get tokens *scope*) (fail :TRUST "Not allowed to update controller"))
cont (nth trec 0)
_ (or
(trust/trusted? cont *caller* :control *scope*)
(fail :TRUST "Not allowed to update controller"))
nrec (assoc trec 0 controller)]
(set! tokens (assoc tokens *scope* nrec))))
;;; Asset SPI
(defn direct-transfer
^{:callable true}
[addr amount data]
(let [addr (address addr)
amount (if amount
(int amount)
0)
id *scope*
bal (-get-balance *caller* id)
tbal (-get-balance addr id)]
;; Amount must be in valid range.
;;
(assert (<= 0
amount
bal))
;; Need this check in case of self-transfers.
(when (= *caller*
addr)
(return amount))
(-set-balance *caller* id (- bal amount))
(-set-balance addr id (+ tbal amount))))
(defn balance
^{:callable true}
([addr]
(let [hs (get-holding addr)
rec (get hs *scope*)]
(if rec (nth rec 0) 0))))
(defn decimals
^{:callable true}
([]
(get (get tokens *scope*) 2 0)))
(defn total-supply
^{:callable true}
([]
(get-in tokens [*scope* 1])))
(defn accept
^{:callable true}
[sender quantity]
(let [id *scope*
quantity (-qc quantity)
_ (cond
(zero? quantity) (return 0)
(< quantity 0) (fail :ARGUMENT "Negative accept amount"))
receiver *caller*
hs (get-holding sender) ;; holdings of sender
rec (get hs id)]
(if rec
(let [os (nth rec 1) ;; offers map
off (or (get os receiver) (fail :STATE "No offer to receiver"))
_ (cond (< off quantity) (fail :STATE "insufficient offer"))
bal (nth rec 0)
nbal (- bal quantity)
_ (cond (< nbal 0) (fail :FUNDS "insufficent balance to accept"))
;; Compute new offer after subtracting quantity
noff (- off quantity)
nos (cond (<= noff 0) (dissoc os receiver) (assoc os receiver noff))
nrec [nbal nos]]
;; Update offer and balance of sender
(set-holding sender (assoc hs id nrec))
;; Add accepted quantity to receiver
(-set-balance receiver id (+ (-get-balance receiver id) quantity))
quantity)
(fail "No offers from sender"))))
(defn get-offer
^{:callable true}
[sender receiver]
(let [id *scope*
rec (or (get (get-holding sender) id) (return 0))]
(or (get (nth rec 1) receiver) 0)))
(defn offer
^{:callable true}
[receiver quantity]
(let [id *scope*
quantity (-qc quantity)
receiver (address receiver)
hs (get-holding *caller*)
rec (get hs id)]
(if rec
(let [os (nth rec 1) ;; offers map
nrec (if (<= quantity 0)
(assoc rec 1 (dissoc os receiver))
(assoc rec 1 (assoc os receiver quantity)))]
(set-holding *caller* (assoc hs id nrec)))
(do ;; create a new record with given offer
(or (get tokens id) (fail "token does not exist"))
(set-holding *caller* {id [0 {receiver quantity}]})))
quantity ;; return value is quantity offered
))
(defn mint
^{:callable true}
[amount]
(let [id *scope*
token (or (get tokens id) (fail "token does not exist"))
[controller supply] token]
(when-not (trust/trusted? controller *caller* :mint)
(fail :TRUST "No rights to mint"))
(let [amount (-qc amount) ;; Mint amount.
new-supply (+ supply amount)
bal (-get-balance *caller* id)
new-bal (+ bal amount)]
;; New supply must be in valid range.
(assert (<= 0 new-supply))
;; new balance must be in range
(assert (<= 0 new-bal))
;; Update state
(-set-balance *caller* id new-bal)
(do
(set! tokens (assoc tokens id [controller new-supply]))
new-supply))))
(defn quantity-add
^{:callable true}
[a b]
(let [a (if a (int a) 0)
b (if b (int b) 0)]
(+ a b)))
(defn quantity-sub
^{:callable true}
[a b]
(let [a (if a (int a) 0)
b (if b (int b) 0)]
(if (>= a b) (- a b) 0)))
(defn quantity-subset?
^{:callable true}
[a b]
(let [a (if a (int a) 0)
b (if b (int b) 0)]
(<= a b)))