Added ToExpr instances Moved ImpTest to cardano-ledger-conway:testlib Moved ConwayEpochs to cardano-ledger-conway:test
### `testlib`
* Add `ToExpr` instances for:
* `CollectError`
* `AlonzoUtxoPredFailure`
* `FailureDescription`
* `TagMismatchDescription`
* `AlonzoUtxosPredFailure`
* `AlonzoUtxowPredFailure`
* `BinaryData`
* `Datum`
* `IsValid`
* `ScriptPurpose`
* `TxOutSource`
* `TranslationError`
* `Addr28Extra`
* `DataHash32`
* `RdmrPtr`
* Add `Test.Cardano.Ledger.Alonzo.Binary.RoundTrip` module with:
* `roundTripAlonzoCommonSpec`
* `roundTripAlonzoEraTypesSpec`
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Language (BinaryPlutus (..), Language (..), Plutus (..))
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
| BadTranslation !(TranslationError (EraCrypto era))
deriving (Generic)
instance ToExpr (TxCert era) => ToExpr (CollectError era)
deriving instance (Era era, Eq (TxCert era)) => Eq (CollectError era)
deriving instance (Era era, Show (TxCert era)) => Show (CollectError era)
deriving instance (Era era, NoThunks (TxCert era)) => NoThunks (CollectError era)
import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, UtxoEnv (..))
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Shelley.Tx (TxIn)
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), areAllAdaOnly, coinBalance, sumAllValue)
import qualified Cardano.Ledger.Val as Val
import Cardano.Slotting.EpochInfo.API (EpochInfo, epochInfoSlotToUTCTime)
| NoCollateralInputs
deriving (Generic)
instance
( ToExpr (Value era)
, ToExpr (TxOut era)
, ToExpr (PredicateFailure (EraRule "UTXOS" era))
) =>
ToExpr (AlonzoUtxoPredFailure era)
deriving stock instance
( Era era
, Show (Value era)
updateUTxOState,
)
import Cardano.Ledger.Shelley.TxCert (ShelleyTxCert)
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), coinBalance)
import Cardano.Ledger.Val ((<->))
import Cardano.Slotting.EpochInfo.Extend (unsafeLinearExtendEpochInfo)
= PlutusFailure Text BS.ByteString
deriving (Show, Eq, Generic, NoThunks)
instance ToExpr FailureDescription
instance EncCBOR FailureDescription where
-- This strange encoding results from the fact that 'FailureDescription'
-- used to have another constructor, which used key 0.
| FailedUnexpectedly (NonEmpty FailureDescription)
deriving (Show, Eq, Generic, NoThunks)
instance ToExpr TagMismatchDescription
instance EncCBOR TagMismatchDescription where
encCBOR PassedUnexpectedly = encode (Sum PassedUnexpectedly 0)
encCBOR (FailedUnexpectedly fs) = encode (Sum FailedUnexpectedly 1 !> To fs)
deriving
(Generic)
instance
( ToExpr (PPUPPredFailure era)
, ToExpr (TxCert era)
) =>
ToExpr (AlonzoUtxosPredFailure era)
instance PPUPPredFailure era ~ () => Inject () (AlonzoUtxosPredFailure era) where
inject () = UpdateFailure ()
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.Shelley.Tx (TxIn (..))
import Cardano.Ledger.Shelley.UTxO (ShelleyScriptsNeeded (..))
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..))
import Control.Monad.Trans.Reader (asks)
import Control.SetAlgebra (domain, eval, (⊆), (➖))
![RdmrPtr]
deriving (Generic)
instance
( Era era
, ToExpr (PredicateFailure (EraRule "UTXO" era))
, ToExpr (TxCert era)
) =>
ToExpr (AlonzoUtxowPredFailure era)
deriving instance
( Era era
, Show (TxCert era)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1 -- NOTE PV1.Data === PV2.Data
import qualified PlutusLedgerApi.V1 as PV1
-- ============================================================================
-- the newtype Data is a wrapper around the type that Plutus expects as data.
-- to validate. This is added by the block creator when constructing the block.
newtype IsValid = IsValid Bool
deriving (Eq, Show, Generic)
deriving newtype (NoThunks, NFData, ToCBOR, EncCBOR, DecCBOR, ToExpr)
deriving newtype (NoThunks, NFData, ToCBOR, EncCBOR, DecCBOR)
instance ToExpr IsValid
data AlonzoTx era = AlonzoTx
{ body :: !(TxBody era)
| Certifying !(TxCert era)
deriving (Generic)
instance ToExpr (TxCert era) => ToExpr (ScriptPurpose era)
deriving instance (Era era, Eq (TxCert era)) => Eq (ScriptPurpose era)
deriving instance (Era era, Show (TxCert era)) => Show (ScriptPurpose era)
deriving instance (Era era, NoThunks (TxCert era)) => NoThunks (ScriptPurpose era)
fromSLanguage,
withSLanguage,
)
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..), ToExpr)
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.SafeHash (SafeHash, extractHash, hashAnnotated)
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
| TxOutFromOutput !TxIx
deriving (Eq, Show, Generic, NoThunks)
instance ToExpr (TxOutSource era)
instance Crypto c => EncCBOR (TxOutSource c) where
encCBOR = \case
TxOutFromInput txIn -> encode $ Sum TxOutFromInput 0 !> To txIn
| TimeTranslationPastHorizon !Text
deriving (Eq, Show, Generic, NoThunks)
instance ToExpr (TranslationError c)
instance Crypto c => EncCBOR (TranslationError c) where
encCBOR = \case
ByronTxOutInContext txOutSource ->
## 1.4.5.0
* Add `Generic` instance for:
* `BabbageUtxoPredFailure`
* `BabbageUtxowPredFailure`
* Add `ToExpr` instance for:
* `BabbageUtxoPredFailure`
* `BabbageUtxowPredFailure`
* `BabbageTxOut`
* Add `ToExpr` instance for:
* `BabbageTxBody`
* `BabbageTxOut`
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
import Cardano.Ledger.Shelley.Rules (ShelleyUtxoPredFailure, UtxoEnv)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.TxIn (TxIn)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..), areAllAdaOnly, balance)
import Cardano.Ledger.Val ((<->))
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))
import Validation (Validation, failureIf, failureUnless)
-- together with the minimum value for the given output.
BabbageOutputTooSmallUTxO
![(TxOut era, Coin)]
deriving (Generic)
instance
( ToExpr (AlonzoUtxoPredFailure era)
, ToExpr (TxOut era)
) =>
ToExpr (BabbageUtxoPredFailure era)
deriving instance
( Era era
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
validateNeededWitnesses,
)
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.UTxO (EraUTxO (..), UTxO (..))
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Typeable
import GHC.Generics (Generic)
import Lens.Micro
import Lens.Micro.Extras (view)
import NoThunks.Class (InspectHeapNamed (..), NoThunks (..))
| -- | the set of malformed script witnesses
MalformedReferenceScripts
!(Set (ScriptHash (EraCrypto era)))
deriving (Generic)
instance
( Era era
, ToExpr (PredicateFailure (EraRule "UTXO" era))
, ToExpr (TxCert era)
) =>
ToExpr (BabbageUtxowPredFailure era)
deriving instance
( Era era
import Cardano.Ledger.Crypto (Crypto (ADDRHASH), StandardCrypto)
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.TreeDiff (
Expr (App),
ToExpr (toExpr),
ToExpr,
)
import Cardano.Ledger.Val (Val (..))
import Control.DeepSeq (NFData (rnf), rwhnf)
{-# UNPACK #-} !DataHash32
deriving (Generic)
instance
( EraTxOut era
, ToExpr (Value era)
, ToExpr (BinaryData era)
, ToExpr (Datum era)
, ToExpr (Script era)
) =>
ToExpr (BabbageTxOut era)
where
toExpr (BabbageTxOut addr val dat sc) = App "BabbageTxOut" [toExpr addr, toExpr val, toExpr dat, toExpr sc]
instance Crypto c => EraTxOut (BabbageEra c) where
{-# SPECIALIZE instance EraTxOut (BabbageEra StandardCrypto) #-}
internBabbageTxOut (interns credsInterns) <$!> decodeBabbageTxOut fromCborBackwardsBothAddr
{-# INLINEABLE decShareCBOR #-}
instance
( ToExpr (CompactAddr (EraCrypto era))
, ToExpr (CompactForm (Value era))
, ToExpr (Script era)
) =>
ToExpr (BabbageTxOut era)
internBabbageTxOut ::
(Credential 'Staking (EraCrypto era) -> Credential 'Staking (EraCrypto era)) ->
BabbageTxOut era ->
## 1.9.0.0
* Add `ToExpr` instance for:
* `Voter`
* `ConwayCertPredFailure`
* `ConwayCertsPredFailure`
* `ConwayDelegPredFailure`
* `ConwayGovPredFailure`
* `ConwayGovCertPredFailure`
* `ConwayLedgerPredFailure`
* `ConwayTxBody`
* Add `Generic` and `NFData` instance for:
* `ConwayNewEpochPredFailure`
* Add `totalObligation`
* Add `utxosDepositedL`
* Add `conwayWitsVKeyNeeded`
* Add `ConwayEraPParams era` constraint to `isCommitteeVotingAllowed` and `votingCommitteeThreshold`
* Add `ToExpr` instance for:
* `Voter`
### testlib
* Add `Test.Cardano.Ledger.Conway.ImpTest`
* Rename `genNewCommittee` to `genUpdateCommitteee`
* Add `genNewCommittee`
* Add `genNoConfidence`
exposed-modules:
Test.Cardano.Ledger.Conway.Arbitrary
Test.Cardano.Ledger.Conway.Binary.RoundTrip
Test.Cardano.Ledger.Conway.ImpTest
visibility: public
hs-source-dirs: testlib
build-depends:
base,
transformers,
bytestring,
cardano-data:testlib,
cardano-ledger-binary,
data-default-class,
containers,
microlens,
cardano-ledger-binary:{cardano-ledger-binary, testlib},
cardano-crypto-class,
cardano-ledger-core:{cardano-ledger-core, testlib},
cardano-ledger-babbage:testlib,
cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
cardano-slotting,
cardano-ledger-conway,
small-steps-test,
cardano-ledger-shelley,
cardano-ledger-babbage,
mtl,
time,
cardano-strict-containers,
small-steps
small-steps,
microlens-mtl,
unliftio,
deepseq
test-suite tests
type: exitcode-stdio-1.0
Test.Cardano.Ledger.Conway.CommitteeRatifySpec
Test.Cardano.Ledger.Conway.GenesisSpec
Test.Cardano.Ledger.Conway.GovActionReorderSpec
Test.Cardano.Ledger.Conway.EpochSpec
Paths_cardano_ledger_conway
default-language: Haskell2010
base,
cardano-ledger-core:testlib,
cardano-ledger-conway,
cardano-ledger-shelley,
cardano-ledger-core,
cardano-ledger-binary:testlib,
containers,
data-default-class,
microlens,
testlib,
text,
cardano-strict-containers,
cardano-ledger-binary:testlib
microlens
VState,
)
import Cardano.Ledger.Shelley.Rules (ShelleyPoolPredFailure)
import Cardano.Ledger.TreeDiff (ToExpr)
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (
Embed,
| GovCertFailure (PredicateFailure (EraRule "GOVCERT" era))
deriving (Generic)
instance
( ToExpr (PredicateFailure (EraRule "DELEG" era))
, ToExpr (PredicateFailure (EraRule "GOVCERT" era))
, ToExpr (PredicateFailure (EraRule "POOL" era))
) =>
ToExpr (ConwayCertPredFailure era)
deriving stock instance
( Show (PredicateFailure (EraRule "DELEG" era))
, Show (PredicateFailure (EraRule "POOL" era))
validateDelegationRegistered,
validateZeroRewards,
)
import Cardano.Ledger.TreeDiff (ToExpr)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
Embed (..),
CertFailure !(PredicateFailure (EraRule "CERT" era))
deriving (Generic)
instance
ToExpr (PredicateFailure (EraRule "CERT" era)) =>
ToExpr (ConwayCertsPredFailure era)
deriving stock instance
Eq (PredicateFailure (EraRule "CERT" era)) =>
Eq (ConwayCertsPredFailure era)
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyRole (Staking))
import Cardano.Ledger.Shelley.LedgerState (DState (..))
import Cardano.Ledger.TreeDiff (ToExpr)
import qualified Cardano.Ledger.UMap as UM
import Control.DeepSeq (NFData)
import Control.Monad (forM_)
| WrongCertificateTypeDELEG
deriving (Show, Eq, Generic)
instance ToExpr (ConwayDelegPredFailure era)
instance NoThunks (ConwayDelegPredFailure era)
instance NFData (ConwayDelegPredFailure era)
import Cardano.Ledger.Keys (KeyRole (..))
import Cardano.Ledger.Rules.ValidationMode (Inject (..), Test, runTest)
import Cardano.Ledger.Shelley.Tx (TxId (..))
import Cardano.Ledger.TreeDiff (ToExpr)
import Control.DeepSeq (NFData)
import Control.Monad (guard)
import Control.Monad.Trans.Reader (asks)
(Map.Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
deriving (Eq, Show, Generic)
instance EraPParams era => ToExpr (ConwayGovPredFailure era)
instance EraPParams era => NFData (ConwayGovPredFailure era)
instance EraPParams era => NoThunks (ConwayGovPredFailure era)
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.DRepDistr (drepAnchorL, drepDepositL, drepExpiryL)
import Cardano.Ledger.Keys (KeyRole (ColdCommitteeRole, DRepRole))
import Cardano.Ledger.TreeDiff (ToExpr)
import Control.DeepSeq (NFData)
import Control.State.Transition.Extended (
BaseM,
| ConwayCommitteeHasPreviouslyResigned !(Credential 'ColdCommitteeRole (EraCrypto era))
deriving (Show, Eq, Generic)
instance ToExpr (ConwayGovCertPredFailure era)
instance NoThunks (ConwayGovCertPredFailure era)
instance NFData (ConwayGovCertPredFailure era)
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
ShelleyLedgersEvent (..),
ShelleyLedgersPredFailure (..),
UtxoEnv (..),
depositEqualsObligation,
shelleyLedgerAssertions,
)
import Cardano.Ledger.Slot (epochInfoEpoch)
import Cardano.Ledger.TreeDiff (ToExpr)
import Cardano.Ledger.UMap (UView (..), dRepMap)
import qualified Cardano.Ledger.UMap as UMap
import Cardano.Ledger.UTxO (EraUTxO (..))
import Control.DeepSeq (NFData)
import Control.Monad (when)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition.Extended (
AssertionViolation (..),
Embed (..),
STS (..),
TRC (..),
Coin
deriving (Generic)
instance
( ToExpr (PredicateFailure (EraRule "UTXOW" era))
, ToExpr (PredicateFailure (EraRule "GOV" era))
, ToExpr (PredicateFailure (EraRule "CERTS" era))
) =>
ToExpr (ConwayLedgerPredFailure era)
deriving instance
( Era era
, Eq (PredicateFailure (EraRule "UTXOW" era))
initialRules = []
transitionRules = [ledgerTransition @ConwayLEDGER]
renderAssertionViolation AssertionViolation {avSTS, avMsg, avCtx, avState} =
"AssertionViolation ("
<> avSTS
<> "): "
<> avMsg
<> "\n"
<> show avCtx
<> "\n"
<> show avState
renderAssertionViolation = depositEqualsObligation
assertions = shelleyLedgerAssertions
As we removed those guards from the chain layer, it is important that the logic layer is doing this filtering.
Fix FF build
To prevent aborting the wrong Head `headId` was added to the `OnAbortTx`. Logic layer now aborts the head that is seen as initialized.
The flaky test picked up this error
# Conflicts: # package.json
* Removed call to tail, and the 'watchPulser' test Co-authored-by: Alexey Kuleshevich <[email protected]>
