Revamped required signatories and remove dead code

plutus-contract/src/Plutus/Contract/Test.hs

@@ -208,8 +208,8 @@ checkPredicateCoverage ::
     -> TracePredicate -- ^ The predicate to check
     -> EmulatorTrace ()
     -> TestTree
-checkPredicateCoverage =
-  checkPredicateCoverageOptions defaultCheckOptions
+checkPredicateCoverage nm cr predicate action =
+  checkPredicateCoverageOptions defaultCheckOptions nm cr predicate action
 
 checkPredicateCoverageOptions ::
     CheckOptions -- ^ Options to use

plutus-contract/src/Plutus/Contract/Wallet.hs

@@ -34,7 +34,7 @@ import Control.Monad.Freer.Error (Error, throwError)
 import Data.Aeson (FromJSON (parseJSON), Object, ToJSON (toJSON), Value (String), object, withObject, (.:), (.=))
 import Data.Aeson.Extras qualified as JSON
 import Data.Aeson.Types (Parser, parseFail)
-import Data.Bifunctor (first)
+import Data.Bifunctor (Bifunctor (bimap), first)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (mapMaybe)
@@ -47,9 +47,7 @@ import Ledger (DCert, Redeemer, StakingCredential, txRedeemers)
 import Ledger qualified (ScriptPurpose (..))
 import Ledger qualified as P
 import Ledger.Ada qualified as Ada
-import Ledger.Constraints (mustPayToAddress)
-import Ledger.Constraints.OffChain (UnbalancedTx (unBalancedTxRequiredSignatories, unBalancedTxUtxoIndex),
-                                    unBalancedTxTx)
+import Ledger.Constraints (UnbalancedTx (UnbalancedCardanoTx, UnbalancedEmulatorTx), mustPayToAddress)
 import Ledger.Tx (CardanoTx, TxId (TxId), TxIn (..), TxOutRef, getCardanoTxInputs, txInRef)
 import Ledger.Validation (CardanoLedgerError, fromPlutusIndex, makeTransactionBody)
 import Ledger.Value (currencyMPSHash)
@@ -253,19 +251,20 @@ export
     :: P.Params
     -> UnbalancedTx
     -> Either CardanoLedgerError ExportTx
-export params utx =
-    let requiredSigners = Set.toList (unBalancedTxRequiredSignatories utx)
-        fromCardanoTx ctx = do
-            utxo <- fromPlutusIndex $ P.UtxoIndex (unBalancedTxUtxoIndex utx)
+export params (UnbalancedEmulatorTx tx sigs utxos) =
+    let requiredSigners = Set.toList sigs
+     in ExportTx
+        <$> bimap Right (C.makeSignedTransaction []) (CardanoAPI.toCardanoTxBody params requiredSigners tx)
+        <*> first Right (mkInputs (P.pNetworkId params) utxos)
+        <*> pure (mkRedeemers tx)
+export params (UnbalancedCardanoTx tx utxos) =
+    let fromCardanoTx ctx = do
+            utxo <- fromPlutusIndex $ P.UtxoIndex utxos
             makeTransactionBody params utxo ctx
      in ExportTx
-        <$> fmap (C.makeSignedTransaction [])
-                 (either
-                     fromCardanoTx
-                     (first Right . CardanoAPI.toCardanoTxBody params requiredSigners)
-                     (unBalancedTxTx utx))
-        <*> first Right (mkInputs (P.pNetworkId params) (unBalancedTxUtxoIndex utx))
-        <*> either (const $ Right []) (Right . mkRedeemers) (unBalancedTxTx utx)
+        <$> fmap (C.makeSignedTransaction []) (fromCardanoTx tx)
+        <*> first Right (mkInputs (P.pNetworkId params) utxos)
+        <*> pure []
 
 mkInputs :: C.NetworkId -> Map Plutus.TxOutRef P.TxOut -> Either CardanoAPI.ToCardanoError [ExportTxInput]
 mkInputs networkId = traverse (uncurry (toExportTxInput networkId)) . Map.toList

plutus-contract/src/Wallet/Emulator/Folds.hs

@@ -104,7 +104,7 @@ failedTransactions phase = preMapMaybe (f >=> filterPhase phase) L.list
         f e = preview (eteEvent . chainEvent . _TxnValidationFail) e
           <|> preview (eteEvent . walletEvent' . _2 . _TxBalanceLog . _ValidationFailed) e
         filterPhase Nothing (_, i, t, v, c, l)   = Just (i, t, v, c, l)
-        filterPhase (Just p) (p', i, t, v, c, l) = guard (p == p') $> (i, t, v, c, l)
+        filterPhase (Just p) (p', i, t, v, c, l) = if p == p' then Just (i, t, v, c, l) else Nothing
 
 -- | Transactions that were validated
 validatedTransactions :: EmulatorEventFold [(TxId, CardanoTx, [Text])]

plutus-contract/src/Wallet/Emulator/Wallet.hs

@@ -318,15 +318,15 @@ handleBalance ::
 handleBalance utx = do
     utxo <- get >>= ownOutputs
     params@Params { pNetworkId } <- WAPI.getClientParams
-    let requiredSigners = Set.toList (U.unBalancedTxRequiredSignatories utx)
-        eitherTx = U.unBalancedTxTx utx
+    let eitherTx = U.unBalancedTxTx utx
         plUtxo = traverse (Tx.toTxOut pNetworkId) utxo
     mappedUtxo <- either (throwError . WAPI.ToCardanoError) pure plUtxo
     cUtxoIndex <- handleError eitherTx $ fromPlutusIndex $ UtxoIndex $ U.unBalancedTxUtxoIndex utx <> mappedUtxo
     case eitherTx of
         Right _ -> do
             -- Find the fixed point of fee calculation, trying maximally n times to prevent an infinite loop
-            let calcFee n fee = do
+            let requiredSigners = Set.toList (U.unBalancedTxRequiredSignatories utx)
+                calcFee n fee = do
                     tx <- handleBalanceTx utxo (utx & U.tx . Ledger.fee .~ fee)
                     newFee <- handleError (Right tx) $ estimateTransactionFee params cUtxoIndex requiredSigners tx
                     if newFee /= fee

plutus-contract/test/Spec/Contract/Tx/Constraints/RequiredSigner.hs

@@ -7,10 +7,13 @@
 {-# LANGUAGE TypeFamilies        #-}
 module Spec.Contract.Tx.Constraints.RequiredSigner(tests) where
 
+import Control.Lens (_Just, has)
 import Control.Monad (void)
 import Data.Void (Void)
 import Test.Tasty (TestTree, testGroup)
 
+import Data.Default (Default (def))
+import Data.Map as M
 import Data.Maybe (fromJust)
 import Data.String (fromString)
 import Data.Text qualified as Text
@@ -19,14 +22,22 @@ import Ledger.Ada qualified as Ada
 import Ledger.CardanoWallet as CW
 import Ledger.Constraints.OffChain qualified as Constraints hiding (requiredSignatories)
 import Ledger.Constraints.OnChain.V1 qualified as Constraints
+import Ledger.Constraints.OnChain.V2 qualified as Cons.V2
 import Ledger.Constraints.TxConstraints qualified as Constraints
 import Ledger.Tx qualified as Tx
+import Ledger.Tx.Constraints qualified as TxCons
 import Ledger.Typed.Scripts qualified as Scripts
 import Plutus.Contract as Con
-import Plutus.Contract.Test (assertFailedTransaction, assertValidatedTransactionCount, checkPredicateOptions,
-                             defaultCheckOptions, mockWalletPaymentPubKey, mockWalletPaymentPubKeyHash, w1, w2)
+import Plutus.Contract.Test (assertFailedTransaction, assertValidatedTransactionCount, changeInitialWalletValue,
+                             checkPredicateOptions, defaultCheckOptions, mockWalletPaymentPubKey,
+                             mockWalletPaymentPubKeyHash, w1, w2)
+import Plutus.Script.Utils.Typed (Any)
+import Plutus.Script.Utils.V2.Address qualified as PSU.V2
+import Plutus.Script.Utils.V2.Typed.Scripts as PSU.V2
 import Plutus.Trace qualified as Trace
+import Plutus.V1.Ledger.Api qualified as PV1
 import Plutus.V1.Ledger.Scripts (ScriptError (EvaluationError), unitDatum)
+import Plutus.V2.Ledger.Api qualified as PV2
 import PlutusTx qualified
 import Prelude
 import Wallet.Emulator.Wallet (signPrivateKeys, walletToMockWallet)
@@ -40,6 +51,8 @@ tests =
         , otherWalletNoSigningProcess
         , phase2FailureMustBeSignedBy
         , withoutOffChainMustBeSignedBy
+        , cardanoTxOwnWallet -- When we'll have enough constraints, reuse the previous tests
+        , cardanoTxOtherWalletNoSigningProcess
         ]
 
 mustBeSignedByContract :: Ledger.PaymentPubKey -> Ledger.PaymentPubKeyHash -> Contract () Empty ContractError ()
@@ -156,3 +169,98 @@ mustBeSignedByTypedValidator = Scripts.mkTypedValidator @UnitTest
     $$(PlutusTx.compile [|| wrap ||])
     where
         wrap = Scripts.mkUntypedValidator
+
+
+-- plutus-tx-constraints tests
+-- all below to be covered by the above tests when the corresponding constraints will be implemented
+-- for CardanoTx
+
+
+{-# INLINABLE mustReferenceOutputValidatorV2 #-}
+mustReferenceOutputValidatorV2 :: PV2.Validator
+mustReferenceOutputValidatorV2 = PV2.mkValidatorScript
+    $$(PlutusTx.compile [|| wrap ||])
+ where
+     mkMustReferenceOutputV2Validator = mkMustReferenceOutputValidator Cons.V2.checkScriptContext
+     wrap = PSU.V2.mkUntypedValidator mkMustReferenceOutputV2Validator
+
+tag :: Trace.ContractInstanceTag
+tag = "instance 1"
+
+mkMustReferenceOutputValidator
+    :: (Constraints.TxConstraints Void Void -> sc -> Bool)
+    -> PV1.TxOutRef -> () -> sc -> Bool
+mkMustReferenceOutputValidator checkScriptContext txOutRef _ =
+    checkScriptContext (Constraints.mustReferenceOutput txOutRef)
+
+mustReferenceOutputV2ValidatorAddress :: Ledger.Address
+mustReferenceOutputV2ValidatorAddress =
+    PSU.V2.mkValidatorAddress mustReferenceOutputValidatorV2
+
+cardanoTxOwnWalletContract
+    :: Ledger.PaymentPubKey
+    -> Ledger.PaymentPubKeyHash
+    -> Contract () EmptySchema ContractError ()
+cardanoTxOwnWalletContract pk pkh = do
+    let mkTx lookups constraints = either (error . show) id $ TxCons.mkTx @Any def lookups constraints
+
+    utxos <- ownUtxos
+    myAddr <- ownAddress
+    let get3 (a:b:c:_) = (a, b, c)
+        get3 _         = error "Spec.Contract.TxConstraints.get3: not enough inputs"
+        ((utxoRef, utxo), (utxoRefForBalance1, _), (utxoRefForBalance2, _)) = get3 $ M.toList utxos
+        vh = fromJust $ Ledger.toValidatorHash mustReferenceOutputV2ValidatorAddress
+        lookups1 = Constraints.unspentOutputs utxos
+               <> Constraints.plutusV2OtherScript mustReferenceOutputValidatorV2
+               <> Constraints.paymentPubKey pk
+        tx1 = Constraints.mustPayToOtherScriptWithDatumInTx
+                vh
+                (Ledger.Datum $ PlutusTx.toBuiltinData utxoRef)
+                (Ada.adaValueOf 5)
+          <> Constraints.mustSpendPubKeyOutput utxoRefForBalance1
+          <> Constraints.mustUseOutputAsCollateral utxoRefForBalance1
+          <> Constraints.mustPayToAddressWithReferenceValidator
+                myAddr
+                vh
+                Nothing
+                (Ada.adaValueOf 30)
+    submitTxConfirmed $ mkTx lookups1 tx1
+
+    -- Trying to unlock the Ada in the script address
+    scriptUtxos <- utxosAt mustReferenceOutputV2ValidatorAddress
+    utxos' <- ownUtxos
+    let
+        scriptUtxo = fst . head . M.toList $ scriptUtxos
+        refScriptUtxo = head . M.keys . M.filter (has $ Tx.decoratedTxOutReferenceScript . _Just) $ utxos'
+        lookups2 = Constraints.unspentOutputs (M.singleton utxoRef utxo <> scriptUtxos <> utxos')
+        tx2 = Constraints.mustReferenceOutput utxoRef
+          <> Constraints.mustSpendScriptOutputWithReference scriptUtxo Ledger.unitRedeemer refScriptUtxo
+          <> Constraints.mustSpendPubKeyOutput utxoRefForBalance2
+          <> Constraints.mustUseOutputAsCollateral utxoRefForBalance2
+          <> Constraints.mustBeSignedBy pkh
+    logInfo @String $ "Required Signatories: " ++ show (Constraints.requiredSignatories tx2)
+    submitTxConfirmed $ mkTx lookups2 tx2
+
+cardanoTxOwnWallet :: TestTree
+cardanoTxOwnWallet =
+    let pk  = mockWalletPaymentPubKey     w1
+        pkh = mockWalletPaymentPubKeyHash w1
+        trace = do
+            void $ Trace.activateContractWallet w1 $ cardanoTxOwnWalletContract pk pkh
+            void Trace.nextSlot
+    in checkPredicateOptions
+        (changeInitialWalletValue w1 (const $ Ada.adaValueOf 1000) defaultCheckOptions)
+        "own wallet's signature passes on-chain mustBeSignedBy validation with cardano tx" (assertValidatedTransactionCount 2) (void trace)
+
+cardanoTxOtherWalletNoSigningProcess :: TestTree
+cardanoTxOtherWalletNoSigningProcess =
+    let pk  = mockWalletPaymentPubKey     w2
+        pkh = mockWalletPaymentPubKeyHash w2
+        trace = do
+            void $ Trace.activateContractWallet w1 $ cardanoTxOwnWalletContract pk pkh
+            void Trace.nextSlot
+    in checkPredicateOptions
+        (changeInitialWalletValue w1 (const $ Ada.adaValueOf 1000) defaultCheckOptions)
+        "without Trace.setSigningProcess fails phase-1 validation"
+        (assertFailedTransaction (\_ err -> case err of {Ledger.CardanoLedgerValidationError msg -> Text.isInfixOf "MissingRequiredSigners" msg; _ -> False  }))
+    (void trace)

plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs

@@ -291,13 +291,8 @@ data UnbalancedTx
         -- Simply refers to  'slTxOutputs' of 'ScriptLookups'.
         }
     | UnbalancedCardanoTx
-        { unBalancedCardanoBuildTx        :: C.CardanoBuildTx
-        , unBalancedTxRequiredSignatories :: Set PaymentPubKeyHash
-        -- ^ These are all the payment public keys that should be used to request the
-        -- signatories from the user's wallet. The signatories are what is required to
-        -- sign the transaction before submitting it to the blockchain. Transaction
-        -- validation will fail if the transaction is not signed by the required wallet.
-        , unBalancedTxUtxoIndex           :: Map TxOutRef TxOut
+        { unBalancedCardanoBuildTx :: C.CardanoBuildTx
+        , unBalancedTxUtxoIndex    :: Map TxOutRef TxOut
         -- ^ Utxo lookups that are used for adding inputs to the 'UnbalancedTx'.
         -- Simply refers to  'slTxOutputs' of 'ScriptLookups'.
         }
@@ -325,10 +320,9 @@ instance Pretty UnbalancedTx where
         , hang 2 $ vsep $ "Requires signatures:" : (pretty <$> Set.toList rs)
         , hang 2 $ vsep $ "Utxo index:" : (pretty <$> Map.toList utxo)
         ]
-    pretty (UnbalancedCardanoTx utx rs utxo) =
+    pretty (UnbalancedCardanoTx utx utxo) =
         vsep
         [ hang 2 $ vsep ["Tx (cardano-api Representation):", pretty utx]
-        , hang 2 $ vsep $ "Requires signatures:" : (pretty <$> Set.toList rs)
         , hang 2 $ vsep $ "Utxo index:" : (pretty <$> Map.toList utxo)
         ]
 

plutus-ledger/src/Ledger/Validation.hs

@@ -304,7 +304,7 @@ makeTransactionBody
   -> Either CardanoLedgerError (C.Api.TxBody C.Api.BabbageEra)
 makeTransactionBody params utxo txBodyContent = do
   txTmp <- first Right $ makeSignedTransaction [] <$> P.makeTransactionBody (Just $ emulatorPParams params) mempty txBodyContent
-  exUnits <- bimap Left id $ (Map.map snd) <$> getTxExUnitsWithLogs params utxo txTmp
+  exUnits <- first Left $ Map.map snd <$> getTxExUnitsWithLogs params utxo txTmp
   first Right $ P.makeTransactionBody (Just $ emulatorPParams params) exUnits txBodyContent
 
 

plutus-tx-constraints/src/Ledger/Tx/Constraints/OffChain.hs

@@ -41,7 +41,6 @@ module Ledger.Tx.Constraints.OffChain(
     , tx
     , txValidityRange
     , txOuts
-    , P.requiredSignatories
     , P.utxoIndex
     , emptyUnbalancedTx
     , P.adjustUnbalancedTx
@@ -61,7 +60,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Bifunctor (first)
 import Data.Either (partitionEithers)
 import Data.Foldable (traverse_)
-import Data.Set qualified as Set
+import Data.List (nub)
 import GHC.Generics (Generic)
 import Ledger (POSIXTimeRange, Params (..), networkIdL, pProtocolParams)
 import Ledger.Constraints qualified as P
@@ -86,6 +85,7 @@ makeLensesFor
     [ ("txIns", "txIns'")
     , ("txInsCollateral", "txInsCollateral'")
     , ("txInsReference", "txInsReference'")
+    , ("txExtraKeyWits", "txExtraKeyWits'")
     , ("txOuts", "txOuts'")
     , ("txValidityRange", "txValidityRange'")
     ] ''C.TxBodyContent
@@ -101,6 +101,14 @@ txInsCollateral = coerced . txInsCollateral' . iso toList fromList
         fromList []    = C.TxInsCollateralNone
         fromList txins = C.TxInsCollateral C.CollateralInBabbageEra txins
 
+txExtraKeyWits :: Lens' C.CardanoBuildTx [C.Hash C.PaymentKey]
+txExtraKeyWits = coerced . txExtraKeyWits' . iso toList fromList
+    where
+        toList C.TxExtraKeyWitnessesNone        = []
+        toList (C.TxExtraKeyWitnesses _ txwits) = txwits
+        fromList []     = C.TxExtraKeyWitnessesNone
+        fromList txwits = C.TxExtraKeyWitnesses C.ExtraKeyWitnessesInBabbageEra $ nub txwits
+
 txInsReference :: Lens' C.CardanoBuildTx [C.TxIn]
 txInsReference = coerced . txInsReference' . iso toList fromList
     where
@@ -140,7 +148,7 @@ emptyCardanoBuildTx p = C.CardanoBuildTx $ C.TxBodyContent
     }
 
 emptyUnbalancedTx :: Params -> UnbalancedTx
-emptyUnbalancedTx params = UnbalancedCardanoTx (emptyCardanoBuildTx params) mempty mempty
+emptyUnbalancedTx params = UnbalancedCardanoTx (emptyCardanoBuildTx params) mempty
 
 initialState :: Params -> P.ConstraintProcessingState
 initialState params = P.ConstraintProcessingState
@@ -279,8 +287,9 @@ processConstraint = \case
             $ guard $ is Tx._PublicKeyDecoratedTxOut txout
         txIn <- throwLeft ToCardanoError $ C.toCardanoTxIn txo
         unbalancedTx . tx . txIns <>= [(txIn, C.BuildTxWith (C.KeyWitness C.KeyWitnessForSpending))]
-    P.MustBeSignedBy pk ->
-        unbalancedTx . P.requiredSignatories %= Set.insert pk
+    P.MustBeSignedBy pk -> do
+        ekw <-  either (throwError . ToCardanoError) pure $ C.toCardanoPaymentKeyHash pk
+        unbalancedTx . tx . txExtraKeyWits <>= [ekw]
     P.MustSpendScriptOutput txo redeemer mref -> do
         txout <- lookupTxOutRef txo
         mkWitness <- case mref of