convex.asset.box.actor.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
Convex core libraries and common utilities
The newest version!
'asset.box.actor

(call *registry*
      (register {:description ["Default actor for `asset.box`."
                               "Implements callable functions for `asset.box` and `convex.asset`."]
                 :name        "Asset box actor."}))

;;;;;;;;;; Setup

(import convex.asset :as asset-lib)

;;;;;;;;;; Values

(def boxes
  ^{:doc {:description "Map of `box id` -> `asset quantity`."}}
  {})

(def counter
  ^{:doc {:description "Count of boxes created, used for creating box ids."}}
  0)

(def offers 
  ^{:doc {:description "Map of `owner` -> (Map of `recipient address` -> `set of box ids`."}}
  {})

(def ownership
  ^{:doc {:descrption "Map of `owner` -> `set of box ids`."}}
  {})

;;;;;;;;;; Private helpers

(defn -qc
  ^{:doc {:description "Checks a box quantity."}
    :private? true}
  [q]
  (cond (set? q) q              ;; base case, quantity of boxes should always be a Set
		(int? q) #{q} 
        (nil? q) #{}
        (fail :ARGUMENT "Invalid box quantity")))

(defn -direct-transfer
  ^{:private? true}
  ;; Internal implementation for executing a direct transfer of box(es).
  [sender receiver quantity]
  (let [q (-qc quantity)
        receiver             (address receiver)
        sender-balance       (get ownership
                                  sender
                                  #{})
        _                    (or (subset? q sender-balance)
        		                 (fail :FUNDS "Cannot transfer box(es) not owned by sender."))  
        receiver-balance     (get ownership
                                  receiver
                                  #{})
        new-sender-balance   (difference sender-balance
                                         q)
        new-receiver-balance (union receiver-balance
                                    q)]
    (set! ownership
         (assoc ownership 
                sender   new-sender-balance
                receiver new-receiver-balance))
    q))

;;;;;;;;;; Implementation of `convex.asset` interface

(defn accept
  ^{:callable true}
  [sender quantity]
  (let [q (-qc quantity)
        sender           (address sender)
        sender-offers    (get offers sender {})  
        offer            (get-in offers [sender *caller*] #{})
        _                (or (subset? q offer) (fail :STATE "Insufficent offer of box(es)"))
        receiver-balance (get ownership
                              *caller*
                              #{})
        new-offer        (difference offer q)]
    (set! offers
      (assoc offers sender
                (assoc sender-offers
                       *caller*
                       new-offer)))
    (-direct-transfer sender *caller* q)))


(defn balance
  ^{:callable true}
  [owner]
  (or (get ownership owner)
      #{}))

(defn direct-transfer
  ^{:callable true}
  [receiver quantity data]
  (-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)))))

(defn receive-asset
  ^{:callable true}
  [path quantity _]
  (let [box-id (int *scope*)]
    ;; NOTE: Accepting first solves the problem of putting a box into itself.
    (asset-lib/accept *caller* path quantity)
    
    (cond
      (not (contains-key? boxes
                          box-id))
      (fail :STATE "Target box does not exist")

      (not (contains-key? (get ownership
                               *caller*)
                          box-id))
      (fail :TRUST
            (str "Box " box-id " not owned")))
    (set! boxes
        (assoc boxes
               box-id
               (asset-lib/quantity-add (get boxes box-id)
                                       [path quantity])))))

(def quantity-add
  ^{:callable true}
  union)

(def quantity-sub
  ^{:callable true}
  difference)

(def quantity-subset?
  ^{:callable true}
  subset?)

;;;;;;;;;; Implementation of `asset.box` interface


(defn burn

  ^{:callable true}

  [set-box-ids]

  (let [owned-boxes (ownership *caller*)]
    (when-not (subset? set-box-ids
                       owned-boxes)
      (fail :TRUST "Burning boxes requires ownership"))
    (for [id set-box-ids]
      (let [contents (boxes id)]
        (if (empty? contents)
          (def boxes
               (dissoc boxes
                       id))
          (fail :STATE (str "Trying to delete non-empty box: " id)))))
    (set! ownership
      (assoc ownership
             *caller*
             (difference owned-boxes
                         set-box-ids)))
    nil))



(defn create
  ^{:callable true}
  []
  (let [id          counter
        owner       *caller*
        owned-boxes (or (get ownership owner) #{})]
    (set! ownership
         (assoc ownership
                owner
                (conj owned-boxes
                      id)))
    (set! boxes
         (assoc boxes
                id
                {})) ;; New box contains no assets
    (set! counter (inc counter))
    [~*address* id]))


(defn remove
  ^{:callable true}
  [asset]
  (let [id *scope*
        current-asset (get boxes id)]
     (when-not (asset-lib/quantity-contains? current-asset asset)
       (fail "Box does not contain quantity of asset specified for removal"))
     (when-not (contains-key? (ownership *caller*)
                              id)
         (fail :TRUST
               (str "Box not owned: " id)))
     (set! boxes
          (assoc boxes
                 id
                 (asset-lib/quantity-sub current-asset
                                         asset)))
     ;; Delivers the asset to the caller.
     ;;
     (asset-lib/transfer *caller* asset)))