Merge pull request #4879 from IntersectMBO/lehins/improve-mkAddr

Improve `mkAddr` and `mkCred` interface

Author: lehins

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxowSpec/Invalid.hs

@@ -9,7 +9,6 @@
 
 module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Invalid (spec) where
 
-import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.Allegra.Scripts (AllegraEraScript (..))
 import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Alonzo.Core
@@ -20,7 +19,7 @@ import Cardano.Ledger.Alonzo.Rules (
  )
 import Cardano.Ledger.Alonzo.Scripts (eraLanguages)
 import Cardano.Ledger.Alonzo.TxWits (Redeemers (..), TxDats (..), unRedeemers)
-import Cardano.Ledger.BaseTypes (Mismatch (..), Network (..), StrictMaybe (..), natVersion)
+import Cardano.Ledger.BaseTypes (Mismatch (..), StrictMaybe (..), natVersion)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
 import Cardano.Ledger.Keys (asWitness, witVKeyHash)
@@ -139,10 +138,9 @@ spec = describe "Invalid transactions" $ do
             testHashMismatch SNothing
 
         it "UnspendableUTxONoDatumHash" $ do
-          let scriptHash = redeemerSameAsDatumHash
-
           txIn <- impAnn "Produce script at a txout with a missing datahash" $ do
-            let addr = Addr Testnet (ScriptHashObj scriptHash) StakeRefNull
+            let scriptHash = redeemerSameAsDatumHash
+            let addr = mkAddr scriptHash StakeRefNull
             let tx =
                   mkBasicTx mkBasicTxBody
                     & bodyTxL . outputsTxBodyL .~ [mkBasicTxOut addr mempty]

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/Examples/Consensus.hs

@@ -99,7 +99,7 @@ exampleTxBodyAlonzo =
     (Set.fromList [mkTxInPartial (TxId (mkDummySafeHash 2)) 1]) -- collateral
     ( StrictSeq.fromList
         [ AlonzoTxOut
-            (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey))
+            (mkAddr SLE.examplePayKey SLE.exampleStakeKey)
             (SLE.exampleMultiAssetValue 2)
             (SJust $ mkDummySafeHash 1) -- outputs
         ]

eras/babbage/test-suite/src/Test/Cardano/Ledger/Babbage/Examples/Consensus.hs

@@ -94,7 +94,7 @@ ledgerExamplesBabbage =
 collateralOutput :: BabbageTxOut BabbageEra
 collateralOutput =
   BabbageTxOut
-    (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey))
+    (mkAddr SLE.examplePayKey SLE.exampleStakeKey)
     (MaryValue (Coin 8675309) mempty)
     NoDatum
     SNothing
