From 48beab8d8900654516a30df3774a1cd5fc8e2f69 Mon Sep 17 00:00:00 2001 From: Tim Sheard Date: Thu, 10 Dec 2020 14:31:12 -0800 Subject: [PATCH] Functionality for Alonzo scripts, and fixed Fast forward problem. Added operations on Scripts and TxBody in Aonzo. Mostly Figure 5 and 6 Also fixed the fast forward problem of merging the pretty printer on top of the change of TxBody to a type family. --- .../impl/src/Cardano/Ledger/Alonzo/PParams.hs | 2 +- .../impl/src/Cardano/Ledger/Alonzo/Scripts.hs | 54 ++++++++--- alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs | 89 ++++++++++++++++++- .../impl/src/Cardano/Ledger/Alonzo/TxBody.hs | 61 ++++++++----- .../Ledger/Alonzo/Serialisation/Generators.hs | 10 ++- .../ShelleyMA/Serialisation/Generators.hs | 15 ++-- .../src/Cardano/Ledger/Pretty.hs | 54 +++++------ 7 files changed, 203 insertions(+), 82 deletions(-) diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index e2e5f35c51c..0370239ac9f 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -36,7 +36,7 @@ import Cardano.Binary encodeWord, ) import qualified Cardano.Crypto.Hash as Hash -import Cardano.Ledger.Alonzo.Scripts +import Cardano.Ledger.Alonzo.Scripts (CostModel, ExUnits (..), Language, Prices (..)) import Cardano.Ledger.Crypto (HASH) import qualified Cardano.Ledger.Crypto as CC import Cardano.Ledger.Era diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs index 0ebb49cb825..4f4bc4f4829 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs @@ -1,11 +1,16 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Cardano.Ledger.Alonzo.Scripts ( Tag (..), - Script, + Script (..), ExUnits (..), CostModel, Language, @@ -14,12 +19,14 @@ module Cardano.Ledger.Alonzo.Scripts where import Cardano.Binary (FromCBOR (fromCBOR), ToCBOR (toCBOR)) +import qualified Cardano.Ledger.Crypto as CC (Crypto) import Cardano.Ledger.Era (Era (Crypto)) import Cardano.Ledger.ShelleyMA.Timelocks import Control.DeepSeq (NFData (..)) import Data.ByteString (ByteString) import Data.Coders import Data.Map (Map) +import Data.Typeable import Data.Word (Word64) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) @@ -29,22 +36,27 @@ import Shelley.Spec.Ledger.Coin (Coin (..)) -- as a validator. data Tag = -- | Validates spending a script-locked UTxO - Input + Spend | -- | Validates minting new tokens Mint | -- | Validates certificate transactions Cert | -- | Validates withdrawl from a reward account - Wdrl + Rewrd deriving (Eq, Generic, Ord, Show) instance NoThunks Tag --- TODO Extend this to include Plutus scripts (CAD-1908) --- data Script era --- = NativeScript (Timelock era) --- | NonNativeScript -type Script era = Timelock (Crypto era) +data Script era + = NativeScript (Timelock (Crypto era)) + | PlutusScript + deriving (Eq, Show, Generic, Ord) + +instance Typeable (Crypto era) => NoThunks (Script era) + +instance NFData (Script era) + +-- type Script era = Timelock (Crypto era) -- | Arbitrary execution unit in which we measure the cost of scripts. data ExUnits = ExUnits @@ -105,18 +117,18 @@ instance NFData Prices instance ToCBOR Tag where toCBOR = encode . encodeTag where - encodeTag Input = Sum Input 0 + encodeTag Spend = Sum Spend 0 encodeTag Mint = Sum Mint 1 encodeTag Cert = Sum Cert 2 - encodeTag Wdrl = Sum Wdrl 3 + encodeTag Rewrd = Sum Rewrd 3 instance FromCBOR Tag where fromCBOR = decode $ Summands "Tag" decodeTag where - decodeTag 0 = SumD Input + decodeTag 0 = SumD Spend decodeTag 1 = SumD Mint decodeTag 2 = SumD Cert - decodeTag 3 = SumD Wdrl + decodeTag 3 = SumD Rewrd decodeTag n = Invalid n instance ToCBOR ExUnits where @@ -130,3 +142,21 @@ instance ToCBOR Prices where instance FromCBOR Prices where fromCBOR = decode $ RecD Prices ToCBOR (Script era) where + toCBOR x = encode (encodeScript x) + where + encodeScript :: Script era -> Encode 'Open (Script era) + encodeScript (NativeScript i) = Sum NativeScript 0 !> To i + encodeScript PlutusScript = Sum PlutusScript 1 + +instance + (CC.Crypto (Crypto era), Typeable (Crypto era), Typeable era) => + FromCBOR (Annotator (Script era)) + where + fromCBOR = decode (Summands "Alonzo Script" decodeScript) + where + decodeScript :: Word -> Decode 'Open (Annotator (Script era)) + decodeScript 0 = Ann (SumD NativeScript) <*! From + decodeScript 1 = Ann (SumD PlutusScript) + decodeScript n = Invalid n diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs index bfc8f4e2afd..6f9c5b99900 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Tx.hs @@ -5,30 +5,51 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} module Cardano.Ledger.Alonzo.Tx ( IsValidating (..), Tx (Tx, body, wits, isValidating, auxiliaryData), + ScriptPurpose (..), + Indexable (..), + txrdmrs, + rdptr, + getMapFromValue, + indexedRdmrs, ) where import Cardano.Binary (FromCBOR (..), ToCBOR (..)) -import Cardano.Ledger.Alonzo.TxBody (TxBody) -import Cardano.Ledger.Alonzo.TxWitness (TxWitness) +import Cardano.Ledger.Alonzo.Data (Data) +import qualified Cardano.Ledger.Alonzo.Scripts as AlonzoScript (Tag (..)) +import Cardano.Ledger.Alonzo.TxBody (AlonzoBody, TxBody (..), TxIn) +import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (..), TxWitness (..)) import Cardano.Ledger.Compactible import qualified Cardano.Ledger.Core as Core -import Cardano.Ledger.Era (Era) +import Cardano.Ledger.Era (Crypto, Era) +import Cardano.Ledger.Mary.Value (AssetName, PolicyID, Value (..)) import Cardano.Ledger.Val (DecodeMint, DecodeNonNegative, Val) import Data.Coders +import qualified Data.Map as Map import Data.MemoBytes (Mem, MemoBytes (Memo), memoBytes) +import Data.Sequence.Strict (StrictSeq) +import qualified Data.Sequence.Strict as StrictSeq +import qualified Data.Set as Set import Data.Typeable (Typeable) +import Data.Word (Word64) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) +import Shelley.Spec.Ledger.Address (RewardAcnt) import Shelley.Spec.Ledger.BaseTypes (StrictMaybe, maybeToStrictMaybe, strictMaybeToMaybe) +import Shelley.Spec.Ledger.Delegation.Certificates (DCert) +import Shelley.Spec.Ledger.TxBody (Wdrl (..), unWdrl) + +-- =================================================== -- | Tag indicating whether non-native scripts in this transaction are expected -- to validate. This is added by the block creator when constructing the block. @@ -182,3 +203,65 @@ deriving via Val (Core.Value era) ) => FromCBOR (Annotator (Tx era)) + +-- =========================================== +-- Operations on scripts from specification +-- Figure 6:Indexing script and data objects + +data ScriptPurpose crypto + = Minting !(PolicyID crypto) + | Spending !(TxIn crypto) + | Rewarding !(RewardAcnt crypto) -- Not sure if this is the right type. + | Certifying !(DCert crypto) + +class Indexable elem container where + indexOf :: elem -> container -> Word64 + atIndex :: Word64 -> container -> elem + +instance Ord k => Indexable k (Set.Set k) where + indexOf n set = fromIntegral $ Set.findIndex n set + atIndex i set = Set.elemAt (fromIntegral i) set + +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) + +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 + +rdptr :: + AlonzoBody era => + TxBody era -> + ScriptPurpose (Crypto era) -> + RdmrPtr +rdptr txbody (Minting pid) = RdmrPtr AlonzoScript.Mint (indexOf pid (getMapFromValue (mint txbody))) +rdptr txbody (Spending txin) = RdmrPtr AlonzoScript.Spend (indexOf txin (inputs txbody)) +rdptr txbody (Rewarding racnt) = RdmrPtr AlonzoScript.Rewrd (indexOf racnt (unWdrl (wdrls txbody))) +rdptr txbody (Certifying d) = RdmrPtr AlonzoScript.Cert (indexOf d (certs txbody)) + +getMapFromValue :: Value crypto -> Map.Map (PolicyID crypto) (Map.Map AssetName Integer) +getMapFromValue (Value _ m) = m + +txrdmrs :: + (Era era, ToCBOR (Core.Script era)) => + TxWitness era -> + Map.Map RdmrPtr (Data era) +txrdmrs (TxWitness {witsRdmr = m}) = m + +indexedRdmrs :: + ( Era era, + ToCBOR (Core.AuxiliaryData era), + ToCBOR (Core.Script era), + ToCBOR (CompactForm (Core.Value era)) + ) => + Tx era -> + ScriptPurpose (Crypto era) -> + Maybe (Data era) +indexedRdmrs tx sp = Map.lookup policyid (txrdmrs . wits $ tx) + where + policyid = rdptr (body tx) sp diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index 141b91e4378..5f7725b7f90 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} @@ -34,6 +35,9 @@ module Cardano.Ledger.Alonzo.TxBody ppHash, scriptHash ), + AlonzoBody, + txins, + txinputs_fee, ) where @@ -47,13 +51,10 @@ import Cardano.Ledger.Compactible import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CC import Cardano.Ledger.Era (Crypto, Era) -import Cardano.Ledger.Mary.Value (Value) +import Cardano.Ledger.Mary.Value (Value (..)) import Cardano.Ledger.ShelleyMA.Timelocks (ValidityInterval (..)) import Cardano.Ledger.Val - ( DecodeMint, - DecodeNonNegative, - EncodeMint, - Val, + ( DecodeNonNegative, decodeMint, decodeNonNegative, encodeMint, @@ -66,6 +67,7 @@ import Data.MemoBytes (Mem, MemoBytes (..), memoBytes) import Data.Sequence.Strict (StrictSeq) import qualified Data.Sequence.Strict as StrictSeq import Data.Set (Set) +import qualified Data.Set as Set import Data.Typeable (Typeable) import Data.Word (Word64) import GHC.Generics (Generic) @@ -79,6 +81,7 @@ import Shelley.Spec.Ledger.Delegation.Certificates (DCert) import Shelley.Spec.Ledger.Hashing import Shelley.Spec.Ledger.PParams (Update) import Shelley.Spec.Ledger.TxBody (TxId, Wdrl (Wdrl), unWdrl) +import Prelude hiding (lookup) -- | Tag indicating whether an input should be used to pay transaction fees. -- This is used to prevent the entirety of a script's inputs being used for fees @@ -129,7 +132,7 @@ deriving stock instance Eq (TxOut era) instance - ( Show (Value era), + ( Show (Core.Value era), Show (CompactForm (Core.Value era)) ) => Show (TxOut era) @@ -170,7 +173,10 @@ data TxBodyRaw era = TxBodyRaw _vldt :: !ValidityInterval, _update :: !(StrictMaybe (Update era)), _adHash :: !(StrictMaybe (AuxiliaryDataHash (Crypto era))), - _mint :: !(Core.Value era), + _mint :: !(Value (Crypto era)), + -- The spec makes it clear that the mint field is a + -- Cardano.Ledger.Mary.Value.Value, not a Core.Value. + -- Operations on the TxBody in the AlonzoEra depend upon this. _exunits :: !ExUnits, _ppHash :: !(StrictMaybe (PPHash (Crypto era))), _scriptHash :: !(StrictMaybe (ScriptDataHash (Crypto era))) @@ -179,6 +185,7 @@ data TxBodyRaw era = TxBodyRaw deriving instance ( Eq (Core.Value era), + CC.Crypto (Crypto era), Eq (CompactForm (Core.Value era)) ) => Eq (TxBodyRaw era) @@ -196,7 +203,8 @@ newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era)) deriving newtype instance ( Eq (Core.Value era), - Eq (CompactForm (Core.Value era)) + Eq (CompactForm (Core.Value era)), + CC.Crypto (Crypto era) ) => Eq (TxBody era) @@ -218,23 +226,22 @@ deriving via ( Era era, Typeable (Core.Script era), Typeable (Core.AuxiliaryData era), - Val (Core.Value era), Compactible (Core.Value era), Show (Core.Value era), DecodeNonNegative (Core.Value era), - DecodeMint (Core.Value era), FromCBOR (Annotator (Core.Script era)) ) => FromCBOR (Annotator (TxBody era)) -pattern TxBody :: +-- The Set of constraints necessary to use the TxBody pattern +type AlonzoBody era = ( Era era, - Typeable (Core.AuxiliaryData era), ToCBOR (CompactForm (Core.Value era)), - ToCBOR (Core.Script era), - EncodeMint (Core.Value era), - Val (Core.Value era) - ) => + ToCBOR (Core.Script era) + ) + +pattern TxBody :: + AlonzoBody era => Set (TxIn (Crypto era)) -> StrictSeq (TxOut era) -> StrictSeq (DCert (Crypto era)) -> @@ -243,7 +250,7 @@ pattern TxBody :: ValidityInterval -> StrictMaybe (Update era) -> StrictMaybe (AuxiliaryDataHash (Crypto era)) -> - Core.Value era -> + Value (Crypto era) -> ExUnits -> StrictMaybe (PPHash (Crypto era)) -> StrictMaybe (ScriptDataHash (Crypto era)) -> @@ -362,8 +369,6 @@ instance encodeTxBodyRaw :: ( Era era, - EncodeMint (Core.Value era), - Val (Core.Value era), ToCBOR (CompactForm (Core.Value era)) ) => TxBodyRaw era -> @@ -417,11 +422,9 @@ instance ( Era era, Typeable (Core.Script era), Typeable (Core.AuxiliaryData era), - Val (Core.Value era), Compactible (Core.Value era), Show (Core.Value era), DecodeNonNegative (Core.Value era), - DecodeMint (Core.Value era), FromCBOR (Annotator (Core.Script era)) ) => FromCBOR (TxBodyRaw era) @@ -485,13 +488,25 @@ instance ( Era era, Typeable (Core.Script era), Typeable (Core.AuxiliaryData era), - Val (Core.Value era), Compactible (Core.Value era), Show (Core.Value era), DecodeNonNegative (Core.Value era), - DecodeMint (Core.Value era), FromCBOR (Annotator (Core.Script era)) ) => FromCBOR (Annotator (TxBodyRaw era)) where fromCBOR = pure <$> fromCBOR + +-- ============================================================ +-- From the specification, Figure 5 "Functions related to fees" + +txins :: AlonzoBody era => TxBody era -> Set (TxId (Crypto era), Word64) +txins (TxBody {inputs = is}) = Set.foldl' accum Set.empty is + where + accum ans (TxInCompact idx index _) = Set.insert (idx, index) ans + +txinputs_fee :: AlonzoBody era => TxBody era -> Set (TxId (Crypto era), Word64) +txinputs_fee (TxBody {inputs = is}) = Set.foldl' accum Set.empty is + where + accum ans (TxInCompact idx index (IsFee True)) = Set.insert (idx, index) ans + accum ans _ = ans 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 ff26ccf0662..9e270c7faef 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 @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} @@ -14,7 +15,7 @@ module Test.Cardano.Ledger.Alonzo.Serialisation.Generators where import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Data (Data (..), DataHash (..)) import Cardano.Ledger.Alonzo.PParams (PPHash (..)) -import Cardano.Ledger.Alonzo.Scripts +import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Script (..), Tag (..)) import Cardano.Ledger.Alonzo.Tx import Cardano.Ledger.Alonzo.TxBody ( IsFee (..), @@ -37,7 +38,7 @@ instance Arbitrary (Data era) where arbitrary = pure NotReallyData instance Arbitrary Tag where - arbitrary = elements [Input, Mint, Cert, Wdrl] + arbitrary = elements [Spend, Mint, Cert, Rewrd] instance Arbitrary RdmrPtr where arbitrary = RdmrPtr <$> arbitrary <*> arbitrary @@ -117,10 +118,13 @@ instance deriving newtype instance Arbitrary IsValidating -instance (Mock c) => Arbitrary (Tx (AlonzoEra c)) where +instance Mock c => Arbitrary (Tx (AlonzoEra c)) where arbitrary = Tx <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary + +instance Mock c => Arbitrary (Script (AlonzoEra c)) where + arbitrary = frequency [(1, pure PlutusScript), (9, NativeScript <$> arbitrary)] diff --git a/shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs b/shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs index 52be908ce21..6c51374c937 100644 --- a/shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs +++ b/shelley-ma/shelley-ma-test/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Generators.hs @@ -25,7 +25,7 @@ module Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ) where -import Cardano.Binary (toCBOR) +import Cardano.Binary (ToCBOR(toCBOR),FromCBOR,Annotator) import Cardano.Crypto.Hash (HashAlgorithm, hashWithSerialiser) import qualified Cardano.Crypto.Hash as Hash import Cardano.Ledger.Allegra (AllegraEra) @@ -113,12 +113,14 @@ sizedTimelock n = ] -- TODO Generate metadata with script preimages -instance +instance forall era c. ( Era era, c ~ Crypto era, Mock c, - Arbitrary (Timelock c), - Core.Script era ~ Timelock c + FromCBOR (Annotator (Core.Script era)), + ToCBOR (Core.Script era), + Ord(Core.Script era), + Arbitrary (Core.Script era) ) => Arbitrary (MA.AuxiliaryData era) where @@ -135,11 +137,10 @@ instance -- in an unsatisfied `MonadFail` constraint. arbitrary = genMetadata' >>= \case - Metadata m -> MA.AuxiliaryData m <$> genScriptSeq + Metadata m -> MA.AuxiliaryData m <$> (genScriptSeq @era) genScriptSeq :: - (Arbitrary (Timelock c)) => - Gen (StrictSeq (Timelock c)) + forall era. Arbitrary (Core.Script era) => Gen(StrictSeq (Core.Script era)) genScriptSeq = do n <- choose (0, 3) l <- vectorOf n arbitrary diff --git a/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs b/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs index 27cf8c76854..5a3a7418e7c 100644 --- a/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs +++ b/shelley/chain-and-ledger/executable-spec/src/Cardano/Ledger/Pretty.hs @@ -9,7 +9,6 @@ module Cardano.Ledger.Pretty where -import Cardano.Binary (ToCBOR) import Cardano.Chain.Common ( AddrAttributes (..), Address (..), @@ -31,6 +30,7 @@ import qualified Data.ByteString as Long (ByteString) import qualified Data.ByteString.Lazy as Lazy (ByteString, toStrict) import Data.IP (IPv4, IPv6) import qualified Data.Map.Strict as Map (Map, toList) +import Data.MemoBytes (MemoBytes (..)) import Data.Proxy (Proxy (..)) import Data.Sequence.Strict (StrictSeq) import Data.Set (Set, toList) @@ -134,6 +134,7 @@ import Shelley.Spec.Ledger.TxBody StakeCreds (..), StakePoolRelay (..), TxBody (..), + TxBodyRaw (..), TxId (..), TxIn (..), TxOut (..), @@ -398,10 +399,7 @@ ppRewardUpdate (RewardUpdate dt dr rss df nonmyop) = ] ppUTxOState :: - ( Era era, - PrettyA (Core.Value era), - Compactible (Core.Value era) - ) => + PrettyA (Core.TxOut era) => UTxOState era -> PDoc ppUTxOState (UTxOState u dep fee ppup) = @@ -413,7 +411,7 @@ ppUTxOState (UTxOState u dep fee ppup) = ("ppups", ppPPUPState ppup) ] -ppEpochState :: (Era era, PrettyA (Core.Value era), Compactible (Core.Value era)) => EpochState era -> PDoc +ppEpochState :: PrettyA (Core.TxOut era) => EpochState era -> PDoc ppEpochState (EpochState acnt snap ls prev pp non) = ppRecord "EpochState" @@ -425,7 +423,7 @@ ppEpochState (EpochState acnt snap ls prev pp non) = ("nonMyopic", ppNonMyopic non) ] -ppLedgerState :: (Era era, PrettyA (Core.Value era), Compactible (Core.Value era)) => LedgerState era -> PDoc +ppLedgerState :: PrettyA (Core.TxOut era) => LedgerState era -> PDoc ppLedgerState (LedgerState u d) = ppRecord "LedgerState" @@ -440,7 +438,9 @@ instance PrettyA (DPState crypto) where prettyA = ppDPState instance PrettyA (DState crypto) where prettyA = ppDState instance - (Era era, PrettyA (Core.Value era), Compactible (Core.Value era)) => + ( Era era, + PrettyA (Core.TxOut era) + ) => PrettyA (EpochState era) where prettyA = ppEpochState @@ -450,7 +450,9 @@ instance PrettyA (FutureGenDeleg crypto) where prettyA = ppFutureGenDeleg instance PrettyA (InstantaneousRewards crypto) where prettyA = ppInstantaneousRewards instance - (Era era, PrettyA (Core.Value era), Compactible (Core.Value era)) => + ( Era era, + PrettyA (Core.TxOut era) + ) => PrettyA (LedgerState era) where prettyA = ppLedgerState @@ -462,7 +464,9 @@ instance PrettyA (PState crypto) where prettyA = ppPState instance PrettyA (RewardUpdate crypto) where prettyA = ppRewardUpdate instance - (Era era, PrettyA (Core.Value era), Compactible (Core.Value era)) => + ( Era era, + PrettyA (Core.TxOut era) + ) => PrettyA (UTxOState era) where prettyA = ppUTxOState @@ -543,19 +547,13 @@ instance PrettyA (SnapShots crypto) where prettyA = ppSnapShots -- Shelley.Spec.Ledger.UTxO ppUTxO :: - ( Era era, - PrettyA (Core.Value era), - Compactible (Core.Value era) - ) => + PrettyA (Core.TxOut era) => UTxO era -> PDoc -ppUTxO (UTxO m) = ppMap' (text "UTxO") ppTxIn ppTxOut m +ppUTxO (UTxO m) = ppMap' (text "UTxO") ppTxIn prettyA m instance - ( Era era, - PrettyA (Core.Value era), - Compactible (Core.Value era) - ) => + PrettyA (Core.TxOut era) => PrettyA (UTxO era) where prettyA = ppUTxO @@ -726,19 +724,14 @@ ppDCert (DCertGenesis x) = ppSexp "DCertGenesis" [ppGenesisDelegCert x] ppDCert (DCertMir x) = ppSexp "DCertMir" [ppMIRCert x] ppTxBody :: - ( Era era, - ToCBOR (Core.Value era), - PrettyA (Core.Value era), - ToCBOR (CompactForm (Core.Value era)), - Compactible (Core.Value era) - ) => + PrettyA (Core.TxOut era) => TxBody era -> PDoc -ppTxBody (TxBody ins outs cs wdrls fee ttl upd mdh) = +ppTxBody (TxBodyConstr (Memo (TxBodyRaw ins outs cs wdrls fee ttl upd mdh) _)) = ppRecord "TxBody" [ ("inputs", ppSet ppTxIn ins), - ("outputs", ppStrictSeq ppTxOut outs), + ("outputs", ppStrictSeq prettyA outs), ("cert", ppStrictSeq ppDCert cs), ("wdrls", ppWdrl wdrls), ("fee", ppCoin fee), @@ -782,12 +775,7 @@ instance PrettyA (MIRCert c) where prettyA = ppMIRCert instance PrettyA (DCert c) where prettyA = ppDCert instance - ( Era era, - ToCBOR (Core.Value era), - PrettyA (Core.Value era), - ToCBOR (CompactForm (Core.Value era)), - Compactible (Core.Value era) - ) => + PrettyA (Core.TxOut era) => PrettyA (TxBody era) where prettyA = ppTxBody