Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Remove unneeded ScriptHash in PReferenceScript/SReferenceScript #959

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
+118 −56
Draft

Remove unneeded ScriptHash in PReferenceScript/SReferenceScript #959

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c461679
Remove unneeded ScriptHash in PReferenceScript/SReferenceScript
carbolymer Oct 31, 2024
eab98ec
more wip
carbolymer Nov 6, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
60 changes: 35 additions & 25 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,7 @@ import Cardano.CLI.Types.TxFeature
import qualified Ouroboros.Network.Protocol.LocalStateQuery.Type as Consensus
import qualified Ouroboros.Network.Protocol.LocalTxSubmission.Client as Net.Tx

import Control.Applicative
import Control.Monad (forM)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
Expand All @@ -71,7 +72,7 @@ import Data.Function ((&))
import qualified Data.List as List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, fromMaybe, mapMaybe)
import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text as Text
Expand Down Expand Up @@ -204,7 +205,7 @@ runTransactionBuildCmd
let allReferenceInputs =
getAllReferenceInputs
inputsAndMaybeScriptWits
(snd valuesWithScriptWits)
(snd <$> snd valuesWithScriptWits)
certsAndMaybeScriptWits
withdrawalsAndMaybeScriptWits
votingProceduresAndMaybeScriptWits
Expand Down Expand Up @@ -697,7 +698,7 @@ runTxBuildRaw
-- ^ Tx upper bound
-> Lovelace
-- ^ Tx fee
-> (Value, [ScriptWitness WitCtxMint era])
-> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
-- ^ Multi-Asset value(s)
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-- ^ Certificate with potential script witness
Expand Down Expand Up @@ -783,7 +784,7 @@ constructTxBodyContent
-- ^ Tx lower bound
-> TxValidityUpperBound era
-- ^ Tx upper bound
-> (Value, [ScriptWitness WitCtxMint era])
-> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
-- ^ Multi-Asset value(s)
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
-- ^ Certificate with potential script witness
Expand Down Expand Up @@ -830,7 +831,7 @@ constructTxBodyContent
let allReferenceInputs =
getAllReferenceInputs
inputsAndMaybeScriptWits
(snd valuesWithScriptWits)
(snd <$> snd valuesWithScriptWits)
certsAndMaybeScriptWits
withdrawals
votingProcedures
Expand Down Expand Up @@ -923,7 +924,7 @@ runTxBuild
-- ^ Normal outputs
-> TxOutChangeAddress
-- ^ A change output
-> (Value, [ScriptWitness WitCtxMint era])
-> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
-- ^ Multi-Asset value(s)
-> Maybe SlotNo
-- ^ Tx lower bound
Expand Down Expand Up @@ -977,7 +978,7 @@ runTxBuild
let allReferenceInputs =
getAllReferenceInputs
inputsAndMaybeScriptWits
(snd valuesWithScriptWits)
(snd <$> snd valuesWithScriptWits)
certsAndMaybeScriptWits
withdrawals
votingProcedures
Expand Down Expand Up @@ -1182,9 +1183,9 @@ getAllReferenceInputs
:: ScriptWitness witctx era -> Maybe TxIn
getReferenceInput sWit =
case sWit of
PlutusScriptWitness _ _ (PReferenceScript refIn _) _ _ _ -> Just refIn
PlutusScriptWitness _ _ (PReferenceScript refIn) _ _ _ -> Just refIn
PlutusScriptWitness _ _ PScript{} _ _ _ -> Nothing
SimpleScriptWitness _ (SReferenceScript refIn _) -> Just refIn
SimpleScriptWitness _ (SReferenceScript refIn) -> Just refIn
SimpleScriptWitness _ SScript{} -> Nothing

