Add experimental Archon actor

Author: mikera

convex-core/src/main/cvx/asset/nft/basic.cvx

@@ -10,15 +10,15 @@
 
 ;;;;;;;;;; Values
 
-(def counter
+(define counter
   ^{:doc {:description "Used for creating NFT ids."}}
   0)
 
-(def offers
+(define offers
   ^{:doc {:description "Map of `owner` -> map of `recipient address` -> `set of NFT ids`"}}
   {})
 
-(def meta
+(define meta
   ^{:doc {:description "Map of ID -> NFT metadata. May be nil for no metadata"}}
   {})
 

convex-core/src/main/cvx/convex/core.cvx

@@ -191,6 +191,16 @@
 		    	  (apply m# (next x))
 		          e)))))
 
+(defmacro define
+		^{:doc {:description "Defines a value in the current environment, like def, but at expand time."
+	          :examples    [{:code "(define cols [:red :green])"}]
+	          :signature   [{:params [name]}
+	                        {:params [name vale]}]}}
+  ([name]
+    (eval `(def ~name)))
+  ([name value]
+     (eval `(def ~name ~value))))
+
 (defmacro defn
   ^{:doc {:description "Defines a function in the current environment."
           :examples    [{:code "(defn my-square [x] (* x x))"}]

convex-core/src/main/cvx/lab/archon.cvx

@@ -0,0 +1,170 @@
+'archon
+
+(call *registry*
+      (register {:description ["Actor for the Archon NFT collection."]
+                 :name         "Archon Actor"}))
+
+(declare balance)
+
+;;;;;;;;;; Governance
+;; We set a controller with upgrade and access rights. This can be removed / modified later
+;; Use the current controller, or the geneses peer account #12 if unspecified
+
+(define guv (or *controller* #12))
+(set-controller guv)
+
+;;;;;;;;;; Values
+
+(define offers
+  ^{:doc {:description "Map of `owner` -> map of `recipient address` -> `set of NFT ids`"}}
+  {})
+
+(define base-url "http://localhost:8080/dlfs/archon")
+
+
+;;;;;;;;;; Archon specific functionality
+
+
+;; Determine if an ID is valid
+(defn valid-id? [id]
+		  (cond
+			(and
+			  (blob? id)
+			  (= 2 (count id))
+			  (<= 1 (int id) 1024))
+			true
+			false))
+
+;; Archon NFT minting, performed once
+(loop [nfts #{} i 1]
+  (cond
+    ;; looping for each Archon NFT
+    (<= i 1024)
+    
+    ;; Run this branch for each NFT
+    (let [;; Generate a 2 byte blob. Small new numeric IDs need an extra byte
+          nft (blob i)
+          nft (if (< i 128) (blob (str "00" nft)) nft)]
+      (if (valid-id? nft)
+    	  (recur (conj nfts nft) (inc i))
+    	  (fail (str "Somehow created an invalid NFT:" nft))))
+		
+    ;; When done give all NFTs to governance account
+    (do (set-holding guv nfts)
+        (or (= (count nfts) 1024) (fail "Unexpected total number of Archons" (count nfts))))))
+
+
+;;;;;;;;;; Implementation of `convex.asset` interface
+
+(defn -qc
+		  ^{:doc {:description "Checks a basic NFT quantity."}
+		    :private? true}
+		  [q]
+		  (cond (set? q) q              ;; base case, quantity should always be a Set
+				(blob? q) #{q} 
+		        (nil? q) #{}
+		        (fail :ARGUMENT "Invalid NFT quantity")))
+
+(defn -direct-transfer
+  ^{:private? true}
+  ;; Used internally by [[accept]] and [[direct-transfer]].
+  [sender receiver quantity]
+  (let [q (-qc quantity)
+        receiver             (address receiver)
+        sender-balance       (or (get-holding sender)
+                                 #{})
+        _                    (or (subset? q sender-balance)
+        		                 (fail :FUNDS "Cannot transfer non-owned NFT(s)"))
+        receiver-balance     (or (get-holding receiver)
+                                 #{})
+        new-sender-balance   (difference sender-balance q)
+        new-receiver-balance (union receiver-balance q)]
+    (set-holding sender new-sender-balance)
+    (set-holding receiver new-receiver-balance)
+    quantity))
+
+
+(defn accept
+  ^{:callable true
+    :private?  true}
+  [sender quantity]
+  (let [q                (-qc quantity)
+        sender           (address sender)
+        sender-offers    (or (get offers
+                                  sender)
+                             {})
+        offer            (or (get-in offers
+                                     [sender
+                                      *caller*])
+                             #{})
+        _                (or (subset? q offer)
+        		             (fail :STATE "Insuffient NFT offer to accept"))
+        receiver-balance (or (get-holding *caller*)
+                             #{})
+        new-offer        (difference offer q)]
+
+    (set! offers
+       (assoc offers
+              sender
+              (assoc sender-offers
+                     *caller*
+                     new-offer)))
+
+    (-direct-transfer sender
+                      *caller*
+                      quantity)))
+
+(defn balance
+  ^{:callable true}
+  [owner]
+  (or (get-holding owner)
+      #{}))
+
+(defn direct-transfer
+  ^{:callable true}
+  [receiver quantity]
+  (-direct-transfer *caller*
+                    receiver
+                    quantity))
+
+(defn offer
+  ^{:callable true}
+  [receiver quantity]
+  (let [q             (-qc quantity)
+        caller-offers (get offers *caller* {})]
+    (set! offers
+         (assoc offers
+                *caller*
+                (assoc caller-offers
+                       receiver
+                       q)))))
+
+
+(def quantity-add
+  ^{:callable true}
+  union)
+
+(def quantity-sub
+  ^{:callable true}
+  difference)
+
+(def quantity-subset?
+  ^{:callable true}
+  subset?)
+
+;;;;;;;;;; Callable functions
+
+
+(defn get-metadata 
+  ^{:callable true
+    :doc       {:description "Gets metadata for a given NFT ID."
+                :signature   [{:params []}
+                              {:params [id]}]}}
+  ([] (recur *scope*))
+  ([id] 
+	(or (valid-id? id) nil)
+    (let [hex (str id)
+	      img (str base-url hex ".png")]
+	  {
+		"image" img
+	  })))

convex-core/src/main/java/convex/core/Constants.java

@@ -169,7 +169,7 @@ public class Constants {
 	/**
 	 * Default print limit
 	 */
-	public static final long PRINT_LIMIT = 4096;
+	public static final long PRINT_LIMIT = 65536;
 
 	public static final String PRINT_EXCEEDED_STRING = "<<Print limit exceeded>>";
 	public static final AString PRINT_EXCEEDED_MESSAGE = Strings.create(PRINT_EXCEEDED_STRING);

convex-core/src/test/java/convex/core/lang/CoreTest.java

@@ -4209,6 +4209,7 @@ public void testSetBang() {
 		// set! fails on undeclared values
 		assertUndeclaredError(step("(set! not-declared 1)"));
 		assertUndeclaredError(step("(do (set! a 13) a)"));
+		assertUndeclaredError(step("(let [foo 3] (set! a 13) a)"));
 
 		// set! works in a function body
 		assertEquals(35L,evalL("(let [a 13 f (fn [x] (set! a 25) (+ x a))] (f 10))"));

convex-core/src/test/java/lab/ArchonTest.java

@@ -0,0 +1,55 @@
+package lab;
+
+import static org.junit.jupiter.api.Assertions.assertEquals;
+
+import java.io.IOException;
+
+import org.junit.jupiter.api.Test;
+
+import convex.core.data.Address;
+import convex.core.lang.ACVMTest;
+import convex.core.lang.Context;
+import convex.core.lang.TestState;
+import convex.core.util.Utils;
+import convex.lib.AssetTester;
+
+public class ArchonTest extends ACVMTest  {
+
+	Address ARCHON;
+	
+	@Override protected Context buildContext(Context ctx) {
+		ctx=TestState.CONTEXT.fork();
+		
+		ctx=exec(ctx,"(import convex.asset :as asset)");
+		ctx=exec(ctx,"(import convex.trust :as trust)");
+		
+		ctx=exec(ctx,"(def archon (deploy '(set-controller *caller*) *address*))");
+		ARCHON=ctx.getResult();
+		
+		try {
+			String code=Utils.readResourceAsString("lab/archon.cvx");
+			ctx=exec(ctx,"(eval-as archon '(do "+code+"))");
+			
+			
+		} catch (IOException e) {
+			// TODO Auto-generated catch block
+			e.printStackTrace();
+			throw new Error(e);
+		}
+		return ctx;
+	}
+	
+	@Test public void testArchonActor() {
+		Context ctx=context();
+		Address archon=eval(ctx,"archon");
+		assertEquals(ARCHON,archon);
+		
+		assertEquals(1024,evalL(ctx,"(count (asset/balance archon))"));
+	}
+	
+	@Test public void testArchonNFTs() {
+		Context ctx=context();
+		ctx=exec(ctx,"(asset/transfer "+VILLAIN+" [archon #{0x0123}])");
+		AssetTester.doAssetTests(ctx, ARCHON, HERO, VILLAIN);
+	}
+}