From a9db549c9f61af929ec09a9b3cfac5a85da6a5ee Mon Sep 17 00:00:00 2001 From: Tim Sheard Date: Fri, 2 Apr 2021 13:01:34 -0700 Subject: [PATCH] Removed calls to error. Removed calls to error, because the method indexOf might fail. Also tracked down a few others. Also discovered that STS.ApplyTx hardcodes in Shelley Tx, rather than Core.Tx Relplace Tx with COre.Tx is its defintion in Shelley.Spec.Ledger.API.Mempool Still Having some trouble writing an ApplyTX for Alonzo. --- alonzo/impl/src/Cardano/Ledger/Alonzo.hs | 29 ++++++++++---- alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs | 7 ---- .../impl/src/Cardano/Ledger/Alonzo/PParams.hs | 16 ++++---- .../src/Cardano/Ledger/Alonzo/Rules/Utxo.hs | 3 ++ .../src/Cardano/Ledger/Alonzo/Rules/Utxos.hs | 6 ++- .../src/Cardano/Ledger/Alonzo/Rules/Utxow.hs | 28 ++++++++++--- alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs | 39 +++++++++---------- .../impl/src/Cardano/Ledger/Alonzo/TxBody.hs | 19 +++++---- .../Ledger/Alonzo/Serialisation/Generators.hs | 5 ++- .../Ledger/Alonzo/Serialisation/Tripping.hs | 2 +- .../src/Shelley/Spec/Ledger/API/Mempool.hs | 15 ++++--- 11 files changed, 101 insertions(+), 68 deletions(-) diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo.hs index cf753e9ca5f..08b08807943 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo.hs @@ -23,6 +23,7 @@ where import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..), getPlutusData) import Cardano.Ledger.Alonzo.PParams (PParams, PParams' (..), PParamsUpdate, updatePParams) +import Cardano.Ledger.Alonzo.Rules.Ledger (AlonzoLEDGER) import qualified Cardano.Ledger.Alonzo.Rules.Utxo as Alonzo (AlonzoUTXO) import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo (UTXOS) import qualified Cardano.Ledger.Alonzo.Rules.Utxow as Alonzo (AlonzoUTXOW) @@ -51,6 +52,7 @@ import Data.Typeable (Typeable) import qualified Plutus.V1.Ledger.Api as Plutus (validateScript) import qualified Shelley.Spec.Ledger.API as API import qualified Shelley.Spec.Ledger.BaseTypes as Shelley +import Shelley.Spec.Ledger.CompactAddr (CompactAddr) import Shelley.Spec.Ledger.Metadata (validMetadatum) import qualified Shelley.Spec.Ledger.STS.Bbody as STS import qualified Shelley.Spec.Ledger.STS.Bbody as Shelley @@ -69,11 +71,16 @@ import Shelley.Spec.Ledger.TxBody (witKeyHash) -- | The Alonzo era data AlonzoEra c -instance API.PraosCrypto c => API.ApplyTx (AlonzoEra c) +{- +instance + ( Show (CompactAddr c), + API.PraosCrypto c + ) => API.ApplyTx (AlonzoEra c) +-} -instance API.PraosCrypto c => API.ApplyBlock (AlonzoEra c) +instance (Show (CompactAddr c), API.PraosCrypto c) => API.ApplyBlock (AlonzoEra c) -instance API.PraosCrypto c => API.GetLedgerView (AlonzoEra c) +instance (Show (CompactAddr c), API.PraosCrypto c) => API.GetLedgerView (AlonzoEra c) instance (CC.Crypto c) => Shelley.ValidateScript (AlonzoEra c) where isNativeScript x = not (isPlutusScript x) @@ -97,8 +104,7 @@ instance -- initialState :: ShelleyGenesis era -> AdditionalGenesisConfig era -> NewEpochState era initialState _ _ = error "TODO: implement initialState" -instance CC.Crypto c => UsesTxOut (AlonzoEra c) where - -- makeTxOut :: Proxy era -> Addr (Crypto era) -> Value era -> TxOut era +instance (Show (CompactAddr c), CC.Crypto c) => UsesTxOut (AlonzoEra c) where makeTxOut _proxy addr val = TxOut addr val Shelley.SNothing instance @@ -149,8 +155,13 @@ instance CC.Crypto c => EraModule.BlockDecoding (AlonzoEra c) where seqIsValidating tx = case isValidating' tx of IsValidating b -> b seqHasValidating = True -- Tx in AlonzoEra has an IsValidating field -instance API.PraosCrypto c => API.ShelleyBasedEra (AlonzoEra c) - +{- +instance + ( Show (CompactAddr c), + API.PraosCrypto c, + Core.Witnesses c ~ TxWitness c + ) => API.ShelleyBasedEra (AlonzoEra c) +-} ------------------------------------------------------------------------------- -- Era Mapping ------------------------------------------------------------------------------- @@ -163,6 +174,7 @@ type instance Core.EraRule "UTXO" (AlonzoEra c) = Alonzo.AlonzoUTXO (AlonzoEra c type instance Core.EraRule "UTXOW" (AlonzoEra c) = Alonzo.AlonzoUTXOW (AlonzoEra c) +{- type LEDGERSTUB c = STUB (API.LedgerEnv (AlonzoEra c)) @@ -173,8 +185,9 @@ type LEDGERSTUB c = instance Typeable c => STS.Embed (LEDGERSTUB c) (API.LEDGERS (AlonzoEra c)) where wrapFailed = error "TODO: implement LEDGER rule" +-} -type instance Core.EraRule "LEDGER" (AlonzoEra c) = LEDGERSTUB c +type instance Core.EraRule "LEDGER" (AlonzoEra c) = AlonzoLEDGER c type instance Core.EraRule "BBODY" (AlonzoEra c) = diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs index caf399f6601..e7c1febf8ad 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs @@ -122,18 +122,11 @@ newtype Data era = DataConstr (MemoBytes Plutus.Data) deriving (Eq, Ord, Generic, Show) deriving newtype (SafeToHash, ToCBOR) -{- deriving via (Mem Plutus.Data) instance (Era era) => FromCBOR (Annotator (Data era)) --} - -instance Typeable era => FromCBOR (Annotator (Data era)) where - fromCBOR = do - (Annotator getT, Annotator getBytes) <- withSlice fromCBOR - pure (Annotator (\fullbytes -> DataConstr (Memo (getT fullbytes) (toShort (toStrict (getBytes fullbytes)))))) instance (Crypto era ~ c) => HashAnnotated (Data era) EraIndependentData c diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index 1d124ea879f..78c649618e3 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -340,14 +340,6 @@ instance NoThunks (PParamsUpdate era) -- writing only those fields where the field is (SJust x), that is the role of -- the local function (omitStrictMaybe key x) -fromSJust :: StrictMaybe a -> a -fromSJust (SJust x) = x -fromSJust SNothing = error "SNothing in fromSJust" - -isSNothing :: StrictMaybe a -> Bool -isSNothing SNothing = True -isSNothing (SJust _) = False - encodePParamsUpdate :: PParamsUpdate era -> Encode ('Closed 'Sparse) (PParamsUpdate era) @@ -380,6 +372,14 @@ encodePParamsUpdate ppup = Word -> StrictMaybe a -> (a -> Encoding) -> Encode ('Closed 'Sparse) (StrictMaybe a) omitStrictMaybe key x enc = Omit isSNothing (Key key (E (enc . fromSJust) x)) + fromSJust :: StrictMaybe a -> a + fromSJust (SJust x) = x + fromSJust SNothing = error "SNothing in fromSJust. This should never happen, it is guarded by isSNothing." + + isSNothing :: StrictMaybe a -> Bool + isSNothing SNothing = True + isSNothing (SJust _) = False + instance (Era era) => ToCBOR (PParamsUpdate era) where toCBOR ppup = encode (encodePParamsUpdate ppup) diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs index 86955896cb1..3bffc44c4f2 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs @@ -81,6 +81,7 @@ import Shelley.Spec.Ledger.BaseTypes StrictMaybe (..), networkId, ) +import Shelley.Spec.Ledger.CompactAddr (CompactAddr) import qualified Shelley.Spec.Ledger.LedgerState as Shelley import qualified Shelley.Spec.Ledger.STS.Utxo as Shelley import Shelley.Spec.Ledger.Tx (TxIn) @@ -274,6 +275,7 @@ utxoTransition :: forall era. ( Era era, ValidateScript era, + Show (CompactAddr (Crypto era)), -- instructions for calling UTXOS from AlonzoUTXO Embed (Core.EraRule "UTXOS" era) (AlonzoUTXO era), Environment (Core.EraRule "UTXOS" era) ~ Shelley.UtxoEnv era, @@ -392,6 +394,7 @@ utxoTransition = do instance forall era. ( ValidateScript era, + Show (CompactAddr (Crypto era)), -- Instructions needed to call the UTXOS transition from this one. Embed (Core.EraRule "UTXOS" era) (AlonzoUTXO era), Environment (Core.EraRule "UTXOS" era) ~ Shelley.UtxoEnv era, diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs index ef9d114b803..3b38c7c5754 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs @@ -43,6 +43,7 @@ import GHC.Generics (Generic) import GHC.Records (HasField (..)) import NoThunks.Class (NoThunks) import Shelley.Spec.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..), strictMaybeToMaybe) +import Shelley.Spec.Ledger.CompactAddr (CompactAddr) import Shelley.Spec.Ledger.LedgerState import qualified Shelley.Spec.Ledger.LedgerState as Shelley import Shelley.Spec.Ledger.PParams (Update) @@ -63,6 +64,7 @@ instance Eq (Core.PParams era), Show (Core.PParams era), Show (PParamsDelta era), + Show (CompactAddr (Crypto era)), Eq (PParamsDelta era), Embed (Core.EraRule "PPUP" era) (UTXOS era), Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era, @@ -90,6 +92,7 @@ instance utxosTransition :: forall era. ( Era era, + Show (CompactAddr (Crypto era)), Core.Script era ~ Script era, Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era, State (Core.EraRule "PPUP" era) ~ PPUPState era, @@ -119,7 +122,8 @@ utxosTransition = scriptsValidateTransition :: forall era. - ( Show (Core.Value era), -- Arises because of the use of (∪) from SetAlgebra, needs Show to report errors. + ( Show (Core.Value era), -- Arises because of the use of (∪) from SetAlgebra, needs Show to report problems. + Show (CompactAddr (Crypto era)), Era era, Environment (Core.EraRule "PPUP" era) ~ PPUPEnv era, State (Core.EraRule "PPUP" era) ~ PPUPState era, diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index 23b9f5d0903..06e80118916 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -87,16 +87,19 @@ data AlonzoPredFail era WrongNetworkInTxBody !Network -- Actual Network ID !Network -- Network ID in transaction body + | ScriptsDidNotValidate [Core.Script era] deriving instance ( Era era, - Show (PredicateFailure (Core.EraRule "UTXO" era)) -- The Shelley UtxowPredicateFailure needs this to Show + Show (PredicateFailure (Core.EraRule "UTXO" era)), -- The Shelley UtxowPredicateFailure needs this to Show + Show (Core.Script era) ) => Show (AlonzoPredFail era) deriving instance ( Era era, - Eq (PredicateFailure (Core.EraRule "UTXO" era)) -- The Shelley UtxowPredicateFailure needs this to Eq + Eq (PredicateFailure (Core.EraRule "UTXO" era)), -- The Shelley UtxowPredicateFailure needs this to Eq + Eq (Core.Script era) ) => Eq (AlonzoPredFail era) @@ -104,7 +107,8 @@ instance ( Era era, ToCBOR (PredicateFailure (Core.EraRule "UTXO" era)), Typeable (Core.AuxiliaryData era), - Typeable (Core.Script era) + Typeable (Core.Script era), + ToCBOR (Core.Script era) ) => ToCBOR (AlonzoPredFail era) where @@ -114,7 +118,8 @@ encodePredFail :: ( Era era, ToCBOR (PredicateFailure (Core.EraRule "UTXO" era)), Typeable (Core.Script era), - Typeable (Core.AuxiliaryData era) + Typeable (Core.AuxiliaryData era), + ToCBOR (Core.Script era) ) => AlonzoPredFail era -> Encode 'Open (AlonzoPredFail era) @@ -126,13 +131,15 @@ encodePredFail (PPViewHashesDontMatch x y) = Sum PPViewHashesDontMatch 4 !> To x encodePredFail (MissingRequiredSigners x) = Sum MissingRequiredSigners 5 !> To x encodePredFail (Phase1ScriptWitnessNotValidating x) = Sum Phase1ScriptWitnessNotValidating 6 !> To x encodePredFail (WrongNetworkInTxBody x y) = Sum WrongNetworkInTxBody 7 !> To x !> To y +encodePredFail (ScriptsDidNotValidate x) = Sum ScriptsDidNotValidate 8 !> To x instance ( Era era, FromCBOR (PredicateFailure (Core.EraRule "UTXO" era)), FromCBOR (Script era), Typeable (Core.Script era), - Typeable (Core.AuxiliaryData era) + Typeable (Core.AuxiliaryData era), + FromCBOR (Core.Script era) ) => FromCBOR (AlonzoPredFail era) where @@ -143,7 +150,8 @@ decodePredFail :: FromCBOR (PredicateFailure (Core.EraRule "UTXO" era)), -- TODO, we should be able to get rid of this constraint FromCBOR (Script era), Typeable (Core.Script era), - Typeable (Core.AuxiliaryData era) + Typeable (Core.AuxiliaryData era), + FromCBOR (Core.Script era) ) => Word -> Decode 'Open (AlonzoPredFail era) @@ -155,6 +163,7 @@ decodePredFail 4 = SumD PPViewHashesDontMatch FromCBOR (ScriptPurpose c) where -- ======================================= class Indexable elem container where - indexOf :: elem -> container -> Word64 - atIndex :: Word64 -> container -> elem + indexOf :: elem -> container -> StrictMaybe Word64 instance Ord k => Indexable k (Set k) where - indexOf n set = fromIntegral $ Set.findIndex n set - atIndex i set = Set.elemAt (fromIntegral i) set + indexOf n set = case Set.lookupIndex n set of + Just x -> SJust (fromIntegral x) + Nothing -> SNothing instance Eq k => Indexable k (StrictSeq k) where indexOf n seqx = case StrictSeq.findIndexL (== n) seqx of - Just m -> fromIntegral m - Nothing -> error "Not found in StrictSeq" - atIndex i seqx = case StrictSeq.lookup (fromIntegral i) seqx of - Just element -> element - Nothing -> error ("No elem at index " ++ show i) + Just m -> SJust (fromIntegral m) + Nothing -> SNothing instance Ord k => Indexable k (Map.Map k v) where - indexOf n mp = fromIntegral $ Map.findIndex n mp - atIndex i mp = fst (Map.elemAt (fromIntegral i) mp) -- If one needs the value, on can use Map.Lookup + indexOf n mp = case Map.lookupIndex n mp of + Just x -> SJust (fromIntegral x) + Nothing -> SNothing rdptr :: forall era. @@ -503,11 +501,11 @@ rdptr :: ) => Core.TxBody era -> ScriptPurpose (Crypto era) -> - RdmrPtr -rdptr txb (Minting (PolicyID hash)) = RdmrPtr Mint (indexOf hash ((getField @"minted" txb) :: Set (ScriptHash (Crypto era)))) -rdptr txb (Spending txin) = RdmrPtr Spend (indexOf txin (getField @"inputs" txb)) -rdptr txb (Rewarding racnt) = RdmrPtr Rewrd (indexOf racnt (unWdrl (getField @"wdrls" txb))) -rdptr txb (Certifying d) = RdmrPtr Cert (indexOf d (getField @"certs" txb)) + StrictMaybe RdmrPtr +rdptr txb (Minting (PolicyID hash)) = RdmrPtr Mint <$> (indexOf hash ((getField @"minted" txb) :: Set (ScriptHash (Crypto era)))) +rdptr txb (Spending txin) = RdmrPtr Spend <$> (indexOf txin (getField @"inputs" txb)) +rdptr txb (Rewarding racnt) = RdmrPtr Rewrd <$> (indexOf racnt (unWdrl (getField @"wdrls" txb))) +rdptr txb (Certifying d) = RdmrPtr Cert <$> (indexOf d (getField @"certs" txb)) getMapFromValue :: Value crypto -> Map.Map (PolicyID crypto) (Map.Map AssetName Integer) getMapFromValue (Value _ m) = m @@ -523,10 +521,11 @@ indexedRdmrs :: Tx era -> ScriptPurpose (Crypto era) -> Maybe (Data era, ExUnits) -indexedRdmrs tx sp = Map.lookup rdptr' rdmrs - where - rdmrs = unRedeemers $ txrdmrs' . getField @"wits" $ tx - rdptr' = rdptr @era (getField @"body" tx) sp +indexedRdmrs tx sp = case rdptr @era (getField @"body" tx) sp of + SNothing -> Nothing + SJust policyid -> Map.lookup policyid rdmrs + where + rdmrs = unRedeemers $ txrdmrs' . getField @"wits" $ tx -- ======================================================= diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 0d7db6ce4e3..4001922af12 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -136,12 +136,12 @@ deriving stock instance ) => Eq (TxOut era) -instance - ( Show (Core.Value era) +deriving instance + ( Show (CompactAddr (Crypto era)), + Show (Core.Value era), + Show (CompactForm (Core.Value era)) ) => Show (TxOut era) - where - show = error "Not yet implemented" deriving via InspectHeapNamed "TxOut" (TxOut era) instance NoThunks (TxOut era) @@ -205,7 +205,11 @@ instance NoThunks (TxBodyRaw era) deriving instance - (Era era, Show (Core.Value era), Show (PParamsDelta era)) => + ( Era era, + Show (Core.Value era), + Show (PParamsDelta era), + Show (CompactAddr (Crypto era)) + ) => Show (TxBodyRaw era) newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era)) @@ -231,7 +235,8 @@ deriving instance ( Era era, Compactible (Core.Value era), Show (Core.Value era), - Show (PParamsDelta era) + Show (PParamsDelta era), + Show (CompactAddr (Crypto era)) ) => Show (TxBody era) @@ -475,7 +480,7 @@ encodeTxBodyRaw fromSJust :: StrictMaybe a -> a fromSJust (SJust x) = x - fromSJust SNothing = error "SNothing in fromSJust" + fromSJust SNothing = error "SNothing in fromSJust. This should never happen, it is guarded by isSNothing" instance forall era. diff --git a/alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs b/alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs index 52cf93f832e..5cfa76c4778 100644 --- a/alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs +++ b/alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs @@ -41,6 +41,7 @@ import Cardano.Ledger.Shelley.Constraints (UsesScript, UsesValue) import Data.Maybe (mapMaybe) import qualified Data.Set as Set import qualified Language.PlutusTx as Plutus +import Shelley.Spec.Ledger.CompactAddr (CompactAddr) import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators (genMintValues) import Test.QuickCheck import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock) @@ -231,7 +232,7 @@ instance Mock c => Arbitrary (UtxosPredicateFailure (AlonzoEra c)) where UpdateFailure <$> arbitrary ] -instance Mock c => Arbitrary (UtxoPredicateFailure (AlonzoEra c)) where +instance (Show (CompactAddr c), Mock c) => Arbitrary (UtxoPredicateFailure (AlonzoEra c)) where arbitrary = oneof [ (BadInputsUTxO) <$> arbitrary, @@ -253,7 +254,7 @@ instance Mock c => Arbitrary (UtxoPredicateFailure (AlonzoEra c)) where FeeContainsNonADA <$> arbitrary ] -instance Mock c => Arbitrary (AlonzoPredFail (AlonzoEra c)) where +instance (Show (CompactAddr c), Mock c) => Arbitrary (AlonzoPredFail (AlonzoEra c)) where arbitrary = oneof [ WrappedShelleyEraFailure <$> arbitrary, diff --git a/alonzo/impl/test/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs b/alonzo/impl/test/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs index 7656c39fad6..e7d6cf7db92 100644 --- a/alonzo/impl/test/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs +++ b/alonzo/impl/test/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs @@ -65,7 +65,7 @@ tripping :: (Eq src, Show src, ToCBOR src, FromCBOR src) => src -> Property tripping x = trippingF roundTrip x -- ========================== --- Catch errors in toolong bytestrings +-- Catch violations ofbytestrings that are toolong. toolong :: BS.ByteString toolong = "1234567890-=`~@#$%^&*()_+qwertyuiopQWERTYUIOPasdfghjklASDFGHJKLzxcvbnmZXCVBNM" diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs index a69e697e91d..c2c5d3236e3 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/API/Mempool.hs @@ -51,12 +51,11 @@ import Shelley.Spec.Ledger.PParams (PParams' (..)) import Shelley.Spec.Ledger.STS.Ledgers (LedgersEnv, LedgersPredicateFailure) import qualified Shelley.Spec.Ledger.STS.Ledgers as Ledgers import Shelley.Spec.Ledger.Slot (SlotNo) -import Shelley.Spec.Ledger.Tx (Tx) -- TODO #1304: add reapplyTxs class - ( ChainData (Tx era), - AnnotatedData (Tx era), + ( ChainData (Core.Tx era), + AnnotatedData (Core.Tx era), Eq (ApplyTxError era), Show (ApplyTxError era), Typeable (ApplyTxError era), @@ -65,7 +64,7 @@ class BaseM (Core.EraRule "LEDGERS" era) ~ ShelleyBase, Environment (Core.EraRule "LEDGERS" era) ~ LedgersEnv era, State (Core.EraRule "LEDGERS" era) ~ MempoolState era, - Signal (Core.EraRule "LEDGERS" era) ~ Seq (Tx era), + Signal (Core.EraRule "LEDGERS" era) ~ Seq (Core.Tx era), PredicateFailure (Core.EraRule "LEDGERS" era) ~ LedgersPredicateFailure era ) => ApplyTx era @@ -74,14 +73,14 @@ class MonadError (ApplyTxError era) m => Globals -> SlotNo -> - Seq (Tx era) -> + Seq (Core.Tx era) -> NewEpochState era -> m (NewEpochState era) default applyTxs :: (MonadError (ApplyTxError era) m) => Globals -> SlotNo -> - Seq (Tx era) -> + Seq (Core.Tx era) -> NewEpochState era -> m (NewEpochState era) applyTxs globals slot txs state = @@ -164,13 +163,13 @@ applyTxsTransition :: BaseM (Core.EraRule "LEDGERS" era) ~ ShelleyBase, Environment (Core.EraRule "LEDGERS" era) ~ LedgersEnv era, State (Core.EraRule "LEDGERS" era) ~ MempoolState era, - Signal (Core.EraRule "LEDGERS" era) ~ Seq (Tx era), + Signal (Core.EraRule "LEDGERS" era) ~ Seq (Core.Tx era), PredicateFailure (Core.EraRule "LEDGERS" era) ~ LedgersPredicateFailure era, MonadError (ApplyTxError era) m ) => Globals -> MempoolEnv era -> - Seq (Tx era) -> + Seq (Core.Tx era) -> MempoolState era -> m (MempoolState era) applyTxsTransition globals env txs state =