optimize the performance of isBootstrapRedeemer

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/CompactAddr.hs

@@ -8,6 +8,7 @@ module Shelley.Spec.Ledger.CompactAddr
     decompactAddr,
     CompactAddr (..),
     substring,
+    isBootstrapRedeemer,
   )
 where
 
@@ -214,3 +215,11 @@ getPayCred :: CC.Crypto crypto => Word8 -> GetShort (PaymentCredential crypto)
 getPayCred header = case testBit header payCredIsScript of
   True -> getScriptHash
   False -> getKeyHash
+
+isBootstrapRedeemer :: CompactAddr crypto -> Bool
+isBootstrapRedeemer (UnsafeCompactAddr bytes) =
+  testBit header byron -- AddrBootstrap
+    && addrType == 2 -- ATRedeem
+  where
+    addrType = SBS.index bytes (SBS.length bytes - 6)
+    header = SBS.index bytes 0

shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/LedgerState.hs

@@ -153,7 +153,7 @@ import GHC.Records (HasField (..))
 import NoThunks.Class (NoThunks (..))
 import Numeric.Natural (Natural)
 import Quiet
-import Shelley.Spec.Ledger.Address (Addr (..), bootstrapKeyHash, isBootstrapRedeemer)
+import Shelley.Spec.Ledger.Address (Addr (..), bootstrapKeyHash)
 import Shelley.Spec.Ledger.Address.Bootstrap
   ( BootstrapWitness (..),
     bootstrapWitKeyHash,
@@ -169,6 +169,7 @@ import Shelley.Spec.Ledger.BaseTypes
     strictMaybeToMaybe,
     unitIntervalToRational,
   )
+import Shelley.Spec.Ledger.CompactAddr (CompactAddr (..), isBootstrapRedeemer)
 import Shelley.Spec.Ledger.Credential (Credential (..))
 import Shelley.Spec.Ledger.Delegation.Certificates
   ( DCert (..),
@@ -1325,7 +1326,7 @@ updateNES
 
 returnRedeemAddrsToReserves ::
   forall era.
-  (Era era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) =>
+  (Era era, HasField "compactAddress" (Core.TxOut era) (CompactAddr (Crypto era))) =>
   EpochState era ->
   EpochState era
 returnRedeemAddrsToReserves es = es {esAccountState = acnt', esLState = ls'}
@@ -1336,7 +1337,7 @@ returnRedeemAddrsToReserves es = es {esAccountState = acnt', esLState = ls'}
     (redeemers, nonredeemers) =
       Map.partition
         ( \out ->
-            isBootstrapRedeemer (getField @"address" out)
+            isBootstrapRedeemer (getField @"compactAddress" out)
         )
         utxo
     acnt = esAccountState es

shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/Address/CompactAddr.hs

@@ -10,6 +10,7 @@ module Test.Shelley.Spec.Ledger.Address.CompactAddr where
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import qualified Data.ByteString.Short as SBS
 import Shelley.Spec.Ledger.Address (Addr (..), serialiseAddr)
+import qualified Shelley.Spec.Ledger.Address as Addr
 import qualified Shelley.Spec.Ledger.CompactAddr as CA
 import Shelley.Spec.Ledger.Credential
   ( PaymentCredential,
@@ -61,6 +62,10 @@ propDecompactShelleyLazyAddr = do
       keyHash1 = unsafeGetHash . CA.decompactAddr . mangle . CA.compactAddr $ addr
    in pure $ keyHash0 == keyHash1
 
+propIsBootstrapRedeemer :: Addr crypto -> Property
+propIsBootstrapRedeemer addr =
+  Addr.isBootstrapRedeemer addr === CA.isBootstrapRedeemer (CA.compactAddr addr)
+
 unsafeGetHash :: Addr crypto -> PaymentCredential crypto
 unsafeGetHash (Addr _ hash _) = hash
 unsafeGetHash _ = error "this can't get a keyhash for a byron address"

shelley/chain-and-ledger/shelley-spec-ledger-test/test/Test/Shelley/Spec/Ledger/PropertyTests.hs

@@ -53,7 +53,7 @@ import Test.Shelley.Spec.Ledger.Address.CompactAddr
   ( propCompactAddrRoundTrip,
     propCompactSerializationAgree,
     propDecompactAddrLazy,
-    propDecompactShelleyLazyAddr,
+    propDecompactShelleyLazyAddr, propIsBootstrapRedeemer
   )
 import Test.Shelley.Spec.Ledger.ByronTranslation (testGroupByronTranslation)
 import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv)
@@ -117,7 +117,8 @@ minimalPropertyTests =
         [ TQC.testProperty "Compact address round trip" (propCompactAddrRoundTrip @(Crypto era)),
           TQC.testProperty "Compact address binary representation" (propCompactSerializationAgree @(Crypto era)),
           TQC.testProperty "determining address type doesn't force contents" (propDecompactAddrLazy @(Crypto era)),
-          TQC.testProperty "reading the keyhash doesn't force the stake reference" (propDecompactShelleyLazyAddr @(Crypto era))
+          TQC.testProperty "reading the keyhash doesn't force the stake reference" (propDecompactShelleyLazyAddr @(Crypto era)),
+          TQC.testProperty "isBootstrapRedeemer is equivalent for CompactAddr and Addr" (propIsBootstrapRedeemer @(Crypto era))
         ]
     ]
 
@@ -199,6 +200,7 @@ propertyTests =
         [ TQC.testProperty "Compact address round trip" (propCompactAddrRoundTrip @(Crypto era)),
           TQC.testProperty "Compact address binary representation" (propCompactSerializationAgree @(Crypto era)),
           TQC.testProperty "determining address type doesn't force contents" (propDecompactAddrLazy @(Crypto era)),
-          TQC.testProperty "reading the keyhash doesn't force the stake reference" (propDecompactShelleyLazyAddr @(Crypto era))
+          TQC.testProperty "reading the keyhash doesn't force the stake reference" (propDecompactShelleyLazyAddr @(Crypto era)),
+          TQC.testProperty "isBootstrapRedeemer is equivalent for CompactAddr and Addr" (propIsBootstrapRedeemer @(Crypto era))
         ]
     ]