@@ -108,7 +108,7 @@ exampleTxBodyBabbage =
     ( StrictSeq.fromList
         [ mkSized (eraProtVerHigh @BabbageEra) $
             BabbageTxOut
-              (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey))
+              (mkAddr SLE.examplePayKey SLE.exampleStakeKey)
               (MarySLE.exampleMultiAssetValue 2)
               (Datum $ dataToBinaryData datumExample) -- inline datum
               (SJust $ alwaysSucceeds @'PlutusV2 3) -- reference script

eras/conway/impl/CHANGELOG.md

@@ -10,6 +10,7 @@
 
 ### `testlib`
 
+* Add `sendCoinTo_` and `sendValueTo_`
 * Add `genRegTxCert` and `genUnRegTxCert`. #4830
 * Add `Arbitrary` instance for `ConwayBbodyPredFailure` and `ConwayMempoolPredFailure`
 

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Regression.hs

@@ -21,16 +21,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway (ConwayEra)
-import Cardano.Ledger.Conway.Core (
-  BabbageEraTxBody (..),
-  EraTx (..),
-  EraTxBody (..),
-  EraTxOut (..),
-  EraTxWits (..),
-  coinTxOutL,
-  eraProtVerLow,
-  txIdTx,
- )
+import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Rules (
   ConwayLedgerPredFailure (..),
   ConwayUtxoPredFailure (..),
@@ -43,7 +34,6 @@ import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Lens.Micro ((%~), (&), (.~))
 import Test.Cardano.Ledger.Conway.ImpTest
-import Test.Cardano.Ledger.Core.KeyPair (mkScriptAddr)
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus.Examples (redeemerSameAsDatum)
 
@@ -95,11 +85,11 @@ spec = describe "Regression" $ do
     withImpInit @(LedgerSpec ConwayEra) $
       it "InsufficientCollateral is not encoded with negative coin #4198" $ do
         collateralAddress <- freshKeyAddr_
-        (_, skp) <- freshKeyPair
+        stakingKeyHash <- freshKeyHash @'Staking
         let
           plutusVersion = SPlutusV2
           scriptHash = hashPlutusScript $ redeemerSameAsDatum plutusVersion
-          lockScriptAddress = mkScriptAddr scriptHash skp
+          lockScriptAddress = mkAddr scriptHash stakingKeyHash
         collateralReturnAddr <- freshKeyAddr_
         lockedTx <-
           submitTxAnn @ConwayEra "Script locked tx" $
@@ -110,7 +100,7 @@ spec = describe "Regression" $ do
                   , mkBasicTxOut collateralAddress mempty
                   ]
               & bodyTxL . collateralReturnTxBodyL
-                .~ SJust (mkBasicTxOut collateralReturnAddr . inject $ Coin 849070)
+                .~ SJust (mkBasicTxOut collateralReturnAddr . inject $ Coin 862000)
         let
           modifyRootCoin = coinTxOutL .~ Coin 989482376
           modifyRootTxOut (x SSeq.:<| SSeq.Empty) =

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/RatifySpec.hs

@@ -7,7 +7,6 @@
 
 module Test.Cardano.Ledger.Conway.Imp.RatifySpec (spec) where
 
-import Cardano.Ledger.Address
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Coin
 import Cardano.Ledger.Conway.Core
@@ -628,7 +627,7 @@ votingSpec =
           -- Bump up the UTxO delegated
           -- to barely make the threshold (65 %! 100)
           stakingKP1 <- lookupKeyPair stakingKH1
-          _ <- sendCoinTo (mkAddr (paymentKP1, stakingKP1)) (inject $ Coin 858_000_000)
+          sendCoinTo_ (mkAddr paymentKP1 stakingKP1) (inject $ Coin 858_000_000)
           passNEpochs 2
           -- The same vote should now successfully ratify the proposal
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)
@@ -929,10 +928,7 @@ votingSpec =
           getLastEnactedCommittee `shouldReturn` SNothing
           -- Bump up the UTxO delegated
           -- to barely make the threshold (51 %! 100)
-          _ <-
-            sendCoinTo
-              (Addr Testnet delegatorCPayment1 (StakeRefBase delegatorCStaking1))
-              (Coin 40_900_000)
+          sendCoinTo_ (mkAddr delegatorCPayment1 delegatorCStaking1) (Coin 40_900_000)
           passNEpochs 2
           -- The same vote should now successfully ratify the proposal
           getLastEnactedCommittee `shouldReturn` SJust (GovPurposeId addCCGaid)

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxoSpec.hs

@@ -35,7 +35,6 @@ import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Lens.Micro ((&), (.~), (^.))
 import Test.Cardano.Ledger.Conway.ImpTest
-import Test.Cardano.Ledger.Core.KeyPair (mkScriptAddr)
 import Test.Cardano.Ledger.Core.Rational ((%!))
 import Test.Cardano.Ledger.Core.Utils (txInAt)
 import Test.Cardano.Ledger.Imp.Common
@@ -149,11 +148,11 @@ spec =
       _ <- impAddNativeScript script
       pure script
 
-    addScriptAddr :: HasCallStack => NativeScript era -> ImpTestM era Addr
+    addScriptAddr :: NativeScript era -> ImpTestM era Addr
     addScriptAddr script = do
-      kpStaking1 <- lookupKeyPair =<< freshKeyHash
       scriptHash <- impAddNativeScript script
-      pure $ mkScriptAddr scriptHash kpStaking1
+      stakingKeyHash <- freshKeyHash @'Staking
+      pure $ mkAddr scriptHash stakingKeyHash
 
     scriptSize :: Script era -> Int
     scriptSize = \case

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/UtxosSpec.hs

@@ -40,7 +40,6 @@ import qualified Data.Set as Set
 import Lens.Micro
 import qualified PlutusLedgerApi.V1 as P1
 import Test.Cardano.Ledger.Conway.ImpTest
-import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus (testingCostModels)
 import Test.Cardano.Ledger.Plutus.Examples (
@@ -629,7 +628,7 @@ scriptLockedTxOut ::
   TxOut era
 scriptLockedTxOut shSpending =
   mkBasicTxOut
-    (Addr Testnet (ScriptHashObj shSpending) StakeRefNull)
+    (mkAddr shSpending StakeRefNull)
     mempty
     & dataHashTxOutL .~ SJust (hashData @era $ Data spendDatum)
 
@@ -640,11 +639,10 @@ mkRefTxOut ::
   ScriptHash ->
   ImpTestM era (TxOut era)
 mkRefTxOut sh = do
-  kpPayment <- lookupKeyPair =<< freshKeyHash
-  kpStaking <- lookupKeyPair =<< freshKeyHash
+  addr <- freshKeyAddr_
   let mbyPlutusScript = impLookupPlutusScriptMaybe sh
   pure $
-    mkBasicTxOut (mkAddr (kpPayment, kpStaking)) mempty
+    mkBasicTxOut addr mempty
       & referenceScriptTxOutL .~ maybeToStrictMaybe (fromPlutusScript <$> mbyPlutusScript)
 
 setupRefTx ::

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/ImpTest.hs

@@ -136,13 +136,12 @@ module Test.Cardano.Ledger.Conway.ImpTest (
   delegateSPORewardAddressToDRep_,
 ) where
 
-import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
+import Cardano.Ledger.Address (RewardAccount (..))
 import Cardano.Ledger.Allegra.Scripts (Timelock)
 import Cardano.Ledger.Alonzo.Scripts (AlonzoScript)
 import Cardano.Ledger.BaseTypes (
   EpochInterval (..),
   EpochNo (..),
-  Network (..),
   ProtVer (..),
   ShelleyBase,
   StrictMaybe (..),
@@ -185,7 +184,7 @@ import Cardano.Ledger.Conway.Rules (
  )
 import Cardano.Ledger.Conway.Tx (AlonzoTx)
 import Cardano.Ledger.Conway.TxCert (Delegatee (..))
-import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
+import Cardano.Ledger.Credential (Credential (..))
 import Cardano.Ledger.DRep
 import Cardano.Ledger.Plutus.Language (Language (..), SLanguage (..), hashPlutusScript)
 import Cardano.Ledger.PoolParams (PoolParams (..), ppRewardAccount)
@@ -241,7 +240,6 @@ import Prettyprinter (align, hsep, viaShow, vsep)
 import Test.Cardano.Ledger.Babbage.ImpTest
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Cardano.Ledger.Conway.TreeDiff (tableDoc)
-import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkCred)
 import Test.Cardano.Ledger.Core.Rational (IsRatio (..))
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Plutus (testingCostModel)
@@ -472,11 +470,7 @@ setupSingleDRep stake = do
   let tx =
         mkBasicTx mkBasicTxBody
           & bodyTxL . certsTxBodyL
-            .~ SSeq.fromList
-              [ RegDepositTxCert
-                  (KeyHashObj delegatorKH)
-                  deposit
-              ]
+            .~ SSeq.fromList [RegDepositTxCert (KeyHashObj delegatorKH) deposit]
   submitTx_ tx
   spendingKP <-
     delegateToDRep (KeyHashObj delegatorKH) (Coin stake) (DRepCredential (KeyHashObj drepKH))
@@ -490,21 +484,13 @@ delegateToDRep ::
   ImpTestM era (KeyPair 'Payment)
 delegateToDRep cred stake dRep = do
   (_, spendingKP) <- freshKeyPair
-  let addr = Addr Testnet (mkCred spendingKP) (StakeRefBase cred)
+
   submitTxAnn_ "Delegate to DRep" $
     mkBasicTx mkBasicTxBody
       & bodyTxL . outputsTxBodyL
-        .~ SSeq.singleton
-          ( mkBasicTxOut
-              addr
-              (inject stake)
-          )
+        .~ SSeq.singleton (mkBasicTxOut (mkAddr spendingKP cred) (inject stake))
       & bodyTxL . certsTxBodyL
-        .~ SSeq.fromList
-          [ DelegTxCert
-              cred
-              (DelegVote dRep)
-          ]
+        .~ SSeq.fromList [DelegTxCert cred (DelegVote dRep)]
   pure spendingKP
 
 lookupDRepState ::
@@ -534,10 +520,7 @@ setupPoolWithStake delegCoin = do
   registerPool khPool
   credDelegatorPayment <- KeyHashObj <$> freshKeyHash
   credDelegatorStaking <- KeyHashObj <$> freshKeyHash
-  void $
-    sendCoinTo
-      (Addr Testnet credDelegatorPayment (StakeRefBase credDelegatorStaking))
-      delegCoin
+  sendCoinTo_ (mkAddr credDelegatorPayment credDelegatorStaking) delegCoin
   pp <- getsNES $ nesEsL . curPParamsEpochStateL
   submitTxAnn_ "Delegate to stake pool" $
     mkBasicTx mkBasicTxBody

eras/conway/test-suite/src/Test/Cardano/Ledger/Conway/Examples/Consensus.hs

@@ -110,7 +110,7 @@ ledgerExamplesConway =
 collateralOutput :: BabbageTxOut ConwayEra
 collateralOutput =
   BabbageTxOut
-    (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey))
+    (mkAddr SLE.examplePayKey SLE.exampleStakeKey)
     (MaryValue (Coin 8675309) mempty)
     NoDatum
     SNothing
@@ -130,7 +130,7 @@ exampleTxBodyConway =
     ( StrictSeq.fromList
         [ mkSized (eraProtVerHigh @ConwayEra) $
             BabbageTxOut
-              (mkAddr (SLE.examplePayKey, SLE.exampleStakeKey))
+              (mkAddr SLE.examplePayKey SLE.exampleStakeKey)
               (MarySLE.exampleMultiAssetValue 2)
               (Datum $ dataToBinaryData datumExample) -- inline datum
               (SJust $ alwaysSucceeds @'PlutusV2 3) -- reference script

eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/Allegra/Examples/Consensus.hs

@@ -46,7 +46,7 @@ exampleAllegraTxBody value =
   mkBasicTxBody
     & inputsTxBodyL .~ exampleTxIns
     & outputsTxBodyL
-      .~ StrictSeq.singleton (mkBasicTxOut (mkAddr (examplePayKey, exampleStakeKey)) value)
+      .~ StrictSeq.singleton (mkBasicTxOut (mkAddr examplePayKey exampleStakeKey) value)
     & certsTxBodyL .~ exampleCerts
     & withdrawalsTxBodyL .~ exampleWithdrawals
     & feeTxBodyL .~ Coin 3

eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/Mary/Examples/Cast.hs

@@ -39,7 +39,7 @@ aliceStake = KeyPair vk sk
 
 -- | Alice's base address
 aliceAddr :: Addr
-aliceAddr = mkAddr (alicePay, aliceStake)
+aliceAddr = mkAddr alicePay aliceStake
 
 -- | Bob's payment key pair
 bobPay :: KeyPair 'Payment
@@ -55,7 +55,7 @@ bobStake = KeyPair vk sk
 
 -- | Bob's address
 bobAddr :: Addr
-bobAddr = mkAddr (bobPay, bobStake)
+bobAddr = mkAddr bobPay bobStake
 
 -- Carl's payment key pair
 carlPay :: KeyPair 'Payment
@@ -71,7 +71,7 @@ carlStake = KeyPair vk sk
 
 -- | Carl's address
 carlAddr :: Addr
-carlAddr = mkAddr (carlPay, carlStake)
+carlAddr = mkAddr carlPay carlStake
 
 -- | Daria's payment key pair
 dariaPay :: KeyPair 'Payment
@@ -87,4 +87,4 @@ dariaStake = KeyPair vk sk
 
 -- | Daria's address
 dariaAddr :: Addr
-dariaAddr = mkAddr (dariaPay, dariaStake)
+dariaAddr = mkAddr dariaPay dariaStake

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/LedgerSpec.hs

@@ -13,7 +13,6 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set
 import Lens.Micro ((&), (.~), (^.))
-import Test.Cardano.Ledger.Core.KeyPair (mkAddr)
 import Test.Cardano.Ledger.Core.Utils (txInAt)
 import Test.Cardano.Ledger.Imp.Common
 import Test.Cardano.Ledger.Shelley.ImpTest
@@ -24,21 +23,19 @@ spec ::
   SpecWith (ImpInit (LedgerSpec era))
 spec = describe "LEDGER" $ do
   it "Transactions update UTxO" $ do
-    kpPayment1 <- lookupKeyPair =<< freshKeyHash
-    kpStaking1 <- lookupKeyPair =<< freshKeyHash
+    addr1 <- freshKeyAddr_
     let coin1 = Coin 2000000
     tx1 <-
       submitTxAnn "First transaction" . mkBasicTx $
         mkBasicTxBody
           & outputsTxBodyL @era
             .~ SSeq.singleton
-              (mkBasicTxOut (mkAddr (kpPayment1, kpStaking1)) $ inject coin1)
+              (mkBasicTxOut addr1 $ inject coin1)
     UTxO utxo1 <- getUTxO
     case Map.lookup (txInAt (0 :: Int) tx1) utxo1 of
       Just out1 -> out1 ^. coinTxOutL `shouldBe` coin1
       Nothing -> expectationFailure "Could not find the TxOut of the first transaction"
-    kpPayment2 <- lookupKeyPair =<< freshKeyHash
-    kpStaking2 <- lookupKeyPair =<< freshKeyHash
+    addr2 <- freshKeyAddr_
     let coin2 = Coin 3000000
     tx2 <-
       submitTxAnn "Second transaction" . mkBasicTx $
@@ -47,8 +44,7 @@ spec = describe "LEDGER" $ do
             .~ Set.singleton
               (txInAt (0 :: Int) tx1)
           & outputsTxBodyL @era
-            .~ SSeq.singleton
-              (mkBasicTxOut (mkAddr (kpPayment2, kpStaking2)) $ inject coin2)
+            .~ SSeq.singleton (mkBasicTxOut addr2 $ inject coin2)
     UTxO utxo2 <- getUTxO
     case Map.lookup (txInAt (0 :: Int) tx2) utxo2 of
       Just out1 -> do