[sBTC DR 0.2] add stx withdrawal requests

romeo/asset-contract/contracts/asset.clar

@@ -17,16 +17,30 @@
 ;;
 (define-constant err-invalid-caller (err u4))
 (define-constant err-forbidden (err u403))
+(define-constant err-not-found (err u404))
 (define-constant err-btc-tx-already-used (err u500))
+(define-constant err-request-id-already-used (err u501))
 
 ;; data vars
 ;;
 (define-data-var contract-owner principal tx-sender)
 (define-data-var bitcoin-wallet-public-key (optional (buff 33)) none)
+(define-data-var last-request-id uint u0)
 
 ;; stores all btc txids that have been used to mint or burn sBTC
 (define-map amounts-by-btc-tx (buff 32) int)
 
+;; stores all fulfilled withdrawal request that have been used to burn sBTC
+(define-map amounts-by-request-id uint int)
+
+;; stores withdrawal requests by tx-sender and request-id
+(define-map requests uint {amount: uint, owner: principal, recipient: {hashbytes: (buff 32), version: (buff 1)}})
+
+;; allowed contract-callers
+(define-map allowance-contract-callers
+    { sender: principal, contract-caller: principal }
+    { until-burn-ht: (optional uint) })
+
 ;; public functions
 ;;
 
@@ -82,6 +96,41 @@
     )
 )
 
+
+;; #[allow(unchecked_data)]
+(define-public (burn-by-request-id (request-id uint))
+    (let ((details (unwrap! (map-get? requests request-id) err-not-found))
+        (amount (get amount details))
+        (owner (get owner details)))
+        (try! (is-contract-owner))
+        (asserts! (map-insert amounts-by-request-id request-id (* -1 (to-int amount))) err-request-id-already-used)
+        (try! (ft-burn? sbtc amount owner))
+        (print {notification: "burn", payload: request-id})
+    	(ok true)
+    )
+)
+
+;; #[allow(unchecked_data)]
+(define-public (request-withdrawal (amount uint) (recipient {hashbytes: (buff 32), version: (buff 1)}))
+    (let ((request-id (+ u1 (var-get last-request-id))))
+        (asserts! (or (is-eq tx-sender contract-caller) (check-caller-allowed)) err-invalid-caller)
+        (map-set requests request-id {amount: amount, owner: tx-sender, recipient: recipient})
+        (var-set last-request-id request-id)
+        (print {notification: "request-withdrawal", payload: {amount: amount, recipient: recipient}})
+        (ok request-id)
+    )
+)
+
+;; #[allow(unchecked_data)]
+(define-public (cancle-request (request-id uint))
+    (let ((details (unwrap! (map-get? requests request-id) err-not-found)))
+        (asserts! (or (is-eq tx-sender contract-caller) (check-caller-allowed)) err-invalid-caller)
+        (map-delete requests request-id)
+        (print {notification: "cancle-request", payload: details})
+        (ok request-id)
+    )
+)
+
 ;; #[allow(unchecked_data)]
 (define-public (transfer (amount uint) (sender principal) (recipient principal) (memo (optional (buff 34))))
 	(begin
@@ -130,6 +179,54 @@
     (map-get? amounts-by-btc-tx btc-txid)
 )
 
+;;
+;; contract caller allowance
+;;
+
+;; Revoke contract-caller authorization to call withdrawal request methods
+;; #[allow(unchecked_data)]
+(define-public (disallow-contract-caller (caller principal))
+  (begin
+    (asserts! (is-eq tx-sender contract-caller)
+              err-invalid-caller)
+    (ok (map-delete allowance-contract-callers { sender: tx-sender, contract-caller: caller }))))
+
+;; Give a contract-caller authorization to call withdrawal request methods
+;;  normally, withdrawal request methods may only be invoked by _direct_ transactions
+;;   (i.e., the tx-sender issues a direct contract-call to the request methods)
+;;  by issuing an allowance, the tx-sender may call through the allowed contract
+;; #[allow(unchecked_data)]
+(define-public (allow-contract-caller (caller principal) (until-burn-ht (optional uint)))
+  (begin
+    (asserts! (is-eq tx-sender contract-caller)
+              err-invalid-caller)
+    (ok (map-set allowance-contract-callers
+               { sender: tx-sender, contract-caller: caller }
+               { until-burn-ht: until-burn-ht }))))
+
+;; Get the burn height at which a particular contract is allowed to make withdrawal requests for a particular principal.
+;; Returns (some (some X)) if X is the burn height at which the allowance terminates
+;; Returns (some none) if the caller is allowed indefinitely
+;; Returns none if there is no allowance record
+(define-read-only (get-allowance-contract-callers (sender principal) (calling-contract principal))
+    (map-get? allowance-contract-callers { sender: sender, contract-caller: calling-contract })
+)
+
+(define-read-only (check-caller-allowed)
+    (or (is-eq tx-sender contract-caller)
+        (let ((caller-allowed
+                 ;; if not in the caller map, return false
+                 (unwrap! (map-get? allowance-contract-callers
+                                    { sender: tx-sender, contract-caller: contract-caller })
+                          false))
+               (expires-at
+                 ;; if until-burn-ht not set, then return true (because no expiry)
+                 (unwrap! (get until-burn-ht caller-allowed) true)))
+          ;; is the caller allowance expired?
+          (if (>= burn-block-height expires-at)
+              false
+              true))))
+
 ;; private functions
 ;;
 (define-private (is-contract-owner)

romeo/asset-contract/tests/asset_test.clar

@@ -9,7 +9,9 @@
 
 (define-constant err-invalid-caller (err u4))
 (define-constant err-forbidden (err u403))
+(define-constant err-not-found (err u404))
 (define-constant err-btc-tx-already-used (err u500))
+(define-constant err-request-id-already-used (err u501))
 
 (define-constant test-burn-height u1)
 (define-constant test-block-header 0x02000000000000000000000000000000000000000000000000000000000000000000000075b8bf903d0153e1463862811283ffbec83f55411c9fa5bd24e4207dee0dc1f1000000000000000000000000)
@@ -165,6 +167,15 @@
 	)
 )
 
+;; @name Withdrawal can be requested by user
+;; @caller wallet_1
+(define-public (test-request-withdrawal)
+	(let ((result (as-contract (contract-call? .asset request-withdrawal u100 {hashbytes: 0x1234, version: 0x01}))))
+		(asserts! (is-ok result) (err {msg: "Should have succeeded", result: result}))
+		(asserts! (is-eq (unwrap-panic result) u1) (err {msg: "Should have returned request id 1", result: result}))
+		(ok true)
+	)
+)
 ;; --- SIP010 tests
 
 ;; @name Token owner can transfer their tokens