(define-constant err-owner (err u100))
(define-constant err-not-found (err u101))
(define-constant err-unauth (err u102))
(define-constant err-amt (err u103))
(define-constant err-closed (err u104))
(define-constant err-funds (err u105))
(define-data-var p-nonce uint u0)
(define-constant ST-ACT u1)
(define-constant ST-CLS u2)
(define-map pools {p-id: uint} {cr: principal,ct: (string-ascii 50),tf: uint,mc: uint,mx: uint,ca: uint,st: uint,cc: uint})
(define-read-only (get-pool (p-id uint)) (map-get? pools {p-id: p-id}))
(define-read-only (get-pool-count) (var-get p-nonce))
(define-public (create-pool (ct (string-ascii 50)) (mc uint) (mx uint))
(let ((nid (+ (var-get p-nonce) u1)))
(asserts! (> mc u0) err-amt)
(asserts! (> mx u0) err-amt)
(map-set pools {p-id: nid} {cr: tx-sender,ct: ct,tf: u0,mc: mc,mx: mx,ca: block-height,st: ST-ACT,cc: u0})
(var-set p-nonce nid)
(print {e: "pool-created",p: nid,cr: tx-sender,ct: ct})
(ok nid)))
(define-map contribs {p-id: uint,c: principal} {a: uint,ca: uint})
(define-read-only (get-contrib (p-id uint) (c principal)) (map-get? contribs {p-id: p-id,c: c}))
(define-public (contribute (p-id uint) (amt uint))
(let ((pool (unwrap! (get-pool p-id) err-not-found))
(ex (default-to {a: u0,ca: u0} (map-get? contribs {p-id: p-id,c: tx-sender}))))
(asserts! (is-eq (get st pool) ST-ACT) err-closed)
(asserts! (>= amt (get mc pool)) err-amt)
(map-set contribs {p-id: p-id,c: tx-sender} {a: (+ (get a ex) amt),ca: block-height})
(map-set pools {p-id: p-id} (merge pool {tf: (+ (get tf pool) amt),cc: (if (is-eq (get a ex) u0) (+ (get cc pool) u1) (get cc pool))}))
(print {e: "contrib",p: p-id,c: tx-sender,a: amt})
(ok true)))
(define-data-var c-nonce uint u0)
(define-constant CL-PEND u1)
(define-constant CL-APPR u2)
(define-constant CL-REJ u3)
(define-constant CL-PAID u4)
(define-map claims {c-id: uint} {p-id: uint,cl: principal,a: uint,r: (string-utf8 500),sa: uint,st: uint,vf: uint,va: uint})
(define-read-only (get-claim (c-id uint)) (map-get? claims {c-id: c-id}))
(define-read-only (get-claim-count) (var-get c-nonce))
(define-public (submit-claim (p-id uint) (amt uint) (r (string-utf8 500)))
(let ((pool (unwrap! (get-pool p-id) err-not-found))
(contrib (unwrap! (get-contrib p-id tx-sender) err-unauth))
(nid (+ (var-get c-nonce) u1)))
(asserts! (is-eq (get st pool) ST-ACT) err-closed)
(asserts! (> (get a contrib) u0) err-unauth)
(asserts! (> amt u0) err-amt)
(asserts! (<= amt (get mx pool)) err-amt)
(asserts! (<= amt (get tf pool)) err-funds)
(map-set claims {c-id: nid} {p-id: p-id,cl: tx-sender,a: amt,r: r,sa: block-height,st: CL-PEND,vf: u0,va: u0})
(var-set c-nonce nid)
(print {e: "claim-sub",c: nid,p: p-id,cl: tx-sender,a: amt})
(ok nid)))
(define-map votes {c-id: uint,v: principal} {vt: bool,vp: uint,va: uint})
(define-read-only (get-vote (c-id uint) (v principal)) (map-get? votes {c-id: c-id,v: v}))
(define-public (vote (c-id uint) (app bool))
(let ((claim (unwrap! (get-claim c-id) err-not-found))
(p-id (get p-id claim))
(pool (unwrap! (get-pool p-id) err-not-found))
(contrib (unwrap! (get-contrib p-id tx-sender) err-unauth))
(vp (get a contrib))
(ex (map-get? votes {c-id: c-id,v: tx-sender})))
(asserts! (is-eq (get st claim) CL-PEND) err-unauth)
(asserts! (> vp u0) err-unauth)
(asserts! (is-none ex) err-unauth)
(map-set votes {c-id: c-id,v: tx-sender} {vt: app,vp: vp,va: block-height})
(map-set claims {c-id: c-id} (merge claim {vf: (if app (+ (get vf claim) vp) (get vf claim)),va: (if app (get va claim) (+ (get va claim) vp))}))
(print {e: "vote",c: c-id,v: tx-sender,app: app,vp: vp})
(ok true)))
(define-public (process-payout (c-id uint))
(let ((claim (unwrap! (get-claim c-id) err-not-found))
(p-id (get p-id claim))
(pool (unwrap! (get-pool p-id) err-not-found))
(tv (+ (get vf claim) (get va claim)))
(th (/ (* (get tf pool) u60) u100)))
(asserts! (is-eq (get st claim) CL-PEND) err-unauth)
(asserts! (>= tv (/ (get tf pool) u2)) err-unauth)
(if (>= (get vf claim) th)
(begin
(map-set claims {c-id: c-id} (merge claim {st: CL-PAID}))
(map-set pools {p-id: p-id} (merge pool {tf: (- (get tf pool) (get a claim))}))
(print {e: "claim-paid",c: c-id,cl: (get cl claim),a: (get a claim)})
(ok true))
(begin
(map-set claims {c-id: c-id} (merge claim {st: CL-REJ}))
(print {e: "claim-rej",c: c-id})
(ok false)))))
(define-public (close-pool (p-id uint))
(let ((pool (unwrap! (get-pool p-id) err-not-found)))
(asserts! (is-eq tx-sender (get cr pool)) err-owner)
(asserts! (is-eq (get st pool) ST-ACT) err-closed)
(map-set pools {p-id: p-id} (merge pool {st: ST-CLS}))
(print {e: "pool-closed",p: p-id,cr: tx-sender})
(ok true)))
(define-public (withdraw (p-id uint))
(let ((pool (unwrap! (get-pool p-id) err-not-found))
(contrib (unwrap! (get-contrib p-id tx-sender) err-not-found))
(wa (get a contrib)))
(asserts! (is-eq (get st pool) ST-CLS) err-unauth)
(asserts! (> wa u0) err-amt)
(let ((sh (/ (* wa (get tf pool)) (get tf pool))))
(map-delete contribs {p-id: p-id,c: tx-sender})
(map-set pools {p-id: p-id} (merge pool {tf: (- (get tf pool) sh),cc: (- (get cc pool) u1)}))
(print {e: "withdraw",p: p-id,c: tx-sender,a: sh})
(ok sh))))