-
Notifications
You must be signed in to change notification settings - Fork 6
/
nft.con
277 lines (247 loc) · 15.5 KB
/
nft.con
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
(def nft
(deploy '(do
(def next-token-id 0)
(def token-records {}) ;; {id {:creator, :owner, :data, :policies, :class}}
(def offers {}) ;; {sender {receiver id-set}}
;; This would be a useful function for convex.core
(defn every? [f coll]
(reduce (fn [_ x] (if (f x) true (reduced false))) true coll))
(defn empty->nil [s]
(if (empty? s) nil s))
;; For convenience, our asset path understands a long to be a singleton set
;; Here's a helper function to do that conversion
(defn num->set [n]
(if (long? n) #{n} n))
;; Some useful getter functions, which are exported for general use
(defn get-token-owner
^{:doc {:description "Gets owner of token.",
:examples [{:code "(get-token-owner 1234)"}]
:type :function
:signature [{:params [id]}]}}
[id]
(get-in token-records [id :owner]))
(defn get-token-creator
^{:doc {:description "Gets creator of token.",
:examples [{:code "(get-token-creator 1234)"}]
:type :function
:signature [{:params [id]}]}}
[id]
(get-in token-records [id :creator]))
(defn get-token-data
^{:doc {:description "Gets data map associated with token.",
:examples [{:code "(get-token-data 1234)"}]
:type :function
:signature [{:params [id]}]}}
[id]
(get-in token-records [id :data]))
(defn get-token-class
^{:doc {:description "Gets class actor for token, returns nil if it is a singleton token with policy map.",
:examples [{:code "(get-token-class 1234)"}]
:type :function
:signature [{:params [id]}]}}
[id]
(get-in token-records [id :class]))
;; It is common for nfts to have a uri where we can retrieve off-chain data associated with this token
;; The class actor handles this call, if available, otherwise we look in the token's data for :uri.
(defn get-uri [id]
(let [record (get token-records id)
class (:class record)]
(if (and class (exports? class 'get-uri))
(call class (get-uri id))
(:uri (:data record)))))
;; Implements the balance function for convex.asset.
(defn balance [owner]
(or (get-holding (address owner)) #{}))
;; Implements the owns? function for convex.asset.
(defn owns? [owner id-set]
(let [owner (address owner)
id-set (num->set id-set)]
(subset? id-set (balance owner))))
;; check-trusted? determines whether a given address has 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)
;; 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
(defn check-trusted? [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
(long? policy) (= addr (get-token-owner policy)) ;; policy is a token id
;; (vector? policy) (asset/owns? addr policy) ;; policy is an asset description
:else (= addr policy))))))
;; create-token
;;
;; All nft tokens carry an arbitrary data map: {:name, :description, :uri, etc.}
;; policy-map-or-class can either be nil
;; or a policy map {:destroy _, :update _, :transfer _, [:update :status] _, etc.}
;; or a "class actor" with a check-trusted? method and optional callbacks
;; for check-transfer, perform-transfer, create-token, destroy-token, set-token-data, merge-token-data,
;; get-uri, get-class-name
;; returns id of newly created token
(defn create-token
^{:doc {:description "Creates token with initial data map. Can specify a policy map or a class actor. Returns id of newly created token.",
: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)"}]
:type :function
: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) (exports? 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 (exports? 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
^{:doc {:description "Destroys token, if (check-trusted? *caller* :destroy id)",
:examples [{:code "(destroy-token 1234)"}]
:type :function
:signature [{:params [id]}]}}
[id]
(if (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 (exports? class 'destroy-token))
(call class (destroy-token *caller* id)))
true)))
(defn set-token-data [id data]
^{:doc {:description "Replaces data map, if (check-trusted? *caller* :update id).",
:examples [{:code "(set-token-data 1234 {:name \"New name\", :redeemed? false})"}]
:type :function
:signature [{:params [id data]}]}}
(if (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 (exports? class 'set-token-data))
(call class (set-token-data *caller* id data)))
data)))
(defn merge-token-data [id data]
^{:doc {:description "Merges data into token's data map, if caller has the right to update overall data map or all the relevant fields. In other words, if (check-trusted? *caller* :update id) OR (check-trusted? *caller* [:update key] id) holds for every key in data.",
:examples [{:code "(merge-token-data 1234 {:redeemed? true})"}]
:type :function
:signature [{:params [id data]}]}}
(if (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 (exports? class 'merge-token-data))
(call class (merge-token-data *caller* id data)))
new-data)))
;; Private function: Groups ids by class, only including them if they export a given symbol
(defn group-by-class [id-set required-export]
(reduce (fn [m id]
(let [class (get-token-class id)]
(if (and class (exports? class required-export))
(assoc m class
(conj (get m class #{}) id))
m)))
{} id-set))
;; Returns string explaining restriction, or nil if no restriction on transfer
;; Implemented for convex.asset
(defn check-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)]
(if msg 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)))))
;; perform-transfer must be a private function
(defn perform-transfer [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]))
;; direct-transfer is the 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.
(defn direct-transfer [receiver id-set]
(perform-transfer *caller* receiver (num->set id-set)))
;; private function, to optimize memory use in offers
(defn cancel-offer [sender receiver]
(if-let [my-offers (empty->nil (dissoc (get offers sender) receiver))]
(def offers (assoc offers sender my-offers))
(def offers (dissoc offers sender))))
;; offer-asset is one of the API functions for generalized transfer, called by the sender
;; can cancel existing offer by passing in [addr #{}]
;; Implemented for convex.asset
(defn offer [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)))))
(defn get-offers
^{:doc {:description "Gets all the offers from a given sender.",
:examples [{:code "(get-offers sender)"}]
:type :function
:signature [{:params [sender]}]}}
[sender]
(get offers (address sender)))
;; accept-offer is one of the API functions for generalized transfer, called by receiver
;; Implemented for convex.asset
(defn accept [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"))
(assert (subset? accepted-id-set offered-id-set)) ;; Assures receiver accepts a subset of offer
(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)))
(export create-token destroy-token get-token-owner get-token-creator get-token-data get-token-class balance get-offers check-trusted? set-token-data merge-token-data check-transfer direct-transfer offer accept owns? get-uri))))
(call convexity (register-asset nft {:name "Non-Fungible Tokens"
:description "Convex Non-Fungible Tokens Actor."
:type :non-fungible}))