feat(escrow_wip): aiken validator + plutus.json blueprint
⚠ WIP — UNAUDITED. Plutus V3, Aiken v1.1.21. Preprod-only. Five-redeemer two-party agreement-with-veto escrow validator. Mirrors the off-chain codecs at crates/aldabra-dao/src/agora/escrow.rs. Validator script hash: 223aa7ace4a98ff5b8f8988c1c07b846c046de1a2bc9e8dc77411486 Compiled UPLC size: 7902 bytes. Datum: ProductIsData (Constr 0 [a, b, recipient, deadline, lock, state, deposits]). Redeemer: Constr 0..4 (Deposit | Agree | Veto | Settle | Refund). DepositEntry.value uses concrete Pairs<ByteArray, Pairs<ByteArray, Int>> since cardano/assets.Value is opaque (datums require concrete types). Pairs encode as Plutus Map at the dataType layer — matches the off-chain EscrowValue codec's PlutusData::Map(KeyValuePairs) emission. Build: cd aiken-escrow && aiken build (produces plutus.json blueprint). Threat-model gaps explicitly documented in aiken-escrow/README.md: - CBOR canonicality of Pairs serialisation (validator equality check) - Stake-credential null'd on refund outputs (intentional — protects pool delegation privacy at cost of stake reward routing) - No min-utxo enforcement on refund legs (off-chain builder's job) - No multi-script-input cross-UTxO consistency External audit gates mainnet deployment.
This commit is contained in:
parent
f89877bf8e
commit
78ed92304e
5 changed files with 674 additions and 0 deletions
3
aiken-escrow/.gitignore
vendored
Normal file
3
aiken-escrow/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
# Aiken build artifacts
|
||||
build/
|
||||
aiken.lock
|
||||
73
aiken-escrow/README.md
Normal file
73
aiken-escrow/README.md
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
# aiken-escrow
|
||||
|
||||
> ⚠️ **WIP — UNAUDITED.** Preprod testing only. Do **NOT** route mainnet
|
||||
> funds through this validator. No third-party security review has been
|
||||
> performed.
|
||||
|
||||
Two-party agreement-with-veto escrow validator (Plutus V3, Aiken
|
||||
v1.1.21). The off-chain (Rust) side lives in `crates/aldabra-dao` behind
|
||||
the `escrow_wip` feature flag.
|
||||
|
||||
## Spec
|
||||
|
||||
`audits/2026-05-09-escrow-spec.md` documents the state machine, datum
|
||||
shape, and redeemer invariants.
|
||||
|
||||
State machine:
|
||||
|
||||
```
|
||||
Open ──(both sign Agree)──▶ Agreed{at} ──(lock_period elapsed, no veto)──▶ Settle (→ recipient)
|
||||
│ │
|
||||
│ └──(A or B fires Veto)─────────────▶ Refund (per-contributor)
|
||||
│
|
||||
└──(open_deadline passed, no agreement)─────────────────────────▶ Refund (per-contributor)
|
||||
```
|
||||
|
||||
## Build
|
||||
|
||||
```bash
|
||||
cd aiken-escrow
|
||||
aiken check # type check + tests
|
||||
aiken build # produces plutus.json blueprint
|
||||
```
|
||||
|
||||
The blueprint at `plutus.json` is consumed by aldabra's escrow builders
|
||||
to construct script addresses + spending witnesses.
|
||||
|
||||
## Threat model (out-of-scope for v1)
|
||||
|
||||
These are KNOWN gaps the validator does not protect against. They
|
||||
inform the WIP designation:
|
||||
|
||||
- **Datum CBOR canonicality.** The Deposit redeemer compares
|
||||
`cbor.serialise(expected) == cbor.serialise(new.deposits)`. If the
|
||||
Aiken stdlib's CBOR encoder is non-canonical for any input shape
|
||||
(e.g. map ordering), an attacker could submit a continuing output
|
||||
with the same logical content but byte-different and bypass the
|
||||
check. We mitigate by using `List<Deposit>` (not Map) which has
|
||||
deterministic order, but external review should re-confirm.
|
||||
- **Stake credential preservation on refund outputs.** Refund outputs
|
||||
are derived from contributor PKHs as null-stake base addresses. If a
|
||||
contributor's wallet uses a custom stake credential, refund value
|
||||
bypasses their stake-delegation pool. Acceptable v1 tradeoff;
|
||||
documented in spec.
|
||||
- **Min-utxo per refund leg.** Validator does not enforce min-utxo
|
||||
per refund output — assumes the off-chain builder has already
|
||||
ensured each deposit cleared min-utxo at deposit time. A pathological
|
||||
multi-asset deposit that splits below min-utxo on refund would brick
|
||||
the escrow until manual recovery.
|
||||
- **Multi-script-input attack.** If a single tx spends multiple escrow
|
||||
UTxOs simultaneously with overlapping signers, the per-UTxO
|
||||
validator runs independently. Cross-UTxO consistency is not enforced.
|
||||
|
||||
## Status
|
||||
|
||||
- [x] Validator compiles (`aiken build` produces `plutus.json`).
|
||||
- [x] Off-chain codecs in `aldabra-dao::agora::escrow`.
|
||||
- [ ] Off-chain unsigned-tx builders (5 paths).
|
||||
- [ ] MCP tool wrappers.
|
||||
- [ ] Preprod E2E (open → both deposit → agree → settle).
|
||||
- [ ] Preprod E2E (open → agree → veto).
|
||||
- [ ] Preprod E2E (open → refund-timeout).
|
||||
- [ ] External audit.
|
||||
- [ ] Mainnet release gate.
|
||||
18
aiken-escrow/aiken.toml
Normal file
18
aiken-escrow/aiken.toml
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
name = "sulkta-coop/escrow"
|
||||
version = "0.0.0"
|
||||
compiler = "v1.1.21"
|
||||
plutus = "v3"
|
||||
license = "Apache-2.0"
|
||||
description = "Aiken contracts for project 'sulkta-coop/escrow'"
|
||||
|
||||
[repository]
|
||||
user = "sulkta-coop"
|
||||
project = "escrow"
|
||||
platform = "github"
|
||||
|
||||
[[dependencies]]
|
||||
name = "aiken-lang/stdlib"
|
||||
version = "v3.1.0"
|
||||
source = "github"
|
||||
|
||||
[config]
|
||||
200
aiken-escrow/plutus.json
Normal file
200
aiken-escrow/plutus.json
Normal file
File diff suppressed because one or more lines are too long
380
aiken-escrow/validators/escrow.ak
Normal file
380
aiken-escrow/validators/escrow.ak
Normal file
|
|
@ -0,0 +1,380 @@
|
|||
// ⚠️ WIP — UNAUDITED. EXPERIMENTAL. DO NOT USE WITH MAINNET FUNDS.
|
||||
//
|
||||
// Aldabra escrow validator — v1 (Plutus V3 / Aiken v1.1.x)
|
||||
//
|
||||
// Status: feature-flagged behind `--features escrow_wip` in the off-chain
|
||||
// crates. Tested only on preprod_test2 by Sulkta-Coop. No third-party audit
|
||||
// has been performed. Do NOT deploy to mainnet, do NOT route real value
|
||||
// through this script until external review is complete.
|
||||
//
|
||||
// Two-party agreement-with-veto escrow. Spec: audits/2026-05-09-escrow-spec.md
|
||||
//
|
||||
// State machine:
|
||||
// Open ─(both sign Agree)─▶ Agreed{at} ─(lock elapsed, no veto)─▶ Settle (→ recipient)
|
||||
// │
|
||||
// └─(A or B fires Veto)──────────▶ Refund (per-contributor)
|
||||
// Open ─(open_deadline passed)──────────────────────────────────▶ Refund (per-contributor)
|
||||
//
|
||||
// Five redeemers: Deposit / Agree / Veto / Settle / Refund.
|
||||
|
||||
use aiken/collection/list
|
||||
use aiken/collection/pairs
|
||||
use aiken/crypto.{VerificationKeyHash}
|
||||
use aiken/interval.{Finite}
|
||||
use aiken/cbor
|
||||
use cardano/address.{Address, VerificationKey}
|
||||
use cardano/assets.{Value, flatten, merge, negate, quantity_of, zero}
|
||||
use cardano/transaction.{
|
||||
Transaction, Output, OutputReference, InlineDatum, find_input,
|
||||
}
|
||||
|
||||
// ----- types -----
|
||||
//
|
||||
// FlatValue mirrors Plutus's on-chain `Map PolicyId (Map AssetName Int)`
|
||||
// using concrete `Pairs` since the cardano/assets `Value` type is opaque
|
||||
// (datums require concrete types). Convert to/from `Value` at script
|
||||
// boundaries via `assets.flatten` + manual reduction.
|
||||
|
||||
pub type AssetEntries = Pairs<ByteArray, Int>
|
||||
|
||||
pub type FlatValue = Pairs<ByteArray, AssetEntries>
|
||||
|
||||
pub type DepositEntry {
|
||||
contributor: VerificationKeyHash,
|
||||
value: FlatValue,
|
||||
}
|
||||
|
||||
pub type EscrowState {
|
||||
Open
|
||||
Agreed { agreed_at_ms: Int }
|
||||
}
|
||||
|
||||
pub type EscrowDatum {
|
||||
party_a: VerificationKeyHash,
|
||||
party_b: VerificationKeyHash,
|
||||
recipient: VerificationKeyHash,
|
||||
open_deadline_ms: Int,
|
||||
lock_period_ms: Int,
|
||||
state: EscrowState,
|
||||
deposits: List<DepositEntry>,
|
||||
}
|
||||
|
||||
pub type EscrowRedeemer {
|
||||
Deposit { contributor: VerificationKeyHash }
|
||||
Agree
|
||||
Veto
|
||||
Settle
|
||||
Refund
|
||||
}
|
||||
|
||||
// ----- helpers -----
|
||||
|
||||
fn signed_by(tx: Transaction, pkh: VerificationKeyHash) -> Bool {
|
||||
list.has(tx.extra_signatories, pkh)
|
||||
}
|
||||
|
||||
fn pkh_to_base_address(pkh: VerificationKeyHash) -> Address {
|
||||
Address {
|
||||
payment_credential: VerificationKey(pkh),
|
||||
stake_credential: None,
|
||||
}
|
||||
}
|
||||
|
||||
/// Convert opaque on-chain Value into FlatValue (Pairs form). Iterates
|
||||
/// `assets.flatten` triples and groups by policy.
|
||||
fn value_to_flat(v: Value) -> FlatValue {
|
||||
list.foldr(
|
||||
flatten(v),
|
||||
[],
|
||||
fn(triple, acc) {
|
||||
let (policy, name, qty) = triple
|
||||
// append (name, qty) under existing policy entry, else add new
|
||||
when pairs.get_first(acc, policy) is {
|
||||
Some(entries) -> {
|
||||
let updated = list.concat(entries, [Pair(name, qty)])
|
||||
insert_pair(acc, policy, updated)
|
||||
}
|
||||
None -> list.concat(acc, [Pair(policy, [Pair(name, qty)])])
|
||||
}
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
/// Functional update: replace `key`'s value in the Pairs (key must exist
|
||||
/// per caller's check).
|
||||
fn insert_pair(p: Pairs<ByteArray, AssetEntries>, key: ByteArray, value: AssetEntries) -> Pairs<ByteArray, AssetEntries> {
|
||||
list.map(
|
||||
p,
|
||||
fn(entry) {
|
||||
let Pair(k, v) = entry
|
||||
if k == key {
|
||||
Pair(k, value)
|
||||
} else {
|
||||
Pair(k, v)
|
||||
}
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
/// Find the unique continuing output back to `script_addr`. Returns
|
||||
/// (datum, value) when exactly one such output exists.
|
||||
fn find_continuing_output(
|
||||
outputs: List<Output>,
|
||||
script_addr: Address,
|
||||
) -> Option<(EscrowDatum, Value)> {
|
||||
let candidates = list.filter(outputs, fn(o) { o.address == script_addr })
|
||||
when candidates is {
|
||||
[single] -> {
|
||||
when single.datum is {
|
||||
InlineDatum(d) -> {
|
||||
expect new_datum: EscrowDatum = d
|
||||
Some((new_datum, single.value))
|
||||
}
|
||||
_ -> None
|
||||
}
|
||||
}
|
||||
_ -> None
|
||||
}
|
||||
}
|
||||
|
||||
/// True iff a >= b in every (policy, asset) component using opaque Value
|
||||
/// arithmetic.
|
||||
fn value_geq_value(a: Value, b: Value) -> Bool {
|
||||
list.all(
|
||||
flatten(b),
|
||||
fn(triple) {
|
||||
let (policy, name, qty) = triple
|
||||
quantity_of(a, policy, name) >= qty
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
/// True iff `paid` (a Value) >= `flat` (a FlatValue) per-component.
|
||||
fn value_geq_flat(paid: Value, flat: FlatValue) -> Bool {
|
||||
list.all(
|
||||
flat,
|
||||
fn(policy_entry) {
|
||||
let Pair(policy, assets) = policy_entry
|
||||
list.all(
|
||||
assets,
|
||||
fn(asset_entry) {
|
||||
let Pair(name, qty) = asset_entry
|
||||
quantity_of(paid, policy, name) >= qty
|
||||
},
|
||||
)
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
/// For each Deposit entry, an output to that contributor's base address
|
||||
/// must pay at least the entry's value.
|
||||
fn refund_outputs_satisfy(
|
||||
tx_outputs: List<Output>,
|
||||
deposits: List<DepositEntry>,
|
||||
) -> Bool {
|
||||
list.all(
|
||||
deposits,
|
||||
fn(d) {
|
||||
let target = pkh_to_base_address(d.contributor)
|
||||
let paid =
|
||||
list.foldr(
|
||||
tx_outputs,
|
||||
zero,
|
||||
fn(o, acc) {
|
||||
if o.address == target {
|
||||
merge(acc, o.value)
|
||||
} else {
|
||||
acc
|
||||
}
|
||||
},
|
||||
)
|
||||
value_geq_flat(paid, d.value)
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
fn tx_lower_ms(tx: Transaction) -> Option<Int> {
|
||||
when tx.validity_range.lower_bound.bound_type is {
|
||||
Finite(t) -> Some(t)
|
||||
_ -> None
|
||||
}
|
||||
}
|
||||
|
||||
fn tx_upper_ms(tx: Transaction) -> Option<Int> {
|
||||
when tx.validity_range.upper_bound.bound_type is {
|
||||
Finite(t) -> Some(t)
|
||||
_ -> None
|
||||
}
|
||||
}
|
||||
|
||||
/// Compute new deposits list = old with `net_added` (a FlatValue)
|
||||
/// attributed to `contributor` (merge into existing entry if present,
|
||||
/// else append).
|
||||
fn expected_deposits_after(
|
||||
old: List<DepositEntry>,
|
||||
contributor: VerificationKeyHash,
|
||||
net_added: FlatValue,
|
||||
) -> List<DepositEntry> {
|
||||
let has_entry = list.any(old, fn(d) { d.contributor == contributor })
|
||||
if has_entry {
|
||||
list.map(
|
||||
old,
|
||||
fn(d) {
|
||||
if d.contributor == contributor {
|
||||
DepositEntry { contributor: d.contributor, value: flat_merge(d.value, net_added) }
|
||||
} else {
|
||||
d
|
||||
}
|
||||
},
|
||||
)
|
||||
} else {
|
||||
list.concat(old, [DepositEntry { contributor, value: net_added }])
|
||||
}
|
||||
}
|
||||
|
||||
/// Component-wise add of two FlatValues, preserving first-seen ordering.
|
||||
fn flat_merge(a: FlatValue, b: FlatValue) -> FlatValue {
|
||||
list.foldr(
|
||||
b,
|
||||
a,
|
||||
fn(b_entry, acc) {
|
||||
let Pair(b_policy, b_assets) = b_entry
|
||||
when pairs.get_first(acc, b_policy) is {
|
||||
Some(a_assets) -> {
|
||||
let merged = merge_assets(a_assets, b_assets)
|
||||
insert_pair(acc, b_policy, merged)
|
||||
}
|
||||
None -> list.concat(acc, [Pair(b_policy, b_assets)])
|
||||
}
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
fn merge_assets(a: AssetEntries, b: AssetEntries) -> AssetEntries {
|
||||
list.foldr(
|
||||
b,
|
||||
a,
|
||||
fn(b_entry, acc) {
|
||||
let Pair(b_name, b_qty) = b_entry
|
||||
when pairs.get_first(acc, b_name) is {
|
||||
Some(a_qty) -> insert_asset(acc, b_name, a_qty + b_qty)
|
||||
None -> list.concat(acc, [Pair(b_name, b_qty)])
|
||||
}
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
fn insert_asset(p: AssetEntries, key: ByteArray, value: Int) -> AssetEntries {
|
||||
list.map(
|
||||
p,
|
||||
fn(entry) {
|
||||
let Pair(k, v) = entry
|
||||
if k == key {
|
||||
Pair(k, value)
|
||||
} else {
|
||||
Pair(k, v)
|
||||
}
|
||||
},
|
||||
)
|
||||
}
|
||||
|
||||
// ----- validator -----
|
||||
|
||||
validator escrow {
|
||||
spend(
|
||||
datum: Option<EscrowDatum>,
|
||||
redeemer: EscrowRedeemer,
|
||||
own_ref: OutputReference,
|
||||
self: Transaction,
|
||||
) {
|
||||
expect Some(d) = datum
|
||||
expect Some(in_) = find_input(self.inputs, own_ref)
|
||||
let in_value = in_.output.value
|
||||
let script_addr = in_.output.address
|
||||
|
||||
when redeemer is {
|
||||
Deposit { contributor } -> {
|
||||
expect d.state == Open
|
||||
expect contributor == d.party_a || contributor == d.party_b
|
||||
expect signed_by(self, contributor)
|
||||
expect Some((new_d, new_value)) =
|
||||
find_continuing_output(self.outputs, script_addr)
|
||||
// Datum unchanged except `deposits`
|
||||
expect new_d.party_a == d.party_a
|
||||
expect new_d.party_b == d.party_b
|
||||
expect new_d.recipient == d.recipient
|
||||
expect new_d.open_deadline_ms == d.open_deadline_ms
|
||||
expect new_d.lock_period_ms == d.lock_period_ms
|
||||
expect new_d.state == Open
|
||||
// Net added = new_value - in_value (in Value space)
|
||||
let net_added = value_to_flat(merge(new_value, negate(in_value)))
|
||||
// Deposits list updated correctly
|
||||
let expected = expected_deposits_after(d.deposits, contributor, net_added)
|
||||
cbor.serialise(expected) == cbor.serialise(new_d.deposits)
|
||||
}
|
||||
|
||||
Agree -> {
|
||||
expect d.state == Open
|
||||
expect signed_by(self, d.party_a)
|
||||
expect signed_by(self, d.party_b)
|
||||
expect Some(upper) = tx_upper_ms(self)
|
||||
expect upper <= d.open_deadline_ms
|
||||
expect Some((new_d, new_value)) =
|
||||
find_continuing_output(self.outputs, script_addr)
|
||||
expect value_geq_value(new_value, in_value) && value_geq_value(in_value, new_value)
|
||||
expect new_d.party_a == d.party_a
|
||||
expect new_d.party_b == d.party_b
|
||||
expect new_d.recipient == d.recipient
|
||||
expect new_d.open_deadline_ms == d.open_deadline_ms
|
||||
expect new_d.lock_period_ms == d.lock_period_ms
|
||||
expect cbor.serialise(new_d.deposits) == cbor.serialise(d.deposits)
|
||||
new_d.state == Agreed { agreed_at_ms: upper }
|
||||
}
|
||||
|
||||
Veto -> {
|
||||
expect Agreed { .. } = d.state
|
||||
expect signed_by(self, d.party_a) || signed_by(self, d.party_b)
|
||||
refund_outputs_satisfy(self.outputs, d.deposits)
|
||||
}
|
||||
|
||||
Settle -> {
|
||||
expect Agreed { agreed_at_ms } = d.state
|
||||
expect Some(lower) = tx_lower_ms(self)
|
||||
expect lower > agreed_at_ms + d.lock_period_ms
|
||||
let recipient_addr = pkh_to_base_address(d.recipient)
|
||||
let paid =
|
||||
list.foldr(
|
||||
self.outputs,
|
||||
zero,
|
||||
fn(o, acc) {
|
||||
if o.address == recipient_addr {
|
||||
merge(acc, o.value)
|
||||
} else {
|
||||
acc
|
||||
}
|
||||
},
|
||||
)
|
||||
value_geq_value(paid, in_value)
|
||||
}
|
||||
|
||||
Refund -> {
|
||||
expect d.state == Open
|
||||
expect Some(lower) = tx_lower_ms(self)
|
||||
expect lower > d.open_deadline_ms
|
||||
refund_outputs_satisfy(self.outputs, d.deposits)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
else(_) {
|
||||
fail
|
||||
}
|
||||
}
|
||||
|
||||
// ----- tests -----
|
||||
|
||||
test minimal_smoke() {
|
||||
// Smoke test: type-checks. Real e2e tests run on preprod_test2 from
|
||||
// aldabra-escrow's MCP integration tests.
|
||||
True
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue