From 5914c8ae728154e5882bdc1ca786529e16c2ffea Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Javier=20D=C3=ADaz?= <javier.diaz@iohk.io>
Date: Mon, 4 Nov 2024 13:16:28 +0000
Subject: [PATCH 1/5] Votes in the state must be by registered entities

---
 src/Ledger/Conway/Conformance/Gov.agda        |  61 +++++----
 .../Conway/Conformance/Gov/Properties.agda    |  25 +++-
 src/Ledger/Conway/Conformance/Ledger.agda     |  15 ++-
 .../Conway/Conformance/Ledger/Properties.agda |   7 +-
 src/Ledger/Gov.lagda                          |  82 +++++++-----
 src/Ledger/Gov/Properties.agda                |  25 +++-
 src/Ledger/Ledger.lagda                       |  15 ++-
 src/Ledger/Ledger/Properties.agda             | 120 +++++++++++++++---
 8 files changed, 258 insertions(+), 92 deletions(-)

diff --git a/src/Ledger/Conway/Conformance/Gov.agda b/src/Ledger/Conway/Conformance/Gov.agda
index 64b68a316..8d24842be 100644
--- a/src/Ledger/Conway/Conformance/Gov.agda
+++ b/src/Ledger/Conway/Conformance/Gov.agda
@@ -3,16 +3,16 @@
 open import Ledger.Types.GovStructure
 open import Ledger.Transaction using (TransactionStructure)
 
-module Ledger.Conway.Conformance.Gov (txs : _) (open TransactionStructure txs using (govStructure)) where
-open GovStructure govStructure hiding (epoch)
+module Ledger.Conway.Conformance.Gov (txs : _) (open TransactionStructure txs hiding (epoch)) where
 
 open import Ledger.Prelude hiding (any?; Any; all?; All; Rel; lookup; ∈-filter)
 
 open import Axiom.Set.Properties th using (∃-sublist-⇔)
 
-open import Ledger.GovernanceActions govStructure hiding (yes; no)
+open import Ledger.GovernanceActions govStructure using (Vote)
 open import Ledger.Enact govStructure
 open import Ledger.Conway.Conformance.Ratify txs hiding (vote)
+open import Ledger.Conway.Conformance.Certs govStructure
 
 open import Data.List.Ext using (subpermutations; sublists)
 open import Data.List.Ext.Properties2
@@ -32,8 +32,7 @@ GovState : Type
 GovState = List (GovActionID × GovActionState)
 
 record GovEnv : Type where
-
-  constructor ⟦_,_,_,_,_⟧ᵍ
+  constructor ⟦_,_,_,_,_,_⟧ᵍ
   field
 
     txid        : TxId
@@ -41,12 +40,7 @@ record GovEnv : Type where
     pparams     : PParams
     ppolicy     : Maybe ScriptHash
     enactState  : EnactState
-
-data
-
-  _⊢_⇀⦇_,GOV'⦈_  : GovEnv × ℕ → GovState → GovVote ⊎ GovProposal → GovState → Type
-
-_⊢_⇀⦇_,GOV⦈_     : GovEnv → GovState → List (GovVote ⊎ GovProposal) → GovState → Type
+    certState   : CertState
 
 private variable
   Γ : GovEnv
@@ -62,6 +56,9 @@ private variable
   k : ℕ
   p : Maybe ScriptHash
 
+open GState
+open PState
+
 govActionPriority : GovAction → ℕ
 govActionPriority NoConfidence             = 0
 govActionPriority (UpdateCommittee _ _ _)  = 1
@@ -74,13 +71,13 @@ govActionPriority Info                     = 6
 _∼_ : ℕ → ℕ → Type
 n ∼ m = (n ≡ m) ⊎ (n ≡ 0 × m ≡ 1) ⊎ (n ≡ 1 × m ≡ 0)
 
-_≈_ : GovAction → GovAction → Type
-a ≈ a' = (govActionPriority a) ∼ (govActionPriority a')
+_≈ᵍ_ : GovAction → GovAction → Type
+a ≈ᵍ a' = (govActionPriority a) ∼ (govActionPriority a')
 
 _∼?_ : (n m : ℕ) → Dec (n ∼ m)
 n ∼? m = n ≟ m ⊎-dec (n ≟ 0 ×-dec m ≟ 1) ⊎-dec (n ≟ 1 ×-dec m ≟ 0)
 
-_≈?_ : (a a' : GovAction) → Dec (a ≈ a')
+_≈?_ : (a a' : GovAction) → Dec (a ≈ᵍ a')
 a ≈? a' = (govActionPriority a) ∼? (govActionPriority a')
 
 
@@ -91,11 +88,6 @@ insertGovAction ((gaID₀ , gaSt₀) ∷ gaPrs) (gaID₁ , gaSt₁)
      then (gaID₀ , gaSt₀) ∷ insertGovAction gaPrs (gaID₁ , gaSt₁)
      else (gaID₁ , gaSt₁) ∷ (gaID₀ , gaSt₀) ∷ gaPrs
 
-addVote : GovState → GovActionID → Voter → Vote → GovState
-addVote s aid voter v = map modifyVotes s
-  where modifyVotes = λ (gid , s') → gid , record s'
-          { votes = if gid ≡ aid then insert (votes s') voter v else votes s'}
-
 mkGovStatePair : Epoch → GovActionID → RwdAddr → (a : GovAction) → NeedsHash a
                  → GovActionID × GovActionState
 mkGovStatePair e aid addr a prev = (aid , record
@@ -106,11 +98,29 @@ addAction : GovState
           → GovState
 addAction s e aid addr a prev = insertGovAction s (mkGovStatePair e aid addr a prev)
 
-validHFAction : GovProposal → GovState → EnactState → Type
-validHFAction (record { action = TriggerHF v ; prevAction = prev }) s e =
-  (let (v' , aid) = EnactState.pv e in aid ≡ prev × pvCanFollow v' v)
-  ⊎ ∃₂[ x , v' ] (prev , x) ∈ fromList s × x .action ≡ TriggerHF v' × pvCanFollow v' v
-validHFAction _ _ _ = ⊤
+opaque
+  addVote : GovState → GovActionID → Voter → Vote → GovState
+  addVote s aid voter v = map modifyVotes s
+    where modifyVotes : GovActionID × GovActionState → GovActionID × GovActionState
+          modifyVotes = λ (gid , s') → gid , record s'
+            { votes = if gid ≡ aid then insert (votes s') voter v else votes s'}
+
+  isRegistered : GovEnv → Voter → Type
+  isRegistered ⟦ _ , _ , _ , _ , _ , ⟦ _ , pState , gState ⟧ᶜˢ ⟧ᵍ (r , c) = case r of λ where
+    CC    → just c ∈ range (gState .ccHotKeys)
+    DRep  → c ∈ dom (gState .dreps)
+    SPO   → c ∈ mapˢ KeyHashObj (dom (pState .pools))
+
+  validHFAction : GovProposal → GovState → EnactState → Type
+  validHFAction (record { action = TriggerHF v ; prevAction = prev }) s e =
+    (let (v' , aid) = EnactState.pv e in aid ≡ prev × pvCanFollow v' v)
+    ⊎ ∃₂[ x , v' ] (prev , x) ∈ fromList s × x .action ≡ TriggerHF v' × pvCanFollow v' v
+  validHFAction _ _ _ = ⊤
+
+data
+  _⊢_⇀⦇_,GOV'⦈_  : GovEnv × ℕ → GovState → GovVote ⊎ GovProposal → GovState → Type
+
+_⊢_⇀⦇_,GOV⦈_   : GovEnv → GovState → List (GovVote ⊎ GovProposal) → GovState → Type
 
 -- Convert list of (GovActionID,GovActionState)-pairs to list of GovActionID pairs.
 getAidPairsList : GovState → List (GovActionID × GovActionID)
@@ -147,7 +157,7 @@ hasParentE e aid a = case getHashES e a of
 hasParent : EnactState → GovState → (a : GovAction) → NeedsHash a → Type
 hasParent e s a aid with getHash aid
 ... | just aid' = hasParentE e aid' a
-                  ⊎ Any (λ (gid , gas) → gid ≡ aid' × action gas ≈ a) s
+                  ⊎ Any (λ (gid , gas) → gid ≡ aid' × action gas ≈ᵍ a) s
 ... | nothing = ⊤
 
 open Equivalence
@@ -236,6 +246,7 @@ data _⊢_⇀⦇_,GOV'⦈_ where
     in
     ∙ (aid , ast) ∈ fromList s
     ∙ canVote pparams (action ast) (proj₁ voter)
+    ∙ isRegistered Γ voter
       ───────────────────────────────────────
       (Γ , k) ⊢ s ⇀⦇ inj₁ vote ,GOV'⦈ addVote s aid voter v
 
diff --git a/src/Ledger/Conway/Conformance/Gov/Properties.agda b/src/Ledger/Conway/Conformance/Gov/Properties.agda
index 1b1665266..00ad0c73e 100644
--- a/src/Ledger/Conway/Conformance/Gov/Properties.agda
+++ b/src/Ledger/Conway/Conformance/Gov/Properties.agda
@@ -75,6 +75,9 @@ private
   hasPrev record { action = (TreasuryWdrl _) }        v = no λ ()
   hasPrev record { action = Info }                    v = no λ ()
 
+opaque
+  unfolding validHFAction isRegistered
+
   instance
     validHFAction? : ∀ {p s e} → validHFAction p s e ⁇
     validHFAction? {record { action = NoConfidence }} = Dec-⊤
@@ -93,6 +96,11 @@ private
     validHFAction? {record { action = TreasuryWdrl _ }} = Dec-⊤
     validHFAction? {record { action = Info }} = Dec-⊤
 
+  isRegistered? : ∀ Γ v → Dec (isRegistered Γ v)
+  isRegistered? _ (CC   , _) = ¿ _ ∈ _ ¿
+  isRegistered? _ (DRep , _) = ¿ _ ∈ _ ¿
+  isRegistered? _ (SPO  , _) = ¿ _ ∈ _ ¿
+
 instance
   Computational-GOV' : Computational _⊢_⇀⦇_,GOV'⦈_ String
   Computational-GOV' = record {Go} where
@@ -103,15 +111,18 @@ instance
       module GoVote sig where
         open GovVote sig
 
-        computeProof = case lookupActionId pparams (proj₁ voter) gid s of λ where
-            (yes p) → case Any↔ .from p of λ where
-              (_ , mem , refl , cV) → success (_ , GOV-Vote (∈-fromList .to mem , cV))
-            (no ¬p)  → failure (genErrors ¬p)
+        computeProof = case lookupActionId pparams (proj₁ voter) gid s ,′ isRegistered? (proj₁ Γ) voter of λ where
+            (yes p , yes p') → case Any↔ .from p of λ where
+              (_ , mem , refl , cV) → success (_ , GOV-Vote (∈-fromList .to mem , cV , p'))
+            (yes _ , no ¬p) → failure (genErrors ¬p)
+            (no ¬p , _)     → failure (genErrors ¬p)
 
         completeness : ∀ s' → Γ ⊢ s ⇀⦇ inj₁ sig ,GOV'⦈ s' → map proj₁ computeProof ≡ success s'
-        completeness s' (GOV-Vote (mem , cV)) with lookupActionId pparams (proj₁ voter) gid s
-        ... | no ¬p = ⊥-elim (¬p (Any↔ .to (_ , ∈-fromList .from mem , refl , cV)))
-        ... | yes p with Any↔ .from p
+        completeness s' (GOV-Vote (mem , cV , reg))
+          with lookupActionId pparams (proj₁ voter) gid s | isRegistered? (proj₁ Γ) voter
+        ... | no ¬p | _ = ⊥-elim (¬p (Any↔ .to (_ , ∈-fromList .from mem , refl , cV)))
+        ... | yes _ | no ¬p = ⊥-elim $ ¬p reg
+        ... | yes p | yes p' with Any↔ .from p
         ... | (_ , mem , refl , cV) = refl
 
       module GoProp prop where
diff --git a/src/Ledger/Conway/Conformance/Ledger.agda b/src/Ledger/Conway/Conformance/Ledger.agda
index 57a9e2599..5016dc0ff 100644
--- a/src/Ledger/Conway/Conformance/Ledger.agda
+++ b/src/Ledger/Conway/Conformance/Ledger.agda
@@ -19,6 +19,8 @@ open import Ledger.Conway.Conformance.Utxow txs abs
 open import Ledger.Conway.Conformance.Certs govStructure
 
 open Tx
+open GState
+open GovActionState
 
 record LEnv : Type where
 
@@ -44,6 +46,17 @@ txgov : TxBody → List (GovVote ⊎ GovProposal)
 txgov txb = map inj₂ txprop ++ map inj₁ txvote
   where open TxBody txb
 
+isUnregisteredDRep : CertState → Voter → Type
+isUnregisteredDRep ⟦ _ , _ , gState ⟧ᶜˢ (r , c) = r ≡ DRep × c ∉ dom (gState .dreps)
+
+removeOrphanDRepVotes : CertState → GovActionState → GovActionState
+removeOrphanDRepVotes certState gas = record gas { votes = votes′ }
+  where
+    votes′ = filterKeys (¬_ ∘ isUnregisteredDRep certState) (votes gas)
+
+_|ᵒ_ : GovState → CertState → GovState
+govSt |ᵒ certState = L.map (map₂ (removeOrphanDRepVotes certState)) govSt
+
 private variable
   Γ : LEnv
   s s' s'' : LState
@@ -70,7 +83,7 @@ data
     ∙  isValid tx ≡ true
     ∙  record { LEnv Γ } ⊢ utxoSt ⇀⦇ tx ,UTXOW⦈ utxoSt'
     ∙  ⟦ epoch slot , pparams , txvote , txwdrls ⟧ᶜ ⊢ certState ⇀⦇ txcerts ,CERTS⦈ certState'
-    ∙  ⟦ txid , epoch slot , pparams , ppolicy , enactState ⟧ᵍ ⊢ govSt ⇀⦇ txgov txb ,GOV⦈ govSt'
+    ∙  ⟦ txid , epoch slot , pparams , ppolicy , enactState , certState' ⟧ᵍ ⊢ govSt |ᵒ certState' ⇀⦇ txgov txb ,GOV⦈ govSt'
        ────────────────────────────────
        Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ ⟦ utxoSt'' , govSt' , certState' ⟧ˡ
 
diff --git a/src/Ledger/Conway/Conformance/Ledger/Properties.agda b/src/Ledger/Conway/Conformance/Ledger/Properties.agda
index 2baadae49..6ee960b27 100644
--- a/src/Ledger/Conway/Conformance/Ledger/Properties.agda
+++ b/src/Ledger/Conway/Conformance/Ledger/Properties.agda
@@ -64,14 +64,15 @@ instance
       where
       utxoΓ = UTxOEnv ∋ record { LEnv Γ }
       certΓ = CertEnv ∋ ⟦ epoch slot , pparams , txvote , txwdrls ⟧ᶜ
-      govΓ  = GovEnv  ∋ ⟦ txid , epoch slot , pparams , ppolicy , enactState ⟧ᵍ
+      govΓ : CertState → GovEnv
+      govΓ = ⟦ txid , epoch slot , pparams , ppolicy , enactState ,_⟧ᵍ
 
       computeProof : ComputationResult String (∃[ s' ] Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s')
       computeProof = case isValid ≟ true of λ where
         (yes p) → do
           (utxoSt' , utxoStep) ← computeUtxow utxoΓ utxoSt tx
           (certSt' , certStep) ← computeCerts certΓ certSt txcerts
-          (govSt'  , govStep)  ← computeGov   govΓ  govSt  (txgov txb)
+          (govSt'  , govStep)  ← computeGov (govΓ certSt') (govSt |ᵒ certSt') (txgov txb)
           success (_ , LEDGER-V⋯ p utxoStep certStep govStep)
         (no ¬p) → do
           (utxoSt' , utxoStep) ← computeUtxow utxoΓ utxoSt tx
@@ -86,7 +87,7 @@ instance
       ... | success (utxoSt' , _) | refl
         with computeCerts certΓ certSt txcerts | complete _ _ _ _ certStep
       ... | success (certSt' , _) | refl
-        with computeGov govΓ govSt (txgov txb) | complete govΓ _ _ _ govStep
+        with computeGov (govΓ certSt') (govSt |ᵒ certSt') (txgov txb) | complete {STS = _⊢_⇀⦇_,GOV⦈_} (govΓ certSt') _ _ _ govStep
       ... | success (govSt' , _) | refl = refl
       completeness ⟦ utxoSt' , govSt' , certState' ⟧ˡ (LEDGER-I⋯ i utxoStep)
         with isValid ≟ true
diff --git a/src/Ledger/Gov.lagda b/src/Ledger/Gov.lagda
index 1eed4b954..232f69a43 100644
--- a/src/Ledger/Gov.lagda
+++ b/src/Ledger/Gov.lagda
@@ -6,16 +6,16 @@
 open import Ledger.Types.GovStructure
 open import Ledger.Transaction using (TransactionStructure)
 
-module Ledger.Gov (txs : _) (open TransactionStructure txs using (govStructure)) where
-open GovStructure govStructure hiding (epoch)
+module Ledger.Gov (txs : _) (open TransactionStructure txs hiding (epoch)) where
 
 open import Ledger.Prelude hiding (any?; Any; all?; All; Rel; lookup; ∈-filter)
 
 open import Axiom.Set.Properties th using (∃-sublist-⇔)
 
-open import Ledger.GovernanceActions govStructure hiding (yes; no)
+open import Ledger.GovernanceActions govStructure using (Vote)
 open import Ledger.Enact govStructure
 open import Ledger.Ratify txs hiding (vote)
+open import Ledger.Certs govStructure
 
 open import Data.List.Ext using (subpermutations; sublists)
 open import Data.List.Ext.Properties2
@@ -43,7 +43,7 @@ GovState = List (GovActionID × GovActionState)
 record GovEnv : Type where
 \end{code}
 \begin{code}[hide]
-  constructor ⟦_,_,_,_,_⟧ᵍ
+  constructor ⟦_,_,_,_,_,_⟧ᵍ
   field
 \end{code}
 \begin{code}
@@ -52,20 +52,9 @@ record GovEnv : Type where
     pparams     : PParams
     ppolicy     : Maybe ScriptHash
     enactState  : EnactState
+    certState   : CertState
 \end{code}
 \end{AgdaMultiCode}
-\emph{Transition relation types}
-\begin{code}[hide]
-data
-\end{code}
-\begin{AgdaSuppressSpace}
-\begin{code}
-  _⊢_⇀⦇_,GOV'⦈_  : GovEnv × ℕ → GovState → GovVote ⊎ GovProposal → GovState → Type
-\end{code}
-\begin{code}
-_⊢_⇀⦇_,GOV⦈_     : GovEnv → GovState → List (GovVote ⊎ GovProposal) → GovState → Type
-\end{code}
-\end{AgdaSuppressSpace}
 \begin{code}[hide]
 private variable
   Γ : GovEnv
@@ -80,9 +69,12 @@ private variable
   prev : NeedsHash a
   k : ℕ
   p : Maybe ScriptHash
+
+open GState
+open PState
 \end{code}
 \emph{Functions used in the GOV rules}
-\begin{AgdaMultiCode}
+\begin{AgdaSuppressSpace}
 \begin{code}
 govActionPriority : GovAction → ℕ
 govActionPriority NoConfidence             = 0
@@ -96,14 +88,14 @@ govActionPriority Info                     = 6
 _∼_ : ℕ → ℕ → Type
 n ∼ m = (n ≡ m) ⊎ (n ≡ 0 × m ≡ 1) ⊎ (n ≡ 1 × m ≡ 0)
 
-_≈_ : GovAction → GovAction → Type
-a ≈ a' = (govActionPriority a) ∼ (govActionPriority a')
+_≈ᵍ_ : GovAction → GovAction → Type
+a ≈ᵍ a' = (govActionPriority a) ∼ (govActionPriority a')
 \end{code}
 \begin{code}[hide]
 _∼?_ : (n m : ℕ) → Dec (n ∼ m)
 n ∼? m = n ≟ m ⊎-dec (n ≟ 0 ×-dec m ≟ 1) ⊎-dec (n ≟ 1 ×-dec m ≟ 0)
 
-_≈?_ : (a a' : GovAction) → Dec (a ≈ a')
+_≈?_ : (a a' : GovAction) → Dec (a ≈ᵍ a')
 a ≈? a' = (govActionPriority a) ∼? (govActionPriority a')
 \end{code}
 \begin{code}
@@ -115,11 +107,6 @@ insertGovAction ((gaID₀ , gaSt₀) ∷ gaPrs) (gaID₁ , gaSt₁)
      then (gaID₀ , gaSt₀) ∷ insertGovAction gaPrs (gaID₁ , gaSt₁)
      else (gaID₁ , gaSt₁) ∷ (gaID₀ , gaSt₀) ∷ gaPrs
 
-addVote : GovState → GovActionID → Voter → Vote → GovState
-addVote s aid voter v = map modifyVotes s
-  where modifyVotes = λ (gid , s') → gid , record s'
-          { votes = if gid ≡ aid then insert (votes s') voter v else votes s'}
-
 mkGovStatePair : Epoch → GovActionID → RwdAddr → (a : GovAction) → NeedsHash a
                  → GovActionID × GovActionState
 mkGovStatePair e aid addr a prev = (aid , record
@@ -129,14 +116,42 @@ addAction : GovState
           → Epoch → GovActionID → RwdAddr → (a : GovAction) → NeedsHash a
           → GovState
 addAction s e aid addr a prev = insertGovAction s (mkGovStatePair e aid addr a prev)
-
-validHFAction : GovProposal → GovState → EnactState → Type
-validHFAction (record { action = TriggerHF v ; prevAction = prev }) s e =
-  (let (v' , aid) = EnactState.pv e in aid ≡ prev × pvCanFollow v' v)
-  ⊎ ∃₂[ x , v' ] (prev , x) ∈ fromList s × x .action ≡ TriggerHF v' × pvCanFollow v' v
-validHFAction _ _ _ = ⊤
 \end{code}
-\end{AgdaMultiCode}
+\begin{code}[hide]
+opaque
+\end{code}
+\begin{code}
+  addVote : GovState → GovActionID → Voter → Vote → GovState
+  addVote s aid voter v = map modifyVotes s
+    where modifyVotes : GovActionID × GovActionState → GovActionID × GovActionState
+          modifyVotes = λ (gid , s') → gid , record s'
+            { votes = if gid ≡ aid then insert (votes s') voter v else votes s'}
+
+  isRegistered : GovEnv → Voter → Type
+  isRegistered ⟦ _ , _ , _ , _ , _ , ⟦ _ , pState , gState ⟧ᶜˢ ⟧ᵍ (r , c) = case r of λ where
+    CC    → just c ∈ range (gState .ccHotKeys)
+    DRep  → c ∈ dom (gState .dreps)
+    SPO   → c ∈ mapˢ KeyHashObj (dom (pState .pools))
+
+  validHFAction : GovProposal → GovState → EnactState → Type
+  validHFAction (record { action = TriggerHF v ; prevAction = prev }) s e =
+    (let (v' , aid) = EnactState.pv e in aid ≡ prev × pvCanFollow v' v)
+    ⊎ ∃₂[ x , v' ] (prev , x) ∈ fromList s × x .action ≡ TriggerHF v' × pvCanFollow v' v
+  validHFAction _ _ _ = ⊤
+\end{code}
+\end{AgdaSuppressSpace}
+\emph{Transition relation types}
+\begin{code}[hide]
+data
+\end{code}
+\begin{AgdaSuppressSpace}
+\begin{code}
+  _⊢_⇀⦇_,GOV'⦈_  : GovEnv × ℕ → GovState → GovVote ⊎ GovProposal → GovState → Type
+\end{code}
+\begin{code}
+_⊢_⇀⦇_,GOV⦈_     : GovEnv → GovState → List (GovVote ⊎ GovProposal) → GovState → Type
+\end{code}
+\end{AgdaSuppressSpace}
 \caption{Types and functions used in the GOV transition system}
 \label{defs:gov-defs}
 \end{figure*}
@@ -184,7 +199,7 @@ hasParentE e aid a = case getHashES e a of
 hasParent : EnactState → GovState → (a : GovAction) → NeedsHash a → Type
 hasParent e s a aid with getHash aid
 ... | just aid' = hasParentE e aid' a
-                  ⊎ Any (λ (gid , gas) → gid ≡ aid' × action gas ≈ a) s
+                  ⊎ Any (λ (gid , gas) → gid ≡ aid' × action gas ≈ᵍ a) s
 ... | nothing = ⊤
 \end{code}
 \begin{code}[hide]
@@ -317,6 +332,7 @@ data _⊢_⇀⦇_,GOV'⦈_ where
     in
     ∙ (aid , ast) ∈ fromList s
     ∙ canVote pparams (action ast) (proj₁ voter)
+    ∙ isRegistered Γ voter
       ───────────────────────────────────────
       (Γ , k) ⊢ s ⇀⦇ inj₁ vote ,GOV'⦈ addVote s aid voter v
 
diff --git a/src/Ledger/Gov/Properties.agda b/src/Ledger/Gov/Properties.agda
index a79bb5634..af0df6e68 100644
--- a/src/Ledger/Gov/Properties.agda
+++ b/src/Ledger/Gov/Properties.agda
@@ -75,6 +75,9 @@ private
   hasPrev record { action = (TreasuryWdrl _) }        v = no λ ()
   hasPrev record { action = Info }                    v = no λ ()
 
+opaque
+  unfolding validHFAction isRegistered
+
   instance
     validHFAction? : ∀ {p s e} → validHFAction p s e ⁇
     validHFAction? {record { action = NoConfidence }} = Dec-⊤
@@ -93,6 +96,11 @@ private
     validHFAction? {record { action = TreasuryWdrl _ }} = Dec-⊤
     validHFAction? {record { action = Info }} = Dec-⊤
 
+  isRegistered? : ∀ Γ v → Dec (isRegistered Γ v)
+  isRegistered? _ (CC   , _) = ¿ _ ∈ _ ¿
+  isRegistered? _ (DRep , _) = ¿ _ ∈ _ ¿
+  isRegistered? _ (SPO  , _) = ¿ _ ∈ _ ¿
+
 instance
   Computational-GOV' : Computational _⊢_⇀⦇_,GOV'⦈_ String
   Computational-GOV' = record {Go} where
@@ -103,15 +111,18 @@ instance
       module GoVote sig where
         open GovVote sig
 
-        computeProof = case lookupActionId pparams (proj₁ voter) gid s of λ where
-            (yes p) → case Any↔ .from p of λ where
-              (_ , mem , refl , cV) → success (_ , GOV-Vote (∈-fromList .to mem , cV))
-            (no ¬p)  → failure (genErrors ¬p)
+        computeProof = case lookupActionId pparams (proj₁ voter) gid s ,′ isRegistered? (proj₁ Γ) voter of λ where
+            (yes p , yes p') → case Any↔ .from p of λ where
+              (_ , mem , refl , cV) → success (_ , GOV-Vote (∈-fromList .to mem , cV , p'))
+            (yes _ , no ¬p) → failure (genErrors ¬p)
+            (no ¬p , _)     → failure (genErrors ¬p)
 
         completeness : ∀ s' → Γ ⊢ s ⇀⦇ inj₁ sig ,GOV'⦈ s' → map proj₁ computeProof ≡ success s'
-        completeness s' (GOV-Vote (mem , cV)) with lookupActionId pparams (proj₁ voter) gid s
-        ... | no ¬p = ⊥-elim (¬p (Any↔ .to (_ , ∈-fromList .from mem , refl , cV)))
-        ... | yes p with Any↔ .from p
+        completeness s' (GOV-Vote (mem , cV , reg))
+          with lookupActionId pparams (proj₁ voter) gid s | isRegistered? (proj₁ Γ) voter
+        ... | no ¬p | _ = ⊥-elim (¬p (Any↔ .to (_ , ∈-fromList .from mem , refl , cV)))
+        ... | yes _ | no ¬p = ⊥-elim $ ¬p reg
+        ... | yes p | yes p' with Any↔ .from p
         ... | (_ , mem , refl , cV) = refl
 
       module GoProp prop where
diff --git a/src/Ledger/Ledger.lagda b/src/Ledger/Ledger.lagda
index e814a12e4..886a9ddf0 100644
--- a/src/Ledger/Ledger.lagda
+++ b/src/Ledger/Ledger.lagda
@@ -21,6 +21,8 @@ open import Ledger.Utxow txs abs
 open import Ledger.Certs govStructure
 
 open Tx
+open GState
+open GovActionState
 \end{code}
 
 The entire state transformation of the ledger state caused by a valid
@@ -57,6 +59,17 @@ record LState : Type where
 txgov : TxBody → List (GovVote ⊎ GovProposal)
 txgov txb = map inj₂ txprop ++ map inj₁ txvote
   where open TxBody txb
+
+isUnregisteredDRep : CertState → Voter → Type
+isUnregisteredDRep ⟦ _ , _ , gState ⟧ᶜˢ (r , c) = r ≡ DRep × c ∉ dom (gState .dreps)
+
+removeOrphanDRepVotes : CertState → GovActionState → GovActionState
+removeOrphanDRepVotes certState gas = record gas { votes = votes′ }
+  where
+    votes′ = filterKeys (¬_ ∘ isUnregisteredDRep certState) (votes gas)
+
+_|ᵒ_ : GovState → CertState → GovState
+govSt |ᵒ certState = L.map (map₂ (removeOrphanDRepVotes certState)) govSt
 \end{code}
 \end{AgdaMultiCode}
 \caption{Types and functions for the LEDGER transition system}
@@ -98,7 +111,7 @@ data
     ∙  isValid tx ≡ true
     ∙  record { LEnv Γ } ⊢ utxoSt ⇀⦇ tx ,UTXOW⦈ utxoSt'
     ∙  ⟦ epoch slot , pparams , txvote , txwdrls ⟧ᶜ ⊢ certState ⇀⦇ txcerts ,CERTS⦈ certState'
-    ∙  ⟦ txid , epoch slot , pparams , ppolicy , enactState ⟧ᵍ ⊢ govSt ⇀⦇ txgov txb ,GOV⦈ govSt'
+    ∙  ⟦ txid , epoch slot , pparams , ppolicy , enactState , certState' ⟧ᵍ ⊢ govSt |ᵒ certState' ⇀⦇ txgov txb ,GOV⦈ govSt'
        ────────────────────────────────
        Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ ⟦ utxoSt' , govSt' , certState' ⟧ˡ
 \end{code}
diff --git a/src/Ledger/Ledger/Properties.agda b/src/Ledger/Ledger/Properties.agda
index 6fdcc59fa..a8d707207 100644
--- a/src/Ledger/Ledger/Properties.agda
+++ b/src/Ledger/Ledger/Properties.agda
@@ -65,14 +65,15 @@ instance
       where
       utxoΓ = UTxOEnv ∋ record { LEnv Γ }
       certΓ = CertEnv ∋ ⟦ epoch slot , pparams , txvote , txwdrls ⟧ᶜ
-      govΓ  = GovEnv  ∋ ⟦ txid , epoch slot , pparams , ppolicy , enactState ⟧ᵍ
+      govΓ : CertState → GovEnv
+      govΓ = ⟦ txid , epoch slot , pparams , ppolicy , enactState ,_⟧ᵍ
 
       computeProof : ComputationResult String (∃[ s' ] Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s')
       computeProof = case isValid ≟ true of λ where
         (yes p) → do
           (utxoSt' , utxoStep) ← computeUtxow utxoΓ utxoSt tx
           (certSt' , certStep) ← computeCerts certΓ certSt txcerts
-          (govSt'  , govStep)  ← computeGov   govΓ  govSt  (txgov txb)
+          (govSt'  , govStep)  ← computeGov (govΓ certSt') (govSt |ᵒ certSt') (txgov txb)
           success (_ , LEDGER-V⋯ p utxoStep certStep govStep)
         (no ¬p) → do
           (utxoSt' , utxoStep) ← computeUtxow utxoΓ utxoSt tx
@@ -87,7 +88,7 @@ instance
       ... | success (utxoSt' , _) | refl
         with computeCerts certΓ certSt txcerts | complete _ _ _ _ certStep
       ... | success (certSt' , _) | refl
-        with computeGov govΓ govSt (txgov txb) | complete govΓ _ _ _ govStep
+        with computeGov (govΓ certSt') (govSt |ᵒ certSt') (txgov txb) | complete {STS = _⊢_⇀⦇_,GOV⦈_} (govΓ certSt') _ _ _ govStep
       ... | success (govSt' , _) | refl = refl
       completeness ⟦ utxoSt' , govSt' , certState' ⟧ˡ (LEDGER-I⋯ i utxoStep)
         with isValid ≟ true
@@ -212,7 +213,7 @@ module LEDGER-PROPS (tx : Tx) (Γ : LEnv) (s : LState) where
   mkAction : GovProposal → ℕ → GovActionID × GovActionState
   mkAction p n = let open GovProposal p in
     mkGovStatePair
-      (PParams.govActionLifetime pp +ᵉ (epoch slot))
+      (PParams.govActionLifetime pp +ᵉ epoch slot)
       (txid , n) returnAddr action prevAction
 
   -- update GovState with a proposal
@@ -232,24 +233,54 @@ module LEDGER-PROPS (tx : Tx) (Γ : LEnv) (s : LState) where
 
   -- updateGovStates faithfully represents a step of the LEDGER sts
   STS→GovSt≡ : ∀ {s' : LState} → Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s'
-               → isValid ≡ true → LState.govSt s' ≡ updateGovStates (txgov txb) 0 (LState.govSt s)
+               → isValid ≡ true → LState.govSt s' ≡ updateGovStates (txgov txb) 0 (LState.govSt s |ᵒ LState.certState s')
   STS→GovSt≡ (LEDGER-V x) refl = STS→updateGovSt≡ (txgov txb) 0 (proj₂ (proj₂ (proj₂ x)))
     where
-    STS→updateGovSt≡ : (vps : List (GovVote ⊎ GovProposal)) (k : ℕ) {govSt govSt' : GovState}
-      → (_⊢_⇀⟦_⟧ᵢ*'_ IdSTS _⊢_⇀⦇_,GOV'⦈_ (⟦ txid , epoch slot , pp , ppolicy , enactState ⟧ᵍ , k) govSt vps govSt')
+    STS→updateGovSt≡ : (vps : List (GovVote ⊎ GovProposal)) (k : ℕ) {certSt : CertState} {govSt govSt' : GovState}
+      → (_⊢_⇀⟦_⟧ᵢ*'_ IdSTS _⊢_⇀⦇_,GOV'⦈_ (⟦ txid , epoch slot , pp , ppolicy , enactState , certSt ⟧ᵍ , k) govSt vps govSt')
       → govSt' ≡ updateGovStates vps k govSt
     STS→updateGovSt≡ [] _ (BS-base Id-nop) = refl
-    STS→updateGovSt≡ (inj₁ v ∷ vps) k {govSt}(BS-ind {s' = .(voteUpdate govSt v)} (GOV-Vote x) h)
+    STS→updateGovSt≡ (inj₁ v ∷ vps) k (BS-ind (GOV-Vote x) h)
       = STS→updateGovSt≡ vps (suc k) h
     STS→updateGovSt≡ (inj₂ p ∷ vps) k (BS-ind (GOV-Propose x) h) = STS→updateGovSt≡ vps (suc k) h
 
+  opaque
+    unfolding addVote
+
+    |ᵒ-[] : ∀ certState → [] |ᵒ certState ≡ []
+    |ᵒ-[] certState = refl
+
+    |ᵒ-++ : ∀ gs gs′ certState → (gs ++ gs′) |ᵒ certState ≡ (gs |ᵒ certState) ++ (gs′ |ᵒ certState)
+    |ᵒ-++ gs gs′ certState = map-++ _ gs gs′
+
+    |ᵒ-singleton : ∀ gid gas certState → ∃[ gas′ ] [ (gid , gas) ] |ᵒ certState ≡ [ (gid , gas′) ]
+    |ᵒ-singleton gid gas certState = (removeOrphanDRepVotes certState gas , refl)
+
+    dpMap-|ᵒ-singleton : ∀ g certState → dpMap ([ g ] |ᵒ certState) ≡ dpMap [ g ]
+    dpMap-|ᵒ-singleton (gid , gas) certState rewrite |ᵒ-singleton gid gas certState .proj₂ = refl
+
+    dpMap-|ᵒ : ∀ govSt certState → dpMap (govSt |ᵒ certState) ≡ dpMap govSt
+    dpMap-|ᵒ [] certState = cong dpMap (|ᵒ-[] certState)
+    dpMap-|ᵒ (g ∷ govSt) certState = let open ≡-Reasoning in begin
+      dpMap ((g ∷ govSt) |ᵒ certState)
+        ≡⟨ cong dpMap (|ᵒ-++ [ g ] govSt certState) ⟩
+      dpMap (([ g ] |ᵒ certState) ++ (govSt |ᵒ certState))
+        ≡⟨ map-++ _ ([ g ] |ᵒ certState) (govSt |ᵒ certState) ⟩
+      dpMap ([ g ] |ᵒ certState) ++ dpMap (govSt |ᵒ certState)
+        ≡⟨ cong (dpMap ([ g ] |ᵒ certState) ++_) (dpMap-|ᵒ govSt certState) ⟩
+      dpMap ([ g ] |ᵒ certState) ++ dpMap govSt
+        ≡⟨ cong (_++ dpMap govSt) (dpMap-|ᵒ-singleton g certState) ⟩
+      dpMap [ g ] ++ dpMap govSt
+        ≡˘⟨ map-++ _ [ g ] govSt ⟩
+      dpMap (g ∷ govSt) ∎
+
 module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
   open Tx tx renaming (body to txb); open TxBody txb
   open LEnv Γ renaming (pparams to pp)
   open PParams pp using (govActionDeposit; poolDeposit)
   govSt : GovState
   govSt = LState.govSt s
-  open LEDGER-PROPS tx Γ s using (utxoDeps; propUpdate; mkAction; updateGovStates; STS→GovSt≡; voteUpdate)
+  open LEDGER-PROPS tx Γ s using (utxoDeps; propUpdate; mkAction; updateGovStates; STS→GovSt≡; voteUpdate; dpMap-|ᵒ)
   open SetoidReasoning (≡ᵉ-Setoid{DepositPurpose})
 
   CredDepIsNotGADep : ∀ {a c} → a ≡ CredentialDeposit c → ¬ isGADeposit a
@@ -342,11 +373,14 @@ module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
   noGACerts (retirepool _ _ ∷ cs) deps = noGACerts cs deps
   noGACerts (ccreghot _ _ ∷ cs) deps = noGACerts cs deps
 
-  dpMap∘voteUpdate≡dpMap : (v : GovVote) {govSt : GovState}
-    → dpMap (voteUpdate govSt v) ≡ dpMap govSt
-  dpMap∘voteUpdate≡dpMap v {[]} = refl
-  dpMap∘voteUpdate≡dpMap v {(aid , ast) ∷ govSt} =
-    cong (λ x → (GovActionDeposit ∘ proj₁) (aid , ast) ∷ x) (dpMap∘voteUpdate≡dpMap v)
+  opaque
+    unfolding addVote
+
+    dpMap∘voteUpdate≡dpMap : (v : GovVote) {govSt : GovState}
+      → dpMap (voteUpdate govSt v) ≡ dpMap govSt
+    dpMap∘voteUpdate≡dpMap v {[]} = refl
+    dpMap∘voteUpdate≡dpMap v {(aid , ast) ∷ govSt} =
+      cong (λ x → (GovActionDeposit ∘ proj₁) (aid , ast) ∷ x) (dpMap∘voteUpdate≡dpMap v)
 
   props-dpMap-votes-invar : (vs : List GovVote) (ps : List GovProposal) {k : ℕ} {govSt : GovState}
     → fromList (dpMap (updateGovStates (map inj₂ ps ++ map inj₁ vs) k govSt ))
@@ -437,6 +471,60 @@ module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
       ≈⟨ connex-lemma gSt p ps ⟩
     fromList (dpMap (updateGovStates (map inj₂ (p ∷ ps)) 0 gSt)) ∎
 
+  -- The list of natural numbers from 0 up to `n` - 1.
+  ⟦0:<_⟧ : ℕ → List ℕ
+  ⟦0:< 0     ⟧ = []
+  ⟦0:< suc n ⟧ = ⟦0:< n ⟧ ++ [ n ]
+
+  connex-lemma-rep : ∀ k govSt ps →
+    fromList (dpMap (updateGovStates (map inj₂ ps) k govSt))
+    ≡ᵉ
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧)
+  connex-lemma-rep k govSt [] = begin
+    fromList (dpMap govSt)
+      ≈˘⟨ ∪-identityʳ (fromList (dpMap govSt)) ⟩
+    fromList (dpMap govSt) ∪ fromList []
+      ≡⟨⟩
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< 0 ⟧) ∎
+  connex-lemma-rep k govSt (p ∷ ps) = begin
+    fromList (dpMap (updateGovStates (map inj₂ (p ∷ ps)) k govSt))
+      ≡⟨⟩
+    fromList (dpMap (updateGovStates (inj₂ p ∷ map inj₂ ps) k govSt))
+      ≡⟨⟩
+    fromList (dpMap (updateGovStates (map inj₂ ps) (suc k) (propUpdate govSt p k)))
+      ≈˘⟨ connex-lemma govSt p ps {k} ⟩
+    fromList (dpMap (updateGovStates (map inj₂ ps) k govSt)) ∪ ❴ GovActionDeposit (txid , k + length ps) ❵
+      ≈⟨ ∪-cong (connex-lemma-rep k govSt ps) ≡ᵉ.refl ⟩
+    (fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧)) ∪ ❴ GovActionDeposit (txid , k + length ps) ❵
+      ≈⟨ ∪-assoc (fromList (dpMap govSt)) (fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧)) ❴ GovActionDeposit (txid , k + length ps) ❵ ⟩
+    fromList (dpMap govSt) ∪ (fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧) ∪ ❴ GovActionDeposit (txid , k + length ps) ❵)
+      ≡⟨⟩
+    fromList (dpMap govSt) ∪ (fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧) ∪ fromList [ GovActionDeposit (txid , k + length ps) ])
+      ≈⟨ ∪-cong ≡ᵉ.refl (∪-fromList-++ (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧) [ GovActionDeposit (txid , k + length ps) ]) ⟩
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length ps ⟧ ++ [ GovActionDeposit (txid , k + length ps) ])
+      ≡˘⟨ cong (λ x → fromList (dpMap govSt) ∪ fromList x) (map-++ _ ⟦0:< length ps ⟧ [ length ps ]) ⟩
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) (⟦0:< length ps ⟧ ++ [ length ps ]))
+      ≡⟨⟩
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length (p ∷ ps) ⟧) ∎
+
+  -- Removing orphan DRep votes does not modify the set of GAs in GovState
+  |ᵒ-GAs-pres : ∀ k govSt certState →
+    fromList (dpMap (updateGovStates (txgov txb) k (govSt |ᵒ certState)))
+    ≡ᵉ
+    fromList (dpMap (updateGovStates (txgov txb) k govSt))
+  |ᵒ-GAs-pres k govSt certState = begin
+    fromList (dpMap (updateGovStates (txgov txb) k (govSt |ᵒ certState)))
+      ≈⟨ props-dpMap-votes-invar txvote txprop {k} {govSt |ᵒ certState} ⟩
+    fromList (dpMap (updateGovStates (map inj₂ txprop) k (govSt |ᵒ certState)))
+      ≈⟨ connex-lemma-rep k (govSt |ᵒ certState) txprop ⟩
+    fromList (dpMap (govSt |ᵒ certState)) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length txprop ⟧)
+      ≡⟨ cong (λ x → fromList x ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length txprop ⟧)) (dpMap-|ᵒ govSt certState) ⟩
+    fromList (dpMap govSt) ∪ fromList (map (λ i → GovActionDeposit (txid , k + i)) ⟦0:< length txprop ⟧)
+      ≈˘⟨ connex-lemma-rep k govSt txprop ⟩
+    fromList (dpMap (updateGovStates (map inj₂ txprop) k govSt))
+      ≈˘⟨ props-dpMap-votes-invar txvote txprop {k} {govSt} ⟩
+    fromList (dpMap (updateGovStates (txgov txb) k govSt)) ∎
+
   -- GA Deposits Invariance Property for LEDGER STS ----------------------------------------------------
   LEDGER-govDepsMatch : ∀ {s' : LState} → Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s'
                         → govDepsMatch s → govDepsMatch s'
@@ -444,7 +532,7 @@ module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
 
   LEDGER-govDepsMatch s'@{⟦ .(⟦ ((UTxOState.utxo (LState.utxoSt s) ∣ txins ᶜ) ∪ˡ (outs txb))
                               , _ , updateDeposits pp txb (UTxOState.deposits (LState.utxoSt s)) , _ ⟧ᵘ)
-                          , govSt' , _ ⟧ˡ}
+                          , govSt' , certState' ⟧ˡ}
     utxosts@(LEDGER-V⋯ tx-valid (UTXOW-UTXOS (Scripts-Yes x)) _ GOV-sts) aprioriMatch = begin
       filterˢ isGADeposit (dom (updateDeposits pp txb utxoDeps))
         ≈⟨ noGACerts txcerts (updateProposalDeposits txprop txid govActionDeposit utxoDeps) ⟩
@@ -453,6 +541,8 @@ module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
       fromList (dpMap (updateGovStates (map inj₂ txprop) 0 govSt))
         ≈˘⟨ props-dpMap-votes-invar txvote txprop ⟩
       fromList (dpMap (updateGovStates (txgov txb) 0 govSt ))
+        ≈˘⟨ |ᵒ-GAs-pres 0 govSt certState' ⟩
+      fromList (dpMap (updateGovStates (txgov txb) 0 (govSt |ᵒ certState')))
         ≡˘⟨ cong (fromList ∘ dpMap ) (STS→GovSt≡ utxosts tx-valid) ⟩
       fromList (dpMap govSt') ∎
 

From 70b8e31b81ea6e08fe4cfb52f1a67f53f518d6f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Javier=20D=C3=ADaz?= <javier.diaz@iohk.io>
Date: Mon, 4 Nov 2024 13:31:38 +0000
Subject: [PATCH 2/5] Remove broken conformance properties of `Ledger`

---
 .../Conway/Conformance/Ledger/Properties.agda | 334 ------------------
 1 file changed, 334 deletions(-)

diff --git a/src/Ledger/Conway/Conformance/Ledger/Properties.agda b/src/Ledger/Conway/Conformance/Ledger/Properties.agda
index 6ee960b27..978a08d7e 100644
--- a/src/Ledger/Conway/Conformance/Ledger/Properties.agda
+++ b/src/Ledger/Conway/Conformance/Ledger/Properties.agda
@@ -98,337 +98,3 @@ instance
 
 Computational-LEDGERS : Computational _⊢_⇀⦇_,LEDGERS⦈_ String
 Computational-LEDGERS = it
-
-instance
-  HasCoin-LState : HasCoin LState
-  HasCoin-LState .getCoin s = getCoin (LState.utxoSt s)
-
--- ** Proof that LEDGER preserves values.
-
-module _ where
-
-  private variable
-    tx : Tx
-    Γ : LEnv
-    s s' : LState
-    l : List Tx
-
-  FreshTx : Tx → LState → Type
-  FreshTx tx ls = tx .body .txid ∉ mapˢ proj₁ (dom (ls .utxoSt .utxo))
-    where open Tx; open TxBody; open UTxOState; open LState
-
-  data FreshTxs : LEnv → LState → List Tx → Type where
-    []-Fresh : FreshTxs Γ s []
-    ∷-Fresh  : FreshTx tx s → Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s' → FreshTxs Γ s' l
-              → FreshTxs Γ s (tx ∷ l)
-
--- ** Proof that the set equality `govDepsMatch` (below) is a LEDGER invariant.
-
--- Mapping a list of `GovActionID × GovActionState`s to a list of
--- `DepositPurpose`s is so common, we give it a name `dpMap`;
--- it's equivalent to `map (λ (id , _) → GovActionDeposit id)`.
-dpMap : GovState → List DepositPurpose
-dpMap = map (GovActionDeposit ∘ proj₁)
-
-isGADeposit : DepositPurpose → Type
-isGADeposit dp = isGADepositᵇ dp ≡ true
-  where
-  isGADepositᵇ : DepositPurpose → Bool
-  isGADepositᵇ (GovActionDeposit _) = true
-  isGADepositᵇ _                    = false
-
-govDepsMatch : LState → Type
-govDepsMatch ⟦ utxoSt , govSt , _ ⟧ˡ =
-  filterˢ isGADeposit (dom (UTxOState.deposits utxoSt)) ≡ᵉ fromList (dpMap govSt)
-
-module _  -- ASSUMPTIONS (TODO: eliminate/prove these) --
-  {- 1 -} {filterCD : ∀ pp c → filterˢ isGADeposit (dom (certDeposit c pp)) ≡ᵉ ∅}
-  {- 2 -} {filterCR : (c : DCert) {deps : DepositPurpose ⇀ Coin}
-                      → filterˢ isGADeposit (dom ( deps ∣ certRefund c ᶜ ˢ )) ≡ᵉ filterˢ isGADeposit (dom (deps ˢ))}
-  where
-  module ≡ᵉ = IsEquivalence (≡ᵉ-isEquivalence {DepositPurpose})
-  pattern UTXOW-UTXOS x = UTXOW⇒UTXO (UTXO-inductive⋯ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ x)
-
-  filterGA : ∀ txid n → filterˢ isGADeposit ❴ GovActionDeposit (txid , n) ❵ ≡ᵉ ❴ GovActionDeposit (txid , n) ❵
-  proj₁ (filterGA txid n) {a} x = (proj₂ (from ∈-filter x)) where open Equivalence
-  proj₂ (filterGA txid n) {a} x = to ∈-filter (ξ (from ∈-singleton x) , x)
-    where
-    open Equivalence
-    ξ : a ≡ GovActionDeposit (txid , n) → isGADeposit a
-    ξ refl = refl
-
-  module LEDGER-PROPS (tx : Tx) (Γ : LEnv) (s : LState) where
-    open Tx tx renaming (body to txb); open TxBody txb
-    open LEnv Γ renaming (pparams to pp)
-    open PParams pp using (govActionDeposit)
-
-    -- initial utxo deposits
-    utxoDeps : DepositPurpose ⇀ Coin
-    utxoDeps = UTxOState.deposits (LState.utxoSt s)
-
-    -- GovState definitions and lemmas --
-    mkAction : GovProposal → ℕ → GovActionID × GovActionState
-    mkAction p n = let open GovProposal p in
-      mkGovStatePair
-        (PParams.govActionLifetime pp +ᵉ (epoch slot))
-        (txid , n) returnAddr action prevAction
-
-    -- update GovState with a proposal
-    propUpdate : GovState → GovProposal → ℕ → GovState
-    propUpdate s p n = insertGovAction s (mkAction p n)
-
-    -- update GovState with a vote
-    voteUpdate : GovState → GovVote → GovState
-    voteUpdate s v = addVote s gid voter vote
-      where open GovVote v
-
-    -- update GovState with a list of votes and proposals
-    updateGovStates : List (GovVote ⊎ GovProposal) → ℕ → GovState → GovState
-    updateGovStates [] _ s = s
-    updateGovStates (inj₁ v ∷ vps) k s = updateGovStates vps (suc k) (voteUpdate s v)
-    updateGovStates (inj₂ p ∷ vps) k s = updateGovStates vps (suc k) (propUpdate s p k)
-
-    -- updateGovStates faithfully represents a step of the LEDGER sts
-    STS→GovSt≡ : ∀ {s' : LState} → Γ ⊢ s ⇀⦇ tx ,LEDGER⦈ s'
-                 → isValid ≡ true → LState.govSt s' ≡ updateGovStates (txgov txb) 0 (LState.govSt s)
-    STS→GovSt≡ (LEDGER-V x) refl = STS→updateGovSt≡ (txgov txb) 0 (proj₂ (proj₂ (proj₂ x)))
-      where
-      STS→updateGovSt≡ : (vps : List (GovVote ⊎ GovProposal)) (k : ℕ) {govSt govSt' : GovState}
-        → (_⊢_⇀⟦_⟧ᵢ*'_ IdSTS _⊢_⇀⦇_,GOV'⦈_ (⟦ txid , epoch slot , pp , ppolicy , enactState ⟧ᵍ , k) govSt vps govSt')
-        → govSt' ≡ updateGovStates vps k govSt
-      STS→updateGovSt≡ [] _ (BS-base Id-nop) = refl
-      STS→updateGovSt≡ (inj₁ v ∷ vps) k {govSt}(BS-ind {s' = .(voteUpdate govSt v)} (GOV-Vote x) h)
-        = STS→updateGovSt≡ vps (suc k) h
-      STS→updateGovSt≡ (inj₂ p ∷ vps) k (BS-ind (GOV-Propose x) h) = STS→updateGovSt≡ vps (suc k) h
-
-  module SetoidProperties (tx : Tx) (Γ : LEnv) (s : LState) where
-    open Tx tx renaming (body to txb); open TxBody txb
-    open LEnv Γ renaming (pparams to pp)
-    open PParams pp using (govActionDeposit)
-    govSt : GovState
-    govSt = LState.govSt s
-    open LEDGER-PROPS tx Γ s using (utxoDeps; propUpdate; mkAction; updateGovStates; STS→GovSt≡; voteUpdate)
-    open SetoidReasoning (≡ᵉ-Setoid{DepositPurpose})
-
-    -- No governance action deposits come fro the certs update.
-    noGACerts : (cs : List DCert) (deps : DepositPurpose ⇀ Coin)
-      → filterˢ isGADeposit (dom (updateCertDeposits pp cs deps)) ≡ᵉ filterˢ isGADeposit (dom deps)
-    noGACerts [] _ = filter-pres-≡ᵉ ≡ᵉ.refl
-    noGACerts (c ∷ cs) deps =
-      let  upCD = updateCertDeposits pp cs deps
-           -- open SetoidReasoning (≡ᵉ-Setoid{DepositPurpose})
-      in begin
-      filterˢ isGADeposit (dom (updateCertDeposits pp (c ∷ cs) deps))
-        ≈⟨ filterCR c {upCD ∪⁺ certDeposit c pp} ⟩
-      filterˢ isGADeposit (dom (upCD ∪⁺ certDeposit c pp))
-        ≈⟨ filter-pres-≡ᵉ dom∪⁺≡∪dom ⟩
-      filterˢ isGADeposit (dom upCD ∪ dom (certDeposit c pp))
-        ≈⟨ filter-hom-∪ ⟩
-      filterˢ isGADeposit (dom upCD) ∪ filterˢ isGADeposit (dom (certDeposit c pp))
-        ≈⟨ ∪-cong (noGACerts cs deps) (filterCD pp c) ⟩
-      filterˢ isGADeposit (dom deps) ∪ ∅
-        ≈⟨ ∪-identityʳ (filterˢ isGADeposit (dom deps)) ⟩
-      filterˢ isGADeposit (dom deps) ∎
-
-    dpMap∘voteUpdate≡dpMap : (v : GovVote) {govSt : GovState}
-      → dpMap (voteUpdate govSt v) ≡ dpMap govSt
-    dpMap∘voteUpdate≡dpMap v {[]} = refl
-    dpMap∘voteUpdate≡dpMap v {(aid , ast) ∷ govSt} =
-      cong (λ x → (GovActionDeposit ∘ proj₁) (aid , ast) ∷ x) (dpMap∘voteUpdate≡dpMap v)
-
-    props-dpMap-votes-invar : (vs : List GovVote) (ps : List GovProposal) {k : ℕ} {govSt : GovState}
-      → fromList (dpMap (updateGovStates (map inj₂ ps ++ map inj₁ vs) k govSt ))
-        ≡ᵉ fromList (dpMap (updateGovStates (map inj₂ ps) k govSt))
-    props-dpMap-votes-invar [] ps {k} {govSt} = ≡ᵉ.reflexive
-      (cong (λ x → fromList (dpMap (updateGovStates x k govSt))) (++-identityʳ (map inj₂ ps)))
-    props-dpMap-votes-invar (v ∷ vs) [] {k} {govSt} = begin
-      fromList (dpMap (updateGovStates (map inj₁ (v ∷ vs)) k govSt))
-        ≈⟨ props-dpMap-votes-invar vs [] ⟩
-      fromList (dpMap (updateGovStates (map inj₂ []) (suc k) (voteUpdate govSt v)))
-        ≡⟨ cong fromList (dpMap∘voteUpdate≡dpMap v) ⟩
-      fromList (dpMap govSt)
-        ∎
-    props-dpMap-votes-invar (v ∷ vs) (p ∷ ps) {k} {govSt} = props-dpMap-votes-invar (v ∷ vs) ps
-
-    dpMap-update-∪ : ∀ gSt p k
-      → fromList (dpMap gSt) ∪ ❴ GovActionDeposit (txid , k) ❵
-          ≡ᵉ fromList (dpMap (propUpdate gSt p k))
-    dpMap-update-∪ [] p k = ∪-identityˡ (fromList (dpMap [ mkAction p k ]))
-    dpMap-update-∪ (g@(gaID₀ , gaSt₀) ∷ gSt) p k
-      with (govActionPriority (GovActionState.action gaSt₀))
-           ≤? (govActionPriority (GovActionState.action (proj₂ (mkAction p k))))
-    ... | yes _  = begin
-        fromList (dpMap (g ∷ gSt)) ∪ ❴ GovActionDeposit (txid , k) ❵
-          ≈⟨ ∪-cong fromList-∪-singleton ≡ᵉ.refl ⟩
-        (❴ GovActionDeposit gaID₀ ❵ ∪ fromList (dpMap gSt)) ∪ ❴ GovActionDeposit (txid , k) ❵
-          ≈⟨ ∪-assoc ❴ GovActionDeposit gaID₀ ❵ (fromList (dpMap gSt)) ❴ GovActionDeposit (txid , k) ❵ ⟩
-        ❴ GovActionDeposit gaID₀ ❵ ∪ (fromList (dpMap gSt) ∪ ❴ GovActionDeposit (txid , k) ❵)
-          ≈⟨ ∪-cong ≡ᵉ.refl (dpMap-update-∪ gSt p k) ⟩
-        ❴ GovActionDeposit gaID₀ ❵ ∪ fromList (dpMap (propUpdate gSt p k))
-          ≈˘⟨ fromList-∪-singleton ⟩
-        fromList (dpMap (g ∷ insertGovAction gSt (mkAction p k)))
-          ∎
-    ... | no _   = begin
-        fromList (dpMap (g ∷ gSt)) ∪ ❴ GovActionDeposit (txid , k) ❵
-          ≈⟨ ∪-comm (fromList (dpMap (g ∷ gSt))) ❴ GovActionDeposit (txid , k) ❵ ⟩
-        ❴ GovActionDeposit (txid , k) ❵ ∪ fromList (dpMap (g ∷ gSt))
-          ≈˘⟨ fromList-∪-singleton ⟩
-        fromList (dpMap ((mkAction p k) ∷ g ∷ gSt))
-          ∎
-
-    connex-lemma : ∀ gSt p ps {k}
-      → fromList (dpMap (updateGovStates (map inj₂ ps) k gSt)) ∪ ❴ GovActionDeposit (txid , k + length ps) ❵
-          ≡ᵉ fromList (dpMap (updateGovStates (map inj₂ ps) (suc k) (propUpdate gSt p k)))
-    connex-lemma gSt p [] {k} = begin
-        fromList (dpMap gSt) ∪ ❴ GovActionDeposit (txid , k + 0) ❵
-          ≡⟨ cong (λ x → fromList (dpMap gSt) ∪ ❴ GovActionDeposit (txid , x) ❵) (+-identityʳ k) ⟩
-        fromList (dpMap gSt) ∪ ❴ GovActionDeposit (txid , k) ❵
-          ≈⟨ dpMap-update-∪ gSt p k ⟩
-        fromList (dpMap (propUpdate gSt p k))
-          ∎
-    connex-lemma gSt p (p' ∷ ps) {k} = begin
-      fromList (dpMap (updateGovStates (map inj₂ (p' ∷ ps)) k gSt))
-        ∪ ❴ GovActionDeposit (txid , k + length (p' ∷ ps)) ❵
-          ≡⟨ cong (λ x → fromList (dpMap (updateGovStates (map inj₂ (p' ∷ ps)) k gSt))
-              ∪ ❴ GovActionDeposit (txid , x) ❵) (+-suc k (length ps)) ⟩
-      fromList (dpMap (updateGovStates (map inj₂ ps) (suc k) (propUpdate gSt p' k)))
-        ∪ ❴ GovActionDeposit (txid , (suc k) + length ps) ❵
-          ≈˘⟨ ∪-cong (connex-lemma gSt p' ps) ≡ᵉ.refl ⟩
-      (fromList (dpMap (updateGovStates (map inj₂ ps) k gSt))
-        ∪ ❴ GovActionDeposit (txid , k + length ps) ❵)
-        ∪ ❴ GovActionDeposit (txid , (suc k) + length ps) ❵
-          ≈⟨ ∪-cong (connex-lemma gSt p ps) ≡ᵉ.refl ⟩
-      fromList (dpMap (updateGovStates (map inj₂ ps) (suc k) (propUpdate gSt p k)))
-        ∪ ❴ GovActionDeposit (txid , (suc k) + length ps) ❵
-          ≈⟨ connex-lemma (propUpdate gSt p k) p' ps ⟩
-      fromList (dpMap (updateGovStates (map inj₂ (p' ∷ ps)) (suc k) (propUpdate gSt p k)))
-          ∎
-
-    utxo-govst-connex : ∀ txp {utxoDs gSt gad}
-      → filterˢ isGADeposit (dom (utxoDs)) ≡ᵉ fromList (dpMap gSt)
-      → filterˢ isGADeposit (dom (updateProposalDeposits txp txid gad utxoDs))
-        ≡ᵉ fromList (dpMap (updateGovStates (map inj₂ txp) 0 gSt))
-    utxo-govst-connex [] x = x
-    utxo-govst-connex (p ∷ ps) {utxoDs} {gSt} {gad} x = begin
-      filterˢ isGADeposit (dom (updateProposalDeposits (p ∷ ps) txid gad utxoDs))
-        ≈⟨ filter-pres-≡ᵉ dom∪⁺≡∪dom ⟩
-      filterˢ isGADeposit ((dom (updateProposalDeposits ps txid gad utxoDs))
-        ∪ (dom{X = DepositPurpose ⇀ Coin} ❴ GovActionDeposit (txid , length ps) , gad ❵))
-        ≈⟨ filter-hom-∪ ⟩
-      filterˢ isGADeposit (dom (updateProposalDeposits ps txid gad utxoDs)) ∪ filterˢ isGADeposit
-          (dom{X = DepositPurpose ⇀ Coin} ❴ GovActionDeposit (txid , length ps) , gad ❵)
-        ≈⟨ ∪-cong (utxo-govst-connex ps x) (filter-pres-≡ᵉ dom-single≡single) ⟩
-      fromList (dpMap (updateGovStates (map inj₂ ps) 0 gSt))
-        ∪ filterˢ isGADeposit ❴ GovActionDeposit (txid , length ps) ❵
-        ≈⟨ ∪-cong  ≡ᵉ.refl (filterGA txid _) ⟩
-      fromList (dpMap (updateGovStates (map inj₂ ps) 0 gSt)) ∪ ❴ GovActionDeposit (txid , length ps) ❵
-        ≈⟨ connex-lemma gSt p ps ⟩
-      fromList (dpMap (updateGovStates (map inj₂ (p ∷ ps)) 0 gSt)) ∎
-
-
-  module EPOCH-PROPS (tx : Tx) (Γ : LEnv) (eps : EpochState) where
-    open Tx tx renaming (body to txb); open TxBody txb
-    open LEnv Γ renaming (pparams to pp); open EpochState eps hiding (es); open LState ls
-    open GovActionState; open RatifyState fut using (removed)
-
-    -- GA Deposits Invariance Property for EPOCH STS -----------------------------------------------
-    EPOCH-govDepsMatch :
-      (ratify-removed : mapˢ (GovActionDeposit ∘ proj₁) removed ⊆ mapˢ proj₁ (UTxOState.deposits utxoSt ˢ))
-      (eps' : EpochState) {e : Epoch}
-      → _ ⊢ eps ⇀⦇ e ,EPOCH⦈ eps'
-      → govDepsMatch (EpochState.ls eps) → govDepsMatch (EpochState.ls eps')
-
-    EPOCH-govDepsMatch ratify-removed ⟦ acnt' , ls' ,  es , _ , fut' ⟧ᵉ'
-      (EPOCH x _) = ≡ᵉ.trans (filter-pres-≡ᵉ $ dom-cong (res-comp-cong $ ≡ᵉ.sym χ'≡χ))
-                            ∘ from ≡ᵉ⇔≡ᵉ' ∘ main-invariance-lemma ∘ to ≡ᵉ⇔≡ᵉ'
-      where
-
-      -- the combinator used in the EPOCH rule
-      χ : (DepositPurpose ⇀ Coin) → ℙ DepositPurpose
-      χ deps = mapˢ (proj₁ ∘ proj₂)
-        (flip concatMapˢ removed
-          (λ (gaid , gast) → mapˢ (returnAddr gast ,_) ((deps ∣ ❴ GovActionDeposit gaid ❵) ˢ)))
-
-      -- a simpler combinator that suffices here;
-      χ' : ℙ DepositPurpose
-      χ' = mapˢ (GovActionDeposit ∘ proj₁) removed
-      -- Below we prove χ and χ' are essentially equivalent.
-
-      P : GovActionID × GovActionState → Type
-      P = λ u → proj₁ u ∉ mapˢ proj₁ removed
-
-      P? : Decidable P
-      P? = λ u → ¿ P u ¿
-
-      utxoDeps : Deposits
-      utxoDeps = UTxOState.deposits utxoSt
-
-      -- utxo deposits restricted to new form of set used in EPOCH rule
-      utxoDeps' : Deposits
-      utxoDeps' = utxoDeps ∣ χ' ᶜ
-
-      -- utxo deposits restricted to old form of set used in EPOCH rule
-      utxoDeps'' : Deposits
-      utxoDeps'' = utxoDeps ∣ χ utxoDeps ᶜ
-
-      open Equivalence
-
-      χ'≡χ : χ' ≡ᵉ χ utxoDeps
-      χ'≡χ = χ'⊆χ , χ⊆χ'
-        where
-        χ'⊆χ : χ' ⊆ χ utxoDeps
-        χ'⊆χ {a} x with from ∈-map x
-        ... | (gaid , gast) , refl , gaidgast∈rem with from ∈-map (ratify-removed x)
-        ... | (dp , c) , refl , dpc∈utxoDeps = let gadc = (GovActionDeposit gaid , c) in
-          to ∈-map ((returnAddr gast , gadc)
-                   , refl
-                   , to ∈-concatMapˢ ((gaid , gast)
-                                     , gaidgast∈rem
-                                     , to ∈-map (gadc , refl , res-singleton⁺ {m = utxoDeps} dpc∈utxoDeps)))
-        χ⊆χ' : χ utxoDeps ⊆ χ'
-        χ⊆χ' {a} x with from ∈-map x
-        ... | (rwa , dp , c) , refl , rwa-dp-c∈ with (from ∈-concatMapˢ rwa-dp-c∈)
-        ... | (gaid , gast) , gaid-gast-∈-removed , rwa-dp-c-∈-map with (from ∈-map rwa-dp-c-∈-map)
-        ... | (.dp , _) , refl , q∈ =
-          to ∈-map ((gaid , gast)
-                   , proj₁ (×-≡,≡←≡ (proj₂ (res-singleton'' {m = utxoDeps} q∈)))
-                   , gaid-gast-∈-removed)
-
-
-      map-filter-decomp : ∀ a → (a ∉ χ' × a ∈ˡ map (GovActionDeposit ∘ proj₁) govSt)
-                                 ⇔ (a ∈ˡ map (GovActionDeposit ∘ proj₁)(filter P? govSt))
-      map-filter-decomp a = mk⇔ i (λ h → ii h , iii h)
-        where
-        i : ((a ∉ χ') × (a ∈ˡ map (GovActionDeposit ∘ proj₁) govSt))
-            → a ∈ˡ map (GovActionDeposit ∘ proj₁) (filter P? govSt)
-        i (a∉χ' , a∈) with Inverse.from (map-∈↔ (GovActionDeposit ∘ proj₁)) a∈
-        ... | b , b∈ , refl = Inverse.to (map-∈↔ (GovActionDeposit ∘ proj₁))
-                                         (b , ∈-filter⁺ P? b∈ (a∉χ' ∘ ∈-map⁺-∘) , refl)
-
-        ii : a ∈ˡ map (GovActionDeposit ∘ proj₁) (filter P? govSt) → a ∉ χ'
-        ii a∈ a∈χ' with from (∈ˡ-map-filter{l = govSt}{P? = P?}) a∈
-        ... | _ , _ , refl , Pb with ∈-map⁻' a∈χ'
-        ... | q , refl , q∈rem = Pb (to ∈-map (q , refl , q∈rem))
-
-        iii : a ∈ˡ map (GovActionDeposit ∘ proj₁) (filter P? govSt)
-              → a ∈ˡ map (GovActionDeposit ∘ proj₁) govSt
-        iii a∈ with from (∈ˡ-map-filter{l = govSt}{P? = P?}) a∈
-        ... | b , b∈ , refl , Pb = Inverse.to (map-∈↔ (GovActionDeposit ∘ proj₁)) (b , (b∈ , refl))
-
-
-      main-invariance-lemma :
-          filterˢ isGADeposit (dom utxoDeps) ≡ᵉ' fromList (map (GovActionDeposit ∘ proj₁) govSt)
-          ---------------------------------------------------------------------------------------------------
-        → filterˢ isGADeposit (dom utxoDeps') ≡ᵉ' fromList (map (GovActionDeposit ∘ proj₁) (filter P? govSt))
-
-      main-invariance-lemma HYP a = let open R.EquationalReasoning in
-        a ∈ (filterˢ isGADeposit (dom utxoDeps'))                       ∼⟨ R.SK-sym ∈-filter ⟩
-        (isGADeposit a × a ∈ dom utxoDeps')                             ∼⟨ R.K-refl ×-cong ∈-resᶜ-dom ⟩
-        (isGADeposit a × a ∉ χ' × ∃[ q ] (a , q) ∈ utxoDeps)            ∼⟨ ×-⇔-swap ⟩
-        (a ∉ χ' × isGADeposit a × ∃[ q ] (a , q) ∈ utxoDeps)            ∼⟨ R.K-refl ×-cong (R.K-refl ×-cong dom∈)⟩
-        (a ∉ χ' × isGADeposit a × a ∈ dom utxoDeps)                     ∼⟨ R.K-refl ×-cong ∈-filter ⟩
-        (a ∉ χ' × a ∈ filterˢ isGADeposit (dom utxoDeps))               ∼⟨ R.K-refl ×-cong (HYP a) ⟩
-        (a ∉ χ' × a ∈ fromList (map (GovActionDeposit ∘ proj₁) govSt))  ∼⟨ R.K-refl ×-cong (R.SK-sym ∈-fromList)⟩
-        (a ∉ χ' × a ∈ˡ map (GovActionDeposit ∘ proj₁) govSt)            ∼⟨ map-filter-decomp a ⟩
-        (a ∈ˡ map (GovActionDeposit ∘ proj₁)(filter P? govSt))          ∼⟨ ∈-fromList ⟩
-        a ∈ fromList (map (GovActionDeposit ∘ proj₁)(filter P? govSt))  ∎

From f6c3eeb3dc7e1de3c83f4814ac3094bd27acc2f5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Javier=20D=C3=ADaz?= <javier.diaz@iohk.io>
Date: Mon, 4 Nov 2024 14:52:46 +0000
Subject: [PATCH 3/5] Fix dependencies issue in the FFI

---
 src/Ledger/Conway/Foreign/HSLedger/Certs.agda |  2 +-
 src/Ledger/Conway/Foreign/HSLedger/Gov.agda   | 19 ++-----------------
 .../Conway/Foreign/HSLedger/Ratify.agda       |  1 +
 .../Conway/Foreign/HSLedger/Transaction.agda  |  1 +
 4 files changed, 5 insertions(+), 18 deletions(-)

diff --git a/src/Ledger/Conway/Foreign/HSLedger/Certs.agda b/src/Ledger/Conway/Foreign/HSLedger/Certs.agda
index c0ba5e932..fa4013f8e 100644
--- a/src/Ledger/Conway/Foreign/HSLedger/Certs.agda
+++ b/src/Ledger/Conway/Foreign/HSLedger/Certs.agda
@@ -2,7 +2,7 @@ module Ledger.Conway.Foreign.HSLedger.Certs where
 
 open import Ledger.Conway.Foreign.HSLedger.Address
 open import Ledger.Conway.Foreign.HSLedger.BaseTypes hiding (DState; CertEnv; GState)
-open import Ledger.Conway.Foreign.HSLedger.Gov
+open import Ledger.Conway.Foreign.HSLedger.Gov.Core
 open import Ledger.Conway.Foreign.HSLedger.PParams
 
 open import Ledger.Conway.Conformance.Certs govStructure using (⟦_,_,_,_⟧ᵈ; DState; GState)
diff --git a/src/Ledger/Conway/Foreign/HSLedger/Gov.agda b/src/Ledger/Conway/Foreign/HSLedger/Gov.agda
index 882d95a08..5dd303ccd 100644
--- a/src/Ledger/Conway/Foreign/HSLedger/Gov.agda
+++ b/src/Ledger/Conway/Foreign/HSLedger/Gov.agda
@@ -6,28 +6,13 @@ open import Ledger.Conway.Foreign.HSLedger.Address
 open import Ledger.Conway.Foreign.HSLedger.BaseTypes
 open import Ledger.Conway.Foreign.HSLedger.Enact
 open import Ledger.Conway.Foreign.HSLedger.PParams
+open import Ledger.Conway.Foreign.HSLedger.Gov.Core
+open import Ledger.Conway.Foreign.HSLedger.Cert
 
 open import Ledger.Conway.Conformance.Gov it
 open import Ledger.Conway.Conformance.Gov.Properties it
 
-open import Ledger.GovernanceActions govStructure using (Vote) public
-
 instance
-  HsTy-GovRole = autoHsType GovRole
-  Conv-GovRole = autoConvert GovRole
-
-  HsTy-Anchor = autoHsType Anchor
-  Conv-Anchor = autoConvert Anchor
-
-  HsTy-VDeleg = autoHsType VDeleg
-  Conv-VDeleg = autoConvert VDeleg
-
-  HsTy-Vote = autoHsType Vote
-  Conv-Vote = autoConvert Vote
-
-  HsTy-GovVote = autoHsType GovVote
-  Conv-GovVote = autoConvert GovVote
-
   HsTy-GovEnv = autoHsType GovEnv ⊣ withConstructor "MkGovEnv"
                                   • fieldPrefix "ge"
   Conv-GovEnv = autoConvert GovEnv
diff --git a/src/Ledger/Conway/Foreign/HSLedger/Ratify.agda b/src/Ledger/Conway/Foreign/HSLedger/Ratify.agda
index 209ac1311..afd2f7989 100644
--- a/src/Ledger/Conway/Foreign/HSLedger/Ratify.agda
+++ b/src/Ledger/Conway/Foreign/HSLedger/Ratify.agda
@@ -4,6 +4,7 @@ open import Ledger.Conway.Foreign.HSLedger.Address
 open import Ledger.Conway.Foreign.HSLedger.BaseTypes
 open import Ledger.Conway.Foreign.HSLedger.Certs
 open import Ledger.Conway.Foreign.HSLedger.Enact
+open import Ledger.Conway.Foreign.HSLedger.Gov.Core
 open import Ledger.Conway.Foreign.HSLedger.Gov
 
 open import Ledger.Enact govStructure
diff --git a/src/Ledger/Conway/Foreign/HSLedger/Transaction.agda b/src/Ledger/Conway/Foreign/HSLedger/Transaction.agda
index ddad68fa0..9f7942bb4 100644
--- a/src/Ledger/Conway/Foreign/HSLedger/Transaction.agda
+++ b/src/Ledger/Conway/Foreign/HSLedger/Transaction.agda
@@ -3,6 +3,7 @@ module Ledger.Conway.Foreign.HSLedger.Transaction where
 open import Ledger.Conway.Foreign.HSLedger.Address
 open import Ledger.Conway.Foreign.HSLedger.BaseTypes
 open import Ledger.Conway.Foreign.HSLedger.Certs
+open import Ledger.Conway.Foreign.HSLedger.Gov.Core
 open import Ledger.Conway.Foreign.HSLedger.Gov
 open import Ledger.Conway.Foreign.HSLedger.PParams
 

From 4a9e188ed7b1f6e23634cb361b0f42dbdbfc942e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Javier=20D=C3=ADaz?= <javier.diaz@iohk.io>
Date: Mon, 4 Nov 2024 14:57:35 +0000
Subject: [PATCH 4/5] Add new module to the FFI

---
 .../Conway/Foreign/HSLedger/Gov/Core.agda     | 22 +++++++++++++++++++
 1 file changed, 22 insertions(+)
 create mode 100644 src/Ledger/Conway/Foreign/HSLedger/Gov/Core.agda

diff --git a/src/Ledger/Conway/Foreign/HSLedger/Gov/Core.agda b/src/Ledger/Conway/Foreign/HSLedger/Gov/Core.agda
new file mode 100644
index 000000000..2175dcb54
--- /dev/null
+++ b/src/Ledger/Conway/Foreign/HSLedger/Gov/Core.agda
@@ -0,0 +1,22 @@
+module Ledger.Conway.Foreign.HSLedger.Gov.Core where
+
+open import Ledger.Conway.Foreign.HSLedger.Address
+open import Ledger.Conway.Foreign.HSLedger.BaseTypes
+open import Ledger.GovernanceActions govStructure using (Vote) public
+
+instance
+  HsTy-GovRole = autoHsType GovRole
+  Conv-GovRole = autoConvert GovRole
+
+  HsTy-Anchor = autoHsType Anchor
+  Conv-Anchor = autoConvert Anchor
+
+  HsTy-VDeleg = autoHsType VDeleg
+  Conv-VDeleg = autoConvert VDeleg
+
+  HsTy-Vote = autoHsType Vote
+  Conv-Vote = autoConvert Vote
+
+  HsTy-GovVote = autoHsType GovVote
+  Conv-GovVote = autoConvert GovVote
+

From 6cb2730c7145ff9687011f90f39d1ef8e10c2da8 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Javier=20D=C3=ADaz?= <javier.diaz@iohk.io>
Date: Mon, 4 Nov 2024 15:38:08 +0000
Subject: [PATCH 5/5] Tweak the imports in `Lib.hs` accordingly

---
 src/Ledger/hs-src/Lib.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/src/Ledger/hs-src/Lib.hs b/src/Ledger/hs-src/Lib.hs
index 6367b50ae..69de8f0cf 100644
--- a/src/Ledger/hs-src/Lib.hs
+++ b/src/Ledger/hs-src/Lib.hs
@@ -24,9 +24,10 @@ import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.Enact       as X
   (EnactState(..), EnactEnv(..), enactStep, GovAction (..))
 import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.Epoch       as X
   (Snapshot(..), Snapshots(..), EpochState(..), epochStep)
+import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.Gov.Core    as X
+  (GovRole(..), Anchor(..), VDeleg(..), Vote(..), GovVote(..))
 import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.Gov         as X
-  ( GovRole(..), Anchor(..), VDeleg(..), Vote(..), GovVote(..), GovEnv(..), GovProposal(..)
-  , GovActionState(..), govStep, GovState, GovActionID, Voter)
+  ( GovEnv(..), GovProposal(..), GovActionState(..), govStep, GovState, GovActionID, Voter)
 import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.Ledger      as X
   (LEnv(..), LState(..), ledgerStep)
 import MAlonzo.Code.Ledger.Conway.Foreign.HSLedger.NewEpoch    as X