Skip to content

Commit bfc7ad5

Browse files
Jimbo4350Jimbo4350
authored
Merge pull request #1213 from IntersectMBO/jordan/experimental-api-propagation-20250602
Experimental api propagation 2025-06-02
2 parents 91a8e09 + 8f0053e commit bfc7ad5

File tree

8 files changed

+322
-197
lines changed

8 files changed

+322
-197
lines changed

‎cardano-cli/cardano-cli.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,7 @@ library
7575
Cardano.CLI.Compatible.Transaction.Command
7676
Cardano.CLI.Compatible.Transaction.Option
7777
Cardano.CLI.Compatible.Transaction.Run
78+
Cardano.CLI.Compatible.Transaction.ScriptWitness
7879
Cardano.CLI.Compatible.Transaction.TxOut
7980
Cardano.CLI.Environment
8081
Cardano.CLI.EraBased.Command

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/Run.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,8 +21,8 @@ import Cardano.Api.Ledger qualified as L hiding
2121

2222
import Cardano.CLI.Compatible.Exception
2323
import Cardano.CLI.Compatible.Transaction.Command
24+
import Cardano.CLI.Compatible.Transaction.ScriptWitness
2425
import Cardano.CLI.Compatible.Transaction.TxOut
25-
import Cardano.CLI.EraBased.Script.Certificate.Read
2626
import Cardano.CLI.EraBased.Script.Certificate.Type
2727
import Cardano.CLI.EraBased.Script.Proposal.Type
2828
import Cardano.CLI.EraBased.Script.Vote.Type

‎cardano-cli/src/Cardano/CLI/Compatible/Transaction/ScriptWitness.hs‎

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE FlexibleContexts #-}
3+
{-# LANGUAGE GADTs #-}
4+
{-# LANGUAGE TupleSections #-}
5+
6+
module Cardano.CLI.Compatible.Transaction.ScriptWitness
7+
( readCertificateScriptWitness
8+
, readCertificateScriptWitnesses
9+
)
10+
where
11+
12+
import Cardano.Api
13+
14+
import Cardano.CLI.EraBased.Script.Certificate.Type
15+
import Cardano.CLI.EraBased.Script.Read.Common
16+
import Cardano.CLI.EraBased.Script.Type
17+
import Cardano.CLI.Type.Common (CertificateFile)
18+
19+
import Control.Monad
20+
21+
readCertificateScriptWitnesses
22+
:: MonadIOTransError (FileError CliScriptWitnessError) t m
23+
=> ShelleyBasedEra era
24+
-> [(CertificateFile, Maybe CliCertificateScriptRequirements)]
25+
-> t m [(CertificateFile, Maybe (CertificateScriptWitness era))]
26+
readCertificateScriptWitnesses sbe =
27+
mapM
28+
( \(certFile, mSWit) -> do
29+
(certFile,) <$> forM mSWit (readCertificateScriptWitness sbe)
30+
)
31+
32+
readCertificateScriptWitness
33+
:: MonadIOTransError (FileError CliScriptWitnessError) t m
34+
=> ShelleyBasedEra era -> CliCertificateScriptRequirements -> t m (CertificateScriptWitness era)
35+
readCertificateScriptWitness sbe certScriptReq =
36+
case certScriptReq of
37+
OnDiskSimpleScript scriptFp -> do
38+
let sFp = unFile scriptFp
39+
s <-
40+
modifyError (fmap SimpleScriptWitnessDecodeError) $
41+
readFileSimpleScript sFp
42+
case s of
43+
SimpleScript ss -> do
44+
return $
45+
CertificateScriptWitness $
46+
SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $
47+
SScript ss
48+
OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits) -> do
49+
let plutusScriptFp = unFile scriptFp
50+
plutusScript <-
51+
modifyError (fmap PlutusScriptWitnessDecodeError) $
52+
readFilePlutusScript plutusScriptFp
53+
redeemer <-
54+
modifyError (FileError plutusScriptFp . PlutusScriptWitnessRedeemerError) $
55+
readScriptDataOrFile redeemerFile
56+
case plutusScript of
57+
AnyPlutusScript lang script -> do
58+
let pScript = PScript script
59+
sLangSupported <-
60+
modifyError (FileError plutusScriptFp)
61+
$ hoistMaybe
62+
( PlutusScriptWitnessLanguageNotSupportedInEra
63+
(AnyPlutusScriptVersion lang)
64+
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
65+
)
66+
$ scriptLanguageSupportedInEra sbe
67+
$ PlutusScriptLanguage lang
68+
return $
69+
CertificateScriptWitness $
70+
PlutusScriptWitness
71+
sLangSupported
72+
lang
73+
pScript
74+
NoScriptDatumForStake
75+
redeemer
76+
execUnits
77+
OnDiskPlutusRefScript (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits) -> do
78+
case anyPlutusScriptVersion of
79+
AnyPlutusScriptVersion lang -> do
80+
let pScript = PReferenceScript refTxIn
81+
redeemer <-
82+
-- TODO: Implement a new error type to capture this. FileError is not representative of cases
83+
-- where we do not have access to the script.
84+
modifyError
85+
( FileError "Reference script filepath not available"
86+
. PlutusScriptWitnessRedeemerError
87+
)
88+
$ readScriptDataOrFile redeemerFile
89+
sLangSupported <-
90+
-- TODO: Implement a new error type to capture this. FileError is not representative of cases
91+
-- where we do not have access to the script.
92+
modifyError (FileError "Reference script filepath not available")
93+
$ hoistMaybe
94+
( PlutusScriptWitnessLanguageNotSupportedInEra
95+
(AnyPlutusScriptVersion lang)
96+
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
97+
)
98+
$ scriptLanguageSupportedInEra sbe
99+
$ PlutusScriptLanguage lang
100+
101+
return $
102+
CertificateScriptWitness $
103+
PlutusScriptWitness
104+
sLangSupported
105+
lang
106+
pScript
107+
NoScriptDatumForStake
108+
redeemer
109+
execUnits

‎cardano-cli/src/Cardano/CLI/EraBased/Script/Certificate/Read.hs‎

Lines changed: 111 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -1,109 +1,130 @@
1-
{-# LANGUAGE DataKinds #-}
21
{-# LANGUAGE FlexibleContexts #-}
32
{-# LANGUAGE GADTs #-}
4-
{-# LANGUAGE TupleSections #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
5+
{-# LANGUAGE TypeApplications #-}
56

67
module Cardano.CLI.EraBased.Script.Certificate.Read
78
( readCertificateScriptWitness
89
, readCertificateScriptWitnesses
910
)
1011
where
1112

12-
import Cardano.Api
13+
import Cardano.Api (File (..))
14+
import Cardano.Api qualified as Api
15+
import Cardano.Api.Experimental
16+
import Cardano.Api.Ledger qualified as L
17+
import Cardano.Api.Plutus (AnyPlutusScriptVersion (..), ToLedgerPlutusLanguage)
1318

19+
import Cardano.CLI.Compatible.Exception
1420
import Cardano.CLI.EraBased.Script.Certificate.Type
1521
import Cardano.CLI.EraBased.Script.Read.Common
1622
import Cardano.CLI.EraBased.Script.Type
23+
import Cardano.CLI.Orphan ()
1724
import Cardano.CLI.Type.Common (CertificateFile)
25+
import Cardano.Ledger.Core qualified as L
26+
import Cardano.Ledger.Plutus.Language qualified as L
27+
import Cardano.Ledger.Plutus.Language qualified as Plutus
1828

19-
import Control.Monad
29+
readCertificateScriptWitness
30+
:: forall era e
31+
. IsEra era
32+
=> CliCertificateScriptRequirements
33+
-> CIO e (AnyWitness (LedgerEra era))
34+
readCertificateScriptWitness (OnDiskSimpleScript scriptFp) = do
35+
let sFp = unFile scriptFp
36+
s <-
37+
fromExceptTCli $
38+
readFileSimpleScript sFp
39+
let nativeScript :: SimpleScript (LedgerEra era) = convertTotimelock useEra s
40+
return $
41+
AnySimpleScriptWitness $
42+
SScript nativeScript
43+
readCertificateScriptWitness (OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits)) = do
44+
let plutusScriptFp = unFile scriptFp
45+
AnyPlutusScript sVer apiScript <-
46+
fromExceptTCli $
47+
readFilePlutusScript plutusScriptFp
2048

21-
readCertificateScriptWitnesses
22-
:: MonadIOTransError (FileError CliScriptWitnessError) t m
23-
=> ShelleyBasedEra era
24-
-> [(CertificateFile, Maybe CliCertificateScriptRequirements)]
25-
-> t m [(CertificateFile, Maybe (CertificateScriptWitness era))]
26-
readCertificateScriptWitnesses sbe =
27-
mapM
28-
( \(certFile, mSWit) -> do
29-
(certFile,) <$> forM mSWit (readCertificateScriptWitness sbe)
30-
)
49+
let lang = toPlutusSLanguage sVer
50+
script <- decodePlutusScript useEra sVer apiScript
3151

52+
redeemer <-
53+
fromExceptTCli $
54+
readScriptDataOrFile redeemerFile
55+
return $
56+
AnyPlutusScriptWitness $
57+
PlutusScriptWitness
58+
lang
59+
script
60+
NoScriptDatum
61+
redeemer
62+
execUnits
3263
readCertificateScriptWitness
33-
:: MonadIOTransError (FileError CliScriptWitnessError) t m
34-
=> ShelleyBasedEra era -> CliCertificateScriptRequirements -> t m (CertificateScriptWitness era)
35-
readCertificateScriptWitness sbe certScriptReq =
36-
case certScriptReq of
37-
OnDiskSimpleScript scriptFp -> do
38-
let sFp = unFile scriptFp
39-
s <-
40-
modifyError (fmap SimpleScriptWitnessDecodeError) $
41-
readFileSimpleScript sFp
42-
case s of
43-
SimpleScript ss -> do
44-
return $
45-
CertificateScriptWitness $
46-
SimpleScriptWitness (sbeToSimpleScriptLanguageInEra sbe) $
47-
SScript ss
48-
OnDiskPlutusScript (OnDiskPlutusScriptCliArgs scriptFp redeemerFile execUnits) -> do
49-
let plutusScriptFp = unFile scriptFp
50-
plutusScript <-
51-
modifyError (fmap PlutusScriptWitnessDecodeError) $
52-
readFilePlutusScript plutusScriptFp
53-
redeemer <-
54-
modifyError (FileError plutusScriptFp . PlutusScriptWitnessRedeemerError) $
55-
readScriptDataOrFile redeemerFile
56-
case plutusScript of
57-
AnyPlutusScript lang script -> do
58-
let pScript = PScript script
59-
sLangSupported <-
60-
modifyError (FileError plutusScriptFp)
61-
$ hoistMaybe
62-
( PlutusScriptWitnessLanguageNotSupportedInEra
63-
(AnyPlutusScriptVersion lang)
64-
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
65-
)
66-
$ scriptLanguageSupportedInEra sbe
67-
$ PlutusScriptLanguage lang
68-
return $
69-
CertificateScriptWitness $
70-
PlutusScriptWitness
71-
sLangSupported
72-
lang
73-
pScript
74-
NoScriptDatumForStake
75-
redeemer
76-
execUnits
77-
OnDiskPlutusRefScript (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits) -> do
78-
case anyPlutusScriptVersion of
79-
AnyPlutusScriptVersion lang -> do
80-
let pScript = PReferenceScript refTxIn
81-
redeemer <-
82-
-- TODO: Implement a new error type to capture this. FileError is not representative of cases
83-
-- where we do not have access to the script.
84-
modifyError
85-
( FileError "Reference script filepath not available"
86-
. PlutusScriptWitnessRedeemerError
87-
)
88-
$ readScriptDataOrFile redeemerFile
89-
sLangSupported <-
90-
-- TODO: Implement a new error type to capture this. FileError is not representative of cases
91-
-- where we do not have access to the script.
92-
modifyError (FileError "Reference script filepath not available")
93-
$ hoistMaybe
94-
( PlutusScriptWitnessLanguageNotSupportedInEra
95-
(AnyPlutusScriptVersion lang)
96-
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
97-
)
98-
$ scriptLanguageSupportedInEra sbe
99-
$ PlutusScriptLanguage lang
64+
( OnDiskPlutusRefScript
65+
(PlutusRefScriptCliArgs refInput (AnyPlutusScriptVersion sVer) redeemerFile execUnits)
66+
) = do
67+
let lang = toPlutusSLanguage sVer
68+
redeemer <-
69+
fromExceptTCli $
70+
readScriptDataOrFile redeemerFile
71+
return $
72+
AnyPlutusScriptWitness $
73+
PlutusScriptWitness
74+
lang
75+
(PReferenceScript refInput)
76+
NoScriptDatum
77+
redeemer
78+
execUnits
79+
80+
decodePlutusScript
81+
:: forall era lang e
82+
. Era era
83+
-> Api.PlutusScriptVersion lang
84+
-> Api.PlutusScript lang
85+
-> CIO e (PlutusScriptOrReferenceInput (ToLedgerPlutusLanguage lang) (LedgerEra era))
86+
decodePlutusScript era sVer (Api.PlutusScriptSerialised script) = obtainConstraints sVer $ do
87+
let runnableScriptBs = L.Plutus $ L.PlutusBinary script
88+
plutusRunnable <-
89+
fromEitherCli $
90+
Plutus.decodePlutusRunnable
91+
(getVersion era)
92+
runnableScriptBs
93+
return $ PScript (PlutusScriptInEra plutusRunnable)
94+
95+
obtainConstraints
96+
:: Api.PlutusScriptVersion lang
97+
-> (L.PlutusLanguage (ToLedgerPlutusLanguage lang) => a)
98+
-> a
99+
obtainConstraints v =
100+
case v of
101+
Api.PlutusScriptV1 -> id
102+
Api.PlutusScriptV2 -> id
103+
Api.PlutusScriptV3 -> id
100104

101-
return $
102-
CertificateScriptWitness $
103-
PlutusScriptWitness
104-
sLangSupported
105-
lang
106-
pScript
107-
NoScriptDatumForStake
108-
redeemer
109-
execUnits
105+
getVersion :: forall era. Era era -> L.Version
106+
getVersion e = obtainCommonConstraints e $ L.eraProtVerLow @(LedgerEra era)
107+
108+
convertTotimelock
109+
:: forall era
110+
. Era era
111+
-> Api.Script Api.SimpleScript'
112+
-> SimpleScript (LedgerEra era)
113+
convertTotimelock era (Api.SimpleScript s) =
114+
let native :: L.NativeScript (LedgerEra era) = obtainCommonConstraints era $ Api.toAllegraTimelock s
115+
in obtainCommonConstraints era $ SimpleScript native
116+
117+
readCertificateScriptWitnesses
118+
:: IsEra era
119+
=> [(CertificateFile, Maybe CliCertificateScriptRequirements)]
120+
-> CIO e [(CertificateFile, AnyWitness (LedgerEra era))]
121+
readCertificateScriptWitnesses certs =
122+
mapM
123+
( \(vFile, mCert) -> do
124+
case mCert of
125+
Nothing -> return (vFile, AnyKeyWitnessPlaceholder)
126+
Just cert -> do
127+
sWit <- readCertificateScriptWitness cert
128+
return (vFile, sWit)
129+
)
130+
certs

‎cardano-cli/src/Cardano/CLI/EraBased/Transaction/Internal/HashCheck.hs‎

Lines changed: 19 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,18 @@ module Cardano.CLI.EraBased.Transaction.Internal.HashCheck
88
where
99

1010
import Cardano.Api
11+
( ExceptT
12+
, Proposal (..)
13+
, ShelleyBasedEra
14+
, VotingProcedures (..)
15+
, except
16+
, firstExceptT
17+
, getAnchorDataFromCertificate
18+
, getAnchorDataFromGovernanceAction
19+
, shelleyBasedEraConstraints
20+
, withExceptT
21+
)
22+
import Cardano.Api.Experimental qualified as Exp
1123
import Cardano.Api.Ledger qualified as L
1224

1325
import Cardano.CLI.EraIndependent.Hash.Internal.Common (carryHashChecks)
@@ -29,9 +41,14 @@ checkAnchorMetadataHash anchor =
2941

3042
-- | Find references to anchor data and check the hashes are valid
3143
-- and they match the linked data.
32-
checkCertificateHashes :: Certificate era -> ExceptT TxCmdError IO ()
44+
checkCertificateHashes
45+
:: Exp.IsEra era => Exp.Certificate (Exp.LedgerEra era) -> ExceptT TxCmdError IO ()
3346
checkCertificateHashes cert = do
34-
mAnchor <- withExceptT TxCmdPoolMetadataHashError $ except $ getAnchorDataFromCertificate cert
47+
mAnchor <-
48+
withExceptT TxCmdPoolMetadataHashError $
49+
except $
50+
getAnchorDataFromCertificate $
51+
Exp.convertToOldApiCertificate Exp.useEra cert
3552
maybe (return mempty) checkAnchorMetadataHash mAnchor
3653

3754
-- | Find references to anchor data in voting procedures and check the hashes are valid

0 commit comments

Comments
 (0)