diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index a84a573e6..7b6c91d94 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1516,7 +1516,7 @@ pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUni AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing + <*> pure NoPolicyIdSource pPlutusStakeReferenceScriptWitnessFiles :: String @@ -1533,7 +1533,7 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits = AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing + <*> pure NoPolicyIdSource pPlutusScriptLanguage :: String -> Parser AnyScriptLanguage pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3" @@ -1922,7 +1922,7 @@ pTxIn sbe balance = -> ScriptWitnessFiles WitCtxTxIn createSimpleReferenceScriptWitnessFiles refTxIn = let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing + in SimpleReferenceScriptWitnessFiles refTxIn simpleLang NoPolicyIdSource pPlutusReferenceScriptWitness :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) @@ -1960,7 +1960,7 @@ pTxIn sbe balance = -> ExecutionUnits -> ScriptWitnessFiles WitCtxTxIn createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits = - PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing + PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits NoPolicyIdSource pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) pEmbeddedPlutusScriptWitness = @@ -2170,7 +2170,7 @@ pMintMultiAsset sbe balanceExecUnits = -> ScriptWitnessFiles WitCtxMint createSimpleMintingReferenceScriptWitnessFiles refTxIn pid = let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (Just pid) + in SimpleReferenceScriptWitnessFiles refTxIn simpleLang (ConcretePolicyId pid) pPlutusMintReferenceScriptWitnessFiles :: BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxMint) @@ -2184,7 +2184,7 @@ pMintMultiAsset sbe balanceExecUnits = AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits "mint-reference-tx-in" ) - <*> (Just <$> pPolicyId) + <*> (ConcretePolicyId <$> pPolicyId) helpText = mconcat diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 97e0a677e..0ef58fa4b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -73,6 +73,7 @@ import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) +import Data.Proxy import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as Text @@ -1396,12 +1397,21 @@ scriptWitnessPolicyId (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) = readValueScriptWitnesses :: ShelleyBasedEra era - -> (Value, [ScriptWitnessFiles WitCtxMint]) - -> ExceptT TxCmdError IO (Value, [(Maybe PolicyId, ScriptWitness WitCtxMint era)]) + -> (a, [ScriptWitnessFiles WitCtxMint]) + -> ExceptT + TxCmdError + IO + (a, [(Maybe (MintingPolicyIdSource OnlineCommand WitCtxMint), ScriptWitness WitCtxMint era)]) readValueScriptWitnesses era (v, sWitFiles) = do sWits <- mapM (firstExceptT TxCmdScriptWitnessError . readScriptWitness era) sWitFiles return (v, sWits) +getpid = undefined :: ScriptWitness WitCtxMint era -> PolicyId + +setpid = undefined :: PolicyId -> ScriptWitness WitCtxMint era -> ScriptWitness WitCtxMint era + +foo = Proxy @SimpleScriptWitness + -- ---------------------------------------------------------------------------- -- Transaction signing -- diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index bcf487cc0..b276b42e3 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -290,7 +290,10 @@ readScriptWitnessFilesTuple era = mapM readSwitFile readScriptWitness :: ShelleyBasedEra era -> ScriptWitnessFiles witctx - -> ExceptT ScriptWitnessError IO (Maybe PolicyId, ScriptWitness witctx era) + -> ExceptT + ScriptWitnessError + IO + (Maybe (MintingPolicyIdSource OnlineCommand witctx), ScriptWitness witctx era) readScriptWitness era (SimpleScriptWitnessFile (File scriptFile)) = do script@(ScriptInAnyLang lang _) <- firstExceptT ScriptWitnessErrorFile $ @@ -352,7 +355,7 @@ readScriptWitness datumOrFile redeemerOrFile execUnits - mPid + pid ) = do caseShelleyToAlonzoOrBabbageEraOnwards ( const $ @@ -375,7 +378,7 @@ readScriptWitness redeemer <- firstExceptT ScriptWitnessErrorScriptData $ readScriptRedeemerOrFile redeemerOrFile - return . (mPid,) $ + return . (Just pid,) $ PlutusScriptWitness sLangInEra version @@ -406,7 +409,7 @@ readScriptWitness Just sLangInEra -> case languageOfScriptLanguageInEra sLangInEra of SimpleScriptLanguage -> - return . (mPid,) . SimpleScriptWitness sLangInEra $ + return . (Just mPid,) . SimpleScriptWitness sLangInEra $ SReferenceScript refTxIn PlutusScriptLanguage{} -> error "readScriptWitness: Should not be possible to specify a plutus script" diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index c765ac64a..cbdfc95de 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -2,8 +2,10 @@ {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} module Cardano.CLI.Types.Common ( AllOrOnly (..) @@ -58,6 +60,8 @@ module Cardano.CLI.Types.Common , ScriptFile , ScriptRedeemerOrFile , ScriptWitnessFiles (..) + , MintingPolicyIdSource (..) + , IsOnlineCommand (..) , SigningKeyFile , SlotsTillKesKeyExpiry (..) , SomeKeyFile (..) @@ -101,6 +105,7 @@ import qualified Data.Aeson as Aeson import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as Text +import Data.Type.Equality (type (==)) import Data.Word (Word64) -- | Determines the direction in which the MIR certificate will transfer ADA. @@ -417,18 +422,28 @@ data ScriptWitnessFiles witctx where -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits - -> Maybe PolicyId - -- ^ For minting reference scripts + -> MintingPolicyIdSource OnlineCommand witctx -> ScriptWitnessFiles witctx SimpleReferenceScriptWitnessFiles :: TxIn -> AnyScriptLanguage - -> Maybe PolicyId - -- ^ For minting reference scripts + -> MintingPolicyIdSource OnlineCommand witctx -> ScriptWitnessFiles witctx deriving instance Show (ScriptWitnessFiles witctx) +data IsOnlineCommand = OnlineCommand | OfflineCommand + +data MintingPolicyIdSource (o :: IsOnlineCommand) witctx where + -- | A concrete policy Id + ConcretePolicyId :: PolicyId -> MintingPolicyIdSource o WitCtxMint + -- | Query policy Id from the UTxO set, only for an online command + QueryUtxoPolicyId :: TxIn -> MintingPolicyIdSource OnlineCommand WitCtxMint + -- | No policy Id is provided for nonminting contexts + NoPolicyIdSource :: (witctx == WitCtxMint) ~ False => MintingPolicyIdSource o witctx + +deriving instance Show (MintingPolicyIdSource o witctx) + data ScriptDatumOrFile witctx where ScriptDatumOrFileForTxIn :: Maybe ScriptDataOrFile -- CIP-0069 - Spending datums optional in Conway era onwards