diff --git a/cabal.project b/cabal.project index d4f940f150..0e9862e099 100644 --- a/cabal.project +++ b/cabal.project @@ -13,8 +13,8 @@ repository cardano-haskell-packages -- See CONTRIBUTING for information about these, including some Nix commands -- you need to run if you change them index-state: - , hackage.haskell.org 2025-11-05T09:40:54Z - , cardano-haskell-packages 2025-11-24T10:27:41Z + , hackage.haskell.org 2025-12-02T22:23:29Z + , cardano-haskell-packages 2025-12-16T19:04:42Z packages: cardano-cli @@ -66,3 +66,11 @@ if impl (ghc >= 9.12) -- IMPORTANT -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. + + +source-repository-package + type: git + location: https://github.com/IntersectMBO/cardano-api.git + tag: de62268d9158f9900c0d9d2aab2ed950ce73946f + --sha256: sha256-a6QYmiR9uOEuBXWCiV3jXO7M3i6VdpccRG/WjC5HsHI= + subdir: cardano-api \ No newline at end of file diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 5e00dd30e6..ca296cd191 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -67,6 +67,7 @@ library Cardano.CLI.Compatible.Governance.Types Cardano.CLI.Compatible.Json.Friendly Cardano.CLI.Compatible.Option + Cardano.CLI.Compatible.Read Cardano.CLI.Compatible.Run Cardano.CLI.Compatible.StakeAddress.Command Cardano.CLI.Compatible.StakeAddress.Option @@ -241,7 +242,7 @@ library binary, bytestring, canonical-json, - cardano-api ^>=10.20, + cardano-api ^>=10.21, cardano-binary, cardano-crypto, cardano-crypto-class ^>=2.2.3.2, @@ -280,6 +281,7 @@ library network, network-uri, optparse-applicative-fork, + ordered-containers, ouroboros-consensus, ouroboros-consensus-cardano, prettyprinter, diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Command.hs b/cardano-cli/src/Cardano/CLI/Compatible/Command.hs index 6780c8cf30..990874f5ba 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Command.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Command.hs @@ -20,10 +20,9 @@ import Cardano.CLI.Compatible.StakePool.Command import Cardano.CLI.Compatible.Transaction.Command import Data.Text -import Data.Typeable (Typeable) data AnyCompatibleCommand where - AnyCompatibleCommand :: Typeable era => CompatibleCommand era -> AnyCompatibleCommand + AnyCompatibleCommand :: CompatibleCommand era -> AnyCompatibleCommand renderAnyCompatibleCommand :: AnyCompatibleCommand -> Text renderAnyCompatibleCommand = \case diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Read.hs b/cardano-cli/src/Cardano/CLI/Compatible/Read.hs new file mode 100644 index 0000000000..821181ee8e --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Compatible/Read.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.CLI.Compatible.Read + ( AnyPlutusScript (..) + , readFilePlutusScript + , readFileSimpleScript + ) +where + +import Cardano.Api as Api + +import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Read (readFileCli) +import Cardano.CLI.Type.Error.ScriptDecodeError +import Prelude + +import Data.Aeson qualified as Aeson +import Data.ByteString qualified as BS + +import Cardano.CLI.Type.Error.PlutusScriptDecodeError + +import Data.Bifunctor + +import Data.Text qualified as Text + + +readFileSimpleScript + :: FilePath + -> CIO e (Script SimpleScript') +readFileSimpleScript file = do + scriptBytes <- readFileCli file + fromEitherCli $ + deserialiseSimpleScript scriptBytes + + +deserialiseSimpleScript + :: BS.ByteString + -> Either ScriptDecodeError (Script SimpleScript') +deserialiseSimpleScript bs = + case deserialiseFromJSON bs of + Left _ -> + -- In addition to the TextEnvelope format, we also try to + -- deserialize the JSON representation of SimpleScripts. + case Aeson.eitherDecodeStrict' bs of + Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) + Right script -> Right $ SimpleScript script + Right te -> + case deserialiseFromTextEnvelopeAnyOf [teType'] te of + Left err -> Left (ScriptDecodeTextEnvelopeError err) + Right script -> Right script + where + teType' :: FromSomeType HasTextEnvelope (Script SimpleScript') + teType' = FromSomeType (AsScript AsSimpleScript) id + + + +data AnyPlutusScript where + AnyPlutusScript + :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript + +readFilePlutusScript + :: FilePath + -> CIO e AnyPlutusScript +readFilePlutusScript plutusScriptFp = do + bs <- + readFileCli plutusScriptFp + fromEitherCli $ deserialisePlutusScript bs + +deserialisePlutusScript + :: BS.ByteString + -> Either PlutusScriptDecodeError AnyPlutusScript +deserialisePlutusScript bs = do + te <- first PlutusScriptJsonDecodeError $ deserialiseFromJSON bs + case teType te of + TextEnvelopeType s -> case s of + sVer@"PlutusScriptV1" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV1 te + sVer@"PlutusScriptV2" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV2 te + sVer@"PlutusScriptV3" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV3 te + unknownScriptVersion -> + Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion + where + deserialiseAnyPlutusScriptVersion + :: IsPlutusScriptLanguage lang + => String + -> PlutusScriptVersion lang + -> TextEnvelope + -> Either PlutusScriptDecodeError AnyPlutusScript + deserialiseAnyPlutusScriptVersion v lang tEnv = + if v == show lang + then + first PlutusScriptDecodeTextEnvelopeError $ + deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv + else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang) + + teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript + teTypes = + \case + AnyPlutusScriptVersion PlutusScriptV1 -> + FromSomeType (AsPlutusScript AsPlutusScriptV1) (AnyPlutusScript PlutusScriptV1) + AnyPlutusScriptVersion PlutusScriptV2 -> + FromSomeType (AsPlutusScript AsPlutusScriptV2) (AnyPlutusScript PlutusScriptV2) + AnyPlutusScriptVersion PlutusScriptV3 -> + FromSomeType (AsPlutusScript AsPlutusScriptV3) (AnyPlutusScript PlutusScriptV3) + AnyPlutusScriptVersion PlutusScriptV4 -> + FromSomeType (AsPlutusScript AsPlutusScriptV4) (AnyPlutusScript PlutusScriptV4) \ No newline at end of file diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs index fee866af24..c28a4d1dde 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -11,29 +12,36 @@ module Cardano.CLI.Compatible.Transaction.Run where import Cardano.Api hiding (VotingProcedures) +import Cardano.Api qualified as OldApi import Cardano.Api.Compatible +import Cardano.Api.Compatible.Certificate qualified as Compatible +import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L hiding ( VotingProcedures ) +import Cardano.Binary import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.Read qualified as Compatible import Cardano.CLI.Compatible.Transaction.Command -import Cardano.CLI.Compatible.Transaction.ScriptWitness import Cardano.CLI.Compatible.Transaction.TxOut import Cardano.CLI.EraBased.Script.Certificate.Type import Cardano.CLI.EraBased.Script.Proposal.Read -import Cardano.CLI.EraBased.Script.Proposal.Type +import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.EraBased.Script.Vote.Read -import Cardano.CLI.EraBased.Script.Vote.Type - ( VoteScriptWitness (..) - ) import Cardano.CLI.EraBased.Transaction.Run import Cardano.CLI.Read import Cardano.CLI.Type.Common import Control.Monad +import Data.ByteString.Short qualified as SBS +import Data.Map.Ordered.Strict qualified as OMap +import Data.Typeable import Lens.Micro runCompatibleTransactionCmd @@ -59,12 +67,12 @@ runCompatibleTransactionCmd allOuts <- mapM (toTxOutInAnyEra sbe) outs certFilesAndMaybeScriptWits <- - readCertificateScriptWitnesses sbe certificates + readCertificateScriptWitnesses' sbe certificates certsAndMaybeScriptWits <- liftIO $ sequenceA - [ fmap (,cswScriptWitness <$> mSwit) $ + [ fmap (,mSwit) $ fromEitherIOCli $ readFileTextEnvelope $ File certFile @@ -85,14 +93,21 @@ runCompatibleTransactionCmd Nothing -> return (NoPParamsUpdate sbe, NoVotes) Just prop -> do pparamUpdate <- readProposalProcedureFile prop - votesAndWits <- readVotingProceduresFiles w mVotes - votingProcedures <- - fromEitherCli $ mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits] - return (pparamUpdate, VotingProcedures w votingProcedures) + votesAndWits :: [(OldApi.VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <- + obtainCommonConstraints (convert w) $ readVotingProceduresFiles mVotes + votingProcedures :: (Exp.TxVotingProcedures (Exp.LedgerEra era)) <- + obtainTypeable w $ + fromEitherCli + ( Exp.mkTxVotingProcedures + [ (obtainCommonConstraints (convert w) $ OldApi.unVotingProcedures vp, anyW) + | (vp, anyW) <- votesAndWits + ] + ) + return (pparamUpdate, VotingProcedures w $ obtainCommonConstraints (convert w) votingProcedures) ) sbe - let txCerts = mkTxCertificates sbe certsAndMaybeScriptWits + let txCerts = mkTxCertificates' sbe certsAndMaybeScriptWits transaction@(ShelleyTx _ ledgerTx) <- fromEitherCli $ @@ -114,6 +129,125 @@ runCompatibleTransactionCmd fromEitherIOCli $ writeTxFileTextEnvelope sbe outputFp signedTx +readCertificateScriptWitnesses' + :: ShelleyBasedEra era + -> [(CertificateFile, Maybe (ScriptRequirements Exp.CertItem))] + -> CIO e [(CertificateFile, Exp.AnyWitness (ShelleyLedgerEra era))] +readCertificateScriptWitnesses' sbe = + mapM + ( \(certFile, mSWit) -> do + case mSWit of + Nothing -> return (certFile, Exp.AnyKeyWitnessPlaceholder) + Just cert -> do + sWit <- readCertificateScriptWitness' sbe cert + return (certFile, sWit) + ) + +-- TODO: Left off here. You need to create this function in order to +-- use createCompatibleTx because you changed it's type signature. +readCertificateScriptWitness' + :: forall era e + . ShelleyBasedEra era + -> ScriptRequirements Exp.CertItem + -> CIO e (Exp.AnyWitness (ShelleyLedgerEra era)) +readCertificateScriptWitness' sbe (OnDiskSimpleScript scriptFp) = do + let sFp = unFile scriptFp + ss <- Compatible.readFileSimpleScript sFp + let serialisedSS = serialiseToCBOR ss + let simpleScriptE :: Either DecoderError (Exp.SimpleScript (ShelleyLedgerEra era)) = shelleyBasedEraConstraints sbe $ Exp.deserialiseSimpleScript serialisedSS + simpleScript <- fromEitherCli simpleScriptE + return $ Exp.AnySimpleScriptWitness $ Exp.SScript simpleScript +readCertificateScriptWitness' + sbe + ( OnDiskPlutusScript + (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) + ) = do + let plutusScriptFp = unFile scriptFp + Compatible.AnyPlutusScript plutusScriptVer (PlutusScriptSerialised sBytes) <- + Compatible.readFilePlutusScript plutusScriptFp + let anyLang :: Exp.AnyPlutusScriptLanguage = case plutusScriptVer of + PlutusScriptV1 -> Exp.AnyPlutusScriptLanguage L.SPlutusV1 + PlutusScriptV2 -> Exp.AnyPlutusScriptLanguage L.SPlutusV2 + PlutusScriptV3 -> Exp.AnyPlutusScriptLanguage L.SPlutusV3 + PlutusScriptV4 -> Exp.AnyPlutusScriptLanguage L.SPlutusV4 + bs = SBS.fromShort sBytes + + eAnyPlutusScript :: Either DecoderError (Exp.AnyPlutusScript (ShelleyLedgerEra era)) = shelleyBasedEraConstraints sbe $ Exp.decodeAnyPlutusScript bs anyLang + Exp.AnyPlutusScript anyPlutusScript <- fromEitherCli eAnyPlutusScript + let + lang = Exp.plutusScriptInEraSLanguage anyPlutusScript + let script' = Exp.PScript anyPlutusScript + + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile + + let sw = + Exp.PlutusScriptWitness + lang + script' + Exp.NoScriptDatum + redeemer + execUnits + return $ + Exp.AnyPlutusScriptWitness $ + Exp.AnyPlutusCertifyingScriptWitness sw +readCertificateScriptWitness' + _ + ( PlutusReferenceScript + ( PlutusRefScriptCliArgs + refInput + (AnySLanguage lang) + Exp.NoScriptDatumAllowed + NoPolicyId + redeemerFile + execUnits + ) + ) = do + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile + return $ + Exp.AnyPlutusScriptWitness $ + Exp.AnyPlutusCertifyingScriptWitness $ + Exp.PlutusScriptWitness + lang + (Exp.PReferenceScript refInput) + Exp.NoScriptDatum + redeemer + execUnits +readCertificateScriptWitness' _ (SimpleReferenceScript (SimpleRefScriptArgs refTxin NoPolicyId)) = + return . Exp.AnySimpleScriptWitness $ Exp.SReferenceScript refTxin + +-- | Create 'TxCertificates'. Note that 'Certificate era' will be deduplicated. Only Certificates with a +-- stake credential will be in the result. +-- +-- Note that, when building a transaction in Conway era, a witness is not required for staking credential +-- registration, but this is only the case during the transitional period of Conway era and only for staking +-- credential registration certificates without a deposit. Future eras will require a witness for +-- registration certificates, because the one without a deposit will be removed. +mkTxCertificates' + :: forall era + . ShelleyBasedEra era + -> [(Exp.Certificate (ShelleyLedgerEra era), Exp.AnyWitness (ShelleyLedgerEra era))] + -> Exp.TxCertificates (ShelleyLedgerEra era) +mkTxCertificates' era certs = Exp.TxCertificates . OMap.fromList $ map getStakeCred certs + where + getStakeCred + :: (Exp.Certificate (ShelleyLedgerEra era), Exp.AnyWitness (ShelleyLedgerEra era)) + -> ( Exp.Certificate (ShelleyLedgerEra era) + , Maybe (StakeCredential, Exp.AnyWitness (ShelleyLedgerEra era)) + ) + getStakeCred (c@(Exp.Certificate cert), wit) = + (c, (,wit) <$> Compatible.getTxCertWitness (convert era) cert) + +obtainTypeable + :: ConwayEraOnwards era + -> (Typeable (Exp.LedgerEra era) => r) + -> r +obtainTypeable ConwayEraOnwardsConway r = r +obtainTypeable ConwayEraOnwardsDijkstra r = r + readUpdateProposalFile :: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile) -> CIO e (AnyProtocolUpdate era) @@ -135,11 +269,11 @@ readProposalProcedureFile (Featured cEraOnwards []) = in return $ NoPParamsUpdate sbe readProposalProcedureFile (Featured cEraOnwards proposals) = do let era = convert cEraOnwards - props :: [(Proposal era, Maybe (ProposalScriptWitness era))] <- + props :: [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] <- Exp.obtainCommonConstraints era $ mapM readProposal proposals return $ Exp.obtainCommonConstraints era $ ProposalProcedures cEraOnwards $ - mkTxProposalProcedures - [(govProp, pswScriptWitness <$> mScriptWit) | (Proposal govProp, mScriptWit) <- props] + Exp.mkTxProposalProcedures + [(govProp, swit) | (Proposal govProp, swit) <- props] diff --git a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs index b64b70832e..4675b4b617 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs @@ -11,10 +11,11 @@ module Cardano.CLI.Compatible.Transaction.ScriptWitness where import Cardano.Api - ( AnyPlutusScriptVersion (..) - , AnyShelleyBasedEra (..) + ( AnyShelleyBasedEra (..) , File (..) + , IsPlutusScriptLanguage , PlutusScriptOrReferenceInput (..) + , PlutusScriptVersion (..) , Script (..) , ScriptDatum (..) , ScriptLanguage (..) @@ -26,14 +27,23 @@ import Cardano.Api , shelleyBasedEraConstraints ) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.Plutus (fromPlutusSLanguage) +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.Read import Cardano.CLI.EraBased.Script.Certificate.Type -import Cardano.CLI.EraBased.Script.Read.Common +import Cardano.CLI.EraBased.Script.Read.Common (readScriptDataOrFile) import Cardano.CLI.EraBased.Script.Type + ( CliScriptWitnessError (..) + , NoPolicyId (..) + , OnDiskPlutusScriptCliArgs (..) + , ScriptRequirements (..) + , SimpleRefScriptCliArgs (..) + ) import Cardano.CLI.EraBased.Script.Type qualified as Exp -import Cardano.CLI.Read -import Cardano.CLI.Type.Common (CertificateFile) +import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile) +import Cardano.Ledger.Plutus.Language qualified as L import Control.Monad @@ -64,8 +74,7 @@ readCertificateScriptWitness sbe certScriptReq = OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - plutusScript <- - readFilePlutusScript plutusScriptFp + plutusScript <- readFilePlutusScript plutusScriptFp redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile @@ -75,7 +84,7 @@ readCertificateScriptWitness sbe certScriptReq = sLangSupported <- fromMaybeCli ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) + (fromOldScriptLanguage lang) (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) ) $ scriptLanguageSupportedInEra sbe @@ -98,33 +107,51 @@ readCertificateScriptWitness sbe certScriptReq = PlutusReferenceScript ( PlutusRefScriptCliArgs refTxIn - anyPlutusScriptVersion + (AnySLanguage lang) Exp.NoScriptDatumAllowed Exp.NoPolicyId redeemerFile execUnits ) -> do - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - redeemer <- - fromExceptTCli $ - readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + let pScript = PReferenceScript refTxIn + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile + sLangSupported <- + fromMaybeCli + ( PlutusScriptWitnessLanguageNotSupportedInEra + (L.plutusLanguage lang) + (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) + ) + $ scriptLanguageSupportedInEra sbe + $ obtainIsPlutusScriptLanguage (fromPlutusSLanguage lang) + $ PlutusScriptLanguage + $ Exp.fromPlutusSLanguage lang - return $ - CertificateScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits + return $ + CertificateScriptWitness $ + obtainIsPlutusScriptLanguage (fromPlutusSLanguage lang) $ + PlutusScriptWitness + sLangSupported + (Exp.fromPlutusSLanguage lang) + pScript + NoScriptDatumForStake + redeemer + execUnits + +fromOldScriptLanguage :: PlutusScriptVersion lang -> L.Language +fromOldScriptLanguage PlutusScriptV1 = L.PlutusV1 +fromOldScriptLanguage PlutusScriptV2 = L.PlutusV2 +fromOldScriptLanguage PlutusScriptV3 = L.PlutusV3 +fromOldScriptLanguage PlutusScriptV4 = L.PlutusV4 + +obtainIsPlutusScriptLanguage + :: PlutusScriptVersion lang + -> (IsPlutusScriptLanguage lang => a) + -> a +obtainIsPlutusScriptLanguage lang f = + case lang of + PlutusScriptV1 -> f + PlutusScriptV2 -> f + PlutusScriptV3 -> f + PlutusScriptV4 -> f diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs index 30585f6a4c..17585a3870 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs @@ -34,6 +34,7 @@ import Cardano.CLI.Type.Governance import Cardano.CLI.Type.Key import Cardano.CLI.Type.Key.VerificationKey import Cardano.Ledger.BaseTypes (NonZero, nonZero) +import Cardano.Ledger.Plutus.Language qualified as L import Control.Monad (void, when) import Data.Aeson qualified as Aeson @@ -1125,7 +1126,7 @@ pVoteReferencePlutusScriptWitness prefix autoBalanceExecUnits = let appendedPrefix = prefix ++ "-" in Voting.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn appendedPrefix "plutus" - <*> plutusP appendedPrefix PlutusScriptV3 "v3" + <*> plutusSLanguageP appendedPrefix L.SPlutusV3 "v3" <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in") <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1183,7 +1184,7 @@ pProposalReferencePlutusScriptWitness prefix autoBalanceExecUnits = let appendedPrefix = prefix ++ "-" in Proposing.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn appendedPrefix "plutus" - <*> plutusP appendedPrefix PlutusScriptV3 "v3" + <*> plutusSLanguageP appendedPrefix L.SPlutusV3 "v3" <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in") <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1383,7 +1384,7 @@ pCertificateReferencePlutusScriptWitness prefix autoBalanceExecUnits = let appendedPrefix = prefix ++ "-" in Certifying.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn appendedPrefix "plutus" - <*> pPlutusScriptLanguage appendedPrefix + <*> pAnyPlutusSLanguage appendedPrefix <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in") <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1498,7 +1499,7 @@ pWithdrawalReferencePlutusScriptWitness prefix autoBalanceExecUnits = let appendedPrefix = prefix ++ "-" in Withdrawal.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn appendedPrefix "plutus" - <*> pPlutusScriptLanguage appendedPrefix + <*> pAnyPlutusSLanguage appendedPrefix <*> pScriptRedeemerOrFile (appendedPrefix ++ "reference-tx-in") <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) @@ -1508,6 +1509,20 @@ pWithdrawalReferencePlutusScriptWitness prefix autoBalanceExecUnits = pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3" +pAnyPlutusSLanguage :: String -> Parser AnySLanguage +pAnyPlutusSLanguage prefix = + plutusSLanguageP prefix L.SPlutusV2 "v2" <|> plutusSLanguageP prefix L.SPlutusV3 "v3" + +plutusSLanguageP + :: L.PlutusLanguage lang + => String -> L.SLanguage lang -> String -> Parser AnySLanguage +plutusSLanguageP prefix plutusVersion versionString = + Opt.flag' + (AnySLanguage plutusVersion) + ( Opt.long (prefix <> "plutus-script-" <> versionString) + <> Opt.help ("Specify a plutus script " <> versionString <> " reference script.") + ) + plutusP :: IsPlutusScriptLanguage lang => String -> PlutusScriptVersion lang -> String -> Parser AnyPlutusScriptVersion @@ -1955,7 +1970,7 @@ pTxIn balance = pPlutusReferenceSpendScriptWitness autoBalanceExecUnits = PlutusSpend.createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "spending-" "plutus" - <*> pPlutusScriptLanguage "spending-" + <*> pAnyPlutusSLanguage "spending-" <*> pScriptDatumOrFileSpendingCip69 "spending-reference-tx-in" <*> pScriptRedeemerOrFile "spending-reference-tx-in" <*> ( case autoBalanceExecUnits of @@ -2167,7 +2182,7 @@ pMintMultiAsset balanceExecUnits = pPlutusMintReferenceScriptWitnessFiles autoBalanceExecUnits = createPlutusReferenceScriptFromCliArgs <$> pReferenceTxIn "mint-" "plutus" - <*> pPlutusScriptLanguage "mint-" + <*> pAnyPlutusSLanguage "mint-" <*> pScriptRedeemerOrFile "mint-reference-tx-in" <*> ( case autoBalanceExecUnits of AutoBalance -> pure (ExecutionUnits 0 0) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Run.hs index 5f69f5ce7f..266c4ab3bb 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Actions/Run.hs @@ -27,7 +27,6 @@ import Cardano.CLI.Compatible.Json.Friendly import Cardano.CLI.EraBased.Governance.Actions.Command import Cardano.CLI.EraBased.Governance.Actions.Command qualified as Cmd import Cardano.CLI.EraBased.Script.Proposal.Read -import Cardano.CLI.EraBased.Script.Proposal.Type import Cardano.CLI.EraIndependent.Hash.Internal.Common (getByteStringFromURL, httpsAndIpfsSchemes) import Cardano.CLI.Read import Cardano.CLI.Type.Common @@ -72,7 +71,7 @@ runGovernanceActionViewCmd , Cmd.mOutFile , Cmd.era } = Exp.obtainCommonConstraints era $ do - proposal :: (Proposal era, Maybe (ProposalScriptWitness era)) <- + proposal :: (Proposal era, Exp.AnyWitness (Exp.LedgerEra era)) <- readProposal (actionFile, Nothing) void $ friendlyProposal outputFormat mOutFile $ fst proposal diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Vote/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Vote/Run.hs index 19e1d2f370..4c66fec66b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Governance/Vote/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Governance/Vote/Run.hs @@ -15,6 +15,7 @@ where import Cardano.Api import Cardano.Api.Experimental (obtainCommonConstraints) +import Cardano.Api.Experimental qualified as Exp import Cardano.Api.Ledger qualified as L import Cardano.CLI.Compatible.Exception @@ -103,7 +104,8 @@ runGovernanceVoteViewCmd , mOutFile } = do obtainCommonConstraints era $ do - voteProcedures <- fst <$> readVoteScriptWitness (convert era) (voteFile, Nothing) + voteProcedures :: VotingProcedures era <- + fst <$> obtainCommonConstraints (era :: Exp.Era era) (readVoteScriptWitness (voteFile, Nothing)) let output = outputFormat diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs index b8061e3391..91bec4c800 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs @@ -12,22 +12,17 @@ module Cardano.CLI.EraBased.Script.Certificate.Read where import Cardano.Api (File (..)) -import Cardano.Api qualified as Api import Cardano.Api.Experimental import Cardano.Api.Experimental qualified as Exp -import Cardano.Api.Ledger qualified as L -import Cardano.Api.Plutus (AnyPlutusScriptVersion (..), ToLedgerPlutusLanguage) +import Cardano.Api.Experimental.AnyScriptWitness +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception --- import Cardano.CLI.EraBased.Script.Certificate.Type import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Orphan () import Cardano.CLI.Read -import Cardano.CLI.Type.Common (CertificateFile) -import Cardano.Ledger.Core qualified as L -import Cardano.Ledger.Plutus.Language qualified as L -import Cardano.Ledger.Plutus.Language qualified as Plutus +import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile) readCertificateScriptWitness :: forall era e @@ -36,98 +31,59 @@ readCertificateScriptWitness -> CIO e (AnyWitness (LedgerEra era)) readCertificateScriptWitness (OnDiskSimpleScript scriptFp) = do let sFp = unFile scriptFp - s <- - readFileSimpleScript sFp - let nativeScript :: SimpleScript (LedgerEra era) = convertTotimelock useEra s - return $ - AnySimpleScriptWitness $ - SScript nativeScript + AnySimpleScriptWitness . SScript <$> readFileSimpleScript sFp useEra readCertificateScriptWitness ( OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) ) = do let plutusScriptFp = unFile scriptFp - AnyPlutusScript sVer apiScript <- - readFilePlutusScript plutusScriptFp + Exp.AnyPlutusScript script <- + readFilePlutusScript @_ @era plutusScriptFp - let lang = toPlutusSLanguage sVer - script <- decodePlutusScript useEra sVer apiScript + let + lang = Exp.plutusScriptInEraSLanguage script + script' = PScript script redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile + + let sw = + PlutusScriptWitness + lang + script' + NoScriptDatum + redeemer + execUnits return $ AnyPlutusScriptWitness $ - PlutusScriptWitness - lang - script - NoScriptDatum - redeemer - execUnits + AnyPlutusCertifyingScriptWitness sw readCertificateScriptWitness ( PlutusReferenceScript ( PlutusRefScriptCliArgs refInput - (AnyPlutusScriptVersion sVer) + (AnySLanguage lang) Exp.NoScriptDatumAllowed NoPolicyId redeemerFile execUnits ) ) = do - let lang = toPlutusSLanguage sVer redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile return $ AnyPlutusScriptWitness $ - PlutusScriptWitness - lang - (PReferenceScript refInput) - NoScriptDatum - redeemer - execUnits + AnyPlutusCertifyingScriptWitness $ + PlutusScriptWitness + lang + (PReferenceScript refInput) + NoScriptDatum + redeemer + execUnits readCertificateScriptWitness (SimpleReferenceScript (SimpleRefScriptArgs refTxin NoPolicyId)) = return . AnySimpleScriptWitness $ SReferenceScript refTxin -decodePlutusScript - :: forall era lang e - . Era era - -> Api.PlutusScriptVersion lang - -> Api.PlutusScript lang - -> CIO e (PlutusScriptOrReferenceInput (ToLedgerPlutusLanguage lang) (LedgerEra era)) -decodePlutusScript era sVer (Api.PlutusScriptSerialised script) = obtainConstraints sVer $ do - let runnableScriptBs = L.Plutus $ L.PlutusBinary script - plutusRunnable <- - fromEitherCli $ - Plutus.decodePlutusRunnable - (getVersion era) - runnableScriptBs - return $ PScript (PlutusScriptInEra plutusRunnable) - -obtainConstraints - :: Api.PlutusScriptVersion lang - -> (L.PlutusLanguage (ToLedgerPlutusLanguage lang) => a) - -> a -obtainConstraints v = - case v of - Api.PlutusScriptV1 -> id - Api.PlutusScriptV2 -> id - Api.PlutusScriptV3 -> id - Api.PlutusScriptV4 -> id - -getVersion :: forall era. Era era -> L.Version -getVersion e = obtainCommonConstraints e $ L.eraProtVerLow @(LedgerEra era) - -convertTotimelock - :: forall era - . Era era - -> Api.Script Api.SimpleScript' - -> SimpleScript (LedgerEra era) -convertTotimelock era (Api.SimpleScript s) = - let native :: L.NativeScript (LedgerEra era) = obtainCommonConstraints era $ Api.toAllegraTimelock s - in obtainCommonConstraints era $ SimpleScript native - readCertificateScriptWitnesses :: IsEra era => [(CertificateFile, Maybe (ScriptRequirements Exp.CertItem))] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Type.hs index 88f4b55608..2458e719d0 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Type.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} module Cardano.CLI.EraBased.Script.Certificate.Type ( CertificateScriptWitness (..) @@ -14,7 +15,7 @@ import Cardano.Api import Cardano.Api.Experimental import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.Type.Common (ScriptDataOrFile) +import Cardano.CLI.Type.Common (AnySLanguage (..), ScriptDataOrFile) newtype CertificateScriptWitness era = CertificateScriptWitness {cswScriptWitness :: ScriptWitness WitCtxStake era} @@ -31,10 +32,10 @@ createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDataOrFile -> ExecutionUnits -> ScriptRequirements CertItem -createPlutusReferenceScriptFromCliArgs txIn version redeemer execUnits = +createPlutusReferenceScriptFromCliArgs txIn l redeemer execUnits = PlutusReferenceScript $ - PlutusRefScriptCliArgs txIn version NoScriptDatumAllowed NoPolicyId redeemer execUnits + PlutusRefScriptCliArgs txIn l NoScriptDatumAllowed NoPolicyId redeemer execUnits diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs index 5b48ef6687..26b22e3537 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraBased.Script.Mint.Read ( readMintScriptWitness @@ -10,106 +12,80 @@ where import Cardano.Api import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness +import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as L +import Cardano.Api.Ledger qualified as L import Cardano.CLI.Compatible.Exception -import Cardano.CLI.EraBased.Script.Mint.Type (MintScriptWitnessWithPolicyId (..)) import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type - ( AnyPlutusScript (..) - , CliScriptWitnessError (..) - , OnDiskPlutusScriptCliArgs (..) - , PlutusRefScriptCliArgs (..) - , ScriptRequirements (..) - , SimpleRefScriptCliArgs (..) - ) import Cardano.CLI.Read +import Cardano.CLI.Type.Common (AnySLanguage (..)) +import Cardano.Ledger.Core qualified as L readMintScriptWitness - :: Exp.IsEra era - => ScriptRequirements Exp.MintItem -> CIO e (MintScriptWitnessWithPolicyId era) + :: forall era e + . Exp.IsEra era + => ScriptRequirements Exp.MintItem -> CIO e (PolicyId, Exp.AnyWitness (Exp.LedgerEra era)) readMintScriptWitness (OnDiskSimpleScript scriptFp) = do let sFp = unFile scriptFp - s <- - readFileSimpleScript sFp - - case s of - SimpleScript ss -> do - let polId = PolicyId $ hashScript s - return $ - MintScriptWitnessWithPolicyId polId $ - SimpleScriptWitness (sbeToSimpleScriptLanguageInEra $ convert Exp.useEra) $ - SScript ss + s <- readFileSimpleScript sFp (Exp.useEra @era) + let sHash :: L.ScriptHash = + Exp.hashSimpleScript (s :: Exp.SimpleScript (Exp.LedgerEra era)) + return (fromMaryPolicyID $ L.PolicyID sHash, Exp.AnySimpleScriptWitness $ Exp.SScript s) readMintScriptWitness ( OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) ) = do let plutusScriptFp = unFile scriptFp - plutusScript <- - readFilePlutusScript plutusScriptFp - + Exp.AnyPlutusScript script <- + readFilePlutusScript @_ @era plutusScriptFp + let polId = fromMaryPolicyID . L.PolicyID $ L.hashPlutusScriptInEra script redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile - case plutusScript of - AnyPlutusScript lang script -> do - let pScript = PScript script - sbe = convert Exp.useEra - polId = scriptPolicyId $ PlutusScript lang script - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang - return $ - MintScriptWitnessWithPolicyId polId $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForMint - redeemer - execUnits + + let pScript = Exp.PScript script + lang = Exp.plutusScriptInEraSLanguage script + let sw = + Exp.PlutusScriptWitness + lang + pScript + Exp.NoScriptDatum + redeemer + execUnits + return + ( polId + , Exp.AnyPlutusScriptWitness $ + AnyPlutusMintingScriptWitness sw + ) readMintScriptWitness ( PlutusReferenceScript ( PlutusRefScriptCliArgs refTxIn - anyPlutusScriptVersion + (AnySLanguage lang) Exp.NoScriptDatumAllowed polId redeemerFile execUnits ) ) = do - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - sbe = convert Exp.useEra - redeemer <- - fromExceptTCli $ readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + redeemer <- + fromExceptTCli $ readScriptDataOrFile redeemerFile - return $ - MintScriptWitnessWithPolicyId polId $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForMint - redeemer - execUnits + let sw = + Exp.PlutusScriptWitness + lang + (Exp.PReferenceScript refTxIn) + Exp.NoScriptDatum + redeemer + execUnits + return + ( polId + , Exp.AnyPlutusScriptWitness $ + AnyPlutusMintingScriptWitness + sw + ) readMintScriptWitness (SimpleReferenceScript (SimpleRefScriptArgs refTxIn polId)) = - return $ - MintScriptWitnessWithPolicyId polId $ - SimpleScriptWitness - (sbeToSimpleScriptLanguageInEra $ convert Exp.useEra) - (SReferenceScript refTxIn) + return (polId, Exp.AnySimpleScriptWitness $ Exp.SReferenceScript refTxIn) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Type.hs index 40585663c1..f9f424c8a9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Type.hs @@ -16,7 +16,7 @@ import Cardano.Api.Experimental import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.Type.Common (ScriptDataOrFile) +import Cardano.CLI.Type.Common (AnySLanguage (..), ScriptDataOrFile) -- We always need the policy id when constructing a transaction that mints. -- In the case of reference scripts, the user currently must provide the policy id (script hash) @@ -47,7 +47,7 @@ createSimpleReferenceScriptFromCliArgs txin polid = createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDataOrFile -> ExecutionUnits -> PolicyId diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs index ce243969b6..3a0f8d03e8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Read.hs @@ -16,6 +16,8 @@ where import Cardano.Api import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Proposal.Type @@ -28,109 +30,83 @@ readProposalScriptWitness :: forall e era . Exp.IsEra era => (ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem)) - -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) + -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era)) readProposalScriptWitness (propFp, Nothing) = do proposal <- obtainCommonConstraints (Exp.useEra @era) $ fromEitherIOCli @(FileError TextEnvelopeError) $ readFileTextEnvelope propFp - return (proposal, Nothing) -readProposalScriptWitness (propFp, Just certScriptReq) = do - let sbe = convert Exp.useEra - proposal <- - obtainCommonConstraints (Exp.useEra @era) $ - fromEitherIOCli @(FileError TextEnvelopeError) $ - readFileTextEnvelope propFp - case certScriptReq of - OnDiskSimpleScript scriptFp -> do - let sFp = unFile scriptFp - s <- - readFileSimpleScript sFp - case s of - SimpleScript ss -> do + return (proposal, Exp.AnyKeyWitnessPlaceholder) +readProposalScriptWitness (propFp, Just certScriptReq) = + do + proposal <- + obtainCommonConstraints (Exp.useEra @era) $ + fromEitherIOCli @(FileError TextEnvelopeError) $ + readFileTextEnvelope propFp + case certScriptReq of + OnDiskSimpleScript scriptFp -> do + let sFp = unFile scriptFp + s <- + Exp.AnySimpleScriptWitness . Exp.SScript <$> readFileSimpleScript sFp (Exp.useEra @era) + + return + ( proposal + , s + ) + OnDiskPlutusScript + (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do + let plutusScriptFp = unFile scriptFp + Exp.AnyPlutusScript plutusScript <- + readFilePlutusScript @_ @era plutusScriptFp + let lang = Exp.plutusScriptInEraSLanguage plutusScript + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile + + let pScript = Exp.PScript plutusScript + sw = + Exp.PlutusScriptWitness + lang + pScript + Exp.NoScriptDatum + redeemer + execUnits return ( proposal - , Just $ - ProposalScriptWitness - ( SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ - SScript ss - ) + , Exp.AnyPlutusScriptWitness $ + AnyPlutusProposingScriptWitness sw ) - OnDiskPlutusScript - (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do - let plutusScriptFp = unFile scriptFp - plutusScript <- - readFilePlutusScript plutusScriptFp - redeemer <- - fromExceptTCli $ - readScriptDataOrFile redeemerFile - case plutusScript of - AnyPlutusScript lang script -> do - let pScript = PScript script - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang - return - ( proposal - , Just $ - ProposalScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits - ) - SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> - return - ( proposal - , Just . ProposalScriptWitness $ - SimpleScriptWitness - (sbeToSimpleScriptLanguageInEra $ convert Exp.useEra) - (SReferenceScript refTxIn) - ) - PlutusReferenceScript - ( PlutusRefScriptCliArgs - refTxIn - anyPlutusScriptVersion - Exp.NoScriptDatumAllowed - NoPolicyId - redeemerFile - execUnits - ) -> do - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - redeemer <- - fromExceptTCli $ - readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> + return + ( proposal + , Exp.AnySimpleScriptWitness $ Exp.SReferenceScript refTxIn + ) + PlutusReferenceScript + ( PlutusRefScriptCliArgs + refTxIn + (AnySLanguage lang) + Exp.NoScriptDatumAllowed + NoPolicyId + redeemerFile + execUnits + ) -> do + let pScript = Exp.PReferenceScript refTxIn + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile - return - ( proposal - , Just $ - ProposalScriptWitness $ - PlutusScriptWitness - sLangSupported + return + ( proposal + , Exp.AnyPlutusScriptWitness $ + AnyPlutusProposingScriptWitness + ( Exp.PlutusScriptWitness lang pScript - NoScriptDatumForStake + Exp.NoScriptDatum redeemer execUnits - ) + ) + ) newtype ProposalError = ProposalErrorFile (FileError CliScriptWitnessError) @@ -142,12 +118,12 @@ instance Error ProposalError where readProposal :: Exp.IsEra era => (ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem)) - -> CIO e (Proposal era, Maybe (ProposalScriptWitness era)) + -> CIO e (Proposal era, Exp.AnyWitness (Exp.LedgerEra era)) readProposal (fp, mScriptWit) = do readProposalScriptWitness (fp, mScriptWit) readTxGovernanceActions :: Exp.IsEra era => [(ProposalFile In, Maybe (ScriptRequirements Exp.ProposalItem))] - -> CIO e [(Proposal era, Maybe (ProposalScriptWitness era))] + -> CIO e [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] readTxGovernanceActions = mapM readProposal diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Type.hs index 3791e5cfcc..6a7d05f4dd 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Proposal/Type.hs @@ -4,7 +4,6 @@ module Cardano.CLI.EraBased.Script.Proposal.Type ( PlutusRefScriptCliArgs (..) - , ProposalScriptWitness (..) , createSimpleOrPlutusScriptFromCliArgs , createPlutusReferenceScriptFromCliArgs ) @@ -15,11 +14,7 @@ import Cardano.Api.Experimental import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.Type.Common (ScriptDataOrFile) - -newtype ProposalScriptWitness era - = ProposalScriptWitness {pswScriptWitness :: ScriptWitness WitCtxStake era} - deriving Show +import Cardano.CLI.Type.Common (AnySLanguage (..), ScriptDataOrFile) createSimpleOrPlutusScriptFromCliArgs :: File ScriptInAnyLang In @@ -32,10 +27,10 @@ createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDataOrFile -> ExecutionUnits -> ScriptRequirements ProposalItem -createPlutusReferenceScriptFromCliArgs txIn version redeemer execUnits = +createPlutusReferenceScriptFromCliArgs txIn anySLang redeemer execUnits = PlutusReferenceScript $ - PlutusRefScriptCliArgs txIn version Exp.NoScriptDatumAllowed NoPolicyId redeemer execUnits + PlutusRefScriptCliArgs txIn anySLang Exp.NoScriptDatumAllowed NoPolicyId redeemer execUnits diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs index ed611bd879..0382ceab5a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Read/Common.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Cardano.CLI.EraBased.Script.Read.Common ( -- * Plutus Script Related @@ -12,12 +13,14 @@ module Cardano.CLI.EraBased.Script.Read.Common where import Cardano.Api as Api +import Cardano.Api.Experimental (obtainCommonConstraints) +import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.Read (readFileCli) import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.ScriptDataError -import Cardano.CLI.Type.Error.ScriptDecodeError +import Cardano.Ledger.Core qualified as L import Prelude @@ -26,32 +29,26 @@ import Data.Bifunctor import Data.ByteString qualified as BS import Data.ByteString.Lazy.Char8 qualified as LBS -deserialiseSimpleScript - :: BS.ByteString - -> Either ScriptDecodeError (Script SimpleScript') -deserialiseSimpleScript bs = +-- TODO: Update to handle hex script bytes directly as well! +readFileSimpleScript + :: forall era e + . FilePath + -> Exp.Era era + -> CIO e (Exp.SimpleScript (Exp.LedgerEra era)) +readFileSimpleScript file era = do + bs <- readFileCli file case deserialiseFromJSON bs of - Left _ -> + Left _ -> do -- In addition to the TextEnvelope format, we also try to - -- deserialize the JSON representation of SimpleScripts. - case Aeson.eitherDecodeStrict' bs of - Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err) - Right script -> Right $ SimpleScript script - Right te -> - case deserialiseFromTextEnvelopeAnyOf [teType'] te of - Left err -> Left (ScriptDecodeTextEnvelopeError err) - Right script -> Right script - where - teType' :: FromSomeType HasTextEnvelope (Script SimpleScript') - teType' = FromSomeType (AsScript AsSimpleScript) id - -readFileSimpleScript - :: FilePath - -> CIO e (Script SimpleScript') -readFileSimpleScript file = do - scriptBytes <- readFileCli file - fromEitherCli $ - deserialiseSimpleScript scriptBytes + -- deserialize the JSON representation of SimpleScripts.. + script :: SimpleScript <- fromEitherCli $ Aeson.eitherDecodeStrict' bs + let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints era $ toAllegraTimelock script + return $ obtainCommonConstraints (era :: Exp.Era era) $ Exp.SimpleScript s + Right te -> do + let scriptBs = teRawCBOR te + obtainCommonConstraints era $ + fromEitherCli $ + Exp.deserialiseSimpleScript scriptBs readScriptDataOrFile :: MonadIO m diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs index 3fc2040520..8fc8b20daf 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Read.hs @@ -3,7 +3,9 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraBased.Script.Spend.Read ( CliSpendScriptWitnessError @@ -22,16 +24,16 @@ import Cardano.Api.Experimental hiding , SScript , SimpleScript ) +import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common -import Cardano.CLI.EraBased.Script.Spend.Type - ( SpendScriptWitness (..) - ) import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Read - -import Control.Monad +import Cardano.CLI.Type.Common (AnySLanguage (..)) +import Cardano.Ledger.Plutus.Language qualified as L newtype CliSpendScriptWitnessError = CliScriptWitnessError CliScriptWitnessError @@ -44,96 +46,80 @@ instance Error CliSpendScriptWitnessError where readSpendScriptWitnesses :: IsEra era => [(TxIn, Maybe (ScriptRequirements TxInItem))] - -> CIO e [(TxIn, Maybe (SpendScriptWitness era))] + -> CIO e [(TxIn, Exp.AnyWitness (LedgerEra era))] readSpendScriptWitnesses = - mapM - ( \(txin, mSWit) -> do - (txin,) <$> forM mSWit readSpendScriptWitness - ) + mapM (\(txin, mWit) -> (txin,) <$> readSpendScriptWitness mWit) readSpendScriptWitness - :: IsEra era => ScriptRequirements TxInItem -> CIO e (SpendScriptWitness era) -readSpendScriptWitness spendScriptReq = - let sbe = convert useEra - in case spendScriptReq of - OnDiskSimpleScript simpleFp -> do - let sFp = unFile simpleFp - s <- - readFileSimpleScript sFp - case s of - SimpleScript ss -> do - return $ - SpendScriptWitness $ - SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ - SScript ss - OnDiskPlutusScript - (OnDiskPlutusScriptCliArgs plutusScriptFp mScriptDatum redeemerFile execUnits) -> do - plutusScript <- - readFilePlutusScript $ - unFile plutusScriptFp + :: forall era e + . IsEra era => Maybe (ScriptRequirements TxInItem) -> CIO e (Exp.AnyWitness (LedgerEra era)) +readSpendScriptWitness Nothing = return Exp.AnyKeyWitnessPlaceholder +readSpendScriptWitness (Just spendScriptReq) = + case spendScriptReq of + OnDiskSimpleScript simpleFp -> do + let sFp = unFile simpleFp + Exp.AnySimpleScriptWitness . Exp.SScript <$> readFileSimpleScript sFp (useEra @era) + OnDiskPlutusScript + (OnDiskPlutusScriptCliArgs plutusScriptFp mScriptDatum redeemerFile execUnits) -> do + anyScript <- + readFilePlutusScript @_ @era (unFile plutusScriptFp) + case anyScript of + Exp.AnyPlutusScript script -> do redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile - case plutusScript of - AnyPlutusScript lang script -> do - let pScript = PScript script - sLangSupported <- - fromMaybeCli - ( CliScriptWitnessError $ - PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang - mDatum <- handlePotentialScriptDatum mScriptDatum - return $ - SpendScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - mDatum - redeemer - execUnits - SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> - return $ - SpendScriptWitness $ - SimpleScriptWitness - (sbeToSimpleScriptLanguageInEra sbe) - (SReferenceScript refTxIn) - PlutusReferenceScript - (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion mScriptDatum NoPolicyId redeemerFile execUnits) -> - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - redeemer <- - fromExceptTCli $ readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( CliScriptWitnessError $ - PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + let lang = Exp.plutusScriptInEraSLanguage script + mDatum <- handlePotentialScriptDatum mScriptDatum lang + + let pScript = Exp.PScript script + plutusScriptWitness = Exp.PlutusScriptWitness lang pScript mDatum redeemer execUnits + return $ + Exp.AnyPlutusScriptWitness $ + Exp.AnyPlutusSpendingScriptWitness $ + Exp.createPlutusSpendingScriptWitness lang plutusScriptWitness + SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> + return $ + Exp.AnySimpleScriptWitness $ + Exp.SReferenceScript refTxIn + PlutusReferenceScript + (PlutusRefScriptCliArgs refTxIn (AnySLanguage lang) mScriptDatum NoPolicyId redeemerFile execUnits) -> do + let pRefScript = Exp.PReferenceScript refTxIn + redeemer <- + fromExceptTCli $ readScriptDataOrFile redeemerFile - mDatum <- handlePotentialScriptDatum mScriptDatum - return $ - SpendScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - mDatum - redeemer - execUnits + mDatum <- handlePotentialScriptDatum mScriptDatum lang + let plutusScriptWitness = Exp.PlutusScriptWitness lang pRefScript mDatum redeemer execUnits + return $ + Exp.AnyPlutusScriptWitness $ + Exp.AnyPlutusSpendingScriptWitness $ + Exp.createPlutusSpendingScriptWitness lang plutusScriptWitness handlePotentialScriptDatum :: ScriptDatumOrFileSpending - -> CIO e (ScriptDatum WitCtxTxIn) -handlePotentialScriptDatum InlineDatum = return InlineScriptDatum -handlePotentialScriptDatum (PotentialDatum mDatum) = - ScriptDatumForTxIn - <$> forM mDatum (fromExceptTCli . readScriptDataOrFile) + -> L.SLanguage lang + -> CIO e (Exp.PlutusScriptDatum lang Exp.SpendingScript) +handlePotentialScriptDatum InlineDatum _ = return Exp.InlineDatum +handlePotentialScriptDatum (PotentialDatum (Just sDatFp)) lang = + case lang of + L.SPlutusV1 -> do + d <- fromExceptTCli $ readScriptDataOrFile sDatFp + return $ Exp.SpendingScriptDatum d + L.SPlutusV2 -> do + d <- fromExceptTCli $ readScriptDataOrFile sDatFp + return $ Exp.SpendingScriptDatum d + L.SPlutusV3 -> do + d <- fromExceptTCli $ readScriptDataOrFile sDatFp + return $ Exp.SpendingScriptDatum $ Just d + L.SPlutusV4 -> do + d <- fromExceptTCli $ readScriptDataOrFile sDatFp + return $ Exp.SpendingScriptDatum $ Just d +handlePotentialScriptDatum (PotentialDatum Nothing) lang = + case lang of + L.SPlutusV1 -> + throwCliError @String + "handlePotentialScriptDatum: You must provide a script datum for Plutus V1 scripts." + L.SPlutusV2 -> + throwCliError @String + "handlePotentialScriptDatum: You must provide a script datum for Plutus V2 scripts." + L.SPlutusV3 -> return Exp.NoScriptDatum + L.SPlutusV4 -> return Exp.NoScriptDatum diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Type.hs index a9b2a175ba..a87bb12e36 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Spend/Type.hs @@ -5,7 +5,6 @@ module Cardano.CLI.EraBased.Script.Spend.Type ( PlutusRefScriptCliArgs (..) , SimpleRefScriptCliArgs (..) - , SpendScriptWitness (..) , createSimpleOrPlutusScriptFromCliArgs , createPlutusReferenceScriptFromCliArgs , createSimpleReferenceScriptFromCliArgs @@ -16,11 +15,7 @@ import Cardano.Api import Cardano.Api.Experimental import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.Type.Common (ScriptDataOrFile) - -newtype SpendScriptWitness era - = SpendScriptWitness {sswScriptWitness :: ScriptWitness WitCtxTxIn era} - deriving Show +import Cardano.CLI.Type.Common (AnySLanguage, ScriptDataOrFile) createSimpleOrPlutusScriptFromCliArgs :: File ScriptInAnyLang In @@ -35,7 +30,7 @@ createSimpleReferenceScriptFromCliArgs = SimpleReferenceScript . flip SimpleRefS createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDatumOrFileSpending -> ScriptDataOrFile -> ExecutionUnits diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Type.hs index c44d2b70a8..eb025376d5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Type.hs @@ -6,10 +6,8 @@ {-# LANGUAGE TypeFamilies #-} module Cardano.CLI.EraBased.Script.Type - ( AnyPlutusScript (..) - - -- * New experimental api - , ScriptRequirements (..) + ( -- * New experimental api + ScriptRequirements (..) , OnDiskPlutusScriptCliArgs (..) , PlutusRefScriptCliArgs (..) , MintPolicyId @@ -25,17 +23,13 @@ where import Cardano.Api import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Ledger qualified as L import Cardano.CLI.Type.Common --- TODO: Move to cardano-api -data AnyPlutusScript where - AnyPlutusScript - :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript - data CliScriptWitnessError = PlutusScriptWitnessLanguageNotSupportedInEra - AnyPlutusScriptVersion + L.Language AnyShelleyBasedEra deriving Show @@ -105,7 +99,7 @@ data PlutusRefScriptCliArgs (witnessable :: Exp.WitnessableItem) where PlutusRefScriptCliArgs :: TxIn -- ^ TxIn with reference script - -> AnyPlutusScriptVersion + -> AnySLanguage -> OptionalDatum witnessable -- ^ Optional Datum (CIP-69) -> MintPolicyId witnessable diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs index 6851a2c994..2c66b45eaa 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Read.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraBased.Script.Vote.Read ( readVotingProceduresFiles @@ -11,124 +13,94 @@ where import Cardano.Api import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.EraBased.Script.Type qualified as Exp -import Cardano.CLI.EraBased.Script.Vote.Type (VoteScriptWitness (..)) import Cardano.CLI.Read +import Cardano.CLI.Type.Common (AnySLanguage (..)) import Cardano.CLI.Type.Governance import Control.Monad readVoteScriptWitness - :: ConwayEraOnwards era - -> (VoteFile In, Maybe (ScriptRequirements Exp.VoterItem)) - -> CIO e (VotingProcedures era, Maybe (VoteScriptWitness era)) -readVoteScriptWitness w (voteFp, Nothing) = do + :: forall era e + . Exp.IsEra era + => (VoteFile In, Maybe (ScriptRequirements Exp.VoterItem)) + -> CIO e (VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era)) +readVoteScriptWitness (voteFp, Nothing) = do votProceds <- - conwayEraOnwardsConstraints w $ + conwayEraOnwardsConstraints (convert $ Exp.useEra @era) $ fromEitherIOCli $ readFileTextEnvelope voteFp - return (votProceds, Nothing) -readVoteScriptWitness w (voteFp, Just certScriptReq) = do - let sbe = convert w + return (votProceds, Exp.AnyKeyWitnessPlaceholder) +readVoteScriptWitness (voteFp, Just certScriptReq) = do votProceds <- - conwayEraOnwardsConstraints w $ + conwayEraOnwardsConstraints (convert $ Exp.useEra @era) $ fromEitherIOCli $ readFileTextEnvelope voteFp case certScriptReq of OnDiskSimpleScript scriptFp -> do let sFp = unFile scriptFp s <- - readFileSimpleScript sFp + Exp.AnySimpleScriptWitness . Exp.SScript <$> readFileSimpleScript sFp (Exp.useEra @era) - case s of - SimpleScript ss -> do - return - ( votProceds - , Just $ - VoteScriptWitness - ( SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ - SScript ss - ) - ) + return + ( votProceds + , s + ) OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do let plutusScriptFp = unFile scriptFp - plutusScript <- - readFilePlutusScript plutusScriptFp - + Exp.AnyPlutusScript script <- + readFilePlutusScript @_ @era plutusScriptFp redeemer <- fromExceptTCli $ readScriptDataOrFile redeemerFile - case plutusScript of - AnyPlutusScript lang script -> do - let pScript = PScript script - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang - return - ( votProceds - , Just $ - VoteScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits - ) + + let pScript = Exp.PScript script + lang = Exp.plutusScriptInEraSLanguage script + let sw = + Exp.PlutusScriptWitness + lang + pScript + Exp.NoScriptDatum + redeemer + execUnits + return + ( votProceds + , Exp.AnyPlutusScriptWitness $ AnyPlutusCertifyingScriptWitness sw + ) PlutusReferenceScript ( PlutusRefScriptCliArgs refTxIn - anyPlutusScriptVersion + (AnySLanguage lang) Exp.NoScriptDatumAllowed Exp.NoPolicyId redeemerFile execUnits ) -> do - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - redeemer <- - fromExceptTCli $ readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + redeemer <- + fromExceptTCli $ readScriptDataOrFile redeemerFile - return - ( votProceds - , Just $ - VoteScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits - ) + return + ( votProceds + , Exp.AnyPlutusScriptWitness $ + AnyPlutusCertifyingScriptWitness $ + Exp.PlutusScriptWitness + lang + (Exp.PReferenceScript refTxIn) + Exp.NoScriptDatum + redeemer + execUnits + ) SimpleReferenceScript (SimpleRefScriptArgs refTxIn _) -> return ( votProceds - , Just $ - VoteScriptWitness $ - SimpleScriptWitness - (sbeToSimpleScriptLanguageInEra sbe) - (SReferenceScript refTxIn) + , Exp.AnySimpleScriptWitness $ Exp.SReferenceScript refTxIn ) -- Because the 'Voter' type is contained only in the 'VotingProcedures' @@ -137,8 +109,8 @@ readVoteScriptWitness w (voteFp, Just certScriptReq) = do -- complicate the code further in terms of contructing the redeemer map -- when it comes to script witnessed votes. readVotingProceduresFiles - :: ConwayEraOnwards era - -> [(VoteFile In, Maybe (ScriptRequirements Exp.VoterItem))] - -> CIO e [(VotingProcedures era, Maybe (VoteScriptWitness era))] -readVotingProceduresFiles w files = - forM files (readVoteScriptWitness w) + :: Exp.IsEra era + => [(VoteFile In, Maybe (ScriptRequirements Exp.VoterItem))] + -> CIO e [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] +readVotingProceduresFiles files = + forM files readVoteScriptWitness diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Type.hs index c49a13146c..12dc407448 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Vote/Type.hs @@ -10,8 +10,7 @@ module Cardano.CLI.EraBased.Script.Vote.Type where import Cardano.Api - ( AnyPlutusScriptVersion - , ExecutionUnits + ( ExecutionUnits , File , FileDirection (In) , ScriptInAnyLang @@ -22,7 +21,7 @@ import Cardano.Api import Cardano.Api.Experimental qualified as Exp import Cardano.CLI.EraBased.Script.Type qualified as Latest -import Cardano.CLI.Type.Common (ScriptDataOrFile) +import Cardano.CLI.Type.Common (AnySLanguage, ScriptDataOrFile) newtype VoteScriptWitness era = VoteScriptWitness {vswScriptWitness :: ScriptWitness WitCtxStake era} @@ -40,15 +39,15 @@ createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDataOrFile -> ExecutionUnits -> Latest.ScriptRequirements Exp.VoterItem -createPlutusReferenceScriptFromCliArgs txIn version redeemer execUnits = +createPlutusReferenceScriptFromCliArgs txIn anySLang redeemer execUnits = Latest.PlutusReferenceScript $ Latest.PlutusRefScriptCliArgs txIn - version + anySLang Exp.NoScriptDatumAllowed Latest.NoPolicyId redeemer diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs index 0cdba8af78..244475c4ea 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Read.hs @@ -2,6 +2,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Cardano.CLI.EraBased.Script.Withdrawal.Read ( readWithdrawalScriptWitness @@ -10,116 +12,92 @@ where import Cardano.Api import Cardano.Api.Experimental - ( IsEra (..) + ( AnyWitness (..) + , IsEra (..) + , LedgerEra , NoScriptDatum (..) , WitnessableItem (..) ) +import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness +import Cardano.Api.Experimental.Plutus qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.EraBased.Script.Withdrawal.Type (WithdrawalScriptWitness (..)) import Cardano.CLI.Read +import Cardano.CLI.Type.Common (AnySLanguage (..)) readWithdrawalScriptWitness - :: IsEra era + :: forall e era + . IsEra era => (StakeAddress, Coin, Maybe (ScriptRequirements WithdrawalItem)) - -> CIO e (StakeAddress, Coin, Maybe (WithdrawalScriptWitness era)) + -> CIO e (StakeAddress, Coin, AnyWitness (LedgerEra era)) readWithdrawalScriptWitness (stakeAddr, withdrawalAmt, Nothing) = - return (stakeAddr, withdrawalAmt, Nothing) + return (stakeAddr, withdrawalAmt, Exp.AnyKeyWitnessPlaceholder) readWithdrawalScriptWitness (stakeAddr, withdrawalAmt, Just certScriptReq) = - let sbe = convert useEra - in case certScriptReq of - OnDiskSimpleScript scriptFp -> do - let sFp = unFile scriptFp - s <- - readFileSimpleScript sFp - case s of - SimpleScript ss -> do - return - ( stakeAddr - , withdrawalAmt - , Just $ - WithdrawalScriptWitness - ( SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $ - SScript ss - ) - ) - OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp NoScriptDatumAllowed redeemerFile execUnits) -> do - let plutusScriptFp = unFile scriptFp - plutusScript <- - readFilePlutusScript plutusScriptFp - redeemer <- - fromExceptTCli $ - readScriptDataOrFile redeemerFile - case plutusScript of - AnyPlutusScript lang script -> do - let pScript = PScript script - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang - return - ( stakeAddr - , withdrawalAmt - , Just $ - WithdrawalScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits - ) - SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> - return - ( stakeAddr - , withdrawalAmt - , Just $ - WithdrawalScriptWitness $ - SimpleScriptWitness - (sbeToSimpleScriptLanguageInEra sbe) - (SReferenceScript refTxIn) - ) - PlutusReferenceScript - ( PlutusRefScriptCliArgs - refTxIn - anyPlutusScriptVersion - NoScriptDatumAllowed - NoPolicyId - redeemerFile - execUnits - ) -> do - case anyPlutusScriptVersion of - AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn - redeemer <- - fromExceptTCli $ - readScriptDataOrFile redeemerFile - sLangSupported <- - fromMaybeCli - ( PlutusScriptWitnessLanguageNotSupportedInEra - (AnyPlutusScriptVersion lang) - (shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe) - ) - $ scriptLanguageSupportedInEra sbe - $ PlutusScriptLanguage lang + case certScriptReq of + OnDiskSimpleScript scriptFp -> do + let sFp = unFile scriptFp + sWit <- AnySimpleScriptWitness . Exp.SScript <$> readFileSimpleScript sFp (Exp.useEra @era) + + return + ( stakeAddr + , withdrawalAmt + , sWit + ) + OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp NoScriptDatumAllowed redeemerFile execUnits) -> do + let plutusScriptFp = unFile scriptFp + Exp.AnyPlutusScript script <- + readFilePlutusScript @_ @era plutusScriptFp + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile - return - ( stakeAddr - , withdrawalAmt - , Just $ - WithdrawalScriptWitness $ - PlutusScriptWitness - sLangSupported - lang - pScript - NoScriptDatumForStake - redeemer - execUnits - ) + let lang = Exp.plutusScriptInEraSLanguage script + pScript = Exp.PScript script + sw = + Exp.PlutusScriptWitness + lang + pScript + Exp.NoScriptDatum + redeemer + execUnits + return + ( stakeAddr + , withdrawalAmt + , AnyPlutusScriptWitness $ + AnyPlutusCertifyingScriptWitness sw + ) + SimpleReferenceScript (SimpleRefScriptArgs refTxIn NoPolicyId) -> + return + ( stakeAddr + , withdrawalAmt + , AnySimpleScriptWitness $ Exp.SReferenceScript refTxIn + ) + PlutusReferenceScript + ( PlutusRefScriptCliArgs + refTxIn + (AnySLanguage lang) + NoScriptDatumAllowed + NoPolicyId + redeemerFile + execUnits + ) -> do + redeemer <- + fromExceptTCli $ + readScriptDataOrFile redeemerFile + let sWit = + Exp.AnyPlutusScriptWitness $ + AnyPlutusCertifyingScriptWitness $ + Exp.PlutusScriptWitness + lang + (Exp.PReferenceScript refTxIn) + Exp.NoScriptDatum + redeemer + execUnits + return + ( stakeAddr + , withdrawalAmt + , sWit + ) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Type.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Type.hs index cf0d32d132..3d0f07841e 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Type.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Withdrawal/Type.hs @@ -4,7 +4,6 @@ module Cardano.CLI.EraBased.Script.Withdrawal.Type ( PlutusRefScriptCliArgs (..) - , WithdrawalScriptWitness (..) , createSimpleOrPlutusScriptFromCliArgs , createPlutusReferenceScriptFromCliArgs ) @@ -14,11 +13,7 @@ import Cardano.Api import Cardano.Api.Experimental import Cardano.CLI.EraBased.Script.Type -import Cardano.CLI.Type.Common (ScriptDataOrFile) - -newtype WithdrawalScriptWitness era - = WithdrawalScriptWitness {wswScriptWitness :: ScriptWitness WitCtxStake era} - deriving Show +import Cardano.CLI.Type.Common (AnySLanguage (..), ScriptDataOrFile) createSimpleOrPlutusScriptFromCliArgs :: File ScriptInAnyLang In @@ -31,7 +26,7 @@ createSimpleOrPlutusScriptFromCliArgs scriptFp Nothing = createPlutusReferenceScriptFromCliArgs :: TxIn - -> AnyPlutusScriptVersion + -> AnySLanguage -> ScriptDataOrFile -> ExecutionUnits -> ScriptRequirements WithdrawalItem diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs index 57f4fd9b5a..b44c2eb79a 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Transaction/Run.hs @@ -39,6 +39,9 @@ import Cardano.Api qualified as Api import Cardano.Api.Byron qualified as Byron import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScript qualified as Exp +import Cardano.Api.Experimental.AnyScriptWitness qualified as Exp +import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L import Cardano.Api.Network qualified as Consensus import Cardano.Api.Network qualified as Net.Tx @@ -49,16 +52,11 @@ import Cardano.CLI.Compatible.Transaction.TxOut import Cardano.CLI.EraBased.Genesis.Internal.Common (readProtocolParameters) import Cardano.CLI.EraBased.Script.Certificate.Read import Cardano.CLI.EraBased.Script.Mint.Read -import Cardano.CLI.EraBased.Script.Mint.Type import Cardano.CLI.EraBased.Script.Proposal.Read -import Cardano.CLI.EraBased.Script.Proposal.Type (ProposalScriptWitness (..)) import Cardano.CLI.EraBased.Script.Read.Common import Cardano.CLI.EraBased.Script.Spend.Read -import Cardano.CLI.EraBased.Script.Spend.Type (SpendScriptWitness (..)) import Cardano.CLI.EraBased.Script.Vote.Read -import Cardano.CLI.EraBased.Script.Vote.Type import Cardano.CLI.EraBased.Script.Withdrawal.Read -import Cardano.CLI.EraBased.Script.Withdrawal.Type (WithdrawalScriptWitness (..)) import Cardano.CLI.EraBased.Transaction.Command import Cardano.CLI.EraBased.Transaction.Command qualified as Cmd import Cardano.CLI.EraBased.Transaction.Internal.HashCheck @@ -167,13 +165,14 @@ runTransactionBuildCmd txinsAndMaybeScriptWits <- readSpendScriptWitnesses txins - let spendingScriptWitnesses = mapMaybe (fmap sswScriptWitness . snd) txinsAndMaybeScriptWits + let spendingScriptWitnesses = map snd txinsAndMaybeScriptWits certFilesAndMaybeScriptWits <- readCertificateScriptWitnesses certificates -- TODO: Conway Era - How can we make this more composable? - certsAndMaybeScriptWits <- + certsAndMaybeScriptWits + :: [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] <- sequence [ (,mSwit) <$> ( fromEitherIOCli @(FileError TextEnvelopeError) $ @@ -209,11 +208,8 @@ runTransactionBuildCmd txOuts <- mapM (toTxOutInAnyEra eon) txouts -- Conway related - votingProceduresAndMaybeScriptWits <- - inEonForEra - (pure mempty) - (`readVotingProceduresFiles` voteFiles) - era' + votingProceduresAndMaybeScriptWits :: [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <- + readVotingProceduresFiles voteFiles forM_ votingProceduresAndMaybeScriptWits (fromExceptTCli . checkVotingProcedureHashes . fst) @@ -265,11 +261,11 @@ runTransactionBuildCmd let allReferenceInputs = getAllReferenceInputs spendingScriptWitnesses - (map mswScriptWitness mintingWitnesses) + (map snd mintingWitnesses) (map snd certsAndMaybeScriptWits) - (mapMaybe (\(_, _, mSwit) -> mSwit) withdrawalsAndMaybeScriptWits) - (mapMaybe snd votingProceduresAndMaybeScriptWits) - (mapMaybe snd proposals) + (map (\(_, _, wit) -> wit) withdrawalsAndMaybeScriptWits) + (map snd votingProceduresAndMaybeScriptWits) + (map snd proposals) readOnlyReferenceInputs let inputsThatRequireWitnessing = [input | (input, _) <- txins] @@ -295,7 +291,7 @@ runTransactionBuildCmd (Just td, Just ctv) -> Just (ctv, td) -- We need to construct the txBodycontent outside of runTxBuild - BalancedTxBody txBodyContent balancedTxBody _ _ <- + (balancedTxBody@(Exp.UnsignedTx tx), txBodyContent) <- fromExceptTCli $ runTxBuild nodeSocketPath @@ -335,32 +331,27 @@ runTransactionBuildCmd <> "removed in a future version. Please use the `calculate-script-cost` command instead." ) - let BuildTxWith mTxProtocolParams = txProtocolParams txBodyContent + let mTxProtocolParams = Exp.txProtocolParams txBodyContent pparams <- mTxProtocolParams & fromMaybeCli TxCmdProtocolParametersNotPresentInTxBody - executionUnitPrices <- - getExecutionUnitPrices era' pparams - & fromMaybeCli TxCmdPParamExecutionUnitsNotAvailable + let executionUnitPrices :: L.Prices = obtainCommonConstraints (Exp.useEra @era) $ pparams ^. L.ppPricesL Refl <- testEquality era' nodeEra & fromMaybeCli (NodeEraMismatchError era' nodeEra) - let scriptExecUnitsMap = - evaluateTransactionExecutionUnits - era' + let ledgerUTxO = + obtainCommonConstraints (Exp.useEra @era) $ Api.toLedgerUTxO (convert $ Exp.useEra @era) txEraUtxo + scriptExecUnitsMap = + Exp.evaluateTransactionExecutionUnits systemStart (toLedgerEpochInfo eraHistory) pparams - txEraUtxo - balancedTxBody + (obtainCommonConstraints (Exp.useEra @era) ledgerUTxO) + tx - scriptHashes <- - monoidForEraInEon @AlonzoEraOnwards - era' - (\aeo -> pure $ collectPlutusScriptHashes aeo (makeSignedTransaction [] balancedTxBody) txEraUtxo) - & fromMaybeCli (TxCmdAlonzoEraOnwardsRequired era') + let scriptHashes = Exp.collectPlutusScriptHashes balancedTxBody ledgerUTxO scriptCostOutput <- fromEitherCli $ @@ -370,7 +361,8 @@ runTransactionBuildCmd scriptExecUnitsMap liftIO $ LBS.writeFile (unFile fp) $ encodePretty scriptCostOutput OutputTxBodyOnly fpath -> fromEitherIOCli $ do - let noWitTx = makeSignedTransaction [] balancedTxBody + let noWitTx = ShelleyTx (convert eon) $ obtainCommonConstraints (Exp.useEra @era) tx + if isCborOutCanonical == TxCborCanonical then writeTxFileTextEnvelopeCanonical eon fpath noWitTx else writeTxFileTextEnvelope eon fpath noWitTx @@ -412,7 +404,6 @@ runTransactionBuildEstimateCmd -- TODO change type , txBodyOutFile } = do let sbe = convert currentEra - meo = convert (convert currentEra :: BabbageEraOnwards era) ledgerPParams <- fromExceptTCli $ @@ -454,7 +445,7 @@ runTransactionBuildEstimateCmd -- TODO change type (pure mempty) ( \w -> conwayEraOnwardsConstraints w $ - readVotingProceduresFiles w voteFiles + readVotingProceduresFiles voteFiles ) sbe @@ -491,10 +482,10 @@ runTransactionBuildEstimateCmd -- TODO change type 0 txAuxScripts txMetadata - TxUpdateProposalNone votingProceduresAndMaybeScriptWits proposals currentTreasuryValueAndDonation + let stakeCredentialsToDeregisterMap = fromList $ catMaybes [getStakeDeregistrationInfo cert | (cert, _) <- certsAndMaybeScriptWits] drepsToDeregisterMap = fromList $ @@ -504,19 +495,21 @@ runTransactionBuildEstimateCmd -- TODO change type catMaybes [getPoolDeregistrationInfo Exp.useEra cert | (cert, _) <- certsAndMaybeScriptWits] totCol = fromMaybe 0 plutusCollateral pScriptExecUnits = - fromList - [ (sWitIndex, execUnits) - | (sWitIndex, AnyScriptWitness (PlutusScriptWitness _ _ _ _ _ execUnits)) <- - collectTxBodyScriptWitnesses sbe txBodyContent - ] - - BalancedTxBody _ balancedTxBody _ _ <- + obtainCommonConstraints currentEra $ + fromList + [ (obtainCommonConstraints currentEra index, Exp.getAnyPlutusScriptWitnessExecutionUnits psw) + | (sWitIndex, Exp.AnyScriptWitnessPlutus psw) <- + Exp.collectTxBodyScriptWitnesses txBodyContent + , index <- maybeToList $ Api.fromScriptWitnessIndex (convert currentEra) sWitIndex + ] + + balancedTxBody :: Exp.TxBodyContent (Exp.LedgerEra era) <- fromEitherCli $ first TxCmdFeeEstimationError $ - estimateBalancedTxBody - meo + Exp.estimateBalancedTxBody + currentEra txBodyContent - (toShelleyLedgerPParamsShim currentEra ledgerPParams) + ledgerPParams poolsToDeregister stakeCredentialsToDeregisterMap drepsToDeregisterMap @@ -526,20 +519,18 @@ runTransactionBuildEstimateCmd -- TODO change type (fromMaybe 0 mByronWitnesses) (maybe 0 unReferenceScriptSize totalReferenceScriptSize) (anyAddressInShelleyBasedEra sbe changeAddr) - totalUTxOValue + (obtainCommonConstraints currentEra $ toLedgerValue (convert currentEra) totalUTxOValue) - let noWitTx = makeSignedTransaction [] balancedTxBody + let unsignedTx = Exp.makeUnsignedTx currentEra balancedTxBody fromEitherIOCli $ - cardanoEraConstraints (toCardanoEra sbe) $ - if isCborOutCanonical == TxCborCanonical - then writeTxFileTextEnvelopeCanonical sbe txBodyOutFile noWitTx - else writeTxFileTextEnvelope sbe txBodyOutFile noWitTx + if isCborOutCanonical == TxCborCanonical + then + writeTxFileTextEnvelopeCanonical (convert currentEra) txBodyOutFile $ unsignedToToApiTx unsignedTx + else writeTxFileTextEnvelope (convert currentEra) txBodyOutFile $ unsignedToToApiTx unsignedTx --- TODO: Update type in cardano-api to be more generic then delete this -toShelleyLedgerPParamsShim - :: Exp.Era era -> L.PParams (Exp.LedgerEra era) -> L.PParams (ShelleyLedgerEra era) -toShelleyLedgerPParamsShim Exp.ConwayEra pp = pp -toShelleyLedgerPParamsShim Exp.DijkstraEra pp = pp +unsignedToToApiTx :: forall era. Exp.IsEra era => Exp.UnsignedTx era -> Api.Tx era +unsignedToToApiTx (Exp.UnsignedTx lTx) = + ShelleyTx (convert $ Exp.useEra @era) $ obtainCommonConstraints (Exp.useEra @era) lTx fromShelleyLedgerPParamsShim :: Exp.Era era -> L.PParams (ShelleyLedgerEra era) -> L.PParams (Exp.LedgerEra era) @@ -578,12 +569,6 @@ getConwayDeregistrationInfo e cert = do (stakeCred, depositRefund) <- obtainCommonConstraints e $ L.getUnRegDepositTxCert cert return (fromShelleyStakeCredential stakeCred, depositRefund) -getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe L.Prices -getExecutionUnitPrices cEra (LedgerProtocolParameters pp) = - forEraInEonMaybe cEra $ \aeo -> - alonzoEraOnwardsConstraints aeo $ - pp ^. L.ppPricesL - runTransactionBuildRawCmd :: forall era e . Cmd.TransactionBuildRawCmdArgs era @@ -643,7 +628,8 @@ runTransactionBuildRawCmd let mLedgerPParams = LedgerProtocolParameters <$> pparams - txUpdateProposal <- case mUpdateProprosalFile of + -- TODO: Remove me as update proposals are deprecated since Conway (replaced with proposals) + _txUpdateProposal <- case mUpdateProprosalFile of Just (Featured w (Just updateProposalFile)) -> fromExceptTCli $ readTxUpdateProposal w updateProposalFile _ -> pure TxUpdateProposalNone @@ -661,7 +647,7 @@ runTransactionBuildRawCmd -- Conway related votingProceduresAndMaybeScriptWits <- conwayEraOnwardsConstraints (convert $ Exp.useEra @era) $ - readVotingProceduresFiles (convert Exp.useEra) voteFiles + readVotingProceduresFiles voteFiles proposals <- readTxGovernanceActions @era proposalFiles @@ -695,15 +681,12 @@ runTransactionBuildRawCmd txAuxScripts txMetadata mLedgerPParams - txUpdateProposal votingProceduresAndMaybeScriptWits proposals currentTreasuryValueAndDonation - let Exp.SignedTx tx = Exp.signTx eon [] [] txBody - -- TODO: Create equivalent write text envelope functions for - -- SignedTx - noWitTx = ShelleyTx (convert eon) tx + let Exp.UnsignedTx lTx = txBody + noWitTx = ShelleyTx (convert eon) lTx fromEitherIOCli $ if isCborOutCanonical == TxCborCanonical then writeTxFileTextEnvelopeCanonical (convert Exp.useEra) txBodyOutFile noWitTx @@ -713,7 +696,7 @@ runTxBuildRaw :: Exp.IsEra era => Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (SpendScriptWitness era))] + -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra era))] -- ^ TxIn with potential script witness -> [TxIn] -- ^ Read only reference inputs @@ -730,19 +713,18 @@ runTxBuildRaw -- ^ Tx upper bound -> Lovelace -- ^ Tx fee - -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era]) + -> (L.MultiAsset, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))]) -- ^ Multi-Asset minted value(s) -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))] + -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))] -> [Hash PaymentKey] -- ^ Required signers -> TxAuxScripts era -> TxMetadataInEra era -> Maybe (LedgerProtocolParameters era) - -> TxUpdateProposal era - -> [(VotingProcedures era, Maybe (VoteScriptWitness era))] - -> [(Proposal era, Maybe (ProposalScriptWitness era))] + -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] + -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) -> Either TxCmdError (Exp.UnsignedTx era) runTxBuildRaw @@ -763,7 +745,6 @@ runTxBuildRaw txAuxScripts txMetadata mpparams - txUpdateProposal votingProcedures proposals mCurrentTreasuryValueAndDonation = do @@ -786,19 +767,18 @@ runTxBuildRaw fee txAuxScripts txMetadata - txUpdateProposal votingProcedures proposals mCurrentTreasuryValueAndDonation - first TxCmdTxBodyError $ Exp.makeUnsignedTx Exp.useEra txBodyContent + return $ Exp.makeUnsignedTx Exp.useEra txBodyContent constructTxBodyContent :: forall era . Exp.IsEra era => Maybe ScriptValidity -> Maybe (L.PParams (Exp.LedgerEra era)) - -> [(TxIn, Maybe (SpendScriptWitness era))] + -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra era))] -- ^ TxIn with potential script witness -> [TxIn] -- ^ Read only reference inputs @@ -814,11 +794,11 @@ constructTxBodyContent -- ^ Tx lower bound -> TxValidityUpperBound era -- ^ Tx upper bound - -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era]) + -> (L.MultiAsset, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))]) -- ^ Multi-Asset value(s) -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))] + -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))] -- ^ Withdrawals -> [Hash PaymentKey] -- ^ Required signers @@ -826,14 +806,13 @@ constructTxBodyContent -- ^ Tx fee -> TxAuxScripts era -> TxMetadataInEra era - -> TxUpdateProposal era - -> [(VotingProcedures era, Maybe (VoteScriptWitness era))] - -> [(Proposal era, Maybe (ProposalScriptWitness era))] + -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] + -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) -- ^ The current treasury value and the donation. This is a stop gap as the -- semantics of the donation and treasury value depend on the script languages -- being used. - -> Either TxCmdError (TxBodyContent BuildTx era) + -> Either TxCmdError (Exp.TxBodyContent (Exp.LedgerEra era)) constructTxBodyContent mScriptValidity mPparams @@ -844,7 +823,7 @@ constructTxBodyContent mTotCollateral txouts mLowerBound - mUpperBound + (TxValidityUpperBound _ mUpperBound) valuesWithScriptWits certsAndMaybeScriptWits withdrawals @@ -852,93 +831,121 @@ constructTxBodyContent fee txAuxScripts txMetadata - txUpdateProposal votingProcedures proposals mCurrentTreasuryValueAndDonation = do - let sbe = convert $ Exp.useEra @era let allReferenceInputs = getAllReferenceInputs - (map sswScriptWitness $ mapMaybe snd inputsAndMaybeScriptWits) - (map mswScriptWitness $ snd valuesWithScriptWits) + (map snd inputsAndMaybeScriptWits) + (map snd $ snd valuesWithScriptWits) (map snd certsAndMaybeScriptWits) - (mapMaybe (\(_, _, mSwit) -> mSwit) withdrawals) - (mapMaybe snd votingProcedures) - (mapMaybe snd proposals) + (map (\(_, _, mSwit) -> mSwit) withdrawals) + (map snd votingProcedures) + (map snd proposals) readOnlyRefIns - - let validatedCollateralTxIns = validateTxInsCollateral @era txinsc -- TODO The last argument of validateTxInsReference is a datum set from reference inputs -- Should we allow providing of datum from CLI? - let validatedRefInputs = validateTxInsReference @BuildTx @era allReferenceInputs mempty - validatedTotCollateral = validateTxTotalCollateral @era mTotCollateral - validatedRetCol = validateTxReturnCollateral @era mReturnCollateral - let txFee = TxFeeExplicit sbe fee - validatedLowerBound = validateTxValidityLowerBound @era mLowerBound - validatedReqSigners = validateRequiredSigners @era reqSigners - validatedTxScriptValidity = validateTxScriptValidity @era mScriptValidity + -- TODO: Figure how to expose resolved datums + let refInputs = Exp.TxInsReference allReferenceInputs Set.empty + expTxouts = map Exp.fromLegacyTxOut txouts + auxScripts = case txAuxScripts of + TxAuxScriptsNone -> [] + TxAuxScripts _ scripts -> mapMaybe scriptInEraToSimpleScript scripts + rCollOut = case mReturnCollateral of + Just rc -> + let Exp.TxOut o _ = Exp.fromLegacyTxOut rc + in Just (o :: (L.TxOut (Exp.LedgerEra era))) + Nothing -> Nothing + txCollateral = + Exp.TxCollateral + <$> (mTotCollateral :: Maybe L.Coin) + <*> (rCollOut :: Maybe (L.TxOut (Exp.LedgerEra era))) + expTxMetadata = case txMetadata of + TxMetadataNone -> TxMetadata mempty + TxMetadataInEra _ mDat -> mDat + let validatedMintValue <- createTxMintValue valuesWithScriptWits - validatedVotingProcedures :: TxVotingProcedures BuildTx era <- + vProcedures <- first TxCmdCBORDecodeError $ convertVotingProcedures votingProcedures + validatedVotingProcedures <- first (TxCmdTxGovDuplicateVotes . TxGovDuplicateVotes) $ - mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votingProcedures] - let txProposals = forShelleyBasedEraInEonMaybe sbe $ \w -> do - let txp :: TxProposalProcedures BuildTx era - txp = - conwayEraOnwardsConstraints w $ - mkTxProposalProcedures $ - [(prop, pswScriptWitness <$> mSwit) | (Proposal prop, mSwit) <- proposals] - Featured w txp - - let validatedCurrentTreasuryValue = validateTxCurrentTreasuryValue @era (fst <$> mCurrentTreasuryValueAndDonation) - validatedTreasuryDonation = validateTxTreasuryDonation @era (snd <$> mCurrentTreasuryValueAndDonation) - return $ - shelleyBasedEraConstraints - sbe - ( defaultTxBodyContent sbe - & setTxIns (validateTxIns inputsAndMaybeScriptWits) - & setTxInsCollateral validatedCollateralTxIns - & setTxInsReference validatedRefInputs - & setTxOuts txouts - & setTxTotalCollateral validatedTotCollateral - & setTxReturnCollateral validatedRetCol - & setTxFee txFee - & setTxValidityLowerBound validatedLowerBound - & setTxValidityUpperBound mUpperBound - & setTxMetadata txMetadata - & setTxAuxScripts txAuxScripts - & setTxExtraKeyWits validatedReqSigners - & setTxProtocolParams - (BuildTxWith $ LedgerProtocolParameters . toShelleyLedgerPParamsShim Exp.useEra <$> mPparams) - & setTxWithdrawals (TxWithdrawals sbe $ map convertWithdrawals withdrawals) - & setTxCertificates - (Exp.mkTxCertificates $ obtainCommonConstraints (Exp.useEra @era) certsAndMaybeScriptWits) - & setTxUpdateProposal txUpdateProposal - & setTxMintValue validatedMintValue - & setTxScriptValidity validatedTxScriptValidity - & setTxVotingProcedures (mkFeatured validatedVotingProcedures) - & setTxProposalProcedures txProposals - & setTxCurrentTreasuryValue validatedCurrentTreasuryValue - & setTxTreasuryDonation validatedTreasuryDonation - ) - where - convertWithdrawals - :: (StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era)) - -> (StakeAddress, Lovelace, BuildTxWith BuildTx (Witness WitCtxStake era)) - convertWithdrawals (sAddr, ll, mScriptWitnessFiles) = - case mScriptWitnessFiles of - Just sWit -> (sAddr, ll, BuildTxWith $ ScriptWitness ScriptWitnessForStakeAddr $ wswScriptWitness sWit) - Nothing -> (sAddr, ll, BuildTxWith $ KeyWitness KeyWitnessForStakeAddr) + Exp.mkTxVotingProcedures vProcedures + let txProposals = [(obtainCommonConstraints (Exp.useEra @era) p, w) | (Proposal p, w) <- proposals] + let validatedTxProposals = + Exp.mkTxProposalProcedures txProposals + let validatedCurrentTreasuryValue = unTxCurrentTreasuryValue . fst <$> mCurrentTreasuryValueAndDonation + validatedTreasuryDonation = unTxTreasuryDonation . snd <$> mCurrentTreasuryValueAndDonation + validatedWithdrawals <- first TxCmdCBORDecodeError $ convertWithdrawals withdrawals + return + ( Exp.defaultTxBodyContent + & Exp.setTxIns inputsAndMaybeScriptWits + & Exp.setTxInsCollateral txinsc + & Exp.setTxInsReference refInputs + & Exp.setTxOuts expTxouts + & maybe id Exp.setTxCollateral txCollateral + & Exp.setTxFee fee + & maybe id Exp.setTxValidityLowerBound mLowerBound + & maybe id Exp.setTxValidityUpperBound mUpperBound + & Exp.setTxMetadata expTxMetadata + & Exp.setTxAuxScripts auxScripts + & Exp.setTxWithdrawals validatedWithdrawals + & Exp.setTxExtraKeyWits (Exp.TxExtraKeyWitnesses reqSigners) + & maybe id (Exp.setTxProtocolParams . Exp.obtainCommonConstraints (Exp.useEra @era)) mPparams + & Exp.setTxCertificates + (Exp.mkTxCertificates Exp.useEra certsAndMaybeScriptWits) + & Exp.setTxMintValue validatedMintValue + & Exp.setTxScriptValidity (fromMaybe ScriptValid mScriptValidity) + & Exp.setTxVotingProcedures validatedVotingProcedures + & Exp.setTxProposalProcedures validatedTxProposals + & maybe id Exp.setTxCurrentTreasuryValue validatedCurrentTreasuryValue + & maybe id Exp.setTxTreasuryDonation validatedTreasuryDonation + ) + +convertWithdrawals + :: [(StakeAddress, L.Coin, Exp.AnyWitness (Exp.LedgerEra era))] + -> Either + CBOR.DecoderError + (Exp.TxWithdrawals (Exp.LedgerEra era)) +convertWithdrawals w = + Exp.TxWithdrawals + <$> mapM + ( \(sAddr, amt, wit) -> + do + return (sAddr, amt, wit) + ) + w + +convertVotingProcedures + :: forall era + . Exp.IsEra era + => [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] + -> Either + CBOR.DecoderError + [(L.VotingProcedures (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] +convertVotingProcedures = + mapM + ( \(VotingProcedures vp, wit) -> + do + return (obtainCommonConstraints (Exp.useEra @era) vp, wit) + ) + +scriptInEraToSimpleScript + :: forall era. Exp.IsEra era => ScriptInEra era -> Maybe (Exp.SimpleScript (Exp.LedgerEra era)) +scriptInEraToSimpleScript s = + obtainCommonConstraints (Exp.useEra @era) $ + Exp.SimpleScript + <$> L.getNativeScript (obtainCommonConstraints (Exp.useEra @era) $ toShelleyScript s) runTxBuild :: forall era . Exp.IsEra era + => HasCallStack => SocketPath -> NetworkId -> Maybe ScriptValidity -- ^ Mark script as expected to pass or fail validation - -> [(TxIn, Maybe (SpendScriptWitness era))] + -> [(TxIn, Exp.AnyWitness (Exp.LedgerEra era))] -- ^ Read only reference inputs -> [TxIn] -- ^ TxIn with potential script witness @@ -952,7 +959,8 @@ runTxBuild -- ^ Normal outputs -> TxOutChangeAddress -- ^ A change output - -> (L.MultiAsset, [MintScriptWitnessWithPolicyId era]) + -> (L.MultiAsset, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))]) -- TODO: Double check why this is a list + -- ^ Multi-Asset value(s) -> Maybe SlotNo -- ^ Tx lower bound @@ -960,18 +968,18 @@ runTxBuild -- ^ Tx upper bound -> [(Exp.Certificate (Exp.LedgerEra era), Exp.AnyWitness (Exp.LedgerEra era))] -- ^ Certificate with potential script witness - -> [(StakeAddress, Lovelace, Maybe (WithdrawalScriptWitness era))] + -> [(StakeAddress, Lovelace, Exp.AnyWitness (Exp.LedgerEra era))] -> [Hash PaymentKey] -- ^ Required signers -> TxAuxScripts era -> TxMetadataInEra era -> TxUpdateProposal era -> Maybe Word - -> [(VotingProcedures era, Maybe (VoteScriptWitness era))] - -> [(Proposal era, Maybe (ProposalScriptWitness era))] + -> [(VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] + -> [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] -> Maybe (TxCurrentTreasuryValue, TxTreasuryDonation) -- ^ The current treasury value and the donation. - -> ExceptT TxCmdError IO (BalancedTxBody era) + -> ExceptT TxCmdError IO (Exp.UnsignedTx era, Exp.TxBodyContent (Exp.LedgerEra era)) runTxBuild socketPath networkId @@ -991,7 +999,7 @@ runTxBuild reqSigners txAuxScripts txMetadata - txUpdateProposal + _txUpdateProposal -- TODO: Remove this parameter mOverrideWits votingProcedures proposals @@ -1005,12 +1013,12 @@ runTxBuild let allReferenceInputs = getAllReferenceInputs - (map sswScriptWitness $ mapMaybe snd inputsAndMaybeScriptWits) - (map mswScriptWitness $ snd mintValueWithScriptWits) + (map snd inputsAndMaybeScriptWits) + (map snd $ snd mintValueWithScriptWits) (map snd certsAndMaybeScriptWits) - (mapMaybe (\(_, _, mSwit) -> mSwit) withdrawals) - (mapMaybe snd votingProcedures) - (mapMaybe snd proposals) + (map (\(_, _, wit) -> wit) withdrawals) + (map snd votingProcedures) + (map snd proposals) readOnlyRefIns let allTxInputs = inputsThatRequireWitnessing ++ allReferenceInputs ++ txinsc @@ -1059,7 +1067,6 @@ runTxBuild 0 txAuxScripts txMetadata - txUpdateProposal votingProcedures proposals mCurrentTreasuryValueAndDonation @@ -1070,73 +1077,56 @@ runTxBuild firstExceptT TxCmdQueryNotScriptLocked . hoistEither $ notScriptLockedTxIns txinsc txEraUtxo - + let ledgerUTxO = Api.toLedgerUTxO (convert Exp.useEra) txEraUtxo cAddr <- pure (anyAddressInEra era changeAddr) & onLeft (error $ "runTxBuild: Byron address used: " <> show changeAddr) -- should this throw instead? - balancedTxBody@(BalancedTxBody _ _ _ fee) <- + r@(unsignedTx, _) <- firstExceptT (TxCmdBalanceTxBody . AnyTxBodyErrorAutoBalance) . hoistEither - $ makeTransactionBodyAutoBalance - sbe + $ Exp.makeTransactionBodyAutoBalance systemStart (toLedgerEpochInfo eraHistory) - pparams + (Exp.obtainCommonConstraints (Exp.useEra @era) $ unLedgerProtocolParameters pparams) stakePools stakeDelegDeposits (Map.map L.fromCompact drepDelegDeposits) - txEraUtxo + (obtainCommonConstraints (Exp.useEra @era) ledgerUTxO) txBodyContent cAddr mOverrideWits + -- Check to see if we lost any scripts during balancing + scriptWitnessesBeforeBalance <- + firstExceptT TxCmdCBORDecodeError $ + hoistEither $ + Exp.extractAllIndexedPlutusScriptWitnesses Exp.useEra txBodyContent + scriptWitnessesAfterBalance <- + hoistEither . first TxCmdCBORDecodeError $ + Exp.extractAllIndexedPlutusScriptWitnesses Exp.useEra (snd r) + when + ( length scriptWitnessesBeforeBalance + /= length scriptWitnessesAfterBalance + ) + $ left + $ LostScriptWitnesses scriptWitnessesBeforeBalance scriptWitnessesAfterBalance - liftIO . putStrLn . docToString $ "Estimated transaction fee:" <+> pretty fee + liftIO . putStrLn . docToString $ + "Estimated transaction fee:" <+> pretty (Exp.getUnsignedTxFee unsignedTx) - return balancedTxBody + return r -- ---------------------------------------------------------------------------- -- Transaction body validation and conversion -- -validateTxIns - :: [(TxIn, Maybe (SpendScriptWitness era))] - -> [(TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era))] -validateTxIns = map convertTxIn - where - convertTxIn - :: (TxIn, Maybe (SpendScriptWitness era)) - -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn era)) - convertTxIn (txin, mScriptWitness) = - case mScriptWitness of - Just sWit -> - (txin, BuildTxWith $ ScriptWitness ScriptWitnessForSpending $ sswScriptWitness sWit) - Nothing -> - (txin, BuildTxWith $ KeyWitness KeyWitnessForSpending) - -validateTxInsCollateral - :: Exp.IsEra era - => [TxIn] - -> TxInsCollateral era -validateTxInsCollateral [] = TxInsCollateralNone -validateTxInsCollateral txins = - TxInsCollateral (convert Exp.useEra) txins - -validateTxInsReference - :: (Applicative (BuildTxWith build), Exp.IsEra era) - => [TxIn] - -> Set HashableScriptData - -> TxInsReference build era -validateTxInsReference [] _ = TxInsReferenceNone -validateTxInsReference allRefIns datumSet = TxInsReference (convert Exp.useEra) allRefIns (pure datumSet) - getAllReferenceInputs - :: [ScriptWitness WitCtxTxIn era] - -> [ScriptWitness WitCtxMint era] + :: [Exp.AnyWitness (Exp.LedgerEra era)] + -> [Exp.AnyWitness (Exp.LedgerEra era)] -> [Exp.AnyWitness (Exp.LedgerEra era)] -- \^ Certificate witnesses - -> [WithdrawalScriptWitness era] - -> [VoteScriptWitness era] - -> [ProposalScriptWitness era] + -> [Exp.AnyWitness (Exp.LedgerEra era)] + -> [Exp.AnyWitness (Exp.LedgerEra era)] + -> [Exp.AnyWitness (Exp.LedgerEra era)] -> [TxIn] -- \^ Read only reference inputs -> [TxIn] @@ -1148,12 +1138,12 @@ getAllReferenceInputs votingProceduresAndMaybeScriptWits propProceduresAnMaybeScriptWits readOnlyRefIns = do - let txinsWitByRefInputs = map getScriptWitnessReferenceInput spendingWitnesses - mintingRefInputs = map getScriptWitnessReferenceInput mintWitnesses + let txinsWitByRefInputs = map getAnyWitnessReferenceInput spendingWitnesses + mintingRefInputs = map getAnyWitnessReferenceInput mintWitnesses certsWitByRefInputs = map getAnyWitnessReferenceInput certScriptWitnesses - withdrawalsWitByRefInputs = map (getScriptWitnessReferenceInput . wswScriptWitness) withdrawals - votesWitByRefInputs = map (getScriptWitnessReferenceInput . vswScriptWitness) votingProceduresAndMaybeScriptWits - propsWitByRefInputs = map (getScriptWitnessReferenceInput . pswScriptWitness) propProceduresAnMaybeScriptWits + withdrawalsWitByRefInputs = map getAnyWitnessReferenceInput withdrawals + votesWitByRefInputs = map getAnyWitnessReferenceInput votingProceduresAndMaybeScriptWits + propsWitByRefInputs = map getAnyWitnessReferenceInput propProceduresAnMaybeScriptWits concatMap catMaybes @@ -1166,11 +1156,27 @@ getAllReferenceInputs , map Just readOnlyRefIns ] +getPlutusScriptWitnessReferenceInput :: Exp.PlutusScriptWitness lang purpose era -> Maybe TxIn +getPlutusScriptWitnessReferenceInput (Exp.PlutusScriptWitness _ (Exp.PReferenceScript ref) _ _ _) = Just ref +getPlutusScriptWitnessReferenceInput (Exp.PlutusScriptWitness _ (Exp.PScript{}) _ _ _) = Nothing + +-- TODO: Move to cardano-api getAnyWitnessReferenceInput :: Exp.AnyWitness era -> Maybe TxIn getAnyWitnessReferenceInput Exp.AnyKeyWitnessPlaceholder = Nothing getAnyWitnessReferenceInput Exp.AnySimpleScriptWitness{} = Nothing -getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness (Exp.PlutusScriptWitness _ (Exp.PReferenceScript ref) _ _ _)) = Just ref -getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness (Exp.PlutusScriptWitness _ (Exp.PScript{}) _ _ _)) = Nothing +getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness swit) = + case swit of + Exp.AnyPlutusMintingScriptWitness s -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusWithdrawingScriptWitness s -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusCertifyingScriptWitness s -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusProposingScriptWitness s -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusVotingScriptWitness s -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusSpendingScriptWitness (Exp.PlutusSpendingScriptWitnessV1 s) -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusSpendingScriptWitness (Exp.PlutusSpendingScriptWitnessV2 s) -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusSpendingScriptWitness (Exp.PlutusSpendingScriptWitnessV3 s) -> getPlutusScriptWitnessReferenceInput s + Exp.AnyPlutusSpendingScriptWitness (Exp.PlutusSpendingScriptWitnessV4 s) -> getPlutusScriptWitnessReferenceInput s + +-- getAnyWitnessReferenceInput (Exp.AnyPlutusScriptWitness (Exp.PlutusScriptWitness _ (Exp.PScript{}) _ _ _)) = Nothing toTxOutInShelleyBasedEra :: Exp.IsEra era @@ -1187,13 +1193,11 @@ toTxOutInShelleyBasedEra (TxOutShelleyBasedEra addr' val' mDatumHash refScriptFp -- for the policy id twice (in the build command) we can potentially query the UTxO and -- access the script (and therefore the policy id). createTxMintValue - :: forall era - . Exp.IsEra era - => (L.MultiAsset, [MintScriptWitnessWithPolicyId era]) - -> Either TxCmdError (TxMintValue BuildTx era) + :: (L.MultiAsset, [(PolicyId, Exp.AnyWitness (Exp.LedgerEra era))]) + -> Either TxCmdError (Exp.TxMintValue (Exp.LedgerEra era)) createTxMintValue (val, scriptWitnesses) = if mempty == val && List.null scriptWitnesses - then return TxMintNone + then return $ Exp.TxMintValue Map.empty else do let policiesWithAssets :: Map PolicyId PolicyAssets policiesWithAssets = multiAssetToPolicyAssets val @@ -1201,18 +1205,17 @@ createTxMintValue (val, scriptWitnesses) = witnessesNeededSet :: Set PolicyId witnessesNeededSet = Map.keysSet policiesWithAssets - witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) - witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitnessWithPolicyId polid sWit <- scriptWitnesses] - + let witnessesProvidedMap = fromList scriptWitnesses witnessesProvidedSet :: Set PolicyId witnessesProvidedSet = Map.keysSet witnessesProvidedMap + -- Check not too many, nor too few: validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet pure $ - TxMintValue (convert Exp.useEra) $ + Exp.TxMintValue $ Map.intersectionWith - (\assets wit -> (assets, BuildTxWith wit)) + (\assets wit -> (assets, wit)) policiesWithAssets witnessesProvidedMap where @@ -1614,9 +1617,10 @@ runTransactionPolicyIdCmd Cmd.TransactionPolicyIdCmdArgs { scriptFile = File sFile } = do - ScriptInAnyLang _ script <- - readFileScriptInAnyLang sFile - liftIO . Text.putStrLn . serialiseToRawBytesHexText $ hashScript script + script <- + readAnyScript @_ @ConwayEra sFile + let hash = fromShelleyScriptHash $ Exp.hashAnyScript script + liftIO . Text.putStrLn $ serialiseToRawBytesHexText hash partitionSomeWitnesses :: [ByronOrShelleyWitness] @@ -1761,3 +1765,9 @@ runTransactionSignWitnessCmd if isCborOutCanonical == TxCborCanonical then writeTxFileTextEnvelopeCanonical era outFile tx else writeTxFileTextEnvelope era outFile tx + +getExecutionUnitPrices :: CardanoEra era -> LedgerProtocolParameters era -> Maybe L.Prices +getExecutionUnitPrices cEra (LedgerProtocolParameters pp) = + forEraInEonMaybe cEra $ \aeo -> + alonzoEraOnwardsConstraints aeo $ + pp ^. L.ppPricesL diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Address/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Address/Run.hs index 35fa705062..4012f01619 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Address/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Address/Run.hs @@ -17,12 +17,14 @@ module Cardano.CLI.EraIndependent.Address.Run where import Cardano.Api +import Cardano.Api.Experimental.AnyScript qualified as Exp import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraIndependent.Address.Command import Cardano.CLI.EraIndependent.Address.Info.Run import Cardano.CLI.EraIndependent.Key.Run qualified as Key import Cardano.CLI.Read +import Cardano.CLI.Read qualified as Exp import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.AddressCmdError import Cardano.CLI.Type.Key @@ -205,10 +207,11 @@ runAddressBuildCmd paymentVerifier mbStakeVerifier nw mOutFp = do throwCliError $ AddressCmdExpectedPaymentVerificationKey nonPaymentKey return $ serialiseAddress (addr :: AddressAny) PaymentVerifierScriptFile (File fp) -> do - ScriptInAnyLang _lang script <- - readFileScriptInAnyLang fp + script <- + readAnyScript @_ @ConwayEra fp - let payCred = PaymentCredentialByScript (hashScript script) + let hash = fromShelleyScriptHash $ Exp.hashAnyScript script + payCred = PaymentCredentialByScript hash stakeAddressReference <- maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier @@ -231,10 +234,12 @@ makeStakeAddressRef stakeIdentifier = readVerificationKeyOrHashOrFile stkVkeyOrFile return . StakeAddressByValue $ StakeCredentialByKey stakeVKeyHash StakeVerifierScriptFile (File fp) -> do - ScriptInAnyLang _lang script <- - readFileScriptInAnyLang fp + script <- + Exp.readAnyScript @_ @ConwayEra fp + + let hash = fromShelleyScriptHash $ Exp.hashAnyScript script + stakeCred = StakeCredentialByScript hash - let stakeCred = StakeCredentialByScript (hashScript script) return (StakeAddressByValue stakeCred) StakeIdentifierAddress stakeAddr -> pure $ StakeAddressByValue $ stakeAddressCredential stakeAddr diff --git a/cardano-cli/src/Cardano/CLI/EraIndependent/Hash/Run.hs b/cardano-cli/src/Cardano/CLI/EraIndependent/Hash/Run.hs index d29bd923bd..810d366b32 100644 --- a/cardano-cli/src/Cardano/CLI/EraIndependent/Hash/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraIndependent/Hash/Run.hs @@ -13,6 +13,7 @@ module Cardano.CLI.EraIndependent.Hash.Run where import Cardano.Api +import Cardano.Api.Experimental.AnyScript qualified as Exp import Cardano.Api.Ledger qualified as L import Cardano.CLI.Compatible.Exception @@ -84,16 +85,18 @@ runHashAnchorDataCmd Cmd.HashAnchorDataCmdArgs{toHash, hashGoal} = do fetchURLToHashCmdError = withExceptT HashFetchURLError runHashScriptCmd - :: () - => Cmd.HashScriptCmdArgs + :: forall e + . Cmd.HashScriptCmdArgs -> CIO e () -runHashScriptCmd Cmd.HashScriptCmdArgs{Cmd.toHash = File toHash, mOutFile} = do - ScriptInAnyLang _ script <- - readFileScriptInAnyLang toHash - fromEitherIOCli @(FileError ()) $ - writeTextOutput mOutFile $ - serialiseToRawBytesHexText $ - hashScript script +runHashScriptCmd Cmd.HashScriptCmdArgs{Cmd.toHash = File toHash, mOutFile} = + do + script <- + readAnyScript @_ @ConwayEra toHash + let hash = Exp.hashAnyScript script + fromEitherIOCli @(FileError ()) $ + writeTextOutput mOutFile $ + serialiseToRawBytesHexText $ + fromShelleyScriptHash hash runHashGenesisFile :: GenesisFile -> CIO e () runHashGenesisFile (GenesisFile fpath) = do diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index dadf7ee509..1990466297 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -5,6 +5,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Cardano.CLI.Read @@ -14,6 +15,7 @@ module Cardano.CLI.Read -- * Script , ScriptDecodeError (..) + , readAnyScript , deserialiseScriptInAnyLang , readFileScriptInAnyLang , PlutusScriptDecodeError (..) @@ -95,10 +97,14 @@ where import Cardano.Api as Api import Cardano.Api.Byron (ByronKey) import Cardano.Api.Byron qualified as Byron +import Cardano.Api.Experimental (obtainCommonConstraints) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.AnyScript qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp' import Cardano.Api.Ledger qualified as L import Cardano.Api.Parser.Text qualified as P +import Cardano.Binary qualified as CBOR import Cardano.CLI.Compatible.Exception import Cardano.CLI.EraBased.Script.Type import Cardano.CLI.Type.Common @@ -192,6 +198,38 @@ readVerificationKeySource extractHash = \case VksKeyHashFile vKeyOrHashOrFile -> L.KeyHashObj . extractHash <$> readVerificationKeyOrHashOrTextEnvFile vKeyOrHashOrFile +readAnyScript + :: forall m era + . (MonadIO m, Exp.IsEra era) + => FilePath -> m (Exp.AnyScript (Exp.LedgerEra era)) +readAnyScript anyScriptFp = do + bs <- + readFileCli anyScriptFp + + case deserialiseFromJSON bs of + Left _ -> do + -- In addition to the TextEnvelope format, we also try to + -- deserialize the JSON representation of SimpleScripts.. + case Aeson.eitherDecodeStrict' bs :: Either String SimpleScript of + Left err -> throwCliError err + Right script -> + let s :: L.NativeScript (Exp.LedgerEra era) = obtainCommonConstraints (Exp.useEra @era) $ toAllegraTimelock script + in return . Exp.AnySimpleScript $ + obtainCommonConstraints (Exp.useEra :: Exp.Era era) $ + Exp.SimpleScript s + Right te -> do + let scriptBs = teRawCBOR te + TextEnvelopeType anyScriptType = teType te + case Exp'.textToPlutusLanguage $ Text.pack anyScriptType of + Just anyPlutusScriptLang -> do + case Exp.obtainCommonConstraints (Exp.useEra @era) $ + Exp'.decodeAnyPlutusScript @(Exp.LedgerEra era) scriptBs anyPlutusScriptLang + :: Either CBOR.DecoderError (Exp'.AnyPlutusScript (Exp.LedgerEra era)) of + Right (Exp'.AnyPlutusScript plutusScript) -> return $ Exp.AnyPlutusScript plutusScript + Left e -> + throwCliError $ "Failed to decode Plutus script: " <> show e + Nothing -> throwCliError $ "Unsupported script language: " <> anyScriptType + -- | Read a script file. The file can either be in the text envelope format -- wrapping the binary representation of any of the supported script languages, -- or alternatively it can be a JSON format file for one of the simple script @@ -772,48 +810,21 @@ readFileCli = withFrozenCallStack . readFileBinary readerFromParsecParser :: P.Parser a -> Opt.ReadM a readerFromParsecParser p = Opt.eitherReader (P.runParser p . T.pack) +-- TODO: Update to handle hex script bytes directly as well! readFilePlutusScript - :: FilePath - -> CIO e AnyPlutusScript + :: forall e era + . Exp.IsEra era + => FilePath + -> CIO e (Exp'.AnyPlutusScript (Exp.LedgerEra era)) readFilePlutusScript plutusScriptFp = do bs <- readFileCli plutusScriptFp - fromEitherCli $ deserialisePlutusScript bs - -deserialisePlutusScript - :: BS.ByteString - -> Either PlutusScriptDecodeError AnyPlutusScript -deserialisePlutusScript bs = do - te <- first PlutusScriptJsonDecodeError $ deserialiseFromJSON bs - case teType te of - TextEnvelopeType s -> case s of - sVer@"PlutusScriptV1" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV1 te - sVer@"PlutusScriptV2" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV2 te - sVer@"PlutusScriptV3" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV3 te - unknownScriptVersion -> - Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion - where - deserialiseAnyPlutusScriptVersion - :: IsPlutusScriptLanguage lang - => String - -> PlutusScriptVersion lang - -> TextEnvelope - -> Either PlutusScriptDecodeError AnyPlutusScript - deserialiseAnyPlutusScriptVersion v lang tEnv = - if v == show lang - then - first PlutusScriptDecodeTextEnvelopeError $ - deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv - else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang) - - teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript - teTypes = - \case - AnyPlutusScriptVersion PlutusScriptV1 -> - FromSomeType (AsPlutusScript AsPlutusScriptV1) (AnyPlutusScript PlutusScriptV1) - AnyPlutusScriptVersion PlutusScriptV2 -> - FromSomeType (AsPlutusScript AsPlutusScriptV2) (AnyPlutusScript PlutusScriptV2) - AnyPlutusScriptVersion PlutusScriptV3 -> - FromSomeType (AsPlutusScript AsPlutusScriptV3) (AnyPlutusScript PlutusScriptV3) - AnyPlutusScriptVersion PlutusScriptV4 -> - FromSomeType (AsPlutusScript AsPlutusScriptV4) (AnyPlutusScript PlutusScriptV4) + te <- fromEitherCli $ deserialiseFromJSON bs + let scriptBs = teRawCBOR te + TextEnvelopeType anyScriptType = teType te + case Exp'.textToPlutusLanguage (Text.pack anyScriptType) of + Just lang -> do + let s :: Either CBOR.DecoderError (Exp'.AnyPlutusScript (Exp.LedgerEra era)) = obtainCommonConstraints (Exp.useEra @era) $ Exp'.decodeAnyPlutusScript scriptBs lang + fromEitherCli s + Nothing -> + throwCliError $ "Unsupported script language: " <> anyScriptType diff --git a/cardano-cli/src/Cardano/CLI/Type/Common.hs b/cardano-cli/src/Cardano/CLI/Type/Common.hs index 4b51a827c0..63ad6213e3 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Common.hs @@ -5,12 +5,14 @@ {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} module Cardano.CLI.Type.Common ( AllOrOnly (..) , AddressKeyType (..) , AnchorScheme (..) , AnyPlutusScriptVersion (..) + , AnySLanguage (..) , BalanceTxExecUnits (..) , BlockId (..) , ByronKeyFormat (..) @@ -106,6 +108,7 @@ import Cardano.Api hiding (Script) import Cardano.Api.Ledger qualified as L import Cardano.Ledger.Api.State.Query qualified as L +import Cardano.Ledger.Plutus.Language qualified as L import Cardano.Ledger.State qualified as L import Data.Aeson (object, pairs, (.=)) @@ -118,6 +121,12 @@ import Data.Text qualified as Text import Data.Word (Word64) import GHC.Generics (Generic) +-- TODO: Move to cardano-api +data AnySLanguage where + AnySLanguage :: L.PlutusLanguage lang => L.SLanguage lang -> AnySLanguage + +deriving instance Show AnySLanguage + -- | Determines the direction in which the MIR certificate will transfer ADA. data TransferDirection = TransferToReserves diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/ScriptDecodeError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/ScriptDecodeError.hs index 31593bf64b..90aafd4a58 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/ScriptDecodeError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/ScriptDecodeError.hs @@ -7,8 +7,6 @@ where import Cardano.Api -import Data.Text - -- -- Handling decoding the variety of script languages and formats -- @@ -16,7 +14,6 @@ import Data.Text data ScriptDecodeError = ScriptDecodeTextEnvelopeError TextEnvelopeError | ScriptDecodeSimpleScriptError JsonDecodeError - | ScriptDecodeUnknownPlutusScriptVersion Text deriving Show instance Error ScriptDecodeError where @@ -25,5 +22,3 @@ instance Error ScriptDecodeError where "Error decoding script:" <+> prettyError err ScriptDecodeSimpleScriptError err -> "Syntax error in script:" <+> prettyError err - ScriptDecodeUnknownPlutusScriptVersion version -> - "Unknown Plutus script version:" <+> pshow version diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs index 83f5662d9d..4a326f6af5 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/TxCmdError.hs @@ -16,8 +16,11 @@ where import Cardano.Api import Cardano.Api.Byron (GenesisDataError) import Cardano.Api.Experimental qualified as Exp +import Cardano.Api.Experimental.Plutus qualified as Exp +import Cardano.Api.Experimental.Tx qualified as Exp import Cardano.Api.Ledger qualified as L +import Cardano.Binary qualified as CBOR import Cardano.CLI.Read import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.BootstrapWitnessError @@ -35,10 +38,14 @@ import Data.Text.Lazy.Builder (toLazyText) import Formatting.Buildable (Buildable (build)) data AnyTxBodyErrorAutoBalance where - AnyTxBodyErrorAutoBalance :: TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance + AnyTxBodyErrorAutoBalance :: Exp.TxBodyErrorAutoBalance era -> AnyTxBodyErrorAutoBalance data TxCmdError - = TxCmdProtocolParamsError ProtocolParamsError + = TxCmdCBORDecodeError !CBOR.DecoderError + | TxCmdProtocolParamsError ProtocolParamsError + | forall era. LostScriptWitnesses + [Exp.AnyIndexedPlutusScriptWitness (Exp.LedgerEra era)] + [Exp.AnyIndexedPlutusScriptWitness (Exp.LedgerEra era)] | TxCmdReadWitnessSigningDataError !ReadWitnessSigningDataError | TxCmdWriteFileError !(FileError ()) | TxCmdBootstrapWitnessError !BootstrapWitnessError @@ -62,7 +69,7 @@ data TxCmdError | TxCmdScriptDataError !ScriptDataError | -- Validation errors forall era. TxCmdTxGovDuplicateVotes (TxGovDuplicateVotes era) - | forall era. TxCmdFeeEstimationError (TxFeeEstimationError era) + | forall era. TxCmdFeeEstimationError (Exp.TxFeeEstimationError era) | TxCmdPoolMetadataHashError Exp.AnchorDataFromCertificateError | TxCmdHashCheckError L.Url HashCheckError | TxCmdUnregisteredStakeAddress !(Set StakeCredential) @@ -80,6 +87,8 @@ instance Error TxCmdError where renderTxCmdError :: TxCmdError -> Doc ann renderTxCmdError = \case + TxCmdCBORDecodeError decErr -> + prettyError decErr TxCmdReadWitnessSigningDataError witSignDataErr -> renderReadWitnessSigningDataError witSignDataErr TxCmdWriteFileError fileErr -> @@ -177,6 +186,15 @@ renderTxCmdError = \case "Error while decoding JSON from UTxO set file: " <> pretty e TxCmdGenesisDataError genesisDataError -> "Error while reading Byron genesis data: " <> pshow (toLazyText $ build genesisDataError) + LostScriptWitnesses before after -> + mconcat + [ "Some Plutus script witnesses were lost during transaction processing. " + , "Number of witnesses before: " + , pretty (length before) + , ", number of witnesses after: " + , pretty (length after) + , "." + ] prettyPolicyIdList :: [PolicyId] -> Doc ann prettyPolicyIdList = diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out index 8bbbbc06d6..e3837ec4d4 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out +++ b/cardano-cli/test/cardano-cli-golden/files/golden/alonzo/transaction-view.out @@ -1,5 +1,4 @@ -auxiliary scripts: '[ScriptInEra PlutusScriptV1InConway (PlutusScript PlutusScriptV1 - (PlutusScriptSerialised "M\SOH\NUL\NUL3\"\" \ENQ\DC2\NUL\DC2\NUL\DC1"))]' +auxiliary scripts: null certificates: - Stake address registration: deposit: 2000000 @@ -789,7 +788,6 @@ redeemers: memory: 110 steps: 100 reference inputs: -- fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#138 - fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#139 - fe5dd07fb576bff960d6e066eade5b26cdb5afebe29f76ea58d0a098bce5d891#141 required signers (payment key hashes needed for scripts): diff --git a/flake.lock b/flake.lock index fa2a54fb4e..45f31ab1b7 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1764072073, - "narHash": "sha256-ZLlhdnWO8bP5gsbmUKg6U+3oxBX66vZUO6jyirAhgHo=", + "lastModified": 1768312326, + "narHash": "sha256-i2c7coWF4U8y9WwiwAQGu3RkLlJJUQgomBPqsuZ7aNc=", "owner": "intersectmbo", "repo": "cardano-haskell-packages", - "rev": "be9725d16fb590998020914e0b71f41a23c50ec2", + "rev": "3240ef4b77e8bd016722d9bc5b8e3f567e6d8968", "type": "github" }, "original": { @@ -226,11 +226,11 @@ "hackageNix": { "flake": false, "locked": { - "lastModified": 1762335884, - "narHash": "sha256-wFZpsYUWC5yJiUmTd8DxvoPeI54g3WI/5ABg8+V1seI=", + "lastModified": 1768311066, + "narHash": "sha256-g2WdhScDFQNkJs2GBjWIGG49upIQuBshgaeAxddujrE=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "360cc2f68f50eb0d48adab0e08f702dd606f9e82", + "rev": "adbb09d536f3a2797f9bd0762a0577a30672b8b1", "type": "github" }, "original": { @@ -556,11 +556,11 @@ "sodium": "sodium" }, "locked": { - "lastModified": 1757407040, - "narHash": "sha256-rSHOQli+iffMmneSF/Ov8Uci6APaROWen+EfRb5mmiU=", + "lastModified": 1767797951, + "narHash": "sha256-74YzTQnjU8zXjFsSGNTElT/JrjEJ+UWxXP4W/aqegKk=", "owner": "input-output-hk", "repo": "iohk-nix", - "rev": "a94259528eb6d37073512d1767f14fd8ea12a8f0", + "rev": "a489231f4a6749fe6a81a63af7159d75bdaff700", "type": "github" }, "original": {