diff --git a/cabal.project b/cabal.project index 1e62c863fce..a331f7fa78d 100644 --- a/cabal.project +++ b/cabal.project @@ -104,8 +104,8 @@ source-repository-package type: git location: https://github.com/tweag/cardano-cls.git subdir: merkle-tree-incremental mempack-scls scls-cbor scls-cardano scls-format scls-core - --sha256: sha256-BoAotLgxMipOIMcZrmlr6EtQzqC5HyEA0ZpK8nvCmJs= - tag: 5161deb34247a51160f2e8d58b6cc2d48044ea2c + --sha256: sha256-RFJKaPudu+Iog+CJQM1XwCXPpaadrq7zkdUtr96nI2Y= + tag: ba6dae91820425e53a65858aee495de23aa87ce5 constraints: -- Happy version 2.2.1 fails to compile haskell-src-exts diff --git a/libs/cardano-ledger-canonical-state/conway/Cardano/Ledger/CanonicalState/Conway.hs b/libs/cardano-ledger-canonical-state/conway/Cardano/Ledger/CanonicalState/Conway.hs index 171c3a013d3..34506b34b08 100644 --- a/libs/cardano-ledger-canonical-state/conway/Cardano/Ledger/CanonicalState/Conway.hs +++ b/libs/cardano-ledger-canonical-state/conway/Cardano/Ledger/CanonicalState/Conway.hs @@ -57,7 +57,7 @@ import qualified Codec.CBOR.Decoding as D import qualified Codec.CBOR.Encoding as E import Data.Map (Map) import Data.Text (Text) -import Data.Word (Word8) +import Data.Word (Word64, Word8) import Lens.Micro type instance NamespaceEra "blocks/v0" = ConwayEra @@ -245,24 +245,28 @@ instance KnownNamespace "gov/proposals/v0" where type NamespaceEntry "gov/proposals/v0" = GovProposalOut CanonicalGovActionState fromGovActionState :: - GovActionState ConwayEra -> (GovProposalIn, GovProposalOut CanonicalGovActionState) -fromGovActionState GovActionState {..} = + Word64 -> GovActionState ConwayEra -> (GovProposalIn, GovProposalOut CanonicalGovActionState) +fromGovActionState n GovActionState {..} = ( mkGovProposalIn gasId - , GovProposalOut $ - CanonicalGovActionState - { gasProposalProcedure = mkOnChain @ConwayEra gasProposalProcedure - , .. - } + , GovProposalOut + ( n + , CanonicalGovActionState + { gasProposalProcedure = mkOnChain @ConwayEra gasProposalProcedure + , .. + } + ) ) toGovActionState :: - (GovProposalIn, GovProposalOut CanonicalGovActionState) -> GovActionState ConwayEra -toGovActionState (govIn, GovProposalOut CanonicalGovActionState {..}) = - GovActionState - { gasProposalProcedure = getValue gasProposalProcedure - , gasId = fromGovProposalIn govIn - , .. - } + (GovProposalIn, GovProposalOut CanonicalGovActionState) -> (Word64, GovActionState ConwayEra) +toGovActionState (govIn, GovProposalOut (n, CanonicalGovActionState {..})) = + ( n + , GovActionState + { gasProposalProcedure = getValue gasProposalProcedure + , gasId = fromGovProposalIn govIn + , .. + } + ) mkGovProposalIn :: GovActionId -> GovProposalIn mkGovProposalIn GovActionId {gaidGovActionIx = GovActionIx idx, gaidTxId} = diff --git a/libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/GovProposals/V0.hs b/libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/GovProposals/V0.hs index 5f7c94abc17..6121967a51e 100644 --- a/libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/GovProposals/V0.hs +++ b/libs/cardano-ledger-canonical-state/src/Cardano/Ledger/CanonicalState/Namespace/GovProposals/V0.hs @@ -41,7 +41,7 @@ import Cardano.SCLS.Versioned (Versioned (..)) import Data.MemPack import Data.MemPack.ByteOrdered import Data.Proxy (Proxy (..)) -import Data.Word (Word16) +import Data.Word (Word16, Word64) import GHC.Generics (Generic) newtype CanonicalGovActionIx = CanonicalGovActionIx Word16 @@ -76,9 +76,7 @@ instance IsKey GovProposalIn where gaidGovActionIx <- unpackM return $ GovProposalIn CanonicalGovActionId {..} --- | Canonical wrapper over gov action state. Because this is on-chain data --- we create a wrapper for that. -newtype GovProposalOut v = GovProposalOut v +newtype GovProposalOut v = GovProposalOut (Word64, v) deriving (Eq, Show, Generic) deriving newtype (ToCanonicalCBOR "gov/proposals/v0") deriving newtype (FromCanonicalCBOR "gov/proposals/v0") diff --git a/libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs b/libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs index 022bd741414..f03261586f2 100644 --- a/libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs +++ b/libs/cardano-ledger-canonical-state/test/Test/Cardano/Ledger/CanonicalState/Spec.hs @@ -15,12 +15,13 @@ module Test.Cardano.Ledger.CanonicalState.Spec (spec) where import Cardano.Ledger.BaseTypes (EpochInterval, NonNegativeInterval, UnitInterval) import Cardano.Ledger.CanonicalState.BasicTypes (CanonicalExUnits (..)) -import Cardano.Ledger.CanonicalState.Conway () +import Cardano.Ledger.CanonicalState.Conway (CanonicalGovActionState) import qualified Cardano.Ledger.CanonicalState.Namespace.Blocks.V0 as Blocks.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.EntitiesCommittee.V0 as Committee.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.GovCommittee.V0 as GovCommittee.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0 as GovConstitution.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0 as GovPParams.V0 +import qualified Cardano.Ledger.CanonicalState.Namespace.GovProposals.V0 as GovProposals.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.UTxO.V0 as UTxO.V0 import Cardano.Ledger.Conway (ConwayEra) import Cardano.Ledger.Core (PParams) @@ -66,6 +67,10 @@ spec = do validateType @"gov/pparams/v0" @CanonicalExUnits "ex_units" isCanonical @"gov/pparams/v0" @(PParams ConwayEra) validateType @"gov/pparams/v0" @(GovPParams.V0.GovPParamsOut ConwayEra) "gov_pparams_out" + describe "gov/proposals/v0" $ do + isCanonical @"gov/proposals/v0" @(GovProposals.V0.GovProposalOut CanonicalGovActionState) + validateType @"gov/proposals/v0" @(GovProposals.V0.GovProposalOut CanonicalGovActionState) + "record_entry" describe "namespaces" $ do testNS @"blocks/v0" testNS @"utxo/v0" diff --git a/libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/Conway/CanonicalState/Arbitrary.hs b/libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/Conway/CanonicalState/Arbitrary.hs index 1a2976e75a0..63f9cf21105 100644 --- a/libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/Conway/CanonicalState/Arbitrary.hs +++ b/libs/cardano-ledger-canonical-state/testlib/Test/Cardano/Ledger/Conway/CanonicalState/Arbitrary.hs @@ -16,7 +16,7 @@ import qualified Cardano.Ledger.CanonicalState.Namespace.GovConstitution.V0 as G import qualified Cardano.Ledger.CanonicalState.Namespace.GovPParams.V0 as GovPParams.V0 import qualified Cardano.Ledger.CanonicalState.Namespace.GovProposals.V0 as GovProposals.V0 import Cardano.Ledger.Conway (ConwayEra) -import Cardano.Ledger.Conway.Governance (Constitution, GovActionState) +import Cardano.Ledger.Conway.Governance (Constitution) import Generic.Random (genericArbitraryU) import Test.Cardano.Ledger.Conway.Arbitrary () import Test.QuickCheck (Arbitrary (..)) @@ -31,4 +31,4 @@ instance Arbitrary (GovPParams.V0.GovPParamsOut ConwayEra) where arbitrary = genericArbitraryU instance Arbitrary (GovProposals.V0.GovProposalOut CanonicalGovActionState) where - arbitrary = snd . fromGovActionState <$> arbitrary @(GovActionState ConwayEra) + arbitrary = snd . fromGovActionState 0 <$> arbitrary