From b765575f51d6eaf3af296bede89a6bafd4d8e93c Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Fri, 14 Jan 2022 06:33:12 +0300 Subject: [PATCH] Improve performance of getting `Addr` and `CompactAddr` from `TxOut` --- eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs | 10 +- .../impl/src/Cardano/Ledger/Alonzo/TxBody.hs | 157 +++++++++--------- .../impl/src/Cardano/Ledger/ShelleyMA.hs | 4 +- .../shelley/impl/cardano-ledger-shelley.cabal | 1 - .../impl/src/Cardano/Ledger/Shelley.hs | 4 +- .../Ledger/Shelley/API/ByronTranslation.hs | 2 +- .../src/Cardano/Ledger/Shelley/API/Wallet.hs | 21 ++- .../src/Cardano/Ledger/Shelley/CompactAddr.hs | 6 + .../src/Cardano/Ledger/Shelley/Constraints.hs | 7 +- .../Cardano/Ledger/Shelley/Rules/Ledger.hs | 2 - .../impl/src/Cardano/Ledger/Shelley/TxBody.hs | 20 +-- .../test-suite/bench/BenchUTxOAggregate.hs | 2 +- .../Ledger/Shelley/Address/CompactAddr.hs | 2 +- .../cardano-ledger-core.cabal | 1 + .../src/Cardano/Ledger/CompactAddress.hs | 4 +- .../src/Cardano/Ledger/Era.hs | 24 ++- .../src/Cardano/Ledger/Pretty.hs | 2 +- .../Bench/Cardano/Ledger/EpochBoundary.hs | 2 +- .../src/Cardano/Ledger/State/Query.hs | 11 +- 19 files changed, 144 insertions(+), 138 deletions(-) create mode 100644 eras/shelley/impl/src/Cardano/Ledger/Shelley/CompactAddr.hs diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs index 657e1817573..804273cc2af 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs @@ -38,7 +38,7 @@ import qualified Cardano.Ledger.Alonzo.Rules.Utxos as Alonzo (UTXOS) import qualified Cardano.Ledger.Alonzo.Rules.Utxow as Alonzo (AlonzoUTXOW) import Cardano.Ledger.Alonzo.Scripts (Script (..), isPlutusScript) import Cardano.Ledger.Alonzo.Tx (ValidatedTx (..), minfee) -import Cardano.Ledger.Alonzo.TxBody (TxBody, TxOut (..)) +import Cardano.Ledger.Alonzo.TxBody (TxBody, TxOut (TxOut), getAlonzoTxOutEitherAddr) import Cardano.Ledger.Alonzo.TxInfo (validScript) import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq (..), hashTxSeq) import Cardano.Ledger.Alonzo.TxWitness (TxWitness (..)) @@ -51,9 +51,7 @@ import qualified Cardano.Ledger.Era as EraModule import Cardano.Ledger.Keys (GenDelegs (GenDelegs)) import qualified Cardano.Ledger.Mary.Value as V (Value) import Cardano.Ledger.PoolDistr (PoolDistr (..)) -import Cardano.Ledger.Rules.ValidationMode - ( applySTSNonStatic, - ) +import Cardano.Ledger.Rules.ValidationMode (applySTSNonStatic) import Cardano.Ledger.SafeHash (hashAnnotated) import Cardano.Ledger.Shelley (nativeMultiSigTag) import qualified Cardano.Ledger.Shelley.API as API @@ -109,6 +107,8 @@ instance where type Crypto (AlonzoEra c) = c + getTxOutEitherAddr = getAlonzoTxOutEitherAddr + instance API.PraosCrypto c => API.ApplyTx (AlonzoEra c) where reapplyTx globals env state vtx = let res = @@ -177,7 +177,7 @@ instance genDelegs = sgGenDelegs sg pp = sgProtocolParams sg -instance (CC.Crypto c) => UsesTxOut (AlonzoEra c) where +instance CC.Crypto c => UsesTxOut (AlonzoEra c) where makeTxOut _proxy addr val = TxOut addr val SNothing instance CC.Crypto c => API.CLI (AlonzoEra c) where diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs index bab38f1256d..ae37e7d3668 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs @@ -18,10 +18,10 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wno-redundant-constraints #-} module Cardano.Ledger.Alonzo.TxBody ( TxOut (.., TxOut, TxOutCompact, TxOutCompactDH), + Addr28Extra, TxBody ( TxBody, inputs, @@ -54,6 +54,7 @@ module Cardano.Ledger.Alonzo.TxBody AlonzoBody, EraIndependentScriptIntegrity, ScriptIntegrityHash, + getAlonzoTxOutEitherAddr, ) where @@ -74,12 +75,13 @@ import Cardano.Ledger.BaseTypes isSNothing, ) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.CompactAddress (CompactAddr, compactAddr, decompactAddr) import Cardano.Ledger.Compactible import Cardano.Ledger.Core (PParamsDelta) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (Credential (..), PaymentCredential, StakeReference (..)) import qualified Cardano.Ledger.Crypto as CC -import Cardano.Ledger.Era (Crypto, Era) +import Cardano.Ledger.Era (Era (Crypto)) import Cardano.Ledger.Hashes ( EraIndependentScriptIntegrity, EraIndependentTxBody, @@ -94,7 +96,6 @@ import Cardano.Ledger.SafeHash extractHash, unsafeMakeSafeHash, ) -import Cardano.Ledger.Shelley.CompactAddr (CompactAddr, compactAddr, decompactAddr) import Cardano.Ledger.Shelley.Delegation.Certificates (DCert) import Cardano.Ledger.Shelley.PParams (Update) import Cardano.Ledger.Shelley.Scripts (ScriptHash (..)) @@ -130,6 +131,14 @@ import GHC.TypeLits import NoThunks.Class (InspectHeapNamed (..), NoThunks) import Prelude hiding (lookup) +data Addr28Extra + = Addr28Extra + {-# UNPACK #-} !Word64 -- Payment Addr + {-# UNPACK #-} !Word64 -- Payment Addr + {-# UNPACK #-} !Word64 -- Payment Addr + {-# UNPACK #-} !Word64 -- Payment Addr (32bits) + ... + 0/1 for Testnet/Mainnet + 0/1 Script/Pubkey + deriving (Eq) + data TxOut era = TxOutCompact' {-# UNPACK #-} !(CompactAddr (Crypto era)) @@ -140,17 +149,11 @@ data TxOut era !(DataHash (Crypto era)) | TxOut_AddrHash28_AdaOnly !(Credential 'Staking (Crypto era)) - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr (32bits) + ... + 0/1 for Testnet/Mainnet + 0/1 Script/Pubkey + {-# UNPACK #-} !Addr28Extra {-# UNPACK #-} !(CompactForm Coin) -- Ada value | TxOut_AddrHash28_AdaOnly_DataHash32 !(Credential 'Staking (Crypto era)) - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr - {-# UNPACK #-} !Word64 -- Payment Addr (32bits) + ... + 0/1 for Testnet/Mainnet + 0/1 Script/Pubkey + {-# UNPACK #-} !Addr28Extra {-# UNPACK #-} !(CompactForm Coin) -- Ada value {-# UNPACK #-} !Word64 -- DataHash {-# UNPACK #-} !Word64 -- DataHash @@ -179,27 +182,22 @@ getAdaOnly _ v = do decodeAddress28 :: forall crypto. - ( SizeHash (CC.ADDRHASH crypto) ~ 28, - HashAlgorithm (CC.ADDRHASH crypto) - ) => + HashAlgorithm (CC.ADDRHASH crypto) => Credential 'Staking crypto -> - Word64 -> - Word64 -> - Word64 -> - Word64 -> - Addr crypto -decodeAddress28 stakeRef a b c d = - Addr network paymentCred (StakeRefBase stakeRef) - where - network = if d `testBit` 1 then Mainnet else Testnet - paymentCred = - if d `testBit` 0 - then KeyHashObj (KeyHash addrHash) - else ScriptHashObj (ScriptHash addrHash) - addrHash :: Hash (CC.ADDRHASH crypto) a - addrHash = - hashFromPackedBytes $ - PackedBytes28 a b c (fromIntegral (d `shiftR` 32)) + Addr28Extra -> + Maybe (Addr crypto) +decodeAddress28 stakeRef (Addr28Extra a b c d) = do + Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH crypto))) (Proxy @28) + let network = if d `testBit` 1 then Mainnet else Testnet + paymentCred = + if d `testBit` 0 + then KeyHashObj (KeyHash addrHash) + else ScriptHashObj (ScriptHash addrHash) + addrHash :: Hash (CC.ADDRHASH crypto) a + addrHash = + hashFromPackedBytes $ + PackedBytes28 a b c (fromIntegral (d `shiftR` 32)) + pure $ Addr network paymentCred (StakeRefBase stakeRef) encodeAddress28 :: forall crypto. @@ -207,7 +205,7 @@ encodeAddress28 :: ) => Network -> PaymentCredential crypto -> - Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Word64, Word64, Word64, Word64) + Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Addr28Extra) encodeAddress28 network paymentCred = do let networkBit, payCredTypeBit :: Word64 networkBit = @@ -220,12 +218,13 @@ encodeAddress28 network paymentCred = do ScriptHashObj {} -> 0 encodeAddr :: Hash (CC.ADDRHASH crypto) a -> - Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Word64, Word64, Word64, Word64) + Maybe (SizeHash (CC.ADDRHASH crypto) :~: 28, Addr28Extra) encodeAddr h = do refl@Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH crypto))) (Proxy @28) case hashToPackedBytes h of PackedBytes28 a b c d -> - Just (refl, a, b, c, (fromIntegral d `shiftL` 32) .|. networkBit .|. payCredTypeBit) + let d' = (fromIntegral d `shiftL` 32) .|. networkBit .|. payCredTypeBit + in Just (refl, Addr28Extra a b c d') _ -> Nothing case paymentCred of KeyHashObj (KeyHash addrHash) -> encodeAddr addrHash @@ -233,9 +232,7 @@ encodeAddress28 network paymentCred = do decodeDataHash32 :: forall crypto. - ( SizeHash (CC.HASH crypto) ~ 32, - HashAlgorithm (CC.HASH crypto) - ) => + (SizeHash (CC.HASH crypto) ~ 32) => Word64 -> Word64 -> Word64 -> @@ -265,17 +262,16 @@ viewCompactTxOut :: viewCompactTxOut txOut = case txOut of TxOutCompact' addr val -> (addr, val, SNothing) TxOutCompactDH' addr val dh -> (addr, val, SJust dh) - TxOut_AddrHash28_AdaOnly stakeRef a b c d adaVal - | Just Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH (Crypto era)))) (Proxy @28) -> - (compactAddr (decodeAddress28 stakeRef a b c d), toCompactValue adaVal, SNothing) - TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef a b c d adaVal e f g h - | Just Refl <- sameNat (Proxy @(SizeHash (CC.HASH (Crypto era)))) (Proxy @32), - Just Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH (Crypto era)))) (Proxy @28) -> - ( compactAddr (decodeAddress28 stakeRef a b c d), - toCompactValue adaVal, - SJust (decodeDataHash32 e f g h) - ) - _ -> error "Impossible: Compacted and address or hash of non-standard size" + TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal + | Just addr <- decodeAddress28 stakeRef addr28Extra -> + (compactAddr addr, toCompactValue adaVal, SNothing) + | otherwise -> error "Impossible: Compacted and address or hash of non-standard size" + TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal e f g h + | Just addr <- decodeAddress28 stakeRef addr28Extra, + Just Refl <- sameNat (Proxy @(SizeHash (CC.HASH (Crypto era)))) (Proxy @32) -> + (compactAddr addr, toCompactValue adaVal, SJust (decodeDataHash32 e f g h)) + | otherwise -> + error "Impossible: Compacted and address or hash of non-standard size" where toCompactValue :: CompactForm Coin -> CompactForm (Core.Value era) toCompactValue ada = @@ -297,14 +293,17 @@ viewTxOut (TxOutCompactDH' bs c dh) = (addr, val, SJust dh) where addr = decompactAddr bs val = fromCompact c -viewTxOut (TxOut_AddrHash28_AdaOnly stakeRef a b c d adaVal) - | Just Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH (Crypto era)))) (Proxy @28) = - (decodeAddress28 stakeRef a b c d, inject (fromCompact adaVal), SNothing) -viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef a b c d adaVal e f g h) - | Just Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH (Crypto era)))) (Proxy @28), +viewTxOut (TxOut_AddrHash28_AdaOnly stakeRef addr28Extra adaVal) + | Just addr <- decodeAddress28 stakeRef addr28Extra = + (addr, inject (fromCompact adaVal), SNothing) +viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra adaVal e f g h) + | Just addr <- decodeAddress28 stakeRef addr28Extra, Just Refl <- sameNat (Proxy @(SizeHash (CC.HASH (Crypto era)))) (Proxy @32) = - (decodeAddress28 stakeRef a b c d, inject (fromCompact adaVal), SJust (decodeDataHash32 e f g h)) -viewTxOut _ = error "Impossible: Compacted and address or hash of non-standard size" + (addr, inject (fromCompact adaVal), SJust (decodeDataHash32 e f g h)) +viewTxOut (TxOut_AddrHash28_AdaOnly {}) = + error "Impossible: Compacted and address or hash of non-standard size" +viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 {}) = + error "Impossible: Compacted and address or hash of non-standard size" instance ( Era era, @@ -334,14 +333,14 @@ pattern TxOut addr vl dh <- TxOut (Addr network paymentCred stakeRef) vl SNothing | StakeRefBase stakeCred <- stakeRef, Just adaCompact <- getAdaOnly (Proxy @era) vl, - Just (Refl, a, b, c, d) <- encodeAddress28 network paymentCred = - TxOut_AddrHash28_AdaOnly stakeCred a b c d adaCompact + Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred = + TxOut_AddrHash28_AdaOnly stakeCred addr28Extra adaCompact TxOut (Addr network paymentCred stakeRef) vl (SJust dh) | StakeRefBase stakeCred <- stakeRef, Just adaCompact <- getAdaOnly (Proxy @era) vl, - Just (Refl, a, b, c, d) <- encodeAddress28 network paymentCred, + Just (Refl, addr28Extra) <- encodeAddress28 network paymentCred, Just (Refl, e, f, g, h) <- encodeDataHash32 dh = - TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred a b c d adaCompact e f g h + TxOut_AddrHash28_AdaOnly_DataHash32 stakeCred addr28Extra adaCompact e f g h TxOut addr vl mdh = let v = fromMaybe (error "Illegal value in txout") $ toCompact vl a = compactAddr addr @@ -427,13 +426,7 @@ newtype TxBody era = TxBodyConstr (MemoBytes (TxBodyRaw era)) deriving (ToCBOR) deriving newtype (SafeToHash) -deriving newtype instance - ( Eq (Core.Value era), - Compactible (Core.Value era), - CC.Crypto (Crypto era), - Eq (PParamsDelta era) - ) => - Eq (TxBody era) +deriving newtype instance CC.Crypto (Crypto era) => Eq (TxBody era) deriving instance ( Typeable era, @@ -648,10 +641,10 @@ instance fromSharedCBOR credsInterns = do lenOrIndef <- decodeListLenOrIndef let internTxOut = \case - TxOut_AddrHash28_AdaOnly cred a b c d ada -> - TxOut_AddrHash28_AdaOnly (interns credsInterns cred) a b c d ada - TxOut_AddrHash28_AdaOnly_DataHash32 cred a b c d ada e f g h -> - TxOut_AddrHash28_AdaOnly_DataHash32 (interns credsInterns cred) a b c d ada e f g h + TxOut_AddrHash28_AdaOnly cred addr28Extra ada -> + TxOut_AddrHash28_AdaOnly (interns credsInterns cred) addr28Extra ada + TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra ada e f g h -> + TxOut_AddrHash28_AdaOnly_DataHash32 (interns credsInterns cred) addr28Extra ada e f g h txOut -> txOut internTxOut <$> case lenOrIndef of Nothing -> do @@ -870,13 +863,11 @@ instance instance HasField "txnetworkid" (TxBody era) (StrictMaybe Network) where getField (TxBodyConstr (Memo m _)) = _txnetworkid m -instance (Era era, Crypto era ~ c) => HasField "compactAddress" (TxOut era) (CompactAddr c) where - getField (TxOutCompact a _) = a - getField (TxOutCompactDH a _ _) = a - instance (Era era, CC.Crypto c, Crypto era ~ c) => HasField "address" (TxOut era) (Addr c) where - getField (TxOutCompact a _) = decompactAddr a - getField (TxOutCompactDH a _ _) = decompactAddr a + getField t = + case getAlonzoTxOutEitherAddr t of + Left a -> a + Right ca -> decompactAddr ca instance (Era era, Core.Value era ~ val, Compactible val) => HasField "value" (TxOut era) val where getField (TxOutCompact _ v) = fromCompact v @@ -885,3 +876,17 @@ instance (Era era, Core.Value era ~ val, Compactible val) => HasField "value" (T instance (Era era, c ~ Crypto era) => HasField "datahash" (TxOut era) (StrictMaybe (DataHash c)) where getField (TxOutCompact _ _) = SNothing getField (TxOutCompactDH _ _ d) = SJust d + +getAlonzoTxOutEitherAddr :: + HashAlgorithm (CC.ADDRHASH (Crypto era)) => + TxOut era -> + Either (Addr (Crypto era)) (CompactAddr (Crypto era)) +getAlonzoTxOutEitherAddr = \case + TxOutCompact' cAddr _ -> Right cAddr + TxOutCompactDH' cAddr _ _ -> Right cAddr + TxOut_AddrHash28_AdaOnly stakeRef addr28Extra _ + | Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr + | otherwise -> error "Impossible: Compacted an address of non-standard size" + TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef addr28Extra _ _ _ _ _ + | Just addr <- decodeAddress28 stakeRef addr28Extra -> Left addr + | otherwise -> error "Impossible: Compacted an address or a hash of non-standard size" diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA.hs index 920df40faee..7fd1a6ac449 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA.hs @@ -27,7 +27,7 @@ import Cardano.Ledger.Coin (Coin) import Cardano.Ledger.Compactible (Compactible) import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CryptoClass -import Cardano.Ledger.Era (Crypto, Era, SupportsSegWit (..), ValidateScript (..)) +import Cardano.Ledger.Era (Era (..), SupportsSegWit (..), ValidateScript (..)) import Cardano.Ledger.Mary.Value (Value, policies, policyID) import Cardano.Ledger.SafeHash (hashAnnotated) import Cardano.Ledger.Shelley (nativeMultiSigTag) @@ -107,6 +107,8 @@ instance where type Crypto (ShelleyMAEra ma c) = c + getTxOutEitherAddr (TxOutCompact a _) = Right a + instance CryptoClass.Crypto c => UsesValue (ShelleyMAEra 'Mary c) instance CryptoClass.Crypto c => UsesValue (ShelleyMAEra 'Allegra c) diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index c4a41f91c0f..88fa5c1d203 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -109,7 +109,6 @@ library mtl, microlens, nothunks, - primitive >= 0.7.1.0, quiet, set-algebra, small-steps, diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley.hs index a9897616b64..1d236fa36a6 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley.hs @@ -34,7 +34,7 @@ import Cardano.Ledger.Coin (Coin) import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CryptoClass import Cardano.Ledger.Era (SupportsSegWit (..), ValidateScript (..)) -import qualified Cardano.Ledger.Era as E (Era (Crypto), TranslationContext) +import qualified Cardano.Ledger.Era as E (Era (..), TranslationContext) import Cardano.Ledger.Hashes (EraIndependentAuxiliaryData) import Cardano.Ledger.SafeHash (makeHashWithExplicitProxys) import Cardano.Ledger.Shelley.BlockChain (bbHash) @@ -64,6 +64,8 @@ data ShelleyEra c instance CryptoClass.Crypto c => E.Era (ShelleyEra c) where type Crypto (ShelleyEra c) = c + getTxOutEitherAddr (STx.TxOutCompact a _) = Right a + instance CryptoClass.Crypto c => UsesValue (ShelleyEra c) instance CryptoClass.Crypto c => UsesTxOut (ShelleyEra c) where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs index 7f33213fec1..a4dff659444 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/ByronTranslation.hs @@ -21,12 +21,12 @@ import qualified Cardano.Crypto.Hashing as Hashing import Cardano.Ledger.BaseTypes (BlocksMade (..)) import Cardano.Ledger.Chain (pparamsToChainChecksPParams) import Cardano.Ledger.Coin (CompactForm (CompactCoin)) +import Cardano.Ledger.CompactAddress (CompactAddr (UnsafeCompactAddr)) import qualified Cardano.Ledger.Crypto as CC import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.API.Protocol import Cardano.Ledger.Shelley.API.Types -import Cardano.Ledger.Shelley.CompactAddr (CompactAddr (UnsafeCompactAddr)) import Cardano.Ledger.Shelley.EpochBoundary import Cardano.Ledger.Slot import Cardano.Ledger.Val ((<->)) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs index 7a0f4880cca..57d430c64fc 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs @@ -60,19 +60,19 @@ import Cardano.Ledger.BaseTypes epochInfo, ) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.CompactAddress (compactAddr) import Cardano.Ledger.Compactible (fromCompact) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Crypto (DSIGN) import qualified Cardano.Ledger.Crypto as CC (Crypto) -import Cardano.Ledger.Era (Crypto, Era) +import Cardano.Ledger.Era (Era (Crypto, getTxOutEitherAddr)) import Cardano.Ledger.Keys (KeyHash, KeyRole (..)) import Cardano.Ledger.PoolDistr ( IndividualPoolStake (..), PoolDistr (..), ) import Cardano.Ledger.Shelley (ShelleyEra) -import Cardano.Ledger.Shelley.CompactAddr (CompactAddr, compactAddr) import Cardano.Ledger.Shelley.Constraints (UsesValue) import qualified Cardano.Ledger.Shelley.EpochBoundary as EB import Cardano.Ledger.Shelley.LedgerState @@ -152,20 +152,19 @@ getUTxO = _utxo . _utxoState . esLState . nesEs -- | Get the UTxO filtered by address. getFilteredUTxO :: - HasField "compactAddress" (Core.TxOut era) (CompactAddr (Crypto era)) => + Era era => NewEpochState era -> Set (Addr (Crypto era)) -> UTxO era -getFilteredUTxO ss addrs = - UTxO $ - Map.filter - (\out -> getField @"compactAddress" out `Set.member` addrSBSs) - fullUTxO +getFilteredUTxO ss addrSet = + UTxO $ Map.filter checkAddr fullUTxO where UTxO fullUTxO = getUTxO ss - -- Instead of decompacting each address in the huge UTxO, compact each - -- address in the small set of address. - addrSBSs = Set.map compactAddr addrs + compactAddrSet = Set.map compactAddr addrSet + checkAddr out = + case getTxOutEitherAddr out of + Left addr -> addr `Set.member` addrSet + Right cAddr -> cAddr `Set.member` compactAddrSet getUTxOSubset :: NewEpochState era -> diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/CompactAddr.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/CompactAddr.hs new file mode 100644 index 00000000000..5b2cf2312ee --- /dev/null +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/CompactAddr.hs @@ -0,0 +1,6 @@ +module Cardano.Ledger.Shelley.CompactAddr + ( module X, + ) +where + +import Cardano.Ledger.CompactAddress as X diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Constraints.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Constraints.hs index 0b45827b1b9..5fb3ebbd2ad 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Constraints.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Constraints.hs @@ -25,11 +25,9 @@ import Cardano.Ledger.Core import Cardano.Ledger.Era (Crypto, Era) import Cardano.Ledger.Hashes (EraIndependentTxBody) import Cardano.Ledger.SafeHash (HashAnnotated) -import Cardano.Ledger.Shelley.CompactAddr (CompactAddr) import Cardano.Ledger.Val (DecodeMint, DecodeNonNegative, EncodeMint, Val) import Data.Kind (Constraint, Type) import Data.Proxy (Proxy) -import GHC.Records (HasField) -------------------------------------------------------------------------------- -- Shelley Era @@ -58,10 +56,7 @@ class ( Era era, ChainData (TxOut era), ToCBOR (TxOut era), - FromCBOR (TxOut era), - HasField "address" (TxOut era) (Addr (Crypto era)), - HasField "compactAddress" (TxOut era) (CompactAddr (Crypto era)), - HasField "value" (TxOut era) (Value era) + FromCBOR (TxOut era) ) => UsesTxOut era where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs index 750aa654935..e956c2e6d49 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs @@ -28,7 +28,6 @@ import Cardano.Binary ToCBOR (..), encodeListLen, ) -import Cardano.Ledger.Address (Addr (..)) import Cardano.Ledger.BaseTypes (ShelleyBase, invalidKey) import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Core as Core @@ -147,7 +146,6 @@ instance ( Show (Core.PParams era), Show (Core.Tx era), HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))), - HasField "address" (Core.TxOut era) (Addr (Crypto era)), DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody), Era era, Embed (Core.EraRule "DELEGS" era) (LEDGER era), diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs index 548c16e3193..24224321bc8 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxBody.hs @@ -83,10 +83,7 @@ import Cardano.Binary szCases, ) import qualified Cardano.Crypto.Hash.Class as HS -import Cardano.Ledger.Address - ( Addr (..), - RewardAcnt (..), - ) +import Cardano.Ledger.Address (Addr (..), RewardAcnt (..)) import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash) import Cardano.Ledger.BaseTypes ( DnsName, @@ -100,6 +97,7 @@ import Cardano.Ledger.BaseTypes strictMaybeToMaybe, ) import Cardano.Ledger.Coin (Coin (..), DeltaCoin) +import Cardano.Ledger.CompactAddress (CompactAddr, compactAddr, decompactAddr) import Cardano.Ledger.Compactible import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential @@ -145,11 +143,6 @@ import Cardano.Ledger.Serialization mapFromCBOR, mapToCBOR, ) -import Cardano.Ledger.Shelley.CompactAddr - ( CompactAddr, - compactAddr, - decompactAddr, - ) import Cardano.Ledger.Shelley.Constraints (TransValue) import Cardano.Ledger.Shelley.Orphans () import Cardano.Ledger.Shelley.PParams (Update) @@ -487,15 +480,6 @@ viewCompactTxOut (TxOutCompact bs c) = (addr, val) addr = decompactAddr bs val = fromCompact c -instance - ( Crypto era ~ c, - Era era, - TransValue Show era - ) => - HasField "compactAddress" (TxOut era) (CompactAddr c) - where - getField (TxOutCompact a _) = a - -- --------------------------- -- WellFormed instances diff --git a/eras/shelley/test-suite/bench/BenchUTxOAggregate.hs b/eras/shelley/test-suite/bench/BenchUTxOAggregate.hs index 15a6cc5f349..9ec50fc617c 100644 --- a/eras/shelley/test-suite/bench/BenchUTxOAggregate.hs +++ b/eras/shelley/test-suite/bench/BenchUTxOAggregate.hs @@ -11,6 +11,7 @@ import Cardano.Ledger.Address ( Addr (..), ) import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.CompactAddress (compactAddr) import Cardano.Ledger.Compactible (toCompact) import Cardano.Ledger.Credential ( Credential (..), @@ -19,7 +20,6 @@ import Cardano.Ledger.Credential ) import Cardano.Ledger.Keys (GenDelegs (..), KeyHash (..), KeyRole (..)) import Cardano.Ledger.SafeHash (unsafeMakeSafeHash) -import Cardano.Ledger.Shelley.CompactAddr (compactAddr) import Cardano.Ledger.Shelley.LedgerState ( DState (..), InstantaneousRewards (..), diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/CompactAddr.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/CompactAddr.hs index 92a88b365f3..c2bc1618eea 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/CompactAddr.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/CompactAddr.hs @@ -8,12 +8,12 @@ module Test.Cardano.Ledger.Shelley.Address.CompactAddr where import Cardano.Ledger.Address (Addr (..), serialiseAddr) import qualified Cardano.Ledger.Address as Addr +import qualified Cardano.Ledger.CompactAddress as CA import Cardano.Ledger.Credential ( PaymentCredential, StakeReference (..), ) import qualified Cardano.Ledger.Crypto as CC (Crypto) -import qualified Cardano.Ledger.Shelley.CompactAddr as CA import qualified Data.ByteString.Short as SBS import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (Mock) import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators () diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 33db8108f16..b5e0d5aadf6 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -42,6 +42,7 @@ library exposed-modules: Cardano.Ledger.Address + Cardano.Ledger.CompactAddress Cardano.Ledger.AuxiliaryData Cardano.Ledger.BaseTypes Cardano.Ledger.BHeaderView diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs index a8174d72097..25bcb1fda86 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/CompactAddress.hs @@ -3,7 +3,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -module Cardano.Ledger.Shelley.CompactAddr +module Cardano.Ledger.CompactAddress ( compactAddr, decompactAddr, CompactAddr (..), @@ -41,8 +41,8 @@ import Cardano.Ledger.Credential ) import Cardano.Ledger.Crypto (ADDRHASH) import qualified Cardano.Ledger.Crypto as CC (Crypto) +import Cardano.Ledger.Hashes (ScriptHash (..)) import Cardano.Ledger.Keys (KeyHash (..)) -import Cardano.Ledger.Shelley.Scripts (ScriptHash (..)) import Cardano.Ledger.Slot (SlotNo (..)) import Cardano.Prelude (Text, cborError, panic) import Control.Monad (ap) diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs index b183a486572..7d418d6f50b 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Era.hs @@ -6,13 +6,11 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilyDependencies #-} -- | Support for multiple (Shelley-based) eras in the ledger. module Cardano.Ledger.Era - ( Era, - Crypto, + ( Era (..), PreviousEra, TranslationContext, TranslateEra (..), @@ -29,6 +27,7 @@ import qualified Cardano.Crypto.Hash as Hash import Cardano.Ledger.Address (Addr) import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash) import Cardano.Ledger.Coin (Coin) +import Cardano.Ledger.CompactAddress (CompactAddr, compactAddr, decompactAddr) import Cardano.Ledger.Compactible (Compactible) import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CryptoClass @@ -69,6 +68,25 @@ class where type Crypto e :: Type + -- | Extract from TxOut either an address or its compact version by doing the + -- least amount of work. Default implementation relies on the "address" field. + getTxOutEitherAddr :: + Core.TxOut e -> + Either (Addr (Crypto e)) (CompactAddr (Crypto e)) + getTxOutEitherAddr = Left . getField @"address" + + getTxOutAddr :: Core.TxOut e -> Addr (Crypto e) + getTxOutAddr t = + case getTxOutEitherAddr t of + Left a -> a + Right ca -> decompactAddr ca + + getTxOutCompactAddr :: Core.TxOut e -> CompactAddr (Crypto e) + getTxOutCompactAddr t = + case getTxOutEitherAddr t of + Left a -> compactAddr a + Right ca -> ca + ----------------------------------------------------------------------------- -- Script Validation ----------------------------------------------------------------------------- diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs index 832983c1fbe..f5b408236a2 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs @@ -46,6 +46,7 @@ import Cardano.Ledger.BaseTypes ) import Cardano.Ledger.Block (Block (..)) import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..)) +import Cardano.Ledger.CompactAddress (CompactAddr (..), decompactAddr) import Cardano.Ledger.Compactible (Compactible (..)) import Cardano.Ledger.Core (PParamsDelta) import qualified Cardano.Ledger.Core as Core @@ -72,7 +73,6 @@ import Cardano.Ledger.Keys import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..)) import Cardano.Ledger.SafeHash (SafeHash, extractHash) import Cardano.Ledger.Shelley.Address.Bootstrap (BootstrapWitness (..), ChainCode (..)) -import Cardano.Ledger.Shelley.CompactAddr (CompactAddr (..), decompactAddr) import Cardano.Ledger.Shelley.EpochBoundary ( SnapShot (..), SnapShots (..), diff --git a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs index c97186cdbd6..b516a1570f2 100644 --- a/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs +++ b/libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/EpochBoundary.hs @@ -9,6 +9,7 @@ import Cardano.Crypto.DSIGN.Mock import Cardano.Ledger.Address (Addr (Addr)) import Cardano.Ledger.BaseTypes (Network (Testnet)) import Cardano.Ledger.Coin (Coin (Coin)) +import Cardano.Ledger.CompactAddress (compactAddr) import Cardano.Ledger.Compactible (Compactible (toCompact)) import Cardano.Ledger.Credential ( Credential (KeyHashObj), @@ -24,7 +25,6 @@ import Cardano.Ledger.SafeHash ( SafeToHash (makeHashWithExplicitProxys), castSafeHash, ) -import Cardano.Ledger.Shelley.CompactAddr (compactAddr) import Cardano.Ledger.Shelley.LedgerState (aggregateUtxoCoinByCredential) import Cardano.Ledger.Shelley.TxBody (TxOut (..)) import Cardano.Ledger.Shelley.UTxO (UTxO (UTxO)) diff --git a/libs/ledger-state/src/Cardano/Ledger/State/Query.hs b/libs/ledger-state/src/Cardano/Ledger/State/Query.hs index ac5012f0f10..434333b79e9 100644 --- a/libs/ledger-state/src/Cardano/Ledger/State/Query.hs +++ b/libs/ledger-state/src/Cardano/Ledger/State/Query.hs @@ -459,15 +459,12 @@ sourceWithSharingUTxO stakeCredentials = sourceUTxO .| mapC (fmap internTxOut) where internTxOut = \case - Alonzo.TxOut_AddrHash28_AdaOnly cred a b c d e -> - Alonzo.TxOut_AddrHash28_AdaOnly (intern (Keys.coerceKeyRole cred) stakeCredentials) a b c d e - Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 cred a b c d e o p q r -> + Alonzo.TxOut_AddrHash28_AdaOnly cred addr28Extra e -> + Alonzo.TxOut_AddrHash28_AdaOnly (intern (Keys.coerceKeyRole cred) stakeCredentials) addr28Extra e + Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 cred addr28Extra e o p q r -> Alonzo.TxOut_AddrHash28_AdaOnly_DataHash32 (intern (Keys.coerceKeyRole cred) stakeCredentials) - a - b - c - d + addr28Extra e o p