toAddressInAnyEra
Expand Down Expand Up @@ -1328,7 +1329,7 @@ toTxAlonzoDatum supp cliDatum =
createTxMintValue
:: forall era
. ShelleyBasedEra era
-> (Value, [ScriptWitness WitCtxMint era])
-> (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
-> Either TxCmdError (TxMintValue BuildTx era)
createTxMintValue era (val, scriptWitnesses) =
if List.null (toList val) && List.null scriptWitnesses
Expand All @@ -1337,28 +1338,37 @@ createTxMintValue era (val, scriptWitnesses) =
caseShelleyToAllegraOrMaryEraOnwards
(const (txFeatureMismatchPure (toCardanoEra era) TxFeatureMintValue))
( \w -> do
-- The set of policy ids for which we need witnesses:
let witnessesNeededSet :: Set PolicyId
witnessesNeededSet =
fromList [pid | (AssetId pid _, _) <- toList val]
let policiesWithAssets :: [(PolicyId, AssetName, Quantity)]
policiesWithAssets = [(pid, assetName, quantity) | (AssetId pid assetName, quantity) <- toList val]

let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
-- The set of policy ids for which we need witnesses:
witnessesNeededSet :: Set PolicyId
witnessesNeededSet = fromList [pid | (pid, _, _) <- policiesWithAssets]

witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era)
witnessesProvidedMap = fromList $ gatherMintingWitnesses scriptWitnesses
witnessesProvidedSet = Map.keysSet witnessesProvidedMap

-- Check not too many, nor too few:
policiesWithWitnesses =
Map.fromListWith
(<>)
[ (pid, [(assetName, quantity, BuildTxWith witness)])
| (pid, assetName, quantity) <- policiesWithAssets
, witness <- maybeToList $ Map.lookup pid witnessesProvidedMap
]

validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet
validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet
return (TxMintValue w val (BuildTxWith witnessesProvidedMap))
pure $ TxMintValue w policiesWithWitnesses
)
era
where
gatherMintingWitnesses
:: [ScriptWitness WitCtxMint era]
:: [(Maybe PolicyId, ScriptWitness WitCtxMint era)]
-> [(PolicyId, ScriptWitness WitCtxMint era)]
gatherMintingWitnesses [] = []
gatherMintingWitnesses (sWit : rest) =
case scriptWitnessPolicyId sWit of
gatherMintingWitnesses ((mPid, sWit) : rest) =
Copy link
Contributor

@Jimbo4350 Jimbo4350 Nov 6, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We need a new data definition.

fetchReferenceMintingScriptWitness :: UTxO era -> ScriptWitness WitCtxMint era -> UpdatedReferenceScriptWitness

and in the case where the user chooses to supply it

updateReferenceScriptWitness :: PolicyId -> ScriptWitness WitCtxMint era -> UpdatedReferenceScriptWitness

Propagating Maybe PolicyId may work but it results in poor readability. If the user does not supply the policy id we want the ability to query the UTxO to get the reference script witnesses so we can calculate the policy ID.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This would be the short to medium term fix until we can figure out how to encapsulate this in cardano-api.

Copy link
Contributor Author

@carbolymer carbolymer Nov 6, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I agree about the first case with fetchReferenceMintingScriptWitness. I'd do this in a follow-up PR.

What is not clear to me is how to thread in Maybe PolicyId from the CLI argument parser to this place in a clean way. What's your idea about this scenario, when the user provides Maybe PolicyId manually?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would start with something like: data MintingReferenceScriptWitness era = MintingReferenceScriptWitness PolicyId (ScriptWitness WitCtxMint era)

I'd do this in a follow-up PR.

In this instance I would insist its done in this PR.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

No worries, let me push some changes tomorrow to make sure what I am suggesting can actually work.

Copy link
Contributor Author

@carbolymer carbolymer Nov 6, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I've removed my comment as I'm still wrapping my head around the idea and experimenting with it. Feel free to push.

case scriptWitnessPolicyId sWit <|> mPid of
Nothing -> gatherMintingWitnesses rest
Just pid -> (pid, sWit) : gatherMintingWitnesses rest

Expand All @@ -1377,17 +1387,17 @@ createTxMintValue era (val, scriptWitnesses) =
scriptWitnessPolicyId :: ScriptWitness witctx era -> Maybe PolicyId
scriptWitnessPolicyId (SimpleScriptWitness _ (SScript script)) =
Just . scriptPolicyId $ SimpleScript script
scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _ mPid)) =
PolicyId <$> mPid
scriptWitnessPolicyId (SimpleScriptWitness _ (SReferenceScript _)) =
Nothing
scriptWitnessPolicyId (PlutusScriptWitness _ version (PScript script) _ _ _) =
Just . scriptPolicyId $ PlutusScript version script
scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _ mPid) _ _ _) =
PolicyId <$> mPid
scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) =
Nothing

readValueScriptWitnesses
:: ShelleyBasedEra era
-> (Value, [ScriptWitnessFiles WitCtxMint])
-> ExceptT TxCmdError IO (Value, [ScriptWitness WitCtxMint era])
-> ExceptT TxCmdError IO (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)])
readValueScriptWitnesses era (v, sWitFiles) = do
sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles
return (v, sWits)
Expand Down
3 changes: 2 additions & 1 deletion cardano-cli/src/Cardano/CLI/Json/Friendly.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -804,7 +804,8 @@ friendlyLovelace value = String $ docToText (pretty value)
friendlyMintValue :: TxMintValue ViewTx era -> Aeson.Value
friendlyMintValue = \case
TxMintNone -> Null
TxMintValue sbe v _ -> friendlyValue (maryEraOnwardsToShelleyBasedEra sbe) v
txMintValue@(TxMintValue w _) ->
friendlyValue (maryEraOnwardsToShelleyBasedEra w) (txMintValueToValue txMintValue)

friendlyTxOutValue :: TxOutValue era -> Aeson.Value
friendlyTxOutValue = \case
Expand Down
28 changes: 15 additions & 13 deletions cardano-cli/src/Cardano/CLI/Read.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -272,7 +272,7 @@ readScriptWitnessFiles
readScriptWitnessFiles era = mapM readSwitFile
where
readSwitFile (tIn, Just switFile) = do
sWit <- readScriptWitness era switFile
sWit <- snd <$> readScriptWitness era switFile
return (tIn, Just sWit)
readSwitFile (tIn, Nothing) = return (tIn, Nothing)

Expand All @@ -283,22 +283,22 @@ readScriptWitnessFilesTuple
readScriptWitnessFilesTuple era = mapM readSwitFile
where
readSwitFile (tIn, b, Just switFile) = do
sWit <- readScriptWitness era switFile
sWit <- snd <$> readScriptWitness era switFile
return (tIn, b, Just sWit)
readSwitFile (tIn, b, Nothing) = return (tIn, b, Nothing)

readScriptWitness
:: ShelleyBasedEra era
-> ScriptWitnessFiles witctx
-> ExceptT ScriptWitnessError IO (ScriptWitness witctx era)
-> ExceptT ScriptWitnessError IO (Maybe PolicyId, ScriptWitness witctx era)
readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do
script@(ScriptInAnyLang lang _) <-
firstExceptT ScriptWitnessErrorFile $
readFileScriptInAnyLang scriptFile
ScriptInEra langInEra script' <- validateScriptSupportedInEra era script
case script' of
SimpleScript sscript ->
return . SimpleScriptWitness langInEra $ SScript sscript
return . (Nothing,) . SimpleScriptWitness langInEra $ SScript sscript
-- If the supplied cli flags were for a simple script (i.e. the user did
-- not supply the datum, redeemer or ex units), but the script file turns
-- out to be a valid plutus script, then we must fail.
Expand Down Expand Up @@ -327,7 +327,7 @@ readScriptWitness
redeemer <-
firstExceptT ScriptWitnessErrorScriptData $
readScriptRedeemerOrFile redeemerOrFile
return $
pure . (Nothing,) $
PlutusScriptWitness
langInEra
version
Expand Down Expand Up @@ -375,11 +375,11 @@ readScriptWitness
redeemer <-
firstExceptT ScriptWitnessErrorScriptData $
readScriptRedeemerOrFile redeemerOrFile
return $
return . (mPid,) $
PlutusScriptWitness
sLangInEra
version
(PReferenceScript refTxIn (unPolicyId <$> mPid))
(PReferenceScript refTxIn)
datum
redeemer
execUnits
Expand All @@ -406,8 +406,8 @@ readScriptWitness
Just sLangInEra ->
case languageOfScriptLanguageInEra sLangInEra of
SimpleScriptLanguage ->
return . SimpleScriptWitness sLangInEra $
SReferenceScript refTxIn (unPolicyId <$> mPid)
return . (mPid,) . SimpleScriptWitness sLangInEra $
SReferenceScript refTxIn
PlutusScriptLanguage{} ->
error "readScriptWitness: Should not be possible to specify a plutus script"
Nothing ->
Expand Down Expand Up @@ -922,8 +922,9 @@ readSingleVote w (voteFp, mScriptWitFiles) = do
let sbe = conwayEraOnwardsToShelleyBasedEra w
runExceptT $ do
sWits <-
firstExceptT VoteErrorScriptWitness $
mapM (readScriptWitness sbe) sWitFile
fmap (fmap snd) $
firstExceptT VoteErrorScriptWitness $
mapM (readScriptWitness sbe) sWitFile
hoistEither $ (,sWits) <$> votProceds

data ConstitutionError
Expand Down Expand Up @@ -968,8 +969,9 @@ readProposal w (fp, mScriptWit) = do
let sbe = conwayEraOnwardsToShelleyBasedEra w
runExceptT $ do
sWit <-
firstExceptT ProposalErrorScriptWitness $
mapM (readScriptWitness sbe) sWitFile
fmap (fmap snd) $
firstExceptT ProposalErrorScriptWitness $
mapM (readScriptWitness sbe) sWitFile
hoistEither $ (,sWit) <$> prop

constitutionHashSourceToHash
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/Types/Output.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -383,7 +383,7 @@ renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping executionCostMapping =
Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum
-- TODO: Create a new sum type to encapsulate the fact that we can also
-- have a txin and render the txin in the case of reference scripts.
Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn _) _ _ _)) ->
Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn) _ _ _)) ->
case Map.lookup refTxIn utxo of
Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) : accum
Just (TxOut _ _ _ refScript) ->
Expand Down
Loading