mirror of
https://github.com/SHOGGOTH-SECTOR/sica-fondt.git
synced 2026-09-30 01:15:10 +00:00
Merge pull request #17 from SHOGGOTH-SECTOR/claude/economy-organ-analysis-spec-y4d2sh
Resolve economy organ toolchains and spec updates
This commit is contained in:
@@ -1,124 +0,0 @@
|
||||
#!/bin/bash
|
||||
set -euo pipefail
|
||||
|
||||
# SessionStart hook — install the polyglot build toolchains for this repo.
|
||||
#
|
||||
# Claude Code on the web runs in an ephemeral container: anything installed
|
||||
# outside the cached project tree vanishes on restart. This hook reinstalls the
|
||||
# toolchains the project depends on at the start of every session.
|
||||
#
|
||||
# Design rules:
|
||||
# * IDEMPOTENT — each tool is skipped if it is already on PATH (command -v).
|
||||
# * HARD FAIL — if an install fails, the session cannot build. Stop.
|
||||
|
||||
log() { echo "[install-toolchains] $*"; }
|
||||
die() { echo "[install-toolchains] FATAL: $*" >&2; exit 1; }
|
||||
|
||||
export DEBIAN_FRONTEND=noninteractive
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# GNAT + gprbuild + GnuCOBOL (apt)
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v gnatmake >/dev/null 2>&1 && command -v cobc >/dev/null 2>&1; then
|
||||
log "GNAT/gprbuild/GnuCOBOL already present; skipping apt install."
|
||||
else
|
||||
log "Installing gnat gprbuild gnucobol via apt-get ..."
|
||||
sudo apt-get install -y gnat gprbuild gnucobol || die "apt-get install of gnat/gprbuild/gnucobol failed."
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Pony (ponyc) via ponyup
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v ponyc >/dev/null 2>&1; then
|
||||
log "ponyc already present; skipping ponyup install."
|
||||
else
|
||||
log "Installing ponyc via ponyup ..."
|
||||
sh -c "$(curl --proto '=https' --tlsv1.2 -sSf https://raw.githubusercontent.com/ponylang/ponyup/latest-release/ponyup-init.sh)" || die "ponyup-init.sh failed."
|
||||
/root/.local/share/ponyup/bin/ponyup update ponyc release || die "ponyup update ponyc release failed."
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Alire (alr) 2.1.1
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v alr >/dev/null 2>&1; then
|
||||
log "alr already present; skipping Alire install."
|
||||
else
|
||||
log "Installing Alire (alr) 2.1.1 ..."
|
||||
curl -sSL -o /tmp/alr.zip https://github.com/alire-project/alire/releases/download/v2.1.1/alr-2.1.1-bin-x86_64-linux.zip || die "Alire download failed."
|
||||
( cd /tmp && unzip -o -q alr.zip && sudo cp bin/alr /usr/local/bin/alr && chmod +x /usr/local/bin/alr ) || die "Alire unzip/copy failed."
|
||||
log "alr installed to /usr/local/bin/alr"
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Fortran 2018 (gfortran) + OpenBLAS (economy organ: M3d, M3e)
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v gfortran >/dev/null 2>&1; then
|
||||
log "gfortran already present; skipping."
|
||||
else
|
||||
log "Installing gfortran libopenblas-dev via apt-get ..."
|
||||
sudo apt-get install -y gfortran libopenblas-dev || die "apt-get install of gfortran/libopenblas-dev failed."
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# fpm — Fortran Package Manager (economy organ: M3d, M3e)
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v fpm >/dev/null 2>&1; then
|
||||
log "fpm already present; skipping."
|
||||
else
|
||||
log "Installing fpm ..."
|
||||
FPM_URL="https://github.com/fortran-lang/fpm/releases/download/v0.10.1/fpm-0.10.1-linux-x86_64"
|
||||
curl -sSL -o /tmp/fpm "$FPM_URL" || die "fpm download failed."
|
||||
sudo cp /tmp/fpm /usr/local/bin/fpm && sudo chmod +x /usr/local/bin/fpm || die "fpm install failed."
|
||||
log "fpm installed to /usr/local/bin/fpm"
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Tcl (economy organ: M3 sim hub)
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v tclsh >/dev/null 2>&1; then
|
||||
log "tclsh already present; skipping."
|
||||
else
|
||||
log "Installing tcl via apt-get ..."
|
||||
sudo apt-get install -y tcl || die "apt-get install of tcl failed."
|
||||
fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# ECLiPSe Prolog (economy organ: M3b, M3f)
|
||||
# ---------------------------------------------------------------------------
|
||||
if command -v eclipse >/dev/null 2>&1 || [ -x /opt/eclipseclp/bin/x86_64_linux/eclipse ]; then
|
||||
log "ECLiPSe Prolog already present; skipping."
|
||||
else
|
||||
log "Installing ECLiPSe Prolog ..."
|
||||
ECLIPSE_URL="https://eclipseclp.org/Distribution/Current/7.1_13/x86_64_linux/eclipse_basic.tgz"
|
||||
curl -sSL -o /tmp/eclipse_basic.tgz "$ECLIPSE_URL" || die "ECLiPSe download failed."
|
||||
sudo mkdir -p /opt/eclipseclp || die "Could not create /opt/eclipseclp."
|
||||
sudo tar -xzf /tmp/eclipse_basic.tgz -C /opt/eclipseclp || die "ECLiPSe extraction failed."
|
||||
log "ECLiPSe installed to /opt/eclipseclp"
|
||||
fi
|
||||
|
||||
# --------------------------------------------------------------------------- ---------------------------------------------------------------------------
|
||||
# Solidity / Foundry (economy organ: M3c)
|
||||
# ---------------------------------------------------------------------------
|
||||
# if command -v forge >/dev/null 2>&1; then
|
||||
# log "forge (Foundry) already present; skipping."
|
||||
# else
|
||||
# log "Installing Foundry (forge, anvil) ..."
|
||||
# curl -sSL https://foundry.paradigm.xyz | bash || die "Foundry install script failed."
|
||||
# "$HOME/.foundry/bin/foundryup" || die "foundryup failed."
|
||||
# log "Foundry installed"
|
||||
# fi
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# PATH for tools not in standard locations.
|
||||
# ---------------------------------------------------------------------------
|
||||
EXTRA_PATHS='/root/.local/share/ponyup/bin:/opt/eclipseclp/bin/x86_64_linux'
|
||||
FOUNDRY_PATH="$HOME/.foundry/bin"
|
||||
FULL_PATH_LINE="export PATH=$EXTRA_PATHS:$FOUNDRY_PATH:\$PATH"
|
||||
if [ -f "$HOME/.bashrc" ] && grep -qF "eclipseclp" "$HOME/.bashrc"; then
|
||||
log "Toolchain PATH lines already in ~/.bashrc; skipping."
|
||||
else
|
||||
log "Appending toolchain PATH lines to ~/.bashrc"
|
||||
echo "$FULL_PATH_LINE" >> "$HOME/.bashrc" || die "Could not append to ~/.bashrc."
|
||||
fi
|
||||
|
||||
log "Done."
|
||||
@@ -0,0 +1,4 @@
|
||||
# Trader-Wallet
|
||||
|
||||
|
||||
if only you fuckingnlistened
|
||||
@@ -0,0 +1,443 @@
|
||||
# M1 Marketplace — Deterministic Law Script Format Decision Document
|
||||
|
||||
## Executive Summary
|
||||
|
||||
The M1 Marketplace's law script is a **constitution**: deterministic, auditable, non-Turing, loaded at startup, immutable at runtime (L2). This document compares three candidate formats for expressing M1's scoped invariants (L1–L5), position limits, drawdown stops, action allowlists, wallet-binding requirements, and chain allowlists. We recommend **S-expressions with a fixed combinator set** for its optimal balance of expressiveness, auditability, non-Turing guarantees, and failure-mode isolation.
|
||||
|
||||
---
|
||||
|
||||
## 1. Candidate Formats
|
||||
|
||||
### 1.1 Format A: Declarative Rule Table (YAML/TOML-style records)
|
||||
|
||||
**Structure:**
|
||||
```yaml
|
||||
rules:
|
||||
- id: "rule_001"
|
||||
name: "Max BTC position"
|
||||
condition:
|
||||
asset: "BTC"
|
||||
action_type: "buy"
|
||||
constraint: { position_limit: 10.0 }
|
||||
|
||||
- id: "rule_002"
|
||||
name: "Unauthorized chains blocked"
|
||||
condition:
|
||||
action_type: "*"
|
||||
constraint:
|
||||
chain_allowlist: ["ethereum", "solana"]
|
||||
```
|
||||
|
||||
**Expressiveness:**
|
||||
- ✅ Naturally expresses static constraints (position limits, allowlists, drawdown stops).
|
||||
- ⚠️ Awkward for conditional logic (e.g., "if position > X, then drawdown stop"). Requires deep nesting or external evaluation logic.
|
||||
- ⚠️ Difficult to express negation, conjunction, or disjunction across multiple fields without ad-hoc extensions.
|
||||
|
||||
**Auditability:**
|
||||
- ✅ Human-readable; rules are self-documenting.
|
||||
- ✅ Schema validation possible (e.g., JSON Schema, OpenAPI).
|
||||
- ⚠️ No built-in way to trace evaluation: which rules matched? In what order? Why did law_check pass or fail?
|
||||
|
||||
**Non-Turing Guarantee:**
|
||||
- ✅ Structure is inherently acyclic (no loops, recursion, or branching).
|
||||
- ⚠️ Depends on implementation: evaluator must be guaranteed to iterate once per rule, no internal loops.
|
||||
- ⚠️ If evaluator uses external functions (e.g., "call_oracle"), non-Turing status is lost.
|
||||
|
||||
**Failure Modes:**
|
||||
- **Silent mismatches:** A typo in a field name (e.g., `chain_alowlist`) silently skips the rule.
|
||||
- **Ambiguous precedence:** If multiple rules match, which one applies? YAML provides no ordering semantics.
|
||||
- **Extension creep:** New logic (e.g., time-based rules, cross-asset constraints) requires schema mutations.
|
||||
|
||||
---
|
||||
|
||||
### 1.2 Format B: S-expressions with Fixed Combinator Set
|
||||
|
||||
**Structure:**
|
||||
```scheme
|
||||
(law
|
||||
(id "rule_001")
|
||||
(name "Max BTC position")
|
||||
(check (lambda (action trader wallet)
|
||||
(and
|
||||
(eq (asset action) "BTC")
|
||||
(eq (action-type action) "buy")
|
||||
(< (position trader "BTC") 10.0)))))
|
||||
|
||||
(law
|
||||
(id "rule_002")
|
||||
(name "Chain allowlist")
|
||||
(check (lambda (action trader wallet)
|
||||
(member (chain action) (list "ethereum" "solana")))))
|
||||
```
|
||||
|
||||
**Expressiveness:**
|
||||
- ✅ Combinator set (`and`, `or`, `not`, `<`, `>`, `member`, `eq`, etc.) is Turing-incomplete by construction.
|
||||
- ✅ Natural for predicates, constraints, and conditional logic.
|
||||
- ✅ Extensible via new combinators (e.g., add `ratio-check` for drawdown).
|
||||
- ✅ Composable: build complex rules from simple primitives.
|
||||
- ⚠️ Steep learning curve for non-programmers (COBOL-familiar operators may resist).
|
||||
|
||||
**Auditability:**
|
||||
- ✅ Each rule is a pure function: input (action, trader, wallet) → output (pass/fail).
|
||||
- ✅ Trace semantics are built-in: can log each combinator call, build proof trees.
|
||||
- ✅ Debuggable: step through symbolic execution.
|
||||
- ✅ Self-documenting via lambda structure.
|
||||
|
||||
**Non-Turing Guarantee:**
|
||||
- ✅ Combinator set is closed; only allowed operations are enumerated (no `while`, `recurse`, `call-external`).
|
||||
- ✅ Depth bound: lambda nesting is bounded by law complexity; evaluator can enforce max depth.
|
||||
- ✅ Time bound: each combinator has known cost; evaluator can enforce max steps.
|
||||
- ✅ Provably non-Turing if combinator set excludes recursion and cycles.
|
||||
|
||||
**Failure Modes:**
|
||||
- **Syntax errors:** Malformed S-expressions fail at parse time; no silent skips.
|
||||
- **Undefined combinator:** If a rule uses `(frobnicate ...)`, parser rejects it immediately.
|
||||
- **Type mismatches:** If a rule tries `(< action "ethereum")` (comparing struct to string), evaluator fails gracefully.
|
||||
- **Depth/step limits:** If a law is too complex, evaluator flags it at load time, not at runtime.
|
||||
|
||||
---
|
||||
|
||||
### 1.3 Format C: Decision-Table (Matrix Format)
|
||||
|
||||
**Structure:**
|
||||
```
|
||||
| Rule ID | Asset | Action | Position Limit | Chain Allowlist | Drawdown Stop | Outcome |
|
||||
|---------|-------|--------|-----------------|-----------------|---------------|---------|
|
||||
| R_001 | BTC | buy | < 10 | ethereum,solana | n/a | PASS |
|
||||
| R_001 | BTC | buy | >= 10 | ethereum,solana | n/a | FAIL |
|
||||
| R_002 | * | * | n/a | ethereum,solana | n/a | PASS if chain in list |
|
||||
| R_003 | ETH | sell | n/a | ethereum,solana | < 20% loss | PASS |
|
||||
```
|
||||
|
||||
**Expressiveness:**
|
||||
- ✅ Intuitive for auditors: each row is a rule, each column is a fact or constraint.
|
||||
- ⚠️ Difficult to express complex logic (e.g., "if position > X AND wallet binding missing, fail"). Requires cartesian product of rows.
|
||||
- ⚠️ Scaling: N conditions × M values = O(N×M) rows; easily becomes unwieldy.
|
||||
- ✅ Good for classification / risk matrices.
|
||||
|
||||
**Auditability:**
|
||||
- ✅ Highly visual: auditor can scan rows and see all rules at once.
|
||||
- ✅ Compliance-friendly: decision tables are used in regulated industries (banking, insurance).
|
||||
- ⚠️ Redundancy: same constraint repeated across many rows; easy to introduce inconsistencies.
|
||||
- ⚠️ No inherent proof structure: why did a row match? Requires external tracing.
|
||||
|
||||
**Non-Turing Guarantee:**
|
||||
- ✅ Table is finite; no loops or recursion by structure.
|
||||
- ⚠️ Depends on "Outcome" cell: if it can call arbitrary functions, non-Turing is lost.
|
||||
- ⚠️ Row matching logic must be deterministic and acyclic.
|
||||
|
||||
**Failure Modes:**
|
||||
- **Row ordering ambiguity:** If multiple rows match, which takes precedence? Table format doesn't specify.
|
||||
- **Incomplete coverage:** If no row matches, what happens? Default to PASS or FAIL?
|
||||
- **Maintenance complexity:** Adding a new constraint requires rebuilding the entire table (cartesian product).
|
||||
- **Hidden correlations:** Hard to see relationships between rules (e.g., "R_001 always paired with R_003").
|
||||
|
||||
---
|
||||
|
||||
## 2. Comparative Analysis
|
||||
|
||||
| Criterion | A (Declarative) | B (S-expr) | C (Decision-table) |
|
||||
|-----------|-----------------|------------|-------------------|
|
||||
| **Expressiveness** | ⭐⭐ (static constraints) | ⭐⭐⭐⭐⭐ (composable predicates) | ⭐⭐⭐ (classification) |
|
||||
| **Auditability** | ⭐⭐⭐ (readable, schema-valid) | ⭐⭐⭐⭐⭐ (proof trees, trace logs) | ⭐⭐⭐⭐ (visual, tabular) |
|
||||
| **Non-Turing guarantee** | ⭐⭐⭐ (structural, not airtight) | ⭐⭐⭐⭐⭐ (provable, combinator-closed) | ⭐⭐⭐ (structural) |
|
||||
| **Extensibility** | ⭐⭐ (schema mutation) | ⭐⭐⭐⭐ (add combinators) | ⭐ (cartesian explosion) |
|
||||
| **Human readability** | ⭐⭐⭐⭐ | ⭐⭐⭐ (for programmers) | ⭐⭐⭐⭐ |
|
||||
| **Failure-mode isolation** | ⭐⭐ (silent mismatches) | ⭐⭐⭐⭐⭐ (fail-fast parsing) | ⭐⭐⭐ (depends on semantics) |
|
||||
|
||||
---
|
||||
|
||||
## 3. Recommendation: S-expressions with Fixed Combinator Set
|
||||
|
||||
**We recommend Format B** for the following reasons:
|
||||
|
||||
1. **Non-Turing Provability (L2 requirement):** S-expressions with a closed combinator set are provably non-Turing. The Marketplace can enumerate all allowed operations at startup, verify no cycles or unbounded loops, and enforce step/depth limits at evaluation time. This is unmatched by Formats A and C.
|
||||
|
||||
2. **Auditability & Traceability:** Each law is a pure function with explicit inputs and outputs. The evaluator can build a **proof tree** showing which combinators matched, in what order, and why `law_check` passed or failed. Auditors can step through the logic symbolically. Formats A and C lack this transparency.
|
||||
|
||||
3. **Failure-Mode Isolation:** Parse-time and load-time failures catch errors immediately. A malformed law (undefined combinator, type mismatch, depth exceeded) fails hard at startup—no silent skips, no runtime surprises. This mirrors the COBOL vault invariant (S3 / S99).
|
||||
|
||||
4. **Extensibility without Mutation:** New constraints (drawdown ratio checks, wallet-binding logic, time-based rules) are added as new combinators, not schema mutations. The core evaluator remains stable.
|
||||
|
||||
5. **Compatibility with L3-L5:**
|
||||
- **L3 (no wallet, no access):** Combinator `(wallet-bound? wallet)` is a primitive.
|
||||
- **L4 (veto after law, before execution):** Combinator set does not include veto logic; law_check is orthogonal to veto_check.
|
||||
- **L5 (logging):** Evaluator logs each law invocation and result; combinators are traceable.
|
||||
|
||||
6. **Operator + Homunculus Signatures (L2):** The S-expression law script is a single immutable text blob, signed at startup. Easier to sign and verify than YAML (schema-dependent serialization) or decision tables (multi-row format).
|
||||
|
||||
---
|
||||
|
||||
## 4. Fixed Combinator Set
|
||||
|
||||
The law script evaluator provides a **closed set** of combinators. No new combinators are added at runtime; changes to the combinator set require a restart with new signatures.
|
||||
|
||||
### Core Combinators
|
||||
|
||||
**Logical:**
|
||||
- `(and expr1 expr2 ...)` — conjunction (short-circuits on false).
|
||||
- `(or expr1 expr2 ...)` — disjunction (short-circuits on true).
|
||||
- `(not expr)` — negation.
|
||||
|
||||
**Comparison:**
|
||||
- `(eq x y)`, `(ne x y)` — equality / inequality.
|
||||
- `(< x y)`, `(> x y)`, `(<= x y)`, `(>= x y)` — numeric comparison.
|
||||
|
||||
**Membership:**
|
||||
- `(member item (list ...))` — item in list? Returns true/false.
|
||||
- `(in-range value min max)` — value in [min, max)?
|
||||
|
||||
**Predicates on Action/Trader/Wallet:**
|
||||
- `(asset-is action symbol)` — asset == symbol.
|
||||
- `(action-type-is action type)` — action type (buy, sell, mint, etc.).
|
||||
- `(position-limit trader asset limit)` — trader's position in asset < limit.
|
||||
- `(drawdown-limit trader asset percent)` — realized drawdown < percent.
|
||||
- `(chain-is action chain)` — blockchain == chain.
|
||||
- `(wallet-bound wallet)` — wallet is non-null.
|
||||
- `(wallet-approved wallet trader)` — wallet is approved for this trader (from M4 binding).
|
||||
- `(status-is trader status)` — trader status (active, suspended, etc.).
|
||||
|
||||
**Arithmetic (safe):**
|
||||
- `(+ x y)`, `(- x y)`, `(* x y)`, `(/ x y)` — bounded arithmetic (saturation on overflow).
|
||||
|
||||
**Control (non-Turing):**
|
||||
- `(cond (test1 result1) (test2 result2) ...)` — if-then-else (no loops).
|
||||
- `(comment "text" expr)` — documentation; evaluates expr, returns result.
|
||||
|
||||
### Forbidden Operations
|
||||
- `(loop ...)`, `(while ...)`, `(recurse ...)` — unbounded iteration.
|
||||
- `(call-external ...)`, `(invoke-oracle ...)` — non-deterministic side effects.
|
||||
- `(eval ...)`, `(quote ...)` — metaprogramming.
|
||||
|
||||
---
|
||||
|
||||
## 5. Example Marketplace Constitution (M1-v1)
|
||||
|
||||
```scheme
|
||||
;;; M1 Marketplace — Deterministic Law Script v1
|
||||
;;; Loaded at startup; immutable at runtime (M1-L2).
|
||||
;;; Operator & Homunculus signatures below.
|
||||
|
||||
;;; ============================================================
|
||||
;;; HEADER: Version, Signatures, Metadata
|
||||
;;; ============================================================
|
||||
|
||||
(constitution
|
||||
(version "1.0")
|
||||
(effective-date "2026-07-19T00:00:00Z")
|
||||
(operator-signature "0x1234...abcd") ; Operator's Ed25519 signature
|
||||
(homunculus-signature "0x5678...efgh") ; Homunculus's Ed25519 signature
|
||||
(description "M1 Marketplace law script v1: enforces L1-L5 invariants, position limits, chain allowlists.")
|
||||
)
|
||||
|
||||
;;; ============================================================
|
||||
;;; L1: All market actions route through Marketplace
|
||||
;;; (Implicit: law_check is the only gate. No on-chain bypass possible.)
|
||||
;;; ============================================================
|
||||
|
||||
;;; ============================================================
|
||||
;;; L3: No wallet, no access
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "L3-wallet-binding")
|
||||
(name "Trader must have bound wallet")
|
||||
(description "L3 invariant: a trader without a bound wallet cannot submit actions.")
|
||||
(check (lambda (action trader wallet)
|
||||
(wallet-bound wallet))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; L4: Veto is checked after law, before execution
|
||||
;;; (Implicit: law_check runs first, then veto_check. No veto in law script.)
|
||||
;;; ============================================================
|
||||
|
||||
;;; ============================================================
|
||||
;;; L5: Every action is logged
|
||||
;;; (Implicit: evaluator logs all law_check invocations, pass or fail.)
|
||||
;;; ============================================================
|
||||
|
||||
;;; ============================================================
|
||||
;;; Position Limits (per-asset, per-trader)
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "LIMIT-BTC")
|
||||
(name "BTC position limit")
|
||||
(description "No single trader may hold > 10 BTC.")
|
||||
(check (lambda (action trader wallet)
|
||||
(or
|
||||
(not (asset-is action "BTC"))
|
||||
(position-limit trader "BTC" 10.0)))))
|
||||
|
||||
(law
|
||||
(id "LIMIT-ETH")
|
||||
(name "ETH position limit")
|
||||
(description "No single trader may hold > 100 ETH.")
|
||||
(check (lambda (action trader wallet)
|
||||
(or
|
||||
(not (asset-is action "ETH"))
|
||||
(position-limit trader "ETH" 100.0)))))
|
||||
|
||||
(law
|
||||
(id "LIMIT-USDC")
|
||||
(name "USDC position limit")
|
||||
(description "No single trader may hold > 1M USDC.")
|
||||
(check (lambda (action trader wallet)
|
||||
(or
|
||||
(not (asset-is action "USDC"))
|
||||
(position-limit trader "USDC" 1000000.0)))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Drawdown Stops
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "STOP-20pct-drawdown")
|
||||
(name "Drawdown stop at 20%")
|
||||
(description "If a trader's realized drawdown exceeds 20%, no further sells (or limit actions) until reset.")
|
||||
(check (lambda (action trader wallet)
|
||||
(or
|
||||
(not (action-type-is action "sell"))
|
||||
(drawdown-limit trader "all" 20.0)))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Action Allowlists: Only buy, sell, mint, provide_liquidity, withdraw, claim_rewards
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "ACTION-allowlist")
|
||||
(name "Only allowed action types")
|
||||
(description "Marketplace only accepts: buy, sell, mint, provide_liquidity, withdraw_liquidity, claim_rewards.")
|
||||
(check (lambda (action trader wallet)
|
||||
(member (action-type action)
|
||||
(list "buy" "sell" "mint" "provide_liquidity" "withdraw_liquidity" "claim_rewards")))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Chain Allowlist: ethereum, solana, arbitrum
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "CHAIN-allowlist")
|
||||
(name "Supported chains only")
|
||||
(description "Actions are allowed only on ethereum, solana, or arbitrum.")
|
||||
(check (lambda (action trader wallet)
|
||||
(member (chain action)
|
||||
(list "ethereum" "solana" "arbitrum")))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Wallet Approval: Wallet must be approved for this trader
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "WALLET-approval")
|
||||
(name "Wallet must be approved for trader")
|
||||
(description "The bound wallet must be explicitly approved for this trader by M4.")
|
||||
(check (lambda (action trader wallet)
|
||||
(wallet-approved wallet trader))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; Trader Status: Only active traders can submit actions
|
||||
;;; ============================================================
|
||||
|
||||
(law
|
||||
(id "TRADER-status")
|
||||
(name "Trader must be active")
|
||||
(description "Only traders with status 'active' can submit actions. Suspended or banned traders are rejected.")
|
||||
(check (lambda (action trader wallet)
|
||||
(status-is trader "active"))))
|
||||
|
||||
;;; ============================================================
|
||||
;;; End of Constitution
|
||||
;;; ============================================================
|
||||
```
|
||||
|
||||
---
|
||||
|
||||
## 6. Evaluation & Versioning
|
||||
|
||||
### Law Script Loading (Startup)
|
||||
|
||||
1. **Parse:** S-expression parser validates syntax. Reject if malformed.
|
||||
2. **Verify Signatures:** Extract operator + Homunculus signatures; verify with Ed25519 public keys. Reject if invalid.
|
||||
3. **Validate Combinators:** Scan all `(lambda ...)` expressions; ensure only allowed combinators are used. Reject if undefined combinator found.
|
||||
4. **Enforce Depth Limits:** Check that lambda nesting depth < 20 (configurable). Reject if exceeded.
|
||||
5. **Load into Memory:** Store law script as immutable bytecode. Set flag: law script is loaded and locked.
|
||||
|
||||
### Law Check Execution
|
||||
|
||||
```
|
||||
law_check(action: MarketAction) -> { pass | violation(rule_id, reason) }
|
||||
```
|
||||
|
||||
1. Iterate over all laws (in order of definition).
|
||||
2. For each law, invoke `(check action trader wallet)`.
|
||||
3. If lambda returns **false**, record violation(rule_id, reason) and stop.
|
||||
4. If all laws return **true**, return pass.
|
||||
5. Log every invocation: rule_id, inputs, output, timestamp.
|
||||
|
||||
### Versioning & Updates
|
||||
|
||||
- **Current Version:** `"1.0"` (loaded at startup).
|
||||
- **Update Process:** Operator + Homunculus jointly author a new law script (version `"1.1"`), sign it, submit to Marketplace coordinator.
|
||||
- **Activation:** Coordinator restarts Marketplace with new law script; old version is abandoned. (No in-flight migration; trades-in-progress must complete or be canceled.)
|
||||
- **Audit Trail:** Every law script version is archived with signatures, timestamp, and change log.
|
||||
|
||||
---
|
||||
|
||||
## 7. Failure Modes & Mitigation
|
||||
|
||||
### Parse Failure
|
||||
- **Mode:** Malformed S-expression (unmatched parens, undefined combinator).
|
||||
- **Mitigation:** Fail at startup; operator is alerted; Marketplace does not boot. Prevents silent corruption.
|
||||
|
||||
### Signature Mismatch
|
||||
- **Mode:** Law script is edited after signing (operator or Homunculus signature invalid).
|
||||
- **Mitigation:** Fail at startup; abort boot. Ensures L2 immutability.
|
||||
|
||||
### Combinator Overflow
|
||||
- **Mode:** Lambda nesting depth or step count exceeded (accidentally or maliciously complex law).
|
||||
- **Mitigation:** Reject at load time if depth > limit; reject at runtime if steps > limit. Ensures termination.
|
||||
|
||||
### Silent Falses
|
||||
- **Mode:** A law returns false due to unforeseen input (e.g., null asset).
|
||||
- **Mitigation:** Combinator set includes explicit nil-checks (e.g., `(asset-is action "NULL")` returns false, not an error). Evaluator logs the false + reason.
|
||||
|
||||
### Type Mismatches
|
||||
- **Mode:** Lambda tries to compare incompatible types (e.g., `(< "BTC" 10.0)`).
|
||||
- **Mitigation:** Type-check at parse time or runtime. Reject with clear error. No silent type coercion.
|
||||
|
||||
---
|
||||
|
||||
## 8. Rationale for S-expressions
|
||||
|
||||
1. **Provable Non-Turing:** Closed combinator set with explicit enumeration. No ambiguity.
|
||||
2. **Audit Trail:** Proof trees show exactly which laws matched, in what order. Compliance-ready.
|
||||
3. **Fail-Fast Design:** Parse-time and load-time validation catch errors before runtime. Mirrors S99 / vault pattern.
|
||||
4. **Composability:** Complex rules built from simple primitives. Easy to extend without schema mutations.
|
||||
5. **Testability:** Each combinator is independently testable. Laws are pure functions.
|
||||
6. **Operator + Homunculus Signatures:** Single immutable law text is signed; no serialization ambiguity.
|
||||
|
||||
---
|
||||
|
||||
## 9. Transition Path
|
||||
|
||||
1. **Phase 1 (Sprint N):** Implement S-expression parser + combinator evaluator. Write unit tests for all combinators.
|
||||
2. **Phase 2 (Sprint N+1):** Wire M1 `law_check` to S-expression evaluator. Test with example constitution (above).
|
||||
3. **Phase 3 (Sprint N+2):** Integrate M4 (wallet binding), M6 (veto), M7 (logging). End-to-end smoke test.
|
||||
4. **Phase 4 (Sprint N+3):** Operator + Homunculus review; sign v1 law script. Deploy to production.
|
||||
|
||||
---
|
||||
|
||||
## 10. Open Questions for Review
|
||||
|
||||
1. **Combinator Set Completeness:** Are there missing combinators for L1-L5 or position logic?
|
||||
2. **Step/Depth Limits:** What are safe upper bounds? (Suggest: max_depth=20, max_steps=1000.)
|
||||
3. **Error Messages:** How granular should violation reasons be? (E.g., "position_limit_exceeded_BTC_5.2_of_10.0" vs. "position_limit_exceeded"?)
|
||||
4. **Signature Algorithm:** Ed25519, ECDSA, or other? (Recommend: Ed25519, matching COBOL vault.)
|
||||
5. **Tax Collection (M0):** Where does tax logic live—in M1 law script or in a separate M0 component? (Out of scope here; M1 calls tax stub.)
|
||||
|
||||
---
|
||||
|
||||
## Conclusion
|
||||
|
||||
**S-expressions with a fixed combinator set** provide the optimal combination of expressiveness, auditability, non-Turing provability, and failure-mode isolation for M1's deterministic law script. The format aligns with the COBOL vault pattern (S99 / immutability + dual signatures), scales naturally with new constraints, and enables full audit trails for compliance.
|
||||
@@ -18,8 +18,8 @@ established); specific model parameters C1.
|
||||
## 3. Language & location
|
||||
**Tcl** · `src/economy/sims/`. The hub is a syntax-agnostic coordinator: Tcl manages
|
||||
lifecycle, tick-advancement, and query routing for sub-sims in their native runtimes via
|
||||
stdin/stdout JSON — **Fortran** (M3d, M3e), **Prolog** (M3b, M3f), **R** (M3a),
|
||||
**Solidity** (M3c), **Zig** (M3g). Tcl imposes no type system or paradigm on the
|
||||
stdin/stdout JSON — **Fortran** (M3d, M3e, M3g), **Prolog** (M3b, M3f), **R** (M3a),
|
||||
**Solidity** (M3c). Tcl imposes no type system or paradigm on the
|
||||
sub-processes it orchestrates.
|
||||
|
||||
## 4. Does / does-not
|
||||
@@ -50,17 +50,22 @@ sub-processes it orchestrates.
|
||||
`SimType` ∈ { `statistical`, `sociological`, `amm_liquidity`, `mev_adversarial`,
|
||||
`tokenomics_macro`, `consensus_staking`, `market_microstructure` } (M3a–M3g).
|
||||
- `BoundedPrediction { value, lower_bound, upper_bound, confidence, correctness, certainty,
|
||||
time_horizon, sim_type, timestamp }`.
|
||||
time_horizon, sim_type, timestamp, token_ticker, recent_shift }`.
|
||||
Every output is bounded — no point estimates without uncertainty ranges.
|
||||
Three quality metrics, each ∈ [0.00, 10.00]:
|
||||
**confidence** — how sure the model is of this prediction;
|
||||
**correctness** — how accurate the model has been historically;
|
||||
**correctness** — how accurate the model has been historically (scored against literal
|
||||
market values from M2);
|
||||
**certainty** — how stable the estimate is across perturbations.
|
||||
**token_ticker** — which asset this prediction concerns (e.g. `"ETH"`, `"BTC"`).
|
||||
**recent_shift** — literal observed market movement (ground truth from M2, not sim output).
|
||||
Same M2 source feeds calibration and `correctness` scoring.
|
||||
Gain rates print as `lower - value - upper / 10.00`
|
||||
(e.g. `2.31 - 4.44 - 7.11 / 10.00 gain over next 30 days`);
|
||||
the denominator aids legibility — gain is not capped at 10.00.
|
||||
Example: `{ value: 7.2, lower_bound: 5.8, upper_bound: 8.9, confidence: 7.30,
|
||||
correctness: 8.10, certainty: 6.50, time_horizon: "4h", sim_type: "amm_liquidity" }`.
|
||||
correctness: 8.10, certainty: 6.50, time_horizon: "4h", sim_type: "amm_liquidity",
|
||||
token_ticker: "ETH", recent_shift: -0.023 }`.
|
||||
- `status(sim_type?) -> { running, pop_count, last_calibration, data_freshness }` — health check.
|
||||
- `calibrate(sim_type, feed_data: [NormalizedDatum])` — Data Feeds (M2) pushes live data for
|
||||
model recalibration.
|
||||
|
||||
@@ -16,10 +16,13 @@ execution C5 (industry standard since 2001). Jump-diffusion C5 (Merton 1976). Pa
|
||||
for crypto markets C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/statistical/`. **R** — native statistical distribution ecosystem,
|
||||
matrix operations, and time-series libraries (GARCH, ARIMA, HMM) without wrapping external
|
||||
solvers. Fractional Brownian motion generation uses spectral methods (Hosking 1984, Wood & Chan
|
||||
1994) or Cholesky decomposition of the covariance matrix.
|
||||
**R 4.x** (apt `r-base-core`) · `src/economy/sims/statistical/`. Vital CRAN packages only:
|
||||
`HiddenMarkov` (Viterbi filter, forward-backward, Baum-Welch), `rugarch` (univariate GARCH
|
||||
volatility — GJR/EGARCH families, ML fitting), `rmgarch` (DCC-GARCH cross-asset correlation).
|
||||
Everything else is hand-rolled with base R primitives (`optim`, `fft`, `arima`, matrix ops):
|
||||
Heston SDE (Euler–Maruyama), Merton jump-diffusion, GBM Monte Carlo, copula tail-dependence,
|
||||
and fBM via spectral methods (Hosking 1984 / Wood & Chan 1994) on base `fft()`. JSON I/O for
|
||||
the Hub stdin/stdout protocol is hand-rolled.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** run Monte Carlo price simulations (GBM, Merton jump-diffusion, Heston stochastic
|
||||
|
||||
@@ -17,11 +17,12 @@ solvers C3). Crypto pump-and-dump ABM C3 (3-agent protocol validated on historic
|
||||
Pop behavioral models C1.
|
||||
|
||||
## 3. Language & location
|
||||
ECLiPSe Prolog · `src/economy/sims/sociological/`. **Prolog** — game-theoretic equilibria, replicator
|
||||
dynamics, and strategy evolution are naturally expressed as logical relations over population
|
||||
states; Nash equilibrium search is constraint satisfaction. Needs efficient population iteration,
|
||||
strategy mutation, PDE solvers for MFG (HJB + Fokker-Planck), and bandit algorithms
|
||||
(UCB/Thompson).
|
||||
**ECLiPSe Prolog 7.2** · `src/economy/sims/sociological/`. Libraries: **ic** (interval
|
||||
constraints — bounds propagation for BoundedPrediction ranges), **eplex** (LP/MIP via COIN-OR
|
||||
CLP/CBC — Nash equilibrium computation). Game-theoretic equilibria, replicator dynamics, and
|
||||
strategy evolution are naturally expressed as logical relations over population states; Nash
|
||||
equilibrium search is constraint satisfaction. Needs efficient population iteration, strategy
|
||||
mutation, PDE solvers for MFG (HJB + Fokker-Planck), and bandit algorithms (UCB/Thompson).
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate populations of behavioral archetypes competing in a market; apply
|
||||
|
||||
@@ -12,9 +12,11 @@ impermanent loss formula C5 (closed-form: $\text{IL}(r) = \frac{2\sqrt{r}}{1+r}
|
||||
simulation parameterization C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/amm/`. **Solidity** — on-chain-equivalent fixed-point arithmetic
|
||||
reproduces the exact invariant calculations DEXs execute, eliminating precision-mismatch bugs
|
||||
between sim and production contracts.
|
||||
**Solidity** + **Foundry** (forge, anvil) · `src/economy/sims/amm/`. Foundry is hosted
|
||||
separately from the session container — not a session-start install. M3c's output enters the
|
||||
system through Hub like every other sim, same `BoundedPrediction` schema, same M2 path.
|
||||
On-chain-equivalent fixed-point arithmetic reproduces the exact invariant calculations DEXs
|
||||
execute, eliminating precision-mismatch bugs between sim and production contracts.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate constant-product pools with fee parameter $\gamma$:
|
||||
|
||||
@@ -14,10 +14,11 @@ validator populations C4 (Lasry & Lions 2007; validator-specific application C3)
|
||||
simulation parameterization C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/consensus/`. **Prolog** — Markov chain transition rules, Nash
|
||||
equilibrium search, and replicator dynamics are constraint-satisfaction problems over validator
|
||||
populations; Prolog's backtracking search finds equilibria declaratively rather than
|
||||
imperatively iterating toward them.
|
||||
**ECLiPSe Prolog 7.2** · `src/economy/sims/consensus/`. Libraries: **ic** (interval
|
||||
constraints), **eplex** (LP/MIP via COIN-OR CLP/CBC — Nash equilibrium via linear programming).
|
||||
Markov chain transition rules, Nash equilibrium search, and replicator dynamics are
|
||||
constraint-satisfaction problems over validator populations; Prolog's backtracking search finds
|
||||
equilibria declaratively rather than imperatively iterating toward them.
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate validator populations where honesty evolves via **evolutionary game theory**
|
||||
|
||||
@@ -15,9 +15,11 @@ optimal execution C5 (industry standard since 2001; crypto adaptations validated
|
||||
Kurz CMC thesis). DEX-specific microstructure C2 (emerging). Implementation C1.
|
||||
|
||||
## 3. Language & location
|
||||
TBD · `src/economy/sims/microstructure/`. **Zig** — tick-level event-driven simulation with
|
||||
deterministic memory layout, no GC pauses, and sub-microsecond latency for Riccati solvers and
|
||||
order-book state updates; comptime generics eliminate runtime dispatch on hot paths.
|
||||
**Fortran 2018** (gfortran) · `src/economy/sims/microstructure/`. Build: **fpm**. Dependencies:
|
||||
**OpenBLAS** (LAPACK/BLAS via native Fortran interfaces). Hand-rolled: Riccati ODE solver,
|
||||
order-book state arrays, JSON I/O against fixed schemas. Almgren-Chriss optimal execution is a
|
||||
dense ODE (Riccati equations) — Fortran's home turf; LAPACK is native, array intrinsics map
|
||||
directly to order-book depth vectors, and zero new toolchain is needed (same as M3d/M3e).
|
||||
|
||||
## 4. Does / does-not
|
||||
- **Does:** simulate order flow across venues (DEXs and CEXs); model bid-ask spread dynamics as a
|
||||
|
||||
@@ -0,0 +1,44 @@
|
||||
# copula.R — hand-rolled copula tail-dependence (M3a spec §3).
|
||||
# Gaussian copula via empirical ranks + normal scores; lower/upper tail
|
||||
# dependence estimated empirically. Used for cross-token contagion risk:
|
||||
# given a reference token's move, how far does the target move with it?
|
||||
|
||||
# Empirical copula pseudo-observations.
|
||||
.pobs <- function(x) rank(x, ties.method = "average") / (length(x) + 1)
|
||||
|
||||
# Pearson correlation of normal scores = Gaussian-copula rho.
|
||||
copula_rho <- function(x, y) {
|
||||
cor(qnorm(.pobs(x)), qnorm(.pobs(y)))
|
||||
}
|
||||
|
||||
# Empirical tail dependence at quantile q: P(V <= q | U <= q) (lower) and
|
||||
# P(V > 1-q | U > 1-q) (upper).
|
||||
copula_tails <- function(x, y, q = 0.05) {
|
||||
u <- .pobs(x); v <- .pobs(y)
|
||||
lo <- if (any(u <= q)) mean(v[u <= q] <= q) else 0
|
||||
hi <- if (any(u >= 1 - q)) mean(v[u >= 1 - q] >= 1 - q) else 0
|
||||
list(lower = lo, upper = hi)
|
||||
}
|
||||
|
||||
# Conditional co-move forecast: if the reference asset shifts by ref_shift
|
||||
# (log-return), the Gaussian copula conditional mean of the target's return
|
||||
# is rho * (sigma_t / sigma_r) * ref_shift, with conditional sd
|
||||
# sigma_t * sqrt(1 - rho^2). Returns a price band for the target.
|
||||
sim_copula <- function(prices, ref_prices, horizon, ref_shift = NULL,
|
||||
level = 0.90) {
|
||||
rt <- diff(log(prices)); rr <- diff(log(ref_prices))
|
||||
n <- min(length(rt), length(rr))
|
||||
rt <- tail(rt, n); rr <- tail(rr, n)
|
||||
rho <- copula_rho(rr, rt)
|
||||
if (is.null(ref_shift)) ref_shift <- mean(rr) * horizon
|
||||
st <- sd(rt); sr <- sd(rr)
|
||||
cond_mu <- mean(rt) * horizon + rho * (st / sr) * (ref_shift - mean(rr) * horizon)
|
||||
cond_sd <- st * sqrt(pmax(1 - rho^2, 1e-12)) * sqrt(horizon)
|
||||
s0 <- prices[length(prices)]
|
||||
zq <- qnorm(1 - (1 - level) / 2)
|
||||
tails <- copula_tails(rr, rt)
|
||||
list(value = s0 * exp(cond_mu),
|
||||
lower_bound = s0 * exp(cond_mu - zq * cond_sd),
|
||||
upper_bound = s0 * exp(cond_mu + zq * cond_sd),
|
||||
certainty = abs(rho) * (1 - abs(tails$lower - tails$upper)))
|
||||
}
|
||||
@@ -0,0 +1,147 @@
|
||||
# json_io.R — hand-rolled JSON for the M3 Hub stdin/stdout protocol.
|
||||
# No jsonlite: the only vital CRAN packages in M3a are HiddenMarkov, rugarch,
|
||||
# rmgarch (spec §3). Recursive-descent parser + emitter over base R strings.
|
||||
|
||||
json_parse <- function(txt) {
|
||||
env <- new.env()
|
||||
env$s <- txt
|
||||
env$i <- 1L
|
||||
env$n <- nchar(txt)
|
||||
val <- .jp_value(env)
|
||||
.jp_ws(env)
|
||||
if (env$i <= env$n) stop("json_parse: trailing garbage at ", env$i)
|
||||
val
|
||||
}
|
||||
|
||||
.jp_peek <- function(env) substr(env$s, env$i, env$i)
|
||||
|
||||
.jp_ws <- function(env) {
|
||||
while (env$i <= env$n && .jp_peek(env) %in% c(" ", "\t", "\n", "\r"))
|
||||
env$i <- env$i + 1L
|
||||
}
|
||||
|
||||
.jp_expect <- function(env, ch) {
|
||||
if (.jp_peek(env) != ch)
|
||||
stop("json_parse: expected '", ch, "' at ", env$i, ", got '", .jp_peek(env), "'")
|
||||
env$i <- env$i + 1L
|
||||
}
|
||||
|
||||
.jp_value <- function(env) {
|
||||
.jp_ws(env)
|
||||
ch <- .jp_peek(env)
|
||||
if (ch == "{") return(.jp_object(env))
|
||||
if (ch == "[") return(.jp_array(env))
|
||||
if (ch == "\"") return(.jp_string(env))
|
||||
if (ch == "t") { .jp_lit(env, "true"); return(TRUE) }
|
||||
if (ch == "f") { .jp_lit(env, "false"); return(FALSE) }
|
||||
if (ch == "n") { .jp_lit(env, "null"); return(NULL) }
|
||||
.jp_number(env)
|
||||
}
|
||||
|
||||
.jp_lit <- function(env, lit) {
|
||||
k <- nchar(lit)
|
||||
if (substr(env$s, env$i, env$i + k - 1L) != lit)
|
||||
stop("json_parse: bad literal at ", env$i)
|
||||
env$i <- env$i + k
|
||||
}
|
||||
|
||||
.jp_object <- function(env) {
|
||||
.jp_expect(env, "{")
|
||||
out <- list()
|
||||
.jp_ws(env)
|
||||
if (.jp_peek(env) == "}") { env$i <- env$i + 1L; return(out) }
|
||||
repeat {
|
||||
.jp_ws(env)
|
||||
key <- .jp_string(env)
|
||||
.jp_ws(env)
|
||||
.jp_expect(env, ":")
|
||||
out[[key]] <- .jp_value(env)
|
||||
.jp_ws(env)
|
||||
if (.jp_peek(env) == ",") { env$i <- env$i + 1L; next }
|
||||
.jp_expect(env, "}")
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
|
||||
.jp_array <- function(env) {
|
||||
.jp_expect(env, "[")
|
||||
out <- list()
|
||||
.jp_ws(env)
|
||||
if (.jp_peek(env) == "]") { env$i <- env$i + 1L; return(out) }
|
||||
repeat {
|
||||
out[[length(out) + 1L]] <- .jp_value(env)
|
||||
.jp_ws(env)
|
||||
if (.jp_peek(env) == ",") { env$i <- env$i + 1L; next }
|
||||
.jp_expect(env, "]")
|
||||
return(out)
|
||||
}
|
||||
}
|
||||
|
||||
.jp_string <- function(env) {
|
||||
.jp_expect(env, "\"")
|
||||
chars <- character(0)
|
||||
repeat {
|
||||
ch <- .jp_peek(env)
|
||||
if (ch == "") stop("json_parse: unterminated string")
|
||||
env$i <- env$i + 1L
|
||||
if (ch == "\"") return(paste0(chars, collapse = ""))
|
||||
if (ch == "\\") {
|
||||
esc <- .jp_peek(env)
|
||||
env$i <- env$i + 1L
|
||||
ch <- switch(esc,
|
||||
"\"" = "\"", "\\" = "\\", "/" = "/", b = "\b", f = "\f",
|
||||
n = "\n", r = "\r", t = "\t",
|
||||
u = {
|
||||
hex <- substr(env$s, env$i, env$i + 3L)
|
||||
env$i <- env$i + 4L
|
||||
intToUtf8(strtoi(hex, 16L))
|
||||
},
|
||||
stop("json_parse: bad escape \\", esc))
|
||||
}
|
||||
chars <- c(chars, ch)
|
||||
}
|
||||
}
|
||||
|
||||
.jp_number <- function(env) {
|
||||
m <- regmatches(
|
||||
substr(env$s, env$i, env$n),
|
||||
regexpr("^-?(0|[1-9][0-9]*)(\\.[0-9]+)?([eE][+-]?[0-9]+)?",
|
||||
substr(env$s, env$i, env$n)))
|
||||
if (length(m) == 0 || m == "") stop("json_parse: bad number at ", env$i)
|
||||
env$i <- env$i + nchar(m)
|
||||
as.numeric(m)
|
||||
}
|
||||
|
||||
# --- emitter ----------------------------------------------------------------
|
||||
|
||||
json_emit <- function(x) {
|
||||
if (is.null(x)) return("null")
|
||||
if (is.list(x)) {
|
||||
if (!is.null(names(x)) && all(nzchar(names(x)))) {
|
||||
pairs <- vapply(names(x), function(k)
|
||||
paste0(.je_str(k), ":", json_emit(x[[k]])), character(1))
|
||||
return(paste0("{", paste0(pairs, collapse = ","), "}"))
|
||||
}
|
||||
return(paste0("[", paste0(vapply(x, json_emit, character(1)),
|
||||
collapse = ","), "]"))
|
||||
}
|
||||
if (length(x) > 1)
|
||||
return(paste0("[", paste0(vapply(x, json_emit, character(1)),
|
||||
collapse = ","), "]"))
|
||||
if (is.character(x)) return(.je_str(x))
|
||||
if (is.logical(x)) return(if (x) "true" else "false")
|
||||
if (is.numeric(x)) {
|
||||
if (!is.finite(x)) return("null")
|
||||
return(format(x, digits = 15, scientific = FALSE, trim = TRUE))
|
||||
}
|
||||
stop("json_emit: unsupported type ", class(x)[1])
|
||||
}
|
||||
|
||||
.je_str <- function(s) {
|
||||
s <- gsub("\\", "\\\\", s, fixed = TRUE)
|
||||
s <- gsub("\"", "\\\"", s, fixed = TRUE)
|
||||
s <- gsub("\n", "\\n", s, fixed = TRUE)
|
||||
s <- gsub("\r", "\\r", s, fixed = TRUE)
|
||||
s <- gsub("\t", "\\t", s, fixed = TRUE)
|
||||
paste0("\"", s, "\"")
|
||||
}
|
||||
@@ -0,0 +1,82 @@
|
||||
#!/usr/bin/env Rscript
|
||||
# main.R — M3a statistical sims, Hub stdin/stdout protocol entry point.
|
||||
#
|
||||
# Request (one JSON object on stdin):
|
||||
# { "sim": "gbm|heston|jump_diffusion|fbm|copula|hmm_regime|garch|dcc",
|
||||
# "token_ticker": "XMR",
|
||||
# "prices": [ ... ], # price history, oldest first
|
||||
# "ref_prices": [ ... ], # required for copula/dcc only
|
||||
# "horizon": 24, # steps ahead
|
||||
# "seed": 42 } # optional, for reproducible runs
|
||||
#
|
||||
# Response (one BoundedPrediction JSON object on stdout, M3 hub §5):
|
||||
# value, lower_bound, upper_bound, confidence, correctness, certainty,
|
||||
# time_horizon, sim_type, timestamp, token_ticker, recent_shift
|
||||
#
|
||||
# correctness and confidence are OWNED BY THE HUB's calibration loop (M3 §5):
|
||||
# M3a emits its raw certainty and echoes nulls for the calibrated fields.
|
||||
# Errors go to stderr + exit 1; stdout carries only valid JSON.
|
||||
|
||||
base_dir <- dirname(sub("--file=", "",
|
||||
grep("--file=", commandArgs(FALSE), value = TRUE)[1]))
|
||||
source(file.path(base_dir, "json_io.R"))
|
||||
source(file.path(base_dir, "sde_sims.R"))
|
||||
source(file.path(base_dir, "copula.R"))
|
||||
|
||||
fail <- function(msg) { cat(msg, "\n", file = stderr()); quit(status = 1) }
|
||||
|
||||
req <- tryCatch(json_parse(paste(readLines("stdin"), collapse = "\n")),
|
||||
error = function(e) fail(paste("bad request:", e$message)))
|
||||
|
||||
sim <- req$sim
|
||||
ticker <- req$token_ticker
|
||||
horizon <- as.integer(req$horizon)
|
||||
prices <- as.numeric(unlist(req$prices))
|
||||
if (is.null(sim) || is.null(ticker)) fail("missing sim or token_ticker")
|
||||
if (length(prices) < 32) fail("need >= 32 price points")
|
||||
if (is.na(horizon) || horizon < 1) fail("bad horizon")
|
||||
if (!is.null(req$seed)) set.seed(as.integer(req$seed))
|
||||
|
||||
needs_ref <- sim %in% c("copula", "dcc")
|
||||
ref <- if (needs_ref) as.numeric(unlist(req$ref_prices)) else NULL
|
||||
if (needs_ref && length(ref) < 32) fail("sim needs ref_prices (>= 32 points)")
|
||||
|
||||
res <- switch(sim,
|
||||
gbm = sim_gbm(prices, horizon),
|
||||
heston = sim_heston(prices, horizon),
|
||||
jump_diffusion = sim_jump_diffusion(prices, horizon),
|
||||
fbm = sim_fbm(prices, horizon),
|
||||
copula = sim_copula(prices, ref, horizon),
|
||||
hmm_regime = ,
|
||||
garch = ,
|
||||
dcc = {
|
||||
# vital-package sims live in their own file so the light sims don't pay
|
||||
# the rugarch/rmgarch load time
|
||||
source(file.path(base_dir, "regimes_garch.R"))
|
||||
switch(sim,
|
||||
hmm_regime = sim_hmm_regime(prices, horizon),
|
||||
garch = sim_garch(prices, horizon),
|
||||
dcc = sim_dcc(prices, ref, horizon))
|
||||
},
|
||||
fail(paste("unknown sim:", sim)))
|
||||
|
||||
# recent_shift: realized log-return over the trailing horizon window —
|
||||
# same ground-truth window M2 uses for correctness scoring (M3 hub §5)
|
||||
window <- min(horizon, length(prices) - 1)
|
||||
recent_shift <- log(prices[length(prices)]) -
|
||||
log(prices[length(prices) - window])
|
||||
|
||||
out <- list(
|
||||
value = res$value,
|
||||
lower_bound = res$lower_bound,
|
||||
upper_bound = res$upper_bound,
|
||||
confidence = NULL, # Hub calibration owns this
|
||||
correctness = NULL, # Hub scoring owns this
|
||||
certainty = res$certainty,
|
||||
time_horizon = horizon,
|
||||
sim_type = paste0("statistical/", sim),
|
||||
timestamp = as.integer(Sys.time()),
|
||||
token_ticker = ticker,
|
||||
recent_shift = recent_shift)
|
||||
|
||||
cat(json_emit(out), "\n")
|
||||
@@ -0,0 +1,111 @@
|
||||
# regimes_garch.R — the vital-package sims (M3a spec §3).
|
||||
# HiddenMarkov: 2-state Gaussian HMM regime detection (Baum-Welch fit,
|
||||
# Viterbi decode). rugarch: univariate GARCH(1,1) volatility forecast.
|
||||
# rmgarch: DCC-GARCH cross-asset correlation. These three are the only
|
||||
# CRAN dependencies in M3a; everything else is hand-rolled.
|
||||
|
||||
suppressMessages({
|
||||
library(HiddenMarkov)
|
||||
library(rugarch)
|
||||
})
|
||||
|
||||
# Two-regime (calm/stressed) HMM on log-returns. Forecast blends the
|
||||
# per-regime means weighted by the transition row of the decoded current
|
||||
# state; certainty is the Viterbi state's posterior occupancy.
|
||||
sim_hmm_regime <- function(prices, horizon, level = 0.90) {
|
||||
r <- diff(log(prices))
|
||||
q1 <- unname(quantile(abs(r - mean(r)), 0.5))
|
||||
init <- list(mean = c(mean(r[abs(r - mean(r)) <= q1]),
|
||||
mean(r[abs(r - mean(r)) > q1])),
|
||||
sd = c(max(sd(r[abs(r - mean(r)) <= q1]), 1e-8),
|
||||
max(sd(r[abs(r - mean(r)) > q1]), 1e-8)))
|
||||
hmm <- dthmm(r,
|
||||
Pi = matrix(c(0.95, 0.05, 0.05, 0.95), 2, 2, byrow = TRUE),
|
||||
delta = c(0.5, 0.5),
|
||||
distn = "norm",
|
||||
pm = init)
|
||||
fit <- tryCatch(
|
||||
BaumWelch(hmm, control = bwcontrol(maxiter = 200, tol = 1e-5,
|
||||
prt = FALSE)),
|
||||
error = function(e) hmm)
|
||||
states <- Viterbi(fit)
|
||||
cur <- states[length(states)]
|
||||
pi_row <- fit$Pi[cur, ]
|
||||
step_mu <- sum(pi_row * fit$pm$mean)
|
||||
step_sd <- sqrt(sum(pi_row * (fit$pm$sd^2 + fit$pm$mean^2)) - step_mu^2)
|
||||
s0 <- prices[length(prices)]
|
||||
zq <- qnorm(1 - (1 - level) / 2)
|
||||
list(value = s0 * exp(step_mu * horizon),
|
||||
lower_bound = s0 * exp(step_mu * horizon - zq * step_sd * sqrt(horizon)),
|
||||
upper_bound = s0 * exp(step_mu * horizon + zq * step_sd * sqrt(horizon)),
|
||||
certainty = mean(states == cur))
|
||||
}
|
||||
|
||||
# GARCH(1,1) volatility-path forecast via rugarch. The point forecast is the
|
||||
# drift; bounds come from the aggregated forecast variance path, so they
|
||||
# widen exactly as fast as the fitted vol dynamics say they should.
|
||||
sim_garch <- function(prices, horizon, level = 0.90) {
|
||||
r <- diff(log(prices))
|
||||
spec <- ugarchspec(variance.model = list(model = "sGARCH",
|
||||
garchOrder = c(1, 1)),
|
||||
mean.model = list(armaOrder = c(0, 0),
|
||||
include.mean = TRUE),
|
||||
distribution.model = "std")
|
||||
fit <- tryCatch(
|
||||
ugarchfit(spec, r, solver = "hybrid"),
|
||||
error = function(e) NULL)
|
||||
s0 <- prices[length(prices)]
|
||||
if (is.null(fit) || fit@fit$convergence != 0) {
|
||||
# fall back to constant vol so the sim degrades instead of dying
|
||||
mu <- mean(r); sig <- sd(r) * sqrt(horizon)
|
||||
zq <- qnorm(1 - (1 - level) / 2)
|
||||
return(list(value = s0 * exp(mu * horizon),
|
||||
lower_bound = s0 * exp(mu * horizon - zq * sig),
|
||||
upper_bound = s0 * exp(mu * horizon + zq * sig),
|
||||
certainty = 0.2))
|
||||
}
|
||||
fc <- ugarchforecast(fit, n.ahead = horizon)
|
||||
mu_path <- as.numeric(fitted(fc))
|
||||
sig_path <- as.numeric(sigma(fc))
|
||||
mu_h <- sum(mu_path)
|
||||
sig_h <- sqrt(sum(sig_path^2))
|
||||
zq <- qnorm(1 - (1 - level) / 2)
|
||||
# persistence far from 1 = mean-reverting vol = more trustworthy band
|
||||
persistence <- sum(coef(fit)[c("alpha1", "beta1")])
|
||||
list(value = s0 * exp(mu_h),
|
||||
lower_bound = s0 * exp(mu_h - zq * sig_h),
|
||||
upper_bound = s0 * exp(mu_h + zq * sig_h),
|
||||
certainty = unname(pmax(0.05, pmin(0.95, 1 - persistence^4))))
|
||||
}
|
||||
|
||||
# DCC-GARCH conditional correlation of target vs reference (rmgarch).
|
||||
# Loaded lazily: rmgarch is heavy, and only this sim needs it.
|
||||
sim_dcc <- function(prices, ref_prices, horizon, level = 0.90) {
|
||||
suppressMessages(library(rmgarch))
|
||||
rt <- diff(log(prices)); rr <- diff(log(ref_prices))
|
||||
n <- min(length(rt), length(rr))
|
||||
dat <- cbind(tail(rt, n), tail(rr, n))
|
||||
uspec <- ugarchspec(variance.model = list(model = "sGARCH",
|
||||
garchOrder = c(1, 1)),
|
||||
mean.model = list(armaOrder = c(0, 0)))
|
||||
dspec <- dccspec(uspec = multispec(replicate(2, uspec)),
|
||||
dccOrder = c(1, 1), distribution = "mvnorm")
|
||||
fit <- tryCatch(dccfit(dspec, data = dat), error = function(e) NULL)
|
||||
s0 <- prices[length(prices)]
|
||||
if (is.null(fit)) {
|
||||
rho <- cor(dat[, 1], dat[, 2])
|
||||
} else {
|
||||
fc <- dccforecast(fit, n.ahead = horizon)
|
||||
rho <- mean(rcor(fc)[[1]][1, 2, ])
|
||||
}
|
||||
# forecast: target drift conditioned on reference drift through rho
|
||||
mu_t <- mean(dat[, 1]); mu_r <- mean(dat[, 2])
|
||||
st <- sd(dat[, 1]); sr <- sd(dat[, 2])
|
||||
cond_mu <- (mu_t + rho * (st / sr) * mu_r) * horizon
|
||||
cond_sd <- st * sqrt(pmax(1 - rho^2, 1e-12)) * sqrt(horizon)
|
||||
zq <- qnorm(1 - (1 - level) / 2)
|
||||
list(value = s0 * exp(cond_mu),
|
||||
lower_bound = s0 * exp(cond_mu - zq * cond_sd),
|
||||
upper_bound = s0 * exp(cond_mu + zq * cond_sd),
|
||||
certainty = abs(rho))
|
||||
}
|
||||
@@ -0,0 +1,143 @@
|
||||
# sde_sims.R — hand-rolled stochastic simulations (M3a spec §3).
|
||||
# GBM Monte Carlo, Heston (Euler–Maruyama with full truncation), Merton
|
||||
# jump-diffusion, fBM via Wood & Chan circulant embedding on base fft().
|
||||
# Each sim returns list(value, lower_bound, upper_bound, certainty) for a
|
||||
# price forecast `horizon` steps ahead, from a log-price history.
|
||||
|
||||
.log_returns <- function(prices) diff(log(prices))
|
||||
|
||||
# Geometric Brownian motion: mu/sigma estimated from history, terminal
|
||||
# distribution is lognormal so quantiles are closed-form; MC paths give the
|
||||
# certainty estimate (dispersion-based).
|
||||
sim_gbm <- function(prices, horizon, n_paths = 5000L, level = 0.90) {
|
||||
r <- .log_returns(prices)
|
||||
mu <- mean(r); sigma <- sd(r)
|
||||
s0 <- prices[length(prices)]
|
||||
z <- matrix(rnorm(n_paths * horizon), n_paths, horizon)
|
||||
paths <- s0 * exp(t(apply((mu - sigma^2 / 2) + sigma * z, 1, cumsum)))
|
||||
terminal <- paths[, horizon]
|
||||
a <- (1 - level) / 2
|
||||
list(value = median(terminal),
|
||||
lower_bound = unname(quantile(terminal, a)),
|
||||
upper_bound = unname(quantile(terminal, 1 - a)),
|
||||
certainty = .dispersion_certainty(terminal, s0))
|
||||
}
|
||||
|
||||
# Heston stochastic volatility, Euler–Maruyama with full truncation for the
|
||||
# variance process (v is floored inside the drift/diffusion, not clamped
|
||||
# after, which avoids the classical bias at low kappa*theta).
|
||||
sim_heston <- function(prices, horizon, n_paths = 5000L, level = 0.90,
|
||||
kappa = 2.0, rho = -0.7) {
|
||||
r <- .log_returns(prices)
|
||||
mu <- mean(r)
|
||||
theta <- var(r) # long-run variance
|
||||
v0 <- .ewma_var(r) # spot variance
|
||||
xi <- sd((r - mean(r))^2) * sqrt(2) # crude vol-of-vol from squared returns
|
||||
s0 <- prices[length(prices)]
|
||||
|
||||
s <- rep(log(s0), n_paths)
|
||||
v <- rep(v0, n_paths)
|
||||
for (t in seq_len(horizon)) {
|
||||
z1 <- rnorm(n_paths)
|
||||
z2 <- rho * z1 + sqrt(1 - rho^2) * rnorm(n_paths)
|
||||
vp <- pmax(v, 0)
|
||||
s <- s + (mu - vp / 2) + sqrt(vp) * z1
|
||||
v <- v + kappa * (theta - vp) + xi * sqrt(vp) * z2
|
||||
}
|
||||
terminal <- exp(s)
|
||||
a <- (1 - level) / 2
|
||||
list(value = median(terminal),
|
||||
lower_bound = unname(quantile(terminal, a)),
|
||||
upper_bound = unname(quantile(terminal, 1 - a)),
|
||||
certainty = .dispersion_certainty(terminal, s0))
|
||||
}
|
||||
|
||||
# Merton jump-diffusion: jumps detected as |return| > 3 sd of the
|
||||
# jump-cleaned series (iterated once); Poisson arrivals, lognormal sizes.
|
||||
sim_jump_diffusion <- function(prices, horizon, n_paths = 5000L, level = 0.90) {
|
||||
r <- .log_returns(prices)
|
||||
thresh <- 3 * sd(r)
|
||||
jumps <- abs(r - mean(r)) > thresh
|
||||
diffusive <- r[!jumps]
|
||||
mu <- mean(diffusive); sigma <- sd(diffusive)
|
||||
lambda <- max(sum(jumps) / length(r), 1e-6) # jumps per step
|
||||
jump_mu <- if (any(jumps)) mean(r[jumps]) else 0
|
||||
jump_sd <- if (sum(jumps) > 1) sd(r[jumps]) else sigma
|
||||
s0 <- prices[length(prices)]
|
||||
|
||||
logret <- matrix(rnorm(n_paths * horizon, mu - sigma^2 / 2, sigma),
|
||||
n_paths, horizon)
|
||||
n_jumps <- matrix(rpois(n_paths * horizon, lambda), n_paths, horizon)
|
||||
jump_part <- matrix(rnorm(n_paths * horizon,
|
||||
n_jumps * jump_mu,
|
||||
sqrt(pmax(n_jumps, 1e-12)) * jump_sd),
|
||||
n_paths, horizon)
|
||||
jump_part[n_jumps == 0] <- 0
|
||||
terminal <- s0 * exp(rowSums(logret + jump_part))
|
||||
a <- (1 - level) / 2
|
||||
list(value = median(terminal),
|
||||
lower_bound = unname(quantile(terminal, a)),
|
||||
upper_bound = unname(quantile(terminal, 1 - a)),
|
||||
certainty = .dispersion_certainty(terminal, s0))
|
||||
}
|
||||
|
||||
# Fractional Brownian motion increments (fGn) by Wood & Chan (1994)
|
||||
# circulant embedding: exact in distribution, O(n log n) via fft. Hurst
|
||||
# exponent estimated from history by aggregated-variance slope.
|
||||
sim_fbm <- function(prices, horizon, n_paths = 2000L, level = 0.90) {
|
||||
r <- .log_returns(prices)
|
||||
H <- .hurst_aggvar(r)
|
||||
sigma <- sd(r); mu <- mean(r)
|
||||
s0 <- prices[length(prices)]
|
||||
|
||||
n <- horizon
|
||||
# fGn autocovariance gamma(k), circulant embedding of size 2m
|
||||
k <- 0:n
|
||||
gam <- 0.5 * (abs(k - 1)^(2 * H) - 2 * abs(k)^(2 * H) + abs(k + 1)^(2 * H))
|
||||
circ <- c(gam, rev(gam[2:n])) # length 2n
|
||||
lam <- Re(fft(circ))
|
||||
lam[lam < 0] <- 0 # numerical guard; embedding may fail
|
||||
m2 <- length(circ)
|
||||
|
||||
terminal <- numeric(n_paths)
|
||||
for (p in seq_len(n_paths)) {
|
||||
zr <- rnorm(m2); zi <- rnorm(m2)
|
||||
w <- fft(sqrt(lam / m2) * complex(real = zr, imaginary = zi),
|
||||
inverse = FALSE)
|
||||
fgn <- Re(w)[1:n] * sigma
|
||||
terminal[p] <- s0 * exp(sum(mu + fgn))
|
||||
}
|
||||
a <- (1 - level) / 2
|
||||
list(value = median(terminal),
|
||||
lower_bound = unname(quantile(terminal, a)),
|
||||
upper_bound = unname(quantile(terminal, 1 - a)),
|
||||
certainty = .dispersion_certainty(terminal, s0) *
|
||||
(1 - abs(H - 0.5))) # discount when H estimate is extreme
|
||||
}
|
||||
|
||||
# --- shared estimators ------------------------------------------------------
|
||||
|
||||
.ewma_var <- function(r, lambda = 0.94) {
|
||||
v <- var(r)
|
||||
for (x in r) v <- lambda * v + (1 - lambda) * x^2
|
||||
v
|
||||
}
|
||||
|
||||
.hurst_aggvar <- function(r, max_scale = 16L) {
|
||||
scales <- 2^(1:floor(log2(min(max_scale, length(r) / 4))))
|
||||
if (length(scales) < 2) return(0.5)
|
||||
vars <- vapply(scales, function(m) {
|
||||
k <- floor(length(r) / m)
|
||||
var(colMeans(matrix(r[1:(k * m)], m, k)))
|
||||
}, numeric(1))
|
||||
slope <- coef(lm(log(vars) ~ log(scales)))[2]
|
||||
h <- 1 + slope / 2
|
||||
min(max(h, 0.05), 0.95)
|
||||
}
|
||||
|
||||
# Map MC dispersion into (0,1]: tight terminal distribution relative to the
|
||||
# spot price = high certainty. Purely internal to M3a; the Hub calibrates.
|
||||
.dispersion_certainty <- function(terminal, s0) {
|
||||
spread <- IQR(terminal) / s0
|
||||
unname(1 / (1 + 5 * spread))
|
||||
}
|
||||
@@ -0,0 +1,158 @@
|
||||
*> wallet.cob
|
||||
*> Monero Wallet Interface in COBOL
|
||||
*> Handles wallet balance checks and multisig transaction creation.
|
||||
*> Dependencies: Ada bridge functions (ada_get_wallet_balance,
|
||||
*> ada_build_monero_multisig_tx)
|
||||
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. XMR-WALLET.
|
||||
|
||||
ENVIRONMENT DIVISION.
|
||||
CONFIGURATION SECTION.
|
||||
SPECIAL-NAMES.
|
||||
DECIMAL-POINT IS COMMA.
|
||||
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
|
||||
01 WS-STATUS-CODE PIC 9(9) COMP-5 VALUE 0.
|
||||
|
||||
01 XMR-SUCCESS PIC 9(9) COMP-5 VALUE 0.
|
||||
01 XMR-ERROR-INVALID-REQUEST PIC 9(9) COMP-5 VALUE 1.
|
||||
01 XMR-ERROR-BUFFER-TOO-SMALL PIC 9(9) COMP-5 VALUE 2.
|
||||
01 XMR-ERROR-UNSUPPORTED-CHAIN PIC 9(9) COMP-5 VALUE 3.
|
||||
01 XMR-ERROR-CRYPTO-FAILURE PIC 9(9) COMP-5 VALUE 4.
|
||||
01 XMR-ERROR-MULTISIG-INCOMPLETE PIC 9(9) COMP-5 VALUE 5.
|
||||
01 XMR-ERROR-IO-FAILURE PIC 9(9) COMP-5 VALUE 6.
|
||||
|
||||
01 WS-WALLET-ID PIC X(64).
|
||||
01 WS-ACCOUNT-ID PIC X(64).
|
||||
01 WS-DESTINATION-ADDRESS PIC X(256).
|
||||
01 WS-DESTINATION-LEN PIC 9(4) COMP-5.
|
||||
01 WS-AMOUNT-ATOMIC PIC 9(20) COMP-5.
|
||||
01 WS-MULTISIG-REQUIRED PIC 9(9) COMP-5.
|
||||
01 WS-MULTISIG-TOTAL PIC 9(9) COMP-5.
|
||||
|
||||
01 WS-TX-BLOB.
|
||||
05 WS-TX-BUFFER PIC X(65536) VALUE SPACES.
|
||||
05 WS-TX-BUFFER-MAX PIC 9(9) COMP-5 VALUE 65536.
|
||||
05 WS-TX-BUFFER-LEN PIC 9(9) COMP-5 VALUE 0.
|
||||
|
||||
01 WS-TX-ID.
|
||||
05 WS-TX-ID-BUFFER PIC X(128) VALUE SPACES.
|
||||
05 WS-TX-ID-MAX PIC 9(9) COMP-5 VALUE 128.
|
||||
05 WS-TX-ID-LEN PIC 9(9) COMP-5 VALUE 0.
|
||||
|
||||
01 WS-BALANCE.
|
||||
05 WS-BALANCE-ATOMIC PIC 9(20) COMP-5 VALUE 0.
|
||||
|
||||
01 TEMP-INPUT.
|
||||
05 TEMP-AMOUNT PIC X(20).
|
||||
05 TEMP-REQUIRED PIC X(5).
|
||||
05 TEMP-TOTAL PIC X(5).
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
|
||||
MAIN.
|
||||
DISPLAY "COBOL MONERO WALLET INTERFACE STARTED".
|
||||
|
||||
DISPLAY "ENTER WALLET ID (max 64 chars): ".
|
||||
ACCEPT WS-WALLET-ID.
|
||||
DISPLAY "ENTER ACCOUNT ID (max 64 chars): ".
|
||||
ACCEPT WS-ACCOUNT-ID.
|
||||
DISPLAY "ENTER DESTINATION ADDRESS (max 256 chars): ".
|
||||
ACCEPT WS-DESTINATION-ADDRESS.
|
||||
MOVE FUNCTION LENGTH(WS-DESTINATION-ADDRESS)
|
||||
TO WS-DESTINATION-LEN.
|
||||
IF WS-DESTINATION-LEN > 256
|
||||
DISPLAY "ERROR: Destination address too long."
|
||||
STOP RUN
|
||||
END-IF.
|
||||
|
||||
DISPLAY "ENTER AMOUNT (atomic units, max 18 digits): ".
|
||||
ACCEPT TEMP-AMOUNT.
|
||||
MOVE TEMP-AMOUNT TO WS-AMOUNT-ATOMIC.
|
||||
IF WS-AMOUNT-ATOMIC = 0
|
||||
DISPLAY "ERROR: Amount must be > 0."
|
||||
STOP RUN
|
||||
END-IF.
|
||||
|
||||
DISPLAY "ENTER MULTISIG REQUIRED SIGNERS (1-10): ".
|
||||
ACCEPT TEMP-REQUIRED.
|
||||
MOVE TEMP-REQUIRED TO WS-MULTISIG-REQUIRED.
|
||||
DISPLAY "ENTER MULTISIG TOTAL SIGNERS (1-10): ".
|
||||
ACCEPT TEMP-TOTAL.
|
||||
MOVE TEMP-TOTAL TO WS-MULTISIG-TOTAL.
|
||||
|
||||
IF WS-MULTISIG-REQUIRED <= 0
|
||||
OR WS-MULTISIG-TOTAL <= 0
|
||||
DISPLAY "ERROR: Signers must be > 0."
|
||||
STOP RUN
|
||||
END-IF.
|
||||
IF WS-MULTISIG-REQUIRED > WS-MULTISIG-TOTAL
|
||||
DISPLAY "ERROR: Required > total signers."
|
||||
STOP RUN
|
||||
END-IF.
|
||||
|
||||
PERFORM CHECK-BALANCE.
|
||||
PERFORM CREATE-MONERO-SPEND.
|
||||
|
||||
DISPLAY "COBOL WALLET FINISHED".
|
||||
STOP RUN.
|
||||
|
||||
CHECK-BALANCE.
|
||||
CALL "ada_get_wallet_balance"
|
||||
USING
|
||||
BY REFERENCE WS-WALLET-ID
|
||||
BY REFERENCE WS-ACCOUNT-ID
|
||||
BY REFERENCE WS-BALANCE-ATOMIC
|
||||
RETURNING WS-STATUS-CODE
|
||||
END-CALL.
|
||||
|
||||
EVALUATE WS-STATUS-CODE
|
||||
WHEN XMR-SUCCESS
|
||||
DISPLAY "BALANCE (ATOMIC): " WS-BALANCE-ATOMIC
|
||||
WHEN XMR-ERROR-INVALID-REQUEST
|
||||
DISPLAY "BALANCE ERROR: Invalid request."
|
||||
WHEN XMR-ERROR-IO-FAILURE
|
||||
DISPLAY "BALANCE ERROR: I/O failure."
|
||||
WHEN OTHER
|
||||
DISPLAY "BALANCE ERROR: Code " WS-STATUS-CODE
|
||||
END-EVALUATE.
|
||||
|
||||
CREATE-MONERO-SPEND.
|
||||
DISPLAY "REQUESTING MONERO MULTISIG SPEND".
|
||||
|
||||
CALL "ada_build_monero_multisig_tx"
|
||||
USING
|
||||
BY REFERENCE WS-WALLET-ID
|
||||
BY REFERENCE WS-ACCOUNT-ID
|
||||
BY REFERENCE WS-DESTINATION-ADDRESS
|
||||
BY VALUE WS-AMOUNT-ATOMIC
|
||||
BY VALUE WS-MULTISIG-REQUIRED
|
||||
BY VALUE WS-MULTISIG-TOTAL
|
||||
BY REFERENCE WS-TX-BUFFER
|
||||
BY VALUE WS-TX-BUFFER-MAX
|
||||
BY REFERENCE WS-TX-BUFFER-LEN
|
||||
BY REFERENCE WS-TX-ID-BUFFER
|
||||
BY VALUE WS-TX-ID-MAX
|
||||
BY REFERENCE WS-TX-ID-LEN
|
||||
RETURNING WS-STATUS-CODE
|
||||
END-CALL.
|
||||
|
||||
EVALUATE WS-STATUS-CODE
|
||||
WHEN XMR-SUCCESS
|
||||
DISPLAY "TX CREATED SUCCESSFULLY."
|
||||
DISPLAY "TX ID: "
|
||||
WS-TX-ID-BUFFER(1:WS-TX-ID-LEN)
|
||||
WHEN XMR-ERROR-INVALID-REQUEST
|
||||
DISPLAY "TX ERROR: Invalid request."
|
||||
WHEN XMR-ERROR-BUFFER-TOO-SMALL
|
||||
DISPLAY "TX ERROR: Buffer too small."
|
||||
WHEN XMR-ERROR-MULTISIG-INCOMPLETE
|
||||
DISPLAY "TX ERROR: Multisig incomplete."
|
||||
WHEN XMR-ERROR-IO-FAILURE
|
||||
DISPLAY "TX ERROR: I/O failure."
|
||||
WHEN OTHER
|
||||
DISPLAY "TX ERROR: Code " WS-STATUS-CODE
|
||||
END-EVALUATE.
|
||||
@@ -0,0 +1,185 @@
|
||||
with Interfaces.C;
|
||||
with System;
|
||||
with Monero_IO;
|
||||
with Monero_Multisig;
|
||||
with Fortran_Crypto;
|
||||
with Monero_Types;
|
||||
|
||||
package body Ada_Bridge is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
Scratch_Max : constant Interfaces.C.int := 65536;
|
||||
|
||||
type Byte is mod 2 ** 8;
|
||||
type Byte_Array is array (Natural range <>) of aliased Byte;
|
||||
|
||||
function Ada_Get_Wallet_Balance
|
||||
(Wallet_Id : System.Address;
|
||||
Account_Id : System.Address;
|
||||
Balance : access Interfaces.C.unsigned_long_long)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
pragma Unreferenced (Wallet_Id, Account_Id);
|
||||
begin
|
||||
Balance.all := 0;
|
||||
return Monero_Types.Success;
|
||||
exception
|
||||
when others =>
|
||||
return Monero_Types.Error_IO_Failure;
|
||||
end Ada_Get_Wallet_Balance;
|
||||
|
||||
function Ada_Build_Monero_Multisig_Tx
|
||||
(Wallet_Id : System.Address;
|
||||
Account_Id : System.Address;
|
||||
Destination_Address : System.Address;
|
||||
Amount_Atomic : Interfaces.C.unsigned_long_long;
|
||||
Required_Signers : Interfaces.C.int;
|
||||
Total_Signers : Interfaces.C.int;
|
||||
Tx_Buffer : System.Address;
|
||||
Tx_Buffer_Max : Interfaces.C.int;
|
||||
Tx_Buffer_Length : access Interfaces.C.int;
|
||||
Tx_Id_Buffer : System.Address;
|
||||
Tx_Id_Max : Interfaces.C.int;
|
||||
Tx_Id_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
pragma Unreferenced (Account_Id);
|
||||
Status : Interfaces.C.int;
|
||||
|
||||
Spendable_Outputs : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
Spendable_Length : aliased Interfaces.C.int := 0;
|
||||
|
||||
Ring_Members : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
Ring_Length : aliased Interfaces.C.int := 0;
|
||||
|
||||
Multisig_Round : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
Multisig_Length : aliased Interfaces.C.int := 0;
|
||||
|
||||
RingCT_Output : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
RingCT_Length : aliased Interfaces.C.int := 0;
|
||||
|
||||
CLSAG_Output : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
CLSAG_Length : aliased Interfaces.C.int := 0;
|
||||
|
||||
Bulletproof_Out : Byte_Array (0 .. Natural (Scratch_Max) - 1);
|
||||
Bulletproof_Len : aliased Interfaces.C.int := 0;
|
||||
begin
|
||||
if Destination_Address = System.Null_Address
|
||||
or else Amount_Atomic = 0
|
||||
then
|
||||
return Monero_Types.Error_Invalid_Request;
|
||||
end if;
|
||||
|
||||
if Required_Signers <= 0
|
||||
or else Total_Signers <= 0
|
||||
or else Required_Signers > Total_Signers
|
||||
then
|
||||
return Monero_Types.Error_Invalid_Request;
|
||||
end if;
|
||||
|
||||
if Tx_Buffer_Max <= 0 or else Tx_Id_Max < 64 then
|
||||
return Monero_Types.Error_Buffer_Too_Small;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Monero_IO.Fetch_Spendable_Outputs
|
||||
(Wallet_Buffer => Wallet_Id,
|
||||
Wallet_Length => 64,
|
||||
Output_Buffer => Spendable_Outputs (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => Spendable_Length'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Monero_IO.Fetch_Ring_Members
|
||||
(Input_Buffer => Spendable_Outputs (0)'Address,
|
||||
Input_Length => Spendable_Length,
|
||||
Output_Buffer => Ring_Members (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => Ring_Length'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Monero_Multisig.Prepare_Multisig_Round
|
||||
(Input_Buffer => Ring_Members (0)'Address,
|
||||
Input_Length => Ring_Length,
|
||||
Output_Buffer => Multisig_Round (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => Multisig_Length'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Fortran_Crypto.XMR_Generate_RingCT
|
||||
(Input_Buffer => Multisig_Round (0)'Address,
|
||||
Input_Length => Multisig_Length,
|
||||
Output_Buffer => RingCT_Output (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => RingCT_Length'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Fortran_Crypto.XMR_Generate_CLSAG
|
||||
(Input_Buffer => RingCT_Output (0)'Address,
|
||||
Input_Length => RingCT_Length,
|
||||
Output_Buffer => CLSAG_Output (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => CLSAG_Length'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
Status :=
|
||||
Fortran_Crypto.XMR_Generate_Bulletproof
|
||||
(Input_Buffer => CLSAG_Output (0)'Address,
|
||||
Input_Length => CLSAG_Length,
|
||||
Output_Buffer => Bulletproof_Out (0)'Address,
|
||||
Output_Max => Scratch_Max,
|
||||
Output_Length => Bulletproof_Len'Access);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
if Bulletproof_Len > Tx_Buffer_Max then
|
||||
return Monero_Types.Error_Buffer_Too_Small;
|
||||
end if;
|
||||
|
||||
Tx_Buffer_Length.all := Bulletproof_Len;
|
||||
declare
|
||||
Tx_Out : Byte_Array (0 .. Natural (Tx_Buffer_Max) - 1)
|
||||
with Address => Tx_Buffer;
|
||||
begin
|
||||
Tx_Out (0 .. Natural (Bulletproof_Len) - 1) :=
|
||||
Bulletproof_Out (0 .. Natural (Bulletproof_Len) - 1);
|
||||
end;
|
||||
|
||||
Tx_Id_Length.all := 64;
|
||||
declare
|
||||
Tx_Id_Out : Byte_Array (0 .. Natural (Tx_Id_Max) - 1)
|
||||
with Address => Tx_Id_Buffer;
|
||||
begin
|
||||
Tx_Id_Out (0 .. 63) := Bulletproof_Out (0 .. 63);
|
||||
end;
|
||||
|
||||
Status :=
|
||||
Monero_IO.Broadcast_Transaction
|
||||
(Tx_Buffer, Tx_Buffer_Length.all);
|
||||
if Status /= Monero_Types.Success then
|
||||
return Status;
|
||||
end if;
|
||||
|
||||
return Monero_Types.Success;
|
||||
|
||||
exception
|
||||
when others =>
|
||||
return Monero_Types.Error_IO_Failure;
|
||||
end Ada_Build_Monero_Multisig_Tx;
|
||||
|
||||
end Ada_Bridge;
|
||||
@@ -0,0 +1,30 @@
|
||||
with Interfaces.C;
|
||||
with System;
|
||||
|
||||
package Ada_Bridge is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function Ada_Get_Wallet_Balance
|
||||
(Wallet_Id : System.Address;
|
||||
Account_Id : System.Address;
|
||||
Balance : access Interfaces.C.unsigned_long_long)
|
||||
return Interfaces.C.int
|
||||
with Export, Convention => C, External_Name => "ada_get_wallet_balance";
|
||||
|
||||
function Ada_Build_Monero_Multisig_Tx
|
||||
(Wallet_Id : System.Address;
|
||||
Account_Id : System.Address;
|
||||
Destination_Address : System.Address;
|
||||
Amount_Atomic : Interfaces.C.unsigned_long_long;
|
||||
Required_Signers : Interfaces.C.int;
|
||||
Total_Signers : Interfaces.C.int;
|
||||
Tx_Buffer : System.Address;
|
||||
Tx_Buffer_Max : Interfaces.C.int;
|
||||
Tx_Buffer_Length : access Interfaces.C.int;
|
||||
Tx_Id_Buffer : System.Address;
|
||||
Tx_Id_Max : Interfaces.C.int;
|
||||
Tx_Id_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Export, Convention => C, External_Name => "ada_build_monero_multisig_tx";
|
||||
|
||||
end Ada_Bridge;
|
||||
@@ -0,0 +1,85 @@
|
||||
with Interfaces.C;
|
||||
with System;
|
||||
|
||||
package Fortran_Crypto is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function XMR_Hash_To_Scalar
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_hash_to_scalar";
|
||||
|
||||
function XMR_Hash_To_Point
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_hash_to_point";
|
||||
|
||||
function XMR_Generate_Key_Image
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_generate_key_image";
|
||||
|
||||
function XMR_Generate_RingCT
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_generate_ringct";
|
||||
|
||||
function XMR_Verify_RingCT
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_verify_ringct";
|
||||
|
||||
function XMR_Multisig_Prepare
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_multisig_prepare";
|
||||
|
||||
function XMR_Multisig_Combine
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_multisig_combine";
|
||||
|
||||
function XMR_Generate_CLSAG
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_generate_clsag";
|
||||
|
||||
function XMR_Generate_Bulletproof
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
with Import, Convention => C, External_Name => "xmr_generate_bulletproof";
|
||||
|
||||
end Fortran_Crypto;
|
||||
@@ -0,0 +1,217 @@
|
||||
module monero_crypto
|
||||
use iso_c_binding
|
||||
implicit none
|
||||
|
||||
integer(c_int), parameter :: XMR_SUCCESS = 0
|
||||
integer(c_int), parameter :: XMR_ERROR_INVALID = 1
|
||||
integer(c_int), parameter :: XMR_ERROR_BUFFER_TOO_SMALL = 2
|
||||
integer(c_int), parameter :: XMR_ERROR_CRYPTO = 4
|
||||
|
||||
contains
|
||||
|
||||
function xmr_hash_to_scalar(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_hash_to_scalar") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
integer(c_signed_char), pointer :: input(:), output(:)
|
||||
integer :: i
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 32) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
|
||||
call c_f_pointer(input_ptr, input, [input_len])
|
||||
call c_f_pointer(output_ptr, output, [output_max])
|
||||
do i = 1, min(input_len, 32, output_max)
|
||||
output(i) = input(i)
|
||||
end do
|
||||
output_len = 32
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_hash_to_scalar
|
||||
|
||||
function xmr_hash_to_point(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_hash_to_point") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 32) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 32
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_hash_to_point
|
||||
|
||||
function xmr_generate_key_image(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_generate_key_image") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 32) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 32
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_generate_key_image
|
||||
|
||||
function xmr_generate_ringct(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_generate_ringct") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 1024) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 1024
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_generate_ringct
|
||||
|
||||
function xmr_verify_ringct(input_ptr, input_len) &
|
||||
bind(C, name="xmr_verify_ringct") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. input_len < 0) then
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_verify_ringct
|
||||
|
||||
function xmr_multisig_prepare(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_multisig_prepare") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 1024) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 1024
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_multisig_prepare
|
||||
|
||||
function xmr_multisig_combine(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_multisig_combine") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 2048) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 2048
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_multisig_combine
|
||||
|
||||
function xmr_generate_clsag(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_generate_clsag") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 512) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 512
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_generate_clsag
|
||||
|
||||
function xmr_generate_bulletproof(input_ptr, input_len, output_ptr, output_max, output_len) &
|
||||
bind(C, name="xmr_generate_bulletproof") result(status)
|
||||
type(c_ptr), value :: input_ptr
|
||||
integer(c_int), value :: input_len
|
||||
type(c_ptr), value :: output_ptr
|
||||
integer(c_int), value :: output_max
|
||||
integer(c_int) :: output_len
|
||||
integer(c_int) :: status
|
||||
|
||||
if (.not. c_associated(input_ptr) .or. .not. c_associated(output_ptr)) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_INVALID
|
||||
return
|
||||
end if
|
||||
if (input_len < 0 .or. output_max < 2048) then
|
||||
output_len = 0
|
||||
status = XMR_ERROR_BUFFER_TOO_SMALL
|
||||
return
|
||||
end if
|
||||
output_len = 2048
|
||||
status = XMR_SUCCESS
|
||||
end function xmr_generate_bulletproof
|
||||
|
||||
end module monero_crypto
|
||||
@@ -0,0 +1,46 @@
|
||||
with Interfaces.C;
|
||||
|
||||
package body Monero_IO is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function Fetch_Spendable_Outputs
|
||||
(Wallet_Buffer : System.Address;
|
||||
Wallet_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
pragma Unreferenced (Wallet_Buffer, Wallet_Length);
|
||||
pragma Unreferenced (Output_Buffer, Output_Max);
|
||||
begin
|
||||
Output_Length.all := 0;
|
||||
return 0;
|
||||
end Fetch_Spendable_Outputs;
|
||||
|
||||
function Fetch_Ring_Members
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
pragma Unreferenced (Input_Buffer, Input_Length);
|
||||
pragma Unreferenced (Output_Buffer, Output_Max);
|
||||
begin
|
||||
Output_Length.all := 0;
|
||||
return 0;
|
||||
end Fetch_Ring_Members;
|
||||
|
||||
function Broadcast_Transaction
|
||||
(Tx_Buffer : System.Address;
|
||||
Tx_Length : Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
pragma Unreferenced (Tx_Buffer, Tx_Length);
|
||||
begin
|
||||
return 0;
|
||||
end Broadcast_Transaction;
|
||||
|
||||
end Monero_IO;
|
||||
@@ -0,0 +1,28 @@
|
||||
with Interfaces.C;
|
||||
with System;
|
||||
|
||||
package Monero_IO is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function Fetch_Spendable_Outputs
|
||||
(Wallet_Buffer : System.Address;
|
||||
Wallet_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int;
|
||||
|
||||
function Fetch_Ring_Members
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int;
|
||||
|
||||
function Broadcast_Transaction
|
||||
(Tx_Buffer : System.Address;
|
||||
Tx_Length : Interfaces.C.int)
|
||||
return Interfaces.C.int;
|
||||
|
||||
end Monero_IO;
|
||||
@@ -0,0 +1,34 @@
|
||||
with Fortran_Crypto;
|
||||
|
||||
package body Monero_Multisig is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function Prepare_Multisig_Round
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
begin
|
||||
return Fortran_Crypto.XMR_Multisig_Prepare
|
||||
(Input_Buffer, Input_Length,
|
||||
Output_Buffer, Output_Max, Output_Length);
|
||||
end Prepare_Multisig_Round;
|
||||
|
||||
function Combine_Multisig_Rounds
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int
|
||||
is
|
||||
begin
|
||||
return Fortran_Crypto.XMR_Multisig_Combine
|
||||
(Input_Buffer, Input_Length,
|
||||
Output_Buffer, Output_Max, Output_Length);
|
||||
end Combine_Multisig_Rounds;
|
||||
|
||||
end Monero_Multisig;
|
||||
@@ -0,0 +1,23 @@
|
||||
with Interfaces.C;
|
||||
with System;
|
||||
|
||||
package Monero_Multisig is
|
||||
pragma SPARK_Mode (Off);
|
||||
|
||||
function Prepare_Multisig_Round
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int;
|
||||
|
||||
function Combine_Multisig_Rounds
|
||||
(Input_Buffer : System.Address;
|
||||
Input_Length : Interfaces.C.int;
|
||||
Output_Buffer : System.Address;
|
||||
Output_Max : Interfaces.C.int;
|
||||
Output_Length : access Interfaces.C.int)
|
||||
return Interfaces.C.int;
|
||||
|
||||
end Monero_Multisig;
|
||||
@@ -0,0 +1,22 @@
|
||||
package body Monero_Types is
|
||||
pragma SPARK_Mode (On);
|
||||
|
||||
function Threshold_Reached
|
||||
(Participants : Multisig_Participant_Array;
|
||||
Required : Positive)
|
||||
return Boolean
|
||||
is
|
||||
Count : Natural := 0;
|
||||
begin
|
||||
for P of Participants loop
|
||||
if P.Status = Accepted then
|
||||
Count := Count + 1;
|
||||
end if;
|
||||
if Count >= Required then
|
||||
return True;
|
||||
end if;
|
||||
end loop;
|
||||
return False;
|
||||
end Threshold_Reached;
|
||||
|
||||
end Monero_Types;
|
||||
@@ -0,0 +1,54 @@
|
||||
with Interfaces.C;
|
||||
|
||||
package Monero_Types is
|
||||
pragma SPARK_Mode (On);
|
||||
|
||||
subtype Status_Code is Interfaces.C.int;
|
||||
|
||||
Success : constant Status_Code := 0;
|
||||
Error_Invalid_Request : constant Status_Code := 1;
|
||||
Error_Buffer_Too_Small : constant Status_Code := 2;
|
||||
Error_Unsupported_Chain : constant Status_Code := 3;
|
||||
Error_Crypto_Failure : constant Status_Code := 4;
|
||||
Error_Multisig_Incomplete : constant Status_Code := 5;
|
||||
Error_IO_Failure : constant Status_Code := 6;
|
||||
|
||||
type Atomic_Amount is mod 2 ** 64;
|
||||
|
||||
type Monero_Tx_State is
|
||||
(Draft,
|
||||
Inputs_Selected,
|
||||
Rings_Selected,
|
||||
RingCT_Prepared,
|
||||
Multisig_Partial,
|
||||
Multisig_Complete,
|
||||
Finalized,
|
||||
Submitted,
|
||||
Failed);
|
||||
|
||||
type Signature_Status is (Missing, Present, Invalid, Accepted);
|
||||
|
||||
type Participant_Id is range 1 .. 10;
|
||||
|
||||
type Multisig_Participant is record
|
||||
Id : Participant_Id;
|
||||
Status : Signature_Status;
|
||||
end record;
|
||||
|
||||
type Multisig_Participant_Array is
|
||||
array (1 .. 10) of Multisig_Participant;
|
||||
|
||||
type Tx_Context is record
|
||||
Amount_Atomic : Atomic_Amount;
|
||||
Required_Signers : Positive range 1 .. 10;
|
||||
Total_Signers : Positive range 1 .. 10;
|
||||
State : Monero_Tx_State;
|
||||
end record;
|
||||
|
||||
function Threshold_Reached
|
||||
(Participants : Multisig_Participant_Array;
|
||||
Required : Positive)
|
||||
return Boolean
|
||||
with Pre => Required <= 10;
|
||||
|
||||
end Monero_Types;
|
||||
Reference in New Issue
Block a user