Add Clarity Backend

copy-test-outputs.py

@@ -17,7 +17,7 @@
 from pathlib import Path
 
 # Backend directories to process
-BACKENDS = ["gambit", "graphviz", "lightning", "smt", "solidity", "vyper"]
+BACKENDS = ["clarity", "gambit", "graphviz", "lightning", "smt", "solidity", "vyper"]
 
 def copy_test_outputs():
     """Copy non-.diff files from test-diffs/BACKEND/ to examples/BACKEND/"""

examples/clarity/MontyHall.clar

@@ -0,0 +1,246 @@
+;; MontyHall - Generated by Vegas Clarity Backend
+
+;; Constants
+(define-constant ERR_NOT_INITIALIZED (err u100))
+(define-constant ERR_ALREADY_INITIALIZED (err u101))
+(define-constant ERR_WRONG_ROLE (err u102))
+(define-constant ERR_NOT_OPEN (err u103))
+(define-constant ERR_TIMEOUT_NOT_READY (err u104))
+(define-constant ERR_NOTHING_TO_WITHDRAW (err u105))
+(define-constant ERR_INVALID_PARAM (err u106))
+(define-constant ERR_COMMIT_MISMATCH (err u107))
+(define-constant ERR_ACTION_ALREADY_DONE (err u108))
+(define-constant ERR_DEPENDENCY_NOT_MET (err u109))
+(define-constant ERR_GUARD_FAILED (err u110))
+(define-constant ERR_PAYOUT_TOO_HIGH (err u111))
+
+;; Data Variables
+(define-data-var initialized bool false)
+(define-data-var last-progress uint u0)
+(define-data-var first-dep-time uint u0)
+(define-data-var payoffs-distributed bool false)
+
+(define-data-var role-guest (optional principal) none)
+(define-data-var deposit-guest uint u0)
+(define-data-var role-host (optional principal) none)
+(define-data-var deposit-host uint u0)
+(define-data-var total-pot uint u0)
+
+(define-data-var commit-host-car (optional (buff 32)) none)
+(define-data-var var-guest-d int 0)
+(define-data-var var-host-goat int 0)
+(define-data-var var-guest-switch bool false)
+(define-data-var var-host-car int 0)
+
+;; Maps
+(define-map action-done uint bool)
+(define-map claims principal uint)
+
+;; Helpers
+(define-read-only (get-time)
+    stacks-block-time
+)
+
+(define-private (check-timeout (delta uint))
+    (>= (get-time) (+ (var-get last-progress) delta))
+)
+(define-private (verify-commit (val (buff 128)) (salt (buff 32)) (comm (buff 32)))
+    (is-eq (sha256 (concat val salt)) comm)
+)
+(define-private (is-done (id uint))
+    (default-to false (map-get? action-done id))
+)
+(define-private (get-contract-principal) (unwrap-panic (as-contract? () tx-sender)))
+
+;; Registration
+(define-public (register-guest)
+    (begin
+        (asserts! (is-none (var-get role-guest)) ERR_ALREADY_INITIALIZED)
+        (try! (stx-transfer? u20 tx-sender (get-contract-principal)))
+        (var-set total-pot (+ (var-get total-pot) u20))
+        (var-set deposit-guest u20)
+        (var-set role-guest (some tx-sender))
+        (if (is-eq (var-get first-dep-time) u0) (var-set first-dep-time (get-time)) true)
+        (check-initialization)
+        (ok true)
+    )
+)
+
+(define-public (register-host)
+    (begin
+        (asserts! (is-none (var-get role-host)) ERR_ALREADY_INITIALIZED)
+        (try! (stx-transfer? u20 tx-sender (get-contract-principal)))
+        (var-set total-pot (+ (var-get total-pot) u20))
+        (var-set deposit-host u20)
+        (var-set role-host (some tx-sender))
+        (if (is-eq (var-get first-dep-time) u0) (var-set first-dep-time (get-time)) true)
+        (check-initialization)
+        (ok true)
+    )
+)
+
+(define-private (check-initialization)
+    (if (and (is-some (var-get role-guest)) (is-some (var-get role-host)))
+        (begin
+            (var-set initialized true)
+            (var-set last-progress (get-time))
+            (map-set action-done u0 true)
+            (map-set action-done u1 true)
+        )
+        true
+    )
+)
+
+;; Cancel
+(define-public (cancel-uninitialized)
+    (begin
+        (asserts! (not (var-get initialized)) ERR_ALREADY_INITIALIZED)
+        (asserts! (> (var-get first-dep-time) u0) ERR_NOT_OPEN)
+        (asserts! (>= (get-time) (+ (var-get first-dep-time) u100)) ERR_TIMEOUT_NOT_READY)
+        (match (var-get role-guest) r
+            (let ((amt (var-get deposit-guest)))
+                (if (> amt u0)
+                    (unwrap-panic (as-contract? ((with-stx amt)) (unwrap-panic (stx-transfer? amt tx-sender r))))
+                    true
+                )
+            )
+            true
+        )
+        (match (var-get role-host) r
+            (let ((amt (var-get deposit-host)))
+                (if (> amt u0)
+                    (unwrap-panic (as-contract? ((with-stx amt)) (unwrap-panic (stx-transfer? amt tx-sender r))))
+                    true
+                )
+            )
+            true
+        )
+        (var-set total-pot u0)
+        (var-set role-guest none)
+        (var-set deposit-guest u0)
+        (var-set role-host none)
+        (var-set deposit-host u0)
+        (var-set first-dep-time u0)
+        (ok true)
+    )
+)
+
+;; Actions
+(define-public (action-host-2 (car (buff 32)) )
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_NOT_OPEN)
+        (asserts! (is-eq (some tx-sender) (var-get role-host)) ERR_WRONG_ROLE)
+        (asserts! (not (is-done u2)) ERR_ACTION_ALREADY_DONE)
+        (asserts! (is-done u1) ERR_DEPENDENCY_NOT_MET)
+        (var-set commit-host-car (some car))
+        (map-set action-done u2 true)
+        (var-set last-progress (get-time))
+        (ok true)
+    )
+)
+
+(define-public (action-guest-3 (d int) )
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_NOT_OPEN)
+        (asserts! (is-eq (some tx-sender) (var-get role-guest)) ERR_WRONG_ROLE)
+        (asserts! (not (is-done u3)) ERR_ACTION_ALREADY_DONE)
+        (asserts! (is-done u2) ERR_DEPENDENCY_NOT_MET)
+        (asserts! (or (is-eq d 0) (is-eq d 1) (is-eq d 2)) ERR_INVALID_PARAM)
+        (var-set var-guest-d d)
+        (map-set action-done u3 true)
+        (var-set last-progress (get-time))
+        (ok true)
+    )
+)
+
+(define-public (action-host-4 (goat int) )
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_NOT_OPEN)
+        (asserts! (is-eq (some tx-sender) (var-get role-host)) ERR_WRONG_ROLE)
+        (asserts! (not (is-done u4)) ERR_ACTION_ALREADY_DONE)
+        (asserts! (is-done u3) ERR_DEPENDENCY_NOT_MET)
+        (asserts! (not (is-eq goat (var-get var-guest-d))) ERR_GUARD_FAILED)
+        (asserts! (or (is-eq goat 0) (is-eq goat 1) (is-eq goat 2)) ERR_INVALID_PARAM)
+        (var-set var-host-goat goat)
+        (map-set action-done u4 true)
+        (var-set last-progress (get-time))
+        (ok true)
+    )
+)
+
+(define-public (action-guest-5 (switch bool) )
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_NOT_OPEN)
+        (asserts! (is-eq (some tx-sender) (var-get role-guest)) ERR_WRONG_ROLE)
+        (asserts! (not (is-done u5)) ERR_ACTION_ALREADY_DONE)
+        (asserts! (is-done u4) ERR_DEPENDENCY_NOT_MET)
+        (var-set var-guest-switch switch)
+        (map-set action-done u5 true)
+        (var-set last-progress (get-time))
+        (ok true)
+    )
+)
+
+(define-public (action-host-6 (car int) (car-salt (buff 32)) )
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_NOT_OPEN)
+        (asserts! (is-eq (some tx-sender) (var-get role-host)) ERR_WRONG_ROLE)
+        (asserts! (not (is-done u6)) ERR_ACTION_ALREADY_DONE)
+        (asserts! (is-done u5) ERR_DEPENDENCY_NOT_MET)
+        (asserts! (is-done u4) ERR_DEPENDENCY_NOT_MET)
+        (asserts! (is-done u2) ERR_DEPENDENCY_NOT_MET)
+        (asserts! (not (is-eq (var-get var-host-goat) car)) ERR_GUARD_FAILED)
+        (asserts! (verify-commit
+    (unwrap-panic (to-consensus-buff? car))
+    car-salt
+    (unwrap-panic (var-get commit-host-car))
+) ERR_COMMIT_MISMATCH)
+        (asserts! (or (is-eq car 0) (is-eq car 1) (is-eq car 2)) ERR_INVALID_PARAM)
+        (var-set var-host-car car)
+        (map-set action-done u6 true)
+        (var-set last-progress (get-time))
+        (ok true)
+    )
+)
+
+;; Finalize
+(define-public (finalize)
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_ALREADY_INITIALIZED)
+        (asserts! (is-done u6) ERR_NOT_OPEN)
+        (asserts! (is-eq (+ (unwrap-panic (to-uint (if (and (or (is-done u2) (is-done u6)) (is-done u5)) (if (is-eq (not (is-eq (var-get var-guest-d) (var-get var-host-car))) (var-get var-guest-switch)) 40 0) (if (not (or (is-done u2) (is-done u6))) 40 0)))) (unwrap-panic (to-uint (if (and (or (is-done u2) (is-done u6)) (is-done u5)) (if (is-eq (not (is-eq (var-get var-guest-d) (var-get var-host-car))) (var-get var-guest-switch)) 0 40) (if (not (or (is-done u2) (is-done u6))) 0 40))))) (var-get total-pot)) ERR_PAYOUT_TOO_HIGH)
+        (map-set claims (unwrap-panic (var-get role-guest)) (unwrap-panic (to-uint (if (and (or (is-done u2) (is-done u6)) (is-done u5)) (if (is-eq (not (is-eq (var-get var-guest-d) (var-get var-host-car))) (var-get var-guest-switch)) 40 0) (if (not (or (is-done u2) (is-done u6))) 40 0)))))
+        (map-set claims (unwrap-panic (var-get role-host)) (unwrap-panic (to-uint (if (and (or (is-done u2) (is-done u6)) (is-done u5)) (if (is-eq (not (is-eq (var-get var-guest-d) (var-get var-host-car))) (var-get var-guest-switch)) 0 40) (if (not (or (is-done u2) (is-done u6))) 0 40)))))
+        (var-set payoffs-distributed true)
+        (ok true)
+    )
+)
+
+;; Timeout
+(define-public (timeout)
+    (begin
+        (asserts! (var-get initialized) ERR_NOT_INITIALIZED)
+        (asserts! (not (var-get payoffs-distributed)) ERR_ALREADY_INITIALIZED)
+        (asserts! (check-timeout u100) ERR_TIMEOUT_NOT_READY)
+        (if (not (is-done u2)) (begin (map-set claims (unwrap-panic (var-get role-guest)) u40) (var-set payoffs-distributed true) (ok true)) (if (not (is-done u3)) (begin (map-set claims (unwrap-panic (var-get role-host)) u40) (var-set payoffs-distributed true) (ok true)) (if (not (is-done u4)) (begin (map-set claims (unwrap-panic (var-get role-guest)) u40) (var-set payoffs-distributed true) (ok true)) (if (not (is-done u5)) (begin (map-set claims (unwrap-panic (var-get role-host)) u40) (var-set payoffs-distributed true) (ok true)) (if (not (is-done u6)) (begin (map-set claims (unwrap-panic (var-get role-guest)) u40) (var-set payoffs-distributed true) (ok true)) (err ERR_NOT_OPEN))))))
+    )
+)
+
+;; Withdraw
+(define-public (withdraw)
+    (let (
+        (recipient tx-sender)
+        (amt (default-to u0 (map-get? claims recipient)))
+    )
+        (asserts! (> amt u0) ERR_NOTHING_TO_WITHDRAW)
+        (map-set claims recipient u0)
+        (try! (as-contract? ((with-stx amt)) (try! (stx-transfer? amt tx-sender recipient))))
+        (ok amt)
+    )
+)