diff --git a/src-lib-exts/stdlib/Data/List.agda b/src-lib-exts/stdlib/Data/List.agda new file mode 100644 index 0000000000..d86ce25d11 --- /dev/null +++ b/src-lib-exts/stdlib/Data/List.agda @@ -0,0 +1,9 @@ +{-# OPTIONS --safe --without-K #-} +module stdlib.Data.List where + +open import Data.List +open import Data.List.Relation.Unary.All +open import Data.Empty + +Is-[] : ∀ {A : Set} → List A → Set +Is-[] = All (λ _ → ⊥) diff --git a/src/Ledger/Conway/Specification/Script/Base.lagda.md b/src/Ledger/Conway/Specification/Script/Base.lagda.md index ca6c4803a2..590cd0564d 100644 --- a/src/Ledger/Conway/Specification/Script/Base.lagda.md +++ b/src/Ledger/Conway/Specification/Script/Base.lagda.md @@ -108,4 +108,7 @@ record ScriptStructure : Type₁ where toP2Script : Script → Maybe P2Script toP2Script = isInj₂ + + getLanguage : Script → Maybe Language + getLanguage s = toP2Script s <&> language ``` diff --git a/src/Ledger/Conway/Specification/Utxow.lagda.md b/src/Ledger/Conway/Specification/Utxow.lagda.md index 8a022ed225..60065e843e 100644 --- a/src/Ledger/Conway/Specification/Utxow.lagda.md +++ b/src/Ledger/Conway/Specification/Utxow.lagda.md @@ -68,10 +68,6 @@ instance languages : Tx → UTxO → ℙ Language languages tx utxo = mapPartial getLanguage (txscripts tx utxo) - where - getLanguage : Script → Maybe Language - getLanguage (inj₁ _) = nothing - getLanguage (inj₂ s) = just (language s) ``` --> diff --git a/src/Ledger/Dijkstra/Specification/Utxow.lagda.md b/src/Ledger/Dijkstra/Specification/Utxow.lagda.md index 4c2c079a55..d6dc1686da 100644 --- a/src/Ledger/Dijkstra/Specification/Utxow.lagda.md +++ b/src/Ledger/Dijkstra/Specification/Utxow.lagda.md @@ -30,12 +30,85 @@ private variable ``` --> +## Witnessing Functions {#sec:witnessing-functions} + ```agda -languages : Tx ℓ → UTxO → ℙ Language -languages tx utxo = ∅ -- TODO +module _ (tx : TopLevelTx) where + open Tx tx + open TxBody txBody + + module _ (utxo : UTxO) where + UsesBootstrapAddress : Type + UsesBootstrapAddress = ∃[ o ∈ (range txOuts) ∪ range (utxo ∣ (txIns ∪ refInputs)) ] isBootstrapAddr (proj₁ o) + + HasInlineDatum : TxOut → Type + HasInlineDatum txout = Is-just (txOutToDatum txout) + + UsesV2Features : Type + UsesV2Features = ∃[ o ∈ (range txOuts) ∪ range (utxo ∣ (txIns ∪ refInputs)) ] HasInlineDatum o + + data UsesV3Features : Set where + hasVotes : ¬ (Is-[] txGovVotes) → UsesV3Features + hasProposals : ¬ (Is-[] txGovProposals) → UsesV3Features + hasDonation : NonZero txDonation → UsesV3Features + hasTreasure : Is-just currentTreasury → UsesV3Features + + data UsesV4Features : Set where + hasSubtransactions : ¬ (Is-[] txSubTransactions) → UsesV4Features + hasGuards : ¬ (Is-∅ txGuards) → UsesV4Features +``` -allowedLanguages : Tx ℓ → UTxO → ℙ Language -allowedLanguages tx utxo = ∅ -- TODO + + +```agda +languages : ℙ P2Script → ℙ Language +languages p2Scripts = mapˢ language p2Scripts + +allowedLanguages : TopLevelTx → UTxO → ℙ Language +allowedLanguages tx utxo = + if UsesBootstrapAddress tx utxo + then ∅ + else + if UsesV4Features tx + then fromList (PlutusV4 ∷ []) + else + if UsesV3Features tx + then fromList (PlutusV4 ∷ PlutusV3 ∷ []) + else + if UsesV2Features tx utxo + then fromList (PlutusV4 ∷ PlutusV3 ∷ PlutusV2 ∷ []) + else fromList (PlutusV4 ∷ PlutusV3 ∷ PlutusV2 ∷ PlutusV1 ∷ []) ``` ```agda @@ -78,7 +151,6 @@ data _⊢_⇀⦇_,SUBUTXOW⦈_ : UTxOEnv → UTxOState → SubLevelTx → UTxOSt ∙ neededVKeyHashes ⊆ witsKeyHashes ∙ neededScriptHashes ⊆ mapˢ hash p1Scripts ∪ mapˢ hash p2Scripts ∙ neededDataHashes ⊆ dom (Γ .globalData) - ∙ languages tx utxo ⊆ allowedLanguages tx utxo ∙ txADhash ≡ map hash txAuxData ∙ Γ ⊢ s ⇀⦇ stx ,SUBUTXO⦈ s' ──────────────────────────────── @@ -123,7 +195,7 @@ data _⊢_⇀⦇_,UTXOW⦈_ : UTxOEnv → UTxOState → TopLevelTx → UTxOState ∙ neededVKeyHashes ⊆ witsKeyHashes ∙ neededScriptHashes ⊆ mapˢ hash p1Scripts ∪ mapˢ hash p2Scripts ∙ neededDataHashes ⊆ dom (Γ .globalData) - ∙ languages tx utxo ⊆ allowedLanguages tx utxo + ∙ languages p2Scripts ⊆ allowedLanguages tx utxo ∙ txADhash ≡ map hash txAuxData ∙ Γ ⊢ s ⇀⦇ tx ,UTXO⦈ s' ──────────────────────────────── diff --git a/src/Ledger/Prelude.lagda.md b/src/Ledger/Prelude.lagda.md index 9afd3f83c3..e32927ac50 100644 --- a/src/Ledger/Prelude.lagda.md +++ b/src/Ledger/Prelude.lagda.md @@ -90,4 +90,7 @@ lookupHash : ∀ {T H : Type} ⦃ _ : DecEq H ⦄ ⦃ _ : Hashable T H ⦄ → H lookupHash h s = if h ∈ mapˢ proj₁ (m ˢ) then just (lookupᵐ m h) else nothing where m = setToMap (mapˢ < hash , id > s) + +Is-∅ : {A : Type} → ℙ A → Type +Is-∅ X = Is-[] (setToList X) ``` diff --git a/src/Prelude.lagda.md b/src/Prelude.lagda.md index ff411f3354..346502960f 100644 --- a/src/Prelude.lagda.md +++ b/src/Prelude.lagda.md @@ -21,6 +21,8 @@ open import Data.Bool.ListAction public open import Data.Empty public open import Data.List public hiding (all; and; any; align; alignWith; filter; fromMaybe; map; or; product; sum; zip; zipWith) +open import stdlib.Data.List public + using (Is-[]) open import Data.List.Membership.Propositional public using () renaming (_∈_ to _∈ˡ_; _∉_ to _∉ˡ_) open import Data.Maybe public @@ -120,4 +122,9 @@ negPart x with sign x ∸≡posPart⊖ {zero} {ℕ.suc n} = _≡_.refl ∸≡posPart⊖ {ℕ.suc m} {zero} = _≡_.refl ∸≡posPart⊖ {ℕ.suc m} {ℕ.suc n} = trans (∸≡posPart⊖{m}{n}) (sym (cong posPart (([1+m]⊖[1+n]≡m⊖n m n)))) + +instance + Dec-NonZero : ∀ {n} → NonZero n ⁇ + Dec-NonZero {zero} .dec = no λ () + Dec-NonZero {suc n} .dec = yes (record { nonZero = tt }) ```