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:
Kayos 2026-05-09 11:38:45 -07:00
parent f89877bf8e
commit 78ed92304e
5 changed files with 674 additions and 0 deletions

3
aiken-escrow/.gitignore vendored Normal file
View file

@ -0,0 +1,3 @@
# Aiken build artifacts
build/
aiken.lock

73
aiken-escrow/README.md Normal file
View 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
View 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

File diff suppressed because one or more lines are too long

View 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
}