All Downloads are FREE. Search and download functionalities are using the official Maven repository.

convex.asset.nft.tokens.cvx Maven / Gradle / Ivy

The newest version!
'asset.nft.tokens


(call *registry*
      (register {:description ["Actor for storing and handling Non-Fungible Tokens, where a token is an map containing:"
                               "- `:creator`, address of the creator"
                               "- `:data`, arbitrary value describing the NFT (eg. a URL)"
                               "- `:owner`, current owner"
                               "At creation, rights can be specified as to who can transfer, destroy, or update the NFT data in anyway (see `create-token`)."
                               "Each NFT implements the asset interface described in `convex.asset`."
                               "Hence, while this account offers specific functions such as `destroy-token`, all other matters are resolved using `convex.asset`."]
                 :name        "Advanced NFT tokens creation and management"}))


;;
;;
;; The primary notion of "quantity" for this contract is a set of token ids.
;; As a convenience, we also recognize a single id as shorthand for the set of that id.
;; Therefore, the contract recognizes the following two types of asset descriptions:
;;
;;   `[nft-contract-address id-set]`
;;   `[nft-contract-address id]`, which is shorthand for `[nft-contract-address #{id}]`
;;
;; This smart contract is designed to be exceptionally simple to use for one-off "singleton tokens",
;; while also providing numerous extension points for creating a class of tokens with shared custom behavior.
;; The goal is that most custom classes of nft tokens will not require building an entire contract
;; from scratch, and instead can be implemented by providing a "class actor" that contains the custom logic.
;; This makes it easier to verify that custom nfts are correct and trustworthy.
;;
;; Each NFT token has a creator, a current owner, and a data map.
;; Note that the owner doesn't necessarily have rights to do anything with the token other than to assert ownership.
;; Singleton tokens utilize a "policy map" to determine who has the right to destroy token,
;; transfer token, or update the data map. By default, these rights reside with the token owner, but
;; the policy map may assign these rights to someone other than the owner, or possibly to no one.
;; One particularly interesting thing you can do with the policy map is to assign a right to
;; the holder of some other token id or asset, thus turning a right into something that is itself transferable.

;; If you desire more complex policy behavior than what the policy map provide, you can implement a
;; "class actor" defining a new class of non-fungible-tokens with some shared behavior.
;; A class actor must implement `check-trusted?`, similarly to what is defined here.
;;
;; As part of the class actor, you may also implement the following "hooks":
;;   (create-token caller id initial-data) - Called when token is created
;;   (destroy-token caller id) - Called when token is destroyed
;;   (set-token-data caller id data) - Called when token's data is replaced with a new data map
;;   (merge-token-data caller id data) - Called when data is merged in with token's existing data.
;;   (get-uri id) - If implemented, this is preferred over :uri field in token's data map.
;;   (check-transfer caller sender receiver id-set) - Additional restrictions beyond basic permission testing.
;;   (perform-transfer caller sender receiver id-set) - Called when transfer takes place
;;
;; Note that a class actor's check-transfer and perform-transfer functions
;; are called with the set of all token ids involved in the transfer that have this class actor.
;; So when transferring a mixed set of tokens from several classes, they are grouped by class,
;; and then each class actor gets called with the set of ids relevant to it.
;;
;; Transfer is implemented using the offer/accept model, following `convex.asset`.
;; So, sender `offer`s a set of ids to the receiver.
;; The receiver's `receive-asset` function is then called to notify them of the offer,
;; and if they want to accept the offer, they call the asset's `accept` function, accepting
;; whatever subset of the offered tokens they want.
;; If an account doesn't implement receive-asset, default behavior is to go ahead and perform the transfer.
;; If an actor doesn't implement receive-asset, default behavior is to fail.
;;
;;


(import convex.asset :as asset)


;;;;;;;;;; Values


(def next-token-id

  ^{:private? true}

  0)



(def token-records

  ^{:private? true}

  ;; {id {:creator, :owner, :data, :policies, :class}}

  {})



(def offers

 ^{:private? true}

 ;; {sender {receiver id-set}}

 {})


;;;;;;;;;; Private - Generic


(defn empty->nil

  ^{:private? true}

  [s]

  (if (empty? s)
    nil
    s))



(defn every?

  ^{:private? true}

  [f coll]

  (reduce (fn [_ x]
            (if (f x)
              true
              (reduced false)))
          true
          coll))


(defn group-by-class

  ^{:private? true}

  ;; Groups ids by class, only including them if they export a given symbol.

  [id-set required-export]

  (reduce (fn [m id]
            (let [class (get-token-class id)]
              (if (and class
                       (callable? class
                                  required-export))
                (assoc m
                       class
                       (conj (get m
                                  class
                                  #{})
                             id))
                m)))
          {}
          id-set))



(defn num->set

  ^{:private? true}

  ;; For convenience, our asset path understands a long to be a singleton set.
  ;; Here's a helper function to do that conversion

  [n]

  (if (long? n)
    #{n}
    n))


;;;;;;;;;; Private - API high-level helpers


(defn cancel-offer

  ^{:private? true}

  ;; Optimizes memory use in offers.

  [sender receiver]

  (def offers
       (if-let [my-offers (empty->nil (dissoc (get offers
                                                   sender)
                                              receiver))]
         (assoc offers
                sender
                my-offers)
         (dissoc offers
                 sender))))



(defn perform-transfer

  ^{:private? true}

  [sender receiver id-set]

  (when-let [msg (check-transfer sender
                                 receiver
                                 id-set)]
    (fail (str msg)))
  (def token-records
       (reduce (fn [records id]
                 (assoc-in records
                           [id
                            :owner]
                           receiver))
               token-records
               id-set))
  (set-holding sender
               (empty->nil (difference (get-holding sender)
                                       id-set)))
  (set-holding receiver
               (union (get-holding receiver)
                      id-set))
  (let [perform-transfer-map (group-by-class id-set
                                             'perform-transfer)]
    (reduce (fn [_ [class id-set]]
              (call class
                    (perform-transfer *caller*
                                      sender
                                      receiver
                                      id-set)))
            nil
            perform-transfer-map)
    [*address*
     id-set]))


;;;;;;;;;; Callable API


(defn create-token

  ^{:callable true
    :doc       {:description ["Creates token with initial data map."
                              "A policy map can provided (see `check-trusted?`) or the address of an account acting as a \"class\"."
                              "A class implements a version of `check-trusted?` and optionally any of the functions found it this account."
                              "Eg. `destroy-token`, `set-token-data`, ..."
                              "Classes are meant for advanced use cases, most of the time a policy map or nil will be sufficient."
                              "Nil means that only the owner can any perform operation on that token (eg. destruction, transfer)"]
                :examples    [{:code "(create-token {:name \"My Amazing Artwork\"} nil)"}
                              {:code "(create-token {:name \"Concert ticket\", :redeemed? false} {:destroy :owner, :update :creator, :transfer :creator})"}
                              {:code "(create-token {:name \"House\"} real-estate-class-actor)"}]
                :signature   [{:params [initial-data policy-map-or-class]}]}}

  [initial-data policy-map-or-class]

  (assert (or (nil? initial-data)
              (map? initial-data))
          (or (nil? policy-map-or-class)
              (map? policy-map-or-class)
              (and (actor? policy-map-or-class)
                   (callable? policy-map-or-class
                              'check-trusted?))))
  (let [holdings     (or (get-holding *caller*)
                         #{})
        id           next-token-id
        token-record {:creator *caller*
                      :owner   *caller*}
        token-record (if initial-data
                       (assoc token-record
                              :data
                              initial-data)
                       token-record)
        token-record (cond
                       (nil? policy-map-or-class) token-record
                       (map? policy-map-or-class) (assoc token-record
                                                         :policies
                                                         policy-map-or-class)
                       :else (assoc token-record
                                    :class
                                    policy-map-or-class))
        class        (:class token-record)]
    (set-holding *caller*
                 (conj holdings
                       id))
    (when (and class
               (callable? class
                          'create-token))
      (call class
            (create-token *caller*
                          id
                          initial-data)))
    (def next-token-id
         (inc next-token-id))
    (def token-records
         (assoc token-records
                id
                token-record))
    id))



(defn destroy-token

  ^{:callable true
    :doc       {:description "Destroys token if `(check-trusted? *caller* :destroy id)` returns true."
                :examples    [{:code "(destroy-token 1234)"}]
                :signature   [{:params [id]}]}}

  [id]

  (when-not (check-trusted? *caller*
                            :destroy
                            id)
    (fail "No right to destroy token"))
  (let [record (get token-records
                    id)
        class  (:class record)
        owner  (:owner record)]
    (set-holding owner (empty->nil (disj (get-holding owner)
                                         id)))
    (def token-records
         (dissoc token-records
                 id))
    (when (and class
               (callable? class
                          'destroy-token))
      (call class
            (destroy-token *caller*
                           id)))
    true))



(defn get-offer

  ^{:callable true
    :doc       {:description "Gets the offer from a given sender to a given receiver."
                :examples    [{:code "(get-offer sender receiver)"}]
                :signature   [{:params [sender receiver]}]}}

  [sender receiver]

  (get-in offers
          [sender
           receiver]))



(defn get-offers

  ^{:callable true
    :doc       {:description "Gets all the offers from a given sender."
                :examples    [{:code "(get-offers sender)"}]
                :signature   [{:params [sender]}]}}
  [sender]

  (get offers
       sender))



(defn get-token-class

  ^{:callable true
    :doc       {:description "Gets class actor for token, returns nil if it is a singleton token with policy map.",
                :examples    [{:code "(get-token-class 1234)"}]
                :signature   [{:params [id]}]}}

  [id]

  (get-in token-records
          [id
           :class]))



(defn get-token-creator

  ^{:callable true
    :doc       {:description "Gets creator of token.",
                :examples    [{:code "(get-token-creator 1234)"}]
                :signature   [{:params [id]}]}}

  [id]

  (get-in token-records
          [id
           :creator]))



(defn get-token-data

  ^{:callable true
    :doc       {:description "Gets data map associated with token."
                :examples    [{:code "(get-token-data 1234)"}]
                :signature   [{:params [id]}]}}

  [id]

  (get-in token-records
          [id
           :data]))



(defn get-token-owner

  ^{:callable true
    :doc       {:description "Gets owner of token.",
                :examples    [{:code "(get-token-owner 1234)"}]
                :signature   [{:params [id]}]}}

  [id]

  (get-in token-records
          [id
           :owner]))



(defn get-uri

  ^{:callable true
    :doc       {:description ["Gets the URI associth with token."
                              "Not all NFTs have a URI pointing to data off-chain but it is common."]}}

  ;; The class actor handles this call, if available, otherwise we look in the token's data for :uri.

  [id]

  (let [record (get token-records
                    id)
        class  (:class record)]
    (if (and class
             (callable? class
                        'get-uri))
      (call class
            (get-uri id))
      (:uri (:data record)))))



(defn merge-token-data

  ^{:callable true
    :doc       {:description ["Merges data into token's data map."
                              "Caller must have the right to do so. Either:"
                              "- `(check-trusted? *caller* :update id)` returns true"
                              "- `(check-trusted? *caller* [:update key] id) returns true for all key-values"]
                :examples    [{:code "(merge-token-data 1234 {:redeemed? true})"}]
                :signature   [{:params [id data]}]}}

  [id data]

  (when-not (or (check-trusted? *caller*
                                :update
                                id)
                (every? (fn [k] (check-trusted? *caller*
                                                [:update
                                                 k]
                                                id))
                        (keys data)))
    (fail "No right to update token's data fields"))
  (let [class    (get-token-class id)
        new-data (merge (get-in token-records
                                [id :data])
                        data)]
    (def token-records
         (assoc-in token-records
                   [id
                    :data]
                   new-data))
    (when (and class
               (callable? class
                          'merge-token-data))
      (call class
            (merge-token-data *caller*
                              id
                              data)))
    new-data))



(defn set-token-data

  ^{:callable true
    :doc       {:description "Replaces data map if `(check-trusted? *caller* :update id)` returns true."
                :examples    [{:code "(set-token-data 1234 {:name \"New name\", :redeemed? false})"}]
                :signature   [{:params [id data]}]}}

  [id data]

  (when-not (check-trusted? *caller*
                            :update
                            id)
    (fail "No right to update token's data"))
  (let [class (get-token-class id)]
    (def token-records
         (assoc-in token-records
                   [id
                    :data]
                   data))
    (when (and class
               (callable? class
                          'set-token-data))
      (call class
            (set-token-data *caller*
                            id
                            data)))
    data))


;;;;;;;;;; Implementation of `convex.asset` interface
;;
;; `get-offer` is implemented as part of the public callable API.


(defn accept

  ^{:callable true
    :private?  true}

  [sender accepted-id-set]

  (let [sender          (address sender)
        receiver        *caller*
        accepted-id-set (num->set accepted-id-set)
        offered-id-set  (or (get-in offers
                                    [sender
                                     receiver])
                            #{})]
    (when-not offer
      (fail "Offer not found"))
    ;; Assures receiver accepts a subset of offer.
    ;;
    (assert (subset? accepted-id-set
                     offered-id-set))
    (if (= accepted-id-set
           offered-id-set)
      (cancel-offer sender
                    receiver)
      (def offers
           (assoc-in offers
                     [sender
                      receiver]
                     (difference offered-id-set
                                 accepted-id-set))))
    (perform-transfer sender
                      receiver
                      accepted-id-set)))



(defn balance

  ^{:callable true
    :private?  true}

  [owner]

  (or (get-holding (address owner))
      #{}))



(defn direct-transfer

  ^{:callable true
    :private?  true}

  ;; Interface for a sender to call the private perform-transfer function
  ;; This does not use the offer/accept model, and does not check whether the receiver wants to receive it.
  ;; Therefore, it is preferred to use `asset/transfer` to transfer assets.

  [receiver id-set data]

  (perform-transfer *caller*
                    receiver
                    (num->set id-set)))



(defn check-transfer

  ^{:callable true
    :private?  true}

  ;; Returns string explaining restriction, or nil if no restriction on transfer.

  [sender receiver id-set]

  (let [id-set (num->set id-set)
        sender (address sender)
        msg    (reduce (fn [_ id]
                         (when-not (check-trusted? sender
                                                   :transfer
                                                   id)
                           (reduced (str "No right to transfer token "
                                         id))))
                       nil
                       id-set)]
    (or msg
        (let [check-transfer-map (group-by-class id-set
                                                 'check-transfer)]
          (reduce (fn [_ [class id-set]]
                    (when-let [msg (call class
                                         (check-transfer *caller*
                                                         sender
                                                         receiver
                                                         id-set))]
                      (reduced msg)))
                  nil
                  check-transfer-map)))))




(defn offer

  ^{:callable true
    :private?  true}

  ;; Can cancel existing offer by passing in `[addr #{}]`.

  [receiver id-set]

  (let [sender   *caller*,
        receiver (address receiver)
        id-set   (num->set id-set)]
    (cond
      (empty? id-set) (cancel-offer sender
                                    receiver)
      :else           (def offers
                           (assoc-in offers
                                     [sender
                                      receiver]
                                     id-set)))))



(def quantity-add

  ^{:callable true
    :private?  true}

  union)



(def quantity-sub

  ^{:callable true
    :private?  true}

  difference)



(defn quantity-subset?

  ^{:callable true
    :private?  true}

  [a b]

  ;; Hack, treats longs as singleton set.
  ;;
  (if (long? a)
    (contains-key? b
                   a)
    (subset? a b)))


;;;;;;;;;; Private callable API


(defn check-trusted?

  ^{:callable true
    :doc       {:description ["Determines whether a given address as certain rights.."
                              "A `policy-key` is either:"
                              "- `:destroy`, right to destroy token"
                              "- `:transfer`, right to transfer token"
                              "- `:update`, right to update token's data map"
                              "- `[:update key]`, right to update specific key in token's data map"
                              "Value for each policy key is determined at token creation (see `create-token`). Either:"
                              "- `:creator`, only creator"
                              "- `:owner`, only current owner"
                              "- `:none`, nobody allowed"
                              "- A specific address"
                              "- Another token id, meaning the owner of that other token has the right"
                              "- An asset as described in `convex.asset`"]
                :signature   [{:params [addr policy-key id]}]}}

  ;; For tokens that have a class actor, we hand off to the class's check-trusted? function,
  ;; and the logic here is bypassed entirely.
  ;;
  ;; For singleton tokens, we check the token's policies (a map).
  ;; The value associated with the given policy-key designates who has the rights to do that action.
  ;; :creator or :owner or :none or a specific account/actor address or
  ;; a token number (whoever owns that token number has the right) or
  ;; asset description (whoever owns that asset/quantity has the right).
  ;; [policy-key key] defaults to policy for policy-key
  ;; Otherwise, a nil policy defaults to :owner

  [addr policy-key id]

  (let [token-record (get token-records
                          id)]
    (if-let [class (:class token-record)]
      (call class
            (check-trusted? addr
                            policy-key
                            id))
      (let [policy (get-in token-record
                           [:policies
                            policy-key])
            policy (if (and (nil? policy)
                            (vector? policy-key))
                     (get-in token-record
                             [:policies
                              (first policy-key)])
                     policy)]
        (cond
          (or (nil? policy)
              (= policy
                 :owner))
          (= addr
             (get-token-owner id))

          (= policy
             :creator)
          (= addr
             (get-token-creator id))

          (= policy
             :none)
          false

          ;; Policy is a token id.
          ;;
          (long? policy)
          (= addr
             (get-token-owner policy))

          ;; Policy is an asset description.
          ;;
          (vector? policy)
          (asset/owns? addr
                       policy)

          :else
          (= addr
             policy))))))




© 2015 - 2024 Weber Informatics LLC | Privacy Policy