diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 61a4daf5ba..6c52171f8c 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -1450,6 +1450,13 @@ substituteExecutionUnits redeemer exunits + adjustScriptWitness + :: (ScriptWitness witctx era -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)) + -> Witness witctx era + -> Either (TxBodyErrorAutoBalance era) (Witness witctx era) + adjustScriptWitness _ (KeyWitness ctx) = Right $ KeyWitness ctx + adjustScriptWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness' + mapScriptWitnessesTxIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] -> Either (TxBodyErrorAutoBalance era) [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] @@ -1461,27 +1468,18 @@ substituteExecutionUnits ] mappedScriptWitnesses = [ (txin, BuildTxWith <$> wit') - | -- The tx ins are indexed in the map order by txid - (ix, (txin, BuildTxWith wit)) <- zip [0 ..] (orderTxIns txins) - , let wit' = case wit of - KeyWitness{} -> Right wit - ScriptWitness ctx witness -> ScriptWitness ctx <$> witness' - where - witness' = substituteExecUnits (ScriptWitnessIndexTxIn ix) witness + | (ix, txin, wit) <- indexTxIns txins + , let wit' = adjustScriptWitness (substituteExecUnits ix) wit ] in traverse - ( \(txIn, eWitness) -> - case eWitness of - Left e -> Left e - Right wit -> Right (txIn, wit) - ) + (\(txIn, eWitness) -> (txIn,) <$> eWitness) mappedScriptWitnesses mapScriptWitnessesWithdrawals :: TxWithdrawals BuildTx era -> Either (TxBodyErrorAutoBalance era) (TxWithdrawals BuildTx era) mapScriptWitnessesWithdrawals TxWithdrawalsNone = Right TxWithdrawalsNone - mapScriptWitnessesWithdrawals (TxWithdrawals supported withdrawals) = + mapScriptWitnessesWithdrawals txWithdrawals'@(TxWithdrawals supported _) = let mappedWithdrawals :: [ ( StakeAddress , L.Coin @@ -1490,55 +1488,30 @@ substituteExecutionUnits ] mappedWithdrawals = [ (addr, withdrawal, BuildTxWith <$> mappedWitness) - | -- The withdrawals are indexed in the map order by stake credential - (ix, (addr, withdrawal, BuildTxWith wit)) <- zip [0 ..] (orderStakeAddrs withdrawals) - , let mappedWitness = adjustWitness (substituteExecUnits (ScriptWitnessIndexWithdrawal ix)) wit + | (ix, addr, withdrawal, wit) <- indexTxWithdrawals txWithdrawals' + , let mappedWitness = adjustScriptWitness (substituteExecUnits ix) wit ] in TxWithdrawals supported <$> traverse - ( \(sAddr, ll, eWitness) -> - case eWitness of - Left e -> Left e - Right wit -> Right (sAddr, ll, wit) - ) + (\(sAddr, ll, eWitness) -> (sAddr,ll,) <$> eWitness) mappedWithdrawals - where - adjustWitness - :: (ScriptWitness witctx era -> Either (TxBodyErrorAutoBalance era) (ScriptWitness witctx era)) - -> Witness witctx era - -> Either (TxBodyErrorAutoBalance era) (Witness witctx era) - adjustWitness _ (KeyWitness ctx) = Right $ KeyWitness ctx - adjustWitness g (ScriptWitness ctx witness') = ScriptWitness ctx <$> g witness' mapScriptWitnessesCertificates :: TxCertificates BuildTx era -> Either (TxBodyErrorAutoBalance era) (TxCertificates BuildTx era) mapScriptWitnessesCertificates TxCertificatesNone = Right TxCertificatesNone - mapScriptWitnessesCertificates - ( TxCertificates - supported - certs - (BuildTxWith witnesses) - ) = - let mappedScriptWitnesses - :: [(StakeCredential, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))] - mappedScriptWitnesses = - [ (stakecred, ScriptWitness ctx <$> witness') - | -- The certs are indexed in list order - (ix, cert) <- zip [0 ..] certs - , stakecred <- maybeToList (selectStakeCredentialWitness cert) - , ScriptWitness ctx witness <- - maybeToList (List.lookup stakecred witnesses) - , let witness' = substituteExecUnits (ScriptWitnessIndexCertificate ix) witness - ] - in TxCertificates supported certs . BuildTxWith - <$> traverse - ( \(sCred, eScriptWitness) -> - case eScriptWitness of - Left e -> Left e - Right wit -> Right (sCred, wit) - ) - mappedScriptWitnesses + mapScriptWitnessesCertificates txCertificates'@(TxCertificates supported certs _) = + let mappedScriptWitnesses + :: [(StakeCredential, Either (TxBodyErrorAutoBalance era) (Witness WitCtxStake era))] + mappedScriptWitnesses = + [ (stakeCred, witness') + | (ix, _, stakeCred, witness) <- indexTxCertificates txCertificates' + , let witness' = adjustScriptWitness (substituteExecUnits ix) witness + ] + in TxCertificates supported certs . BuildTxWith + <$> traverse + (\(sCred, eScriptWitness) -> (sCred,) <$> eScriptWitness) + mappedScriptWitnesses mapScriptWitnessesVotes :: Maybe (Featured ConwayEraOnwards era (TxVotingProcedures build era)) @@ -1548,13 +1521,11 @@ substituteExecutionUnits mapScriptWitnessesVotes Nothing = return Nothing mapScriptWitnessesVotes (Just (Featured _ TxVotingProceduresNone)) = return Nothing mapScriptWitnessesVotes (Just (Featured _ (TxVotingProcedures _ ViewTx))) = return Nothing - mapScriptWitnessesVotes (Just (Featured era (TxVotingProcedures vProcedures (BuildTxWith sWitMap)))) = do + mapScriptWitnessesVotes (Just (Featured era txVotingProcedures'@(TxVotingProcedures vProcedures (BuildTxWith _)))) = do let eSubstitutedExecutionUnits = [ (vote, updatedWitness) - | let allVoteMap = L.unVotingProcedures vProcedures - , (vote, scriptWitness) <- toList sWitMap - , index <- maybeToList $ Map.lookupIndex vote allVoteMap - , let updatedWitness = substituteExecUnits (ScriptWitnessIndexVoting $ fromIntegral index) scriptWitness + | (ix, vote, witness) <- indexTxVotingProcedures txVotingProcedures' + , let updatedWitness = substituteExecUnits ix witness ] substitutedExecutionUnits <- traverseScriptWitnesses eSubstitutedExecutionUnits @@ -1571,13 +1542,11 @@ substituteExecutionUnits mapScriptWitnessesProposals Nothing = return Nothing mapScriptWitnessesProposals (Just (Featured _ TxProposalProceduresNone)) = return Nothing mapScriptWitnessesProposals (Just (Featured _ (TxProposalProcedures _ ViewTx))) = return Nothing - mapScriptWitnessesProposals (Just (Featured era txpp@(TxProposalProcedures osetProposalProcedures (BuildTxWith sWitMap)))) = do - let allProposalsList = toList $ convProposalProcedures txpp - eSubstitutedExecutionUnits = + mapScriptWitnessesProposals (Just (Featured era txpp@(TxProposalProcedures osetProposalProcedures (BuildTxWith _)))) = do + let eSubstitutedExecutionUnits = [ (proposal, updatedWitness) - | (proposal, scriptWitness) <- toList sWitMap - , index <- maybeToList $ List.elemIndex proposal allProposalsList - , let updatedWitness = substituteExecUnits (ScriptWitnessIndexProposing $ fromIntegral index) scriptWitness + | (ix, proposal, scriptWitness) <- indexTxProposalProcedures txpp + , let updatedWitness = substituteExecUnits ix scriptWitness ] substitutedExecutionUnits <- traverseScriptWitnesses eSubstitutedExecutionUnits @@ -1596,7 +1565,7 @@ substituteExecutionUnits mapScriptWitnessesMinting txMintValue'@(TxMintValue w _) = do let mappedScriptWitnesses = [ (policyId, pure . (assetName',quantity,) <$> substitutedWitness) - | (ix, policyId, assetName', quantity, BuildTxWith witness) <- txMintValueToIndexed txMintValue' + | (ix, policyId, assetName', quantity, BuildTxWith witness) <- indexTxMintValue txMintValue' , let substitutedWitness = BuildTxWith <$> substituteExecUnits ix witness ] final <- Map.fromListWith (<>) <$> traverseScriptWitnesses mappedScriptWitnesses diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index ce59e80da5..0ba0c92068 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -696,6 +696,23 @@ data SimpleScriptOrReferenceInput lang | SReferenceScript TxIn deriving (Eq, Show) +-- ---------------------------------------------------------------------------- +-- The kind of witness to use, key (signature) or script +-- + +data Witness witctx era where + KeyWitness + :: KeyWitnessInCtx witctx + -> Witness witctx era + ScriptWitness + :: ScriptWitnessInCtx witctx + -> ScriptWitness witctx era + -> Witness witctx era + +deriving instance Eq (Witness witctx era) + +deriving instance Show (Witness witctx era) + -- | A /use/ of a script within a transaction body to witness that something is -- being used in an authorised manner. That can be -- @@ -797,23 +814,6 @@ getScriptWitnessReferenceInputOrScript = \case PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _ -> Right txIn --- ---------------------------------------------------------------------------- --- The kind of witness to use, key (signature) or script --- - -data Witness witctx era where - KeyWitness - :: KeyWitnessInCtx witctx - -> Witness witctx era - ScriptWitness - :: ScriptWitnessInCtx witctx - -> ScriptWitness witctx era - -> Witness witctx era - -deriving instance Eq (Witness witctx era) - -deriving instance Show (Witness witctx era) - data KeyWitnessInCtx witctx where KeyWitnessForSpending :: KeyWitnessInCtx WitCtxTxIn KeyWitnessForStakeAddr :: KeyWitnessInCtx WitCtxStake diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index e2601300c8..2627375931 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -101,6 +101,7 @@ module Cardano.Api.Tx.Body -- * Transaction inputs , TxIn (..) , TxIns + , indexTxIns , TxIx (..) , genesisUTxOPseudoTxIn , getReferenceInputsSizeForTxIds @@ -132,15 +133,19 @@ module Cardano.Api.Tx.Body , TxAuxScripts (..) , TxExtraKeyWitnesses (..) , TxWithdrawals (..) + , indexTxWithdrawals , TxCertificates (..) + , indexTxCertificates , TxUpdateProposal (..) , TxMintValue (..) , txMintValueToValue - , txMintValueToIndexed + , indexTxMintValue , TxVotingProcedures (..) , mkTxVotingProcedures + , indexTxVotingProcedures , TxProposalProcedures (..) , mkTxProposalProcedures + , indexTxProposalProcedures , convProposalProcedures -- ** Building vs viewing transactions @@ -196,8 +201,6 @@ module Cardano.Api.Tx.Body -- * Misc helpers , calculateExecutionUnitsLovelace - , orderStakeAddrs - , orderTxIns -- * Data family instances , AsType (AsTxId, AsTxBody, AsByronTxBody, AsShelleyTxBody, AsMaryTxBody) @@ -314,7 +317,8 @@ import Data.String import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) +import Data.Type.Equality +import Data.Typeable import Data.Word (Word16, Word32, Word64) import GHC.Exts (IsList (..)) import GHC.Stack @@ -934,6 +938,23 @@ deriving instance Show a => Show (BuildTxWith build a) type TxIns build era = [(TxIn, BuildTxWith build (Witness WitCtxTxIn era))] +-- | Index transaction inputs ordered by TxIn +-- Please note that the result can contain also 'KeyWitness'es. +-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf +indexTxIns + :: TxIns BuildTx era + -> [(ScriptWitnessIndex, TxIn, Witness WitCtxTxIn era)] +indexTxIns txins = + [ (ScriptWitnessIndexTxIn ix, txIn, witness) + | (ix, (txIn, BuildTxWith witness)) <- zip [0 ..] $ orderTxIns txins + ] + where + -- This relies on the TxId Ord instance being consistent with the + -- Ledger.TxId Ord instance via the toShelleyTxId conversion + -- This is checked by prop_ord_distributive_TxId + orderTxIns :: [(TxIn, v)] -> [(TxIn, v)] + orderTxIns = sortBy (compare `on` fst) + data TxInsCollateral era where TxInsCollateralNone :: TxInsCollateral era @@ -1238,6 +1259,23 @@ deriving instance Eq (TxWithdrawals build era) deriving instance Show (TxWithdrawals build era) +-- | Index the withdrawals with witnesses in the order of stake addresses. +-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf +indexTxWithdrawals + :: TxWithdrawals BuildTx era + -> [(ScriptWitnessIndex, StakeAddress, L.Coin, Witness WitCtxStake era)] +indexTxWithdrawals TxWithdrawalsNone = [] +indexTxWithdrawals (TxWithdrawals _ withdrawals) = + [ (ScriptWitnessIndexWithdrawal ix, addr, coin, witness) + | (ix, (addr, coin, BuildTxWith witness)) <- zip [0 ..] (orderStakeAddrs withdrawals) + ] + where + -- This relies on the StakeAddress Ord instance being consistent with the + -- Shelley.RewardAcnt Ord instance via the toShelleyStakeAddr conversion + -- This is checked by prop_ord_distributive_StakeAddress + orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)] + orderStakeAddrs = sortBy (compare `on` (\(k, _, _) -> k)) + -- ---------------------------------------------------------------------------- -- Certificates within transactions (era-dependent) -- @@ -1256,6 +1294,22 @@ deriving instance Eq (TxCertificates build era) deriving instance Show (TxCertificates build era) +-- | Index certificates with witnesses by the order they appear in the list (in the transaction). If there are multiple witnesses for the same stake credential, they will be present multiple times with the same index. +-- are multiple witnesses for the credential, there will be multiple entries for +-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf +indexTxCertificates + :: TxCertificates BuildTx era + -> [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)] +indexTxCertificates TxCertificatesNone = [] +indexTxCertificates (TxCertificates _ certs (BuildTxWith witnesses)) = + [ (ScriptWitnessIndexCertificate ix, cert, stakeCred, wit) + | (ix, cert) <- zip [0 ..] certs + , stakeCred <- maybeToList (selectStakeCredentialWitness cert) + , wit <- findAll stakeCred witnesses + ] + where + findAll needle = map snd . filter ((==) needle . fst) + -- ---------------------------------------------------------------------------- -- Transaction update proposal (era-dependent) -- @@ -1301,7 +1355,7 @@ txMintValueToValue (TxMintValue _ policiesWithAssets) = -- | Index the assets with witnesses in the order of policy ids. -- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf -txMintValueToIndexed +indexTxMintValue :: TxMintValue build era -> [ ( ScriptWitnessIndex , PolicyId @@ -1310,8 +1364,8 @@ txMintValueToIndexed , BuildTxWith build (ScriptWitness WitCtxMint era) ) ] -txMintValueToIndexed TxMintNone = [] -txMintValueToIndexed (TxMintValue _ policiesWithAssets) = +indexTxMintValue TxMintNone = [] +indexTxMintValue (TxMintValue _ policiesWithAssets) = [ (ScriptWitnessIndexMint ix, policyId', assetName', quantity, witness) | (ix, (policyId', assets)) <- zip [0 ..] $ toList policiesWithAssets , (assetName', quantity, witness) <- assets @@ -1368,6 +1422,22 @@ mkTxVotingProcedures votingProcedures = do getVotingScriptCredentials (VotingProcedures (L.VotingProcedures m)) = listToMaybe $ Map.keys m +-- | Index voting procedures by the order of the votes ('Ord'). +indexTxVotingProcedures + :: TxVotingProcedures BuildTx era + -> [ ( ScriptWitnessIndex + , L.Voter (Ledger.EraCrypto (ShelleyLedgerEra era)) + , ScriptWitness WitCtxStake era + ) + ] +indexTxVotingProcedures TxVotingProceduresNone = [] +indexTxVotingProcedures (TxVotingProcedures vProcedures (BuildTxWith sWitMap)) = + [ (ScriptWitnessIndexVoting $ fromIntegral index, vote, scriptWitness) + | let allVoteMap = L.unVotingProcedures vProcedures + , (vote, scriptWitness) <- toList sWitMap + , index <- maybeToList $ Map.lookupIndex vote allVoteMap + ] + -- ---------------------------------------------------------------------------- -- Proposals within transactions (era-dependent) -- @@ -1409,6 +1479,18 @@ mkTxProposalProcedures proposalsWithWitnessesList = do partitionProposals (ps, pws) (p, Just w) = (DList.snoc ps p, DList.snoc pws (p, w)) -- add a proposal both to the list and to the witnessed list +-- | Index proposal procedures by their order ('Ord'). +indexTxProposalProcedures + :: TxProposalProcedures BuildTx era + -> [(ScriptWitnessIndex, L.ProposalProcedure (ShelleyLedgerEra era), ScriptWitness WitCtxStake era)] +indexTxProposalProcedures TxProposalProceduresNone = [] +indexTxProposalProcedures txpp@(TxProposalProcedures _ (BuildTxWith witnesses)) = do + let allProposalsList = toList $ convProposalProcedures txpp + [ (ScriptWitnessIndexProposing $ fromIntegral ix, proposal, scriptWitness) + | (proposal, scriptWitness) <- toList witnesses + , ix <- maybeToList $ List.elemIndex proposal allProposalsList + ] + -- ---------------------------------------------------------------------------- -- Transaction body content -- @@ -3311,10 +3393,26 @@ toShelleyTxOutAny _ = \case -- | A 'ScriptWitness' in any 'WitCtx'. This lets us handle heterogeneous -- collections of script witnesses from multiple contexts. data AnyScriptWitness era where - AnyScriptWitness :: ScriptWitness witctx era -> AnyScriptWitness era + AnyScriptWitness + :: Typeable witctx + => ScriptWitness witctx era + -> AnyScriptWitness era deriving instance Show (AnyScriptWitness era) +instance Eq (AnyScriptWitness era) where + AnyScriptWitness sw1 == AnyScriptWitness sw2 = + case eqsw sw1 sw2 of + Just Refl -> sw1 == sw2 + Nothing -> False + where + eqsw + :: (Typeable w1, Typeable w2) + => ScriptWitness w1 era + -> ScriptWitness w2 era + -> Maybe (w1 :~: w2) + eqsw _ _ = eqT + -- | Identify the location of a 'ScriptWitness' within the context of a -- 'TxBody'. These are indexes of the objects within the transaction that -- need or can use script witnesses: inputs, minted assets, withdrawals and @@ -3482,81 +3580,61 @@ collectTxBodyScriptWitnesses scriptWitnessesTxIns :: [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] -> [(ScriptWitnessIndex, AnyScriptWitness era)] - scriptWitnessesTxIns txins = - [ (ScriptWitnessIndexTxIn ix, AnyScriptWitness witness) - | -- The tx ins are indexed in the map order by txid - (ix, (_, BuildTxWith (ScriptWitness _ witness))) <- - zip [0 ..] (orderTxIns txins) - ] + scriptWitnessesTxIns txIns' = + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, ScriptWitness _ witness) <- indexTxIns txIns' + ] scriptWitnessesWithdrawals :: TxWithdrawals BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesWithdrawals TxWithdrawalsNone = [] - scriptWitnessesWithdrawals (TxWithdrawals _ withdrawals) = - [ (ScriptWitnessIndexWithdrawal ix, AnyScriptWitness witness) - | -- The withdrawals are indexed in the map order by stake credential - (ix, (_, _, BuildTxWith (ScriptWitness _ witness))) <- - zip [0 ..] (orderStakeAddrs withdrawals) - ] + scriptWitnessesWithdrawals txw = + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, _, ScriptWitness _ witness) <- indexTxWithdrawals txw + ] scriptWitnessesCertificates :: TxCertificates BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesCertificates TxCertificatesNone = [] - scriptWitnessesCertificates (TxCertificates _ certs (BuildTxWith witnesses)) = - [ (ScriptWitnessIndexCertificate ix, AnyScriptWitness witness) - | -- The certs are indexed in list order - (ix, cert) <- zip [0 ..] certs - , ScriptWitness _ witness <- maybeToList $ do - stakecred <- selectStakeCredentialWitness cert - List.lookup stakecred witnesses - ] + scriptWitnessesCertificates txc = + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, _, ScriptWitness _ witness) <- indexTxCertificates txc + ] scriptWitnessesMinting :: TxMintValue BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesMinting TxMintNone = [] scriptWitnessesMinting txMintValue' = - [ (ix, AnyScriptWitness witness) - | (ix, _, _, _, BuildTxWith witness) <- txMintValueToIndexed txMintValue' - ] + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, _, _, BuildTxWith witness) <- indexTxMintValue txMintValue' + ] scriptWitnessesVoting :: TxVotingProcedures BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesVoting TxVotingProceduresNone = [] - scriptWitnessesVoting (TxVotingProcedures (L.VotingProcedures votes) (BuildTxWith witnesses)) = - [ (ScriptWitnessIndexVoting ix, AnyScriptWitness witness) - | let voterList = toList votes - , (ix, (voter, _)) <- zip [0 ..] voterList - , witness <- maybeToList (Map.lookup voter witnesses) - ] + scriptWitnessesVoting txv = + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, witness) <- indexTxVotingProcedures txv + ] scriptWitnessesProposing :: TxProposalProcedures BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesProposing TxProposalProceduresNone = [] -scriptWitnessesProposing (TxProposalProcedures proposalProcedures (BuildTxWith mScriptWitnesses)) - | Map.null mScriptWitnesses = [] - | otherwise = - [ (ScriptWitnessIndexProposing ix, AnyScriptWitness witness) - | let proposalsList = toList proposalProcedures - , (ix, proposal) <- zip [0 ..] proposalsList - , witness <- maybeToList (Map.lookup proposal mScriptWitnesses) - ] - --- This relies on the TxId Ord instance being consistent with the --- Ledger.TxId Ord instance via the toShelleyTxId conversion --- This is checked by prop_ord_distributive_TxId -orderTxIns :: [(TxIn, v)] -> [(TxIn, v)] -orderTxIns = sortBy (compare `on` fst) - --- This relies on the StakeAddress Ord instance being consistent with the --- Shelley.RewardAcnt Ord instance via the toShelleyStakeAddr conversion --- This is checked by prop_ord_distributive_StakeAddress -orderStakeAddrs :: [(StakeAddress, x, v)] -> [(StakeAddress, x, v)] -orderStakeAddrs = sortBy (compare `on` (\(k, _, _) -> k)) +scriptWitnessesProposing txp = + List.nub + [ (ix, AnyScriptWitness witness) + | (ix, _, witness) <- indexTxProposalProcedures txp + ] -- TODO: Investigate if we need toShelleyWithdrawal :: [(StakeAddress, L.Coin, a)] -> L.Withdrawals StandardCrypto diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index dd5078cde1..4ca9994569 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -394,7 +394,7 @@ module Cardano.Api , TxUpdateProposal (..) , TxMintValue (..) , txMintValueToValue - , txMintValueToIndexed + , indexTxMintValue , TxVotingProcedures (..) , mkTxVotingProcedures , TxProposalProcedures (..)