Skip to content

Commit b271e1f

Browse files
Jimbo4350Jimbo4350
committed
Split
1 parent 4b24672 commit b271e1f

File tree

34 files changed

+1000
-931
lines changed

34 files changed

+1000
-931
lines changed

‎cabal.project‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,8 +13,8 @@ repository cardano-haskell-packages
1313
-- See CONTRIBUTING for information about these, including some Nix commands
1414
-- you need to run if you change them
1515
index-state:
16-
, hackage.haskell.org 2025-11-05T09:40:54Z
17-
, cardano-haskell-packages 2025-11-24T10:27:41Z
16+
, hackage.haskell.org 2025-12-02T22:23:29Z
17+
, cardano-haskell-packages 2025-12-16T19:04:42Z
1818

1919
packages:
2020
cardano-cli
@@ -66,3 +66,11 @@ if impl (ghc >= 9.12)
6666
-- IMPORTANT
6767
-- Do NOT add more source-repository-package stanzas here unless they are strictly
6868
-- temporary! Please read the section in CONTRIBUTING about updating dependencies.
69+
70+
71+
source-repository-package
72+
type: git
73+
location: https://github.com/IntersectMBO/cardano-api.git
74+
tag: adc33c01ee11a7fe08311a1be32ed23b31e0cf41
75+
--sha256: sha256-FpjbpDH2Vu2Sh85J+JX9PO1WRcCEoCC1uM4OpqGqEH0=
76+
subdir: cardano-api

‎cardano-cli/cardano-cli.cabal‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -67,6 +67,7 @@ library
6767
Cardano.CLI.Compatible.Governance.Types
6868
Cardano.CLI.Compatible.Json.Friendly
6969
Cardano.CLI.Compatible.Option
70+
Cardano.CLI.Compatible.Read
7071
Cardano.CLI.Compatible.Run
7172
Cardano.CLI.Compatible.StakeAddress.Command
7273
Cardano.CLI.Compatible.StakeAddress.Option
@@ -241,7 +242,7 @@ library
241242
binary,
242243
bytestring,
243244
canonical-json,
244-
cardano-api ^>=10.20,
245+
cardano-api ^>=10.21,
245246
cardano-binary,
246247
cardano-crypto,
247248
cardano-crypto-class ^>=2.2.3.2,

‎cardano-cli/src/Cardano/CLI/Compatible/Command.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,10 +20,9 @@ import Cardano.CLI.Compatible.StakePool.Command
2020
import Cardano.CLI.Compatible.Transaction.Command
2121

2222
import Data.Text
23-
import Data.Typeable (Typeable)
2423

2524
data AnyCompatibleCommand where
26-
AnyCompatibleCommand :: Typeable era => CompatibleCommand era -> AnyCompatibleCommand
25+
AnyCompatibleCommand :: CompatibleCommand era -> AnyCompatibleCommand
2726

2827
renderAnyCompatibleCommand :: AnyCompatibleCommand -> Text
2928
renderAnyCompatibleCommand = \case

‎cardano-cli/src/Cardano/CLI/Compatible/Read.hs‎

Lines changed: 112 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,112 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE DataKinds #-}
5+
{-# LANGUAGE LambdaCase #-}
6+
{-# LANGUAGE OverloadedStrings #-}
7+
{-# LANGUAGE ScopedTypeVariables #-}
8+
{-# LANGUAGE TypeFamilies #-}
9+
10+
module Cardano.CLI.Compatible.Read
11+
( AnyPlutusScript (..)
12+
, readFilePlutusScript
13+
, readFileSimpleScript
14+
)
15+
where
16+
17+
import Cardano.Api as Api
18+
19+
import Cardano.CLI.Compatible.Exception
20+
import Cardano.CLI.Read (readFileCli)
21+
import Cardano.CLI.Type.Error.ScriptDecodeError
22+
import Prelude
23+
24+
import Data.Aeson qualified as Aeson
25+
import Data.ByteString qualified as BS
26+
27+
import Cardano.CLI.Type.Error.PlutusScriptDecodeError
28+
29+
import Data.Bifunctor
30+
31+
import Data.Text qualified as Text
32+
33+
34+
readFileSimpleScript
35+
:: FilePath
36+
-> CIO e (Script SimpleScript')
37+
readFileSimpleScript file = do
38+
scriptBytes <- readFileCli file
39+
fromEitherCli $
40+
deserialiseSimpleScript scriptBytes
41+
42+
43+
deserialiseSimpleScript
44+
:: BS.ByteString
45+
-> Either ScriptDecodeError (Script SimpleScript')
46+
deserialiseSimpleScript bs =
47+
case deserialiseFromJSON bs of
48+
Left _ ->
49+
-- In addition to the TextEnvelope format, we also try to
50+
-- deserialize the JSON representation of SimpleScripts.
51+
case Aeson.eitherDecodeStrict' bs of
52+
Left err -> Left (ScriptDecodeSimpleScriptError $ JsonDecodeError err)
53+
Right script -> Right $ SimpleScript script
54+
Right te ->
55+
case deserialiseFromTextEnvelopeAnyOf [teType'] te of
56+
Left err -> Left (ScriptDecodeTextEnvelopeError err)
57+
Right script -> Right script
58+
where
59+
teType' :: FromSomeType HasTextEnvelope (Script SimpleScript')
60+
teType' = FromSomeType (AsScript AsSimpleScript) id
61+
62+
63+
64+
data AnyPlutusScript where
65+
AnyPlutusScript
66+
:: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> PlutusScript lang -> AnyPlutusScript
67+
68+
readFilePlutusScript
69+
:: FilePath
70+
-> CIO e AnyPlutusScript
71+
readFilePlutusScript plutusScriptFp = do
72+
bs <-
73+
readFileCli plutusScriptFp
74+
fromEitherCli $ deserialisePlutusScript bs
75+
76+
deserialisePlutusScript
77+
:: BS.ByteString
78+
-> Either PlutusScriptDecodeError AnyPlutusScript
79+
deserialisePlutusScript bs = do
80+
te <- first PlutusScriptJsonDecodeError $ deserialiseFromJSON bs
81+
case teType te of
82+
TextEnvelopeType s -> case s of
83+
sVer@"PlutusScriptV1" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV1 te
84+
sVer@"PlutusScriptV2" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV2 te
85+
sVer@"PlutusScriptV3" -> deserialiseAnyPlutusScriptVersion sVer PlutusScriptV3 te
86+
unknownScriptVersion ->
87+
Left . PlutusScriptDecodeErrorUnknownVersion $ Text.pack unknownScriptVersion
88+
where
89+
deserialiseAnyPlutusScriptVersion
90+
:: IsPlutusScriptLanguage lang
91+
=> String
92+
-> PlutusScriptVersion lang
93+
-> TextEnvelope
94+
-> Either PlutusScriptDecodeError AnyPlutusScript
95+
deserialiseAnyPlutusScriptVersion v lang tEnv =
96+
if v == show lang
97+
then
98+
first PlutusScriptDecodeTextEnvelopeError $
99+
deserialiseFromTextEnvelopeAnyOf [teTypes (AnyPlutusScriptVersion lang)] tEnv
100+
else Left $ PlutusScriptDecodeErrorVersionMismatch (Text.pack v) (AnyPlutusScriptVersion lang)
101+
102+
teTypes :: AnyPlutusScriptVersion -> FromSomeType HasTextEnvelope AnyPlutusScript
103+
teTypes =
104+
\case
105+
AnyPlutusScriptVersion PlutusScriptV1 ->
106+
FromSomeType (AsPlutusScript AsPlutusScriptV1) (AnyPlutusScript PlutusScriptV1)
107+
AnyPlutusScriptVersion PlutusScriptV2 ->
108+
FromSomeType (AsPlutusScript AsPlutusScriptV2) (AnyPlutusScript PlutusScriptV2)
109+
AnyPlutusScriptVersion PlutusScriptV3 ->
110+
FromSomeType (AsPlutusScript AsPlutusScriptV3) (AnyPlutusScript PlutusScriptV3)
111+
AnyPlutusScriptVersion PlutusScriptV4 ->
112+
FromSomeType (AsPlutusScript AsPlutusScriptV4) (AnyPlutusScript PlutusScriptV4)

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE FlexibleContexts #-}
12
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE RankNTypes #-}
34
{-# LANGUAGE ScopedTypeVariables #-}

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

Lines changed: 29 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
{-# LANGUAGE DataKinds #-}
22
{-# LANGUAGE ExistentialQuantification #-}
3+
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE RankNTypes #-}
56
{-# LANGUAGE ScopedTypeVariables #-}
@@ -11,8 +12,11 @@ module Cardano.CLI.Compatible.Transaction.Run
1112
where
1213

1314
import Cardano.Api hiding (VotingProcedures)
15+
import Cardano.Api qualified as OldApi
1416
import Cardano.Api.Compatible
17+
import Cardano.Api.Experimental (obtainCommonConstraints)
1518
import Cardano.Api.Experimental qualified as Exp
19+
import Cardano.Api.Experimental.Tx qualified as Exp
1620
import Cardano.Api.Ledger qualified as L hiding
1721
( VotingProcedures
1822
)
@@ -23,17 +27,14 @@ import Cardano.CLI.Compatible.Transaction.ScriptWitness
2327
import Cardano.CLI.Compatible.Transaction.TxOut
2428
import Cardano.CLI.EraBased.Script.Certificate.Type
2529
import Cardano.CLI.EraBased.Script.Proposal.Read
26-
import Cardano.CLI.EraBased.Script.Proposal.Type
2730
import Cardano.CLI.EraBased.Script.Type
2831
import Cardano.CLI.EraBased.Script.Vote.Read
29-
import Cardano.CLI.EraBased.Script.Vote.Type
30-
( VoteScriptWitness (..)
31-
)
3232
import Cardano.CLI.EraBased.Transaction.Run
3333
import Cardano.CLI.Read
3434
import Cardano.CLI.Type.Common
3535

3636
import Control.Monad
37+
import Data.Typeable
3738
import Lens.Micro
3839

3940
runCompatibleTransactionCmd
@@ -85,10 +86,17 @@ runCompatibleTransactionCmd
8586
Nothing -> return (NoPParamsUpdate sbe, NoVotes)
8687
Just prop -> do
8788
pparamUpdate <- readProposalProcedureFile prop
88-
votesAndWits <- readVotingProceduresFiles w mVotes
89-
votingProcedures <-
90-
fromEitherCli $ mkTxVotingProcedures [(v, vswScriptWitness <$> mSwit) | (v, mSwit) <- votesAndWits]
91-
return (pparamUpdate, VotingProcedures w votingProcedures)
89+
votesAndWits :: [(OldApi.VotingProcedures era, Exp.AnyWitness (Exp.LedgerEra era))] <-
90+
obtainCommonConstraints (convert w) $ readVotingProceduresFiles mVotes
91+
votingProcedures :: (Exp.TxVotingProcedures (Exp.LedgerEra era)) <-
92+
obtainTypeable w $
93+
fromEitherCli
94+
( Exp.mkTxVotingProcedures
95+
[ (obtainCommonConstraints (convert w) $ OldApi.unVotingProcedures vp, anyW)
96+
| (vp, anyW) <- votesAndWits
97+
]
98+
)
99+
return (pparamUpdate, VotingProcedures w $ obtainCommonConstraints (convert w) votingProcedures)
92100
)
93101
sbe
94102

@@ -114,6 +122,13 @@ runCompatibleTransactionCmd
114122
fromEitherIOCli $
115123
writeTxFileTextEnvelope sbe outputFp signedTx
116124

125+
obtainTypeable
126+
:: ConwayEraOnwards era
127+
-> (Typeable (Exp.LedgerEra era) => r)
128+
-> r
129+
obtainTypeable ConwayEraOnwardsConway r = r
130+
obtainTypeable ConwayEraOnwardsDijkstra r = r
131+
117132
readUpdateProposalFile
118133
:: Featured ShelleyToBabbageEra era (Maybe UpdateProposalFile)
119134
-> CIO e (AnyProtocolUpdate era)
@@ -135,11 +150,15 @@ readProposalProcedureFile (Featured cEraOnwards []) =
135150
in return $ NoPParamsUpdate sbe
136151
readProposalProcedureFile (Featured cEraOnwards proposals) = do
137152
let era = convert cEraOnwards
138-
props :: [(Proposal era, Maybe (ProposalScriptWitness era))] <-
153+
props :: [(Proposal era, Exp.AnyWitness (Exp.LedgerEra era))] <-
139154
Exp.obtainCommonConstraints era $ mapM readProposal proposals
140155

141156
return $
142157
Exp.obtainCommonConstraints era $
143158
ProposalProcedures cEraOnwards $
144159
mkTxProposalProcedures
145-
[(govProp, pswScriptWitness <$> mScriptWit) | (Proposal govProp, mScriptWit) <- props]
160+
[(govProp, conv swit) | (Proposal govProp, swit) <- props]
161+
162+
conv :: Exp.AnyWitness (Exp.LedgerEra era) -> Maybe (ScriptWitness WitCtxStake era)
163+
conv Exp.AnyKeyWitnessPlaceholder = Nothing
164+
conv _ = Nothing

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

Lines changed: 59 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -11,10 +11,11 @@ module Cardano.CLI.Compatible.Transaction.ScriptWitness
1111
where
1212

1313
import Cardano.Api
14-
( AnyPlutusScriptVersion (..)
15-
, AnyShelleyBasedEra (..)
14+
( AnyShelleyBasedEra (..)
1615
, File (..)
16+
, IsPlutusScriptLanguage
1717
, PlutusScriptOrReferenceInput (..)
18+
, PlutusScriptVersion (..)
1819
, Script (..)
1920
, ScriptDatum (..)
2021
, ScriptLanguage (..)
@@ -26,14 +27,23 @@ import Cardano.Api
2627
, shelleyBasedEraConstraints
2728
)
2829
import Cardano.Api.Experimental qualified as Exp
30+
import Cardano.Api.Experimental.Plutus (fromPlutusSLanguage)
31+
import Cardano.Api.Experimental.Plutus qualified as Exp
2932

3033
import Cardano.CLI.Compatible.Exception
34+
import Cardano.CLI.Compatible.Read
3135
import Cardano.CLI.EraBased.Script.Certificate.Type
32-
import Cardano.CLI.EraBased.Script.Read.Common
36+
import Cardano.CLI.EraBased.Script.Read.Common (readScriptDataOrFile)
3337
import Cardano.CLI.EraBased.Script.Type
38+
( CliScriptWitnessError (..)
39+
, NoPolicyId (..)
40+
, OnDiskPlutusScriptCliArgs (..)
41+
, ScriptRequirements (..)
42+
, SimpleRefScriptCliArgs (..)
43+
)
3444
import Cardano.CLI.EraBased.Script.Type qualified as Exp
35-
import Cardano.CLI.Read
36-
import Cardano.CLI.Type.Common (CertificateFile)
45+
import Cardano.CLI.Type.Common (AnySLanguage (..), CertificateFile)
46+
import Cardano.Ledger.Plutus.Language qualified as L
3747

3848
import Control.Monad
3949

@@ -64,8 +74,7 @@ readCertificateScriptWitness sbe certScriptReq =
6474
OnDiskPlutusScript
6575
(OnDiskPlutusScriptCliArgs scriptFp Exp.NoScriptDatumAllowed redeemerFile execUnits) -> do
6676
let plutusScriptFp = unFile scriptFp
67-
plutusScript <-
68-
readFilePlutusScript plutusScriptFp
77+
plutusScript <- readFilePlutusScript plutusScriptFp
6978
redeemer <-
7079
fromExceptTCli $
7180
readScriptDataOrFile redeemerFile
@@ -75,7 +84,7 @@ readCertificateScriptWitness sbe certScriptReq =
7584
sLangSupported <-
7685
fromMaybeCli
7786
( PlutusScriptWitnessLanguageNotSupportedInEra
78-
(AnyPlutusScriptVersion lang)
87+
(fromOldScriptLanguage lang)
7988
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
8089
)
8190
$ scriptLanguageSupportedInEra sbe
@@ -98,33 +107,51 @@ readCertificateScriptWitness sbe certScriptReq =
98107
PlutusReferenceScript
99108
( PlutusRefScriptCliArgs
100109
refTxIn
101-
anyPlutusScriptVersion
110+
(AnySLanguage lang)
102111
Exp.NoScriptDatumAllowed
103112
Exp.NoPolicyId
104113
redeemerFile
105114
execUnits
106115
) -> do
107-
case anyPlutusScriptVersion of
108-
AnyPlutusScriptVersion lang -> do
109-
let pScript = PReferenceScript refTxIn
110-
redeemer <-
111-
fromExceptTCli $
112-
readScriptDataOrFile redeemerFile
113-
sLangSupported <-
114-
fromMaybeCli
115-
( PlutusScriptWitnessLanguageNotSupportedInEra
116-
(AnyPlutusScriptVersion lang)
117-
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
118-
)
119-
$ scriptLanguageSupportedInEra sbe
120-
$ PlutusScriptLanguage lang
116+
let pScript = PReferenceScript refTxIn
117+
redeemer <-
118+
fromExceptTCli $
119+
readScriptDataOrFile redeemerFile
120+
sLangSupported <-
121+
fromMaybeCli
122+
( PlutusScriptWitnessLanguageNotSupportedInEra
123+
(L.plutusLanguage lang)
124+
(shelleyBasedEraConstraints sbe $ AnyShelleyBasedEra sbe)
125+
)
126+
$ scriptLanguageSupportedInEra sbe
127+
$ obtainIsPlutusScriptLanguage (fromPlutusSLanguage lang)
128+
$ PlutusScriptLanguage
129+
$ Exp.fromPlutusSLanguage lang
121130

122-
return $
123-
CertificateScriptWitness $
124-
PlutusScriptWitness
125-
sLangSupported
126-
lang
127-
pScript
128-
NoScriptDatumForStake
129-
redeemer
130-
execUnits
131+
return $
132+
CertificateScriptWitness $
133+
obtainIsPlutusScriptLanguage (fromPlutusSLanguage lang) $
134+
PlutusScriptWitness
135+
sLangSupported
136+
(Exp.fromPlutusSLanguage lang)
137+
pScript
138+
NoScriptDatumForStake
139+
redeemer
140+
execUnits
141+
142+
fromOldScriptLanguage :: PlutusScriptVersion lang -> L.Language
143+
fromOldScriptLanguage PlutusScriptV1 = L.PlutusV1
144+
fromOldScriptLanguage PlutusScriptV2 = L.PlutusV2
145+
fromOldScriptLanguage PlutusScriptV3 = L.PlutusV3
146+
fromOldScriptLanguage PlutusScriptV4 = L.PlutusV4
147+
148+
obtainIsPlutusScriptLanguage
149+
:: PlutusScriptVersion lang
150+
-> (IsPlutusScriptLanguage lang => a)
151+
-> a
152+
obtainIsPlutusScriptLanguage lang f =
153+
case lang of
154+
PlutusScriptV1 -> f
155+
PlutusScriptV2 -> f
156+
PlutusScriptV3 -> f
157+
PlutusScriptV4 -> f

0 commit comments

Comments
 (0)