Skip to content

Commit

Permalink
SRP
Browse files Browse the repository at this point in the history
  • Loading branch information
Jimbo4350 committed Nov 14, 2023
1 parent a90dc81 commit 090fb0f
Show file tree
Hide file tree
Showing 10 changed files with 173 additions and 44 deletions.
5 changes: 5 additions & 0 deletions cabal.project
Original file line number Diff line number Diff line change
Expand Up @@ -43,3 +43,8 @@ write-ghc-environment-files: always
-- 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/input-output-hk/cardano-api.git
tag: dd496b21d0e2bb41d73465798c562add40e5cc9e
subdir: cardano-api
8 changes: 4 additions & 4 deletions cardano-cli/src/Cardano/CLI/EraBased/Commands/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ data TransactionBuildRawCmdArgs era = TransactionBuildRawCmdArgs
-- ^ Read only reference inputs
, txInsCollateral :: ![TxIn]
-- ^ Transaction inputs for collateral, only key witnesses, no scripts.
, mReturnCollateral :: !(Maybe TxOutAnyEra)
, mReturnCollateral :: !(Maybe TxOutShelleyBasedEra)
-- ^ Return collateral
, mTotalCollateral :: !(Maybe Lovelace)
-- ^ Total collateral
Expand Down Expand Up @@ -98,7 +98,7 @@ data TransactionBuildCmdArgs era = TransactionBuildCmdArgs
-- ^ Required signers
, txinsc :: ![TxIn]
-- ^ Transaction inputs for collateral, only key witnesses, no scripts.
, mReturnCollateral :: !(Maybe TxOutAnyEra)
, mReturnCollateral :: !(Maybe TxOutShelleyBasedEra)
-- ^ Return collateral
, mTotalCollateral :: !(Maybe Lovelace)
-- ^ Total collateral
Expand Down Expand Up @@ -168,9 +168,9 @@ data TransactionCalculateMinFeeCmdArgs = TransactionCalculateMinFeeCmdArgs
} deriving Show

data TransactionCalculateMinValueCmdArgs era = TransactionCalculateMinValueCmdArgs
{ eon :: !(CardanoEra era)
{ eon :: !(ShelleyBasedEra era)
, protocolParamsFile :: !ProtocolParamsFile
, txOut :: !TxOutAnyEra
, txOut :: !TxOutShelleyBasedEra
} deriving Show

newtype TransactionHashScriptDataCmdArgs = TransactionHashScriptDataCmdArgs
Expand Down
36 changes: 34 additions & 2 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -1848,9 +1848,9 @@ pTxInCollateral =
<> Opt.help "TxId#TxIx"
)

pReturnCollateral :: Parser TxOutAnyEra
pReturnCollateral :: Parser TxOutShelleyBasedEra
pReturnCollateral =
Opt.option (readerFromParsecParser parseTxOutAnyEra)
Opt.option (readerFromParsecParser parseTxOutShelleyBasedEra)
( mconcat
[ Opt.long "tx-out-return-collateral"
, Opt.metavar "ADDRESS VALUE"
Expand Down Expand Up @@ -1899,6 +1899,19 @@ pTxOut =
<*> pTxOutDatum
<*> pRefScriptFp

pTxOutShelleyBased :: Parser TxOutShelleyBasedEra
pTxOutShelleyBased =
Opt.option (readerFromParsecParser parseTxOutShelleyBasedEra)
( Opt.long "tx-out"
<> Opt.metavar "ADDRESS VALUE"
-- TODO alonzo: Update the help text to describe the new syntax as well.
<> Opt.help "The transaction output as ADDRESS VALUE where ADDRESS is \
\the Bech32-encoded address followed by the value in \
\Lovelace."
)
<*> pTxOutDatum
<*> pRefScriptFp

pTxOutDatum :: Parser TxOutDatumAnyEra
pTxOutDatum =
pTxOutDatumByHashOnly
Expand Down Expand Up @@ -2998,6 +3011,25 @@ pDRepActivity =
, Opt.help "TODO"
]

parseTxOutShelleyBasedEra
:: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutShelleyBasedEra)
parseTxOutShelleyBasedEra = do
addr <- parseShelleyAddress
Parsec.spaces
-- Accept the old style of separating the address and value in a
-- transaction output:
Parsec.option () (Parsec.char '+' >> Parsec.spaces)
val <- parseValue
return (TxOutShelleyBasedEra addr val)

parseShelleyAddress :: Parsec.Parser (Address ShelleyAddr)
parseShelleyAddress = do
str <- lexPlausibleAddressString
case deserialiseAddress AsShelleyAddress str of
Nothing -> fail $ "invalid address: " <> Text.unpack str
Just addr -> pure addr


parseTxOutAnyEra
:: Parsec.Parser (TxOutDatumAnyEra -> ReferenceScriptAnyEra -> TxOutAnyEra)
parseTxOutAnyEra = do
Expand Down
25 changes: 15 additions & 10 deletions cardano-cli/src/Cardano/CLI/EraBased/Options/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,12 +78,17 @@ pTransactionCmds era envCli =
$ subParser "calculate-min-fee"
$ Opt.info (pTransactionCalculateMinFee envCli)
$ Opt.progDesc "Calculate the minimum fee for a transaction."
, Just
$ subParser "calculate-min-required-utxo"
$ Opt.info (pTransactionCalculateMinReqUTxO era)
$ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
, Just
$ pCalculateMinRequiredUtxoBackwardCompatible era
, caseByronOrShelleyBasedEra
(const Nothing)
(\sbe -> Just $ subParser "calculate-min-required-utxo"
$ Opt.info (pTransactionCalculateMinReqUTxO sbe)
$ Opt.progDesc "Calculate the minimum required UTxO for a transaction output."
)
era
, caseByronOrShelleyBasedEra
(const Nothing)
(Just . pCalculateMinRequiredUtxoBackwardCompatible)
era
, Just
$ subParser "hash-script-data"
$ Opt.info pTxHashScriptData
Expand All @@ -99,12 +104,12 @@ pTransactionCmds era envCli =
]

-- Backwards compatible parsers
calcMinValueInfo :: CardanoEra era -> ParserInfo (TransactionCmds era)
calcMinValueInfo :: ShelleyBasedEra era -> ParserInfo (TransactionCmds era)
calcMinValueInfo era =
Opt.info (pTransactionCalculateMinReqUTxO era)
$ Opt.progDesc "DEPRECATED: Use 'calculate-min-required-utxo' instead."

pCalculateMinRequiredUtxoBackwardCompatible :: CardanoEra era -> Parser (TransactionCmds era)
pCalculateMinRequiredUtxoBackwardCompatible :: ShelleyBasedEra era -> Parser (TransactionCmds era)
pCalculateMinRequiredUtxoBackwardCompatible era =
Opt.subparser
$ Opt.command "calculate-min-value" (calcMinValueInfo era) <> Opt.internal
Expand Down Expand Up @@ -275,12 +280,12 @@ pTransactionCalculateMinFee envCli =
<*> pTxShelleyWitnessCount
<*> pTxByronWitnessCount

pTransactionCalculateMinReqUTxO :: CardanoEra era -> Parser (TransactionCmds era)
pTransactionCalculateMinReqUTxO :: ShelleyBasedEra era -> Parser (TransactionCmds era)
pTransactionCalculateMinReqUTxO era =
fmap TransactionCalculateMinValueCmd $
TransactionCalculateMinValueCmdArgs era
<$> pProtocolParamsFile
<*> pTxOut
<*> pTxOutShelleyBased

pTxHashScriptData :: Parser (TransactionCmds era)
pTxHashScriptData =
Expand Down
104 changes: 89 additions & 15 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
Expand Down Expand Up @@ -164,7 +165,7 @@ runTransactionBuildCmd
_ -> pure TxUpdateProposalNone

requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners
mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra era
mReturnCollateral <- forM mReturnColl $ toTxOutInShelleyBasedEra eon

txOuts <- mapM (toTxOutInAnyEra era) txouts

Expand Down Expand Up @@ -319,7 +320,11 @@ runTransactionBuildRawCmd
_ -> pure TxUpdateProposalNone

requiredSigners <- mapM (firstExceptT TxCmdRequiredSignerError . newExceptT . readRequiredSigner) reqSigners
mReturnCollateral <- forM mReturnColl $ toTxOutInAnyEra eon

mReturnCollateral <- forEraInEon eon (pure Nothing) $ \sbe ->
forM mReturnColl $ toTxOutInShelleyBasedEra sbe

-- NB: We need to be able to construct txs in Byron to other Byron addresses
txOuts <- mapM (toTxOutInAnyEra eon) txouts

-- the same collateral input can be used for several plutus scripts
Expand Down Expand Up @@ -690,6 +695,14 @@ toAddressInAnyEra era addrAny = runExcept $ do
pure (AddressInEra (ShelleyAddressInEra sbe) sAddr)


toAddressInShelleyBasedEra
:: ShelleyBasedEra era
-> Address ShelleyAddr
-> Either TxCmdError (AddressInEra era)
toAddressInShelleyBasedEra sbe sAddr = runExcept $
pure (AddressInEra (ShelleyAddressInEra sbe) sAddr)


lovelaceToCoin :: Lovelace -> Ledger.Coin
lovelaceToCoin (Lovelace ll) = Ledger.Coin ll

Expand All @@ -698,10 +711,10 @@ toTxOutValueInAnyEra
-> Value
-> Either TxCmdError (TxOutValue era)
toTxOutValueInAnyEra era val =
caseByronOrShelleyBasedEra
(\w ->
caseByronOrShelleyBasedEra
(const $
case valueToLovelace val of
Just l -> return (TxOutValueByron w l)
Just l -> return (TxOutValueByron l)
Nothing -> txFeatureMismatchPure era TxFeatureMultiAssetOutputs
)
(\sbe ->
Expand All @@ -715,6 +728,70 @@ toTxOutValueInAnyEra era val =
sbe
)
era
toTxOutValueInShelleyBasedEra
:: ShelleyBasedEra era
-> Value
-> Either TxCmdError (TxOutValue era)
toTxOutValueInShelleyBasedEra sbe val =
caseShelleyToAllegraOrMaryEraOnwards
(\_ -> case valueToLovelace val of
Just l -> return (TxOutValueShelleyBased sbe $ lovelaceToCoin l)
Nothing -> txFeatureMismatchPure (toCardanoEra sbe) TxFeatureMultiAssetOutputs
)
(\w -> return (TxOutValueShelleyBased sbe (toLedgerValue w val))
)
sbe


toTxOutInShelleyBasedEra
:: ShelleyBasedEra era
-> TxOutShelleyBasedEra
-> ExceptT TxCmdError IO (TxOut CtxTx era)
toTxOutInShelleyBasedEra era (TxOutShelleyBasedEra addr' val' mDatumHash refScriptFp) = do
addr <- hoistEither $ toAddressInShelleyBasedEra era addr'
val <- hoistEither $ toTxOutValueInShelleyBasedEra era val'

datum <-
caseShelleyToMaryOrAlonzoEraOnwards
(const (pure TxOutDatumNone))
(\wa -> toTxAlonzoDatum wa mDatumHash)
era

refScript <- inEonForEra
(pure ReferenceScriptNone)
(\wb -> getReferenceScript wb refScriptFp)
(toCardanoEra era)

pure $ TxOut addr val datum refScript

where
getReferenceScript :: ()
=> BabbageEraOnwards era
-> ReferenceScriptAnyEra
-> ExceptT TxCmdError IO (ReferenceScript era)
getReferenceScript w = \case
ReferenceScriptAnyEraNone -> return ReferenceScriptNone
ReferenceScriptAnyEra fp -> ReferenceScript w <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp)

toTxAlonzoDatum :: ()
=> AlonzoEraOnwards era
-> TxOutDatumAnyEra
-> ExceptT TxCmdError IO (TxOutDatum CtxTx era)
toTxAlonzoDatum supp cliDatum =
case cliDatum of
TxOutDatumByNone -> pure TxOutDatumNone
TxOutDatumByHashOnly h -> pure (TxOutDatumHash supp h)
TxOutDatumByHashOf sDataOrFile -> do
sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile
pure (TxOutDatumHash supp $ hashScriptDataBytes sData)
TxOutDatumByValue sDataOrFile -> do
sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile
pure (TxOutDatumInTx supp sData)
TxOutInlineDatumByValue sDataOrFile -> do
let cEra = alonzoEraOnwardsToCardanoEra supp
forEraInEon cEra (txFeatureMismatch cEra TxFeatureInlineDatums) $ \babbageOnwards -> do
sData <- firstExceptT TxCmdScriptDataError $ readScriptDataOrFile sDataOrFile
pure $ TxOutDatumInline babbageOnwards sData

toTxOutInAnyEra :: CardanoEra era
-> TxOutAnyEra
Expand All @@ -735,9 +812,7 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do
(const (pure ReferenceScriptNone))
(\wb -> getReferenceScript wb refScriptFp)
era

pure $ TxOut addr val datum refScript

where
getReferenceScript :: ()
=> BabbageEraOnwards era
Expand All @@ -746,7 +821,6 @@ toTxOutInAnyEra era (TxOutAnyEra addr' val' mDatumHash refScriptFp) = do
getReferenceScript w = \case
ReferenceScriptAnyEraNone -> return ReferenceScriptNone
ReferenceScriptAnyEra fp -> ReferenceScript w <$> firstExceptT TxCmdScriptFileError (readFileScriptInAnyLang fp)

toTxAlonzoDatum :: ()
=> AlonzoEraOnwards era
-> TxOutDatumAnyEra
Expand Down Expand Up @@ -1023,14 +1097,14 @@ runTransactionCalculateMinValueCmd
, txOut
} = do
pp <- firstExceptT TxCmdProtocolParamsError (readProtocolParameters protocolParamsFile)
out <- toTxOutInAnyEra eon txOut
out <- toTxOutInShelleyBasedEra eon txOut
-- TODO: shouldn't we just require shelley based era here instead of error-ing for byron?
forEraInEon eon (error "runTransactionCalculateMinValueCmd: Byron era not implemented yet") $ \sbe -> do
firstExceptT TxCmdPParamsErr . hoistEither
$ checkProtocolParameters sbe pp
pp' <- hoistEither . first TxCmdProtocolParamsConverstionError $ toLedgerPParams sbe pp
let minValue = calculateMinimumUTxO sbe out pp'
liftIO . IO.print $ minValue

firstExceptT TxCmdPParamsErr . hoistEither
$ checkProtocolParameters eon pp
pp' <- hoistEither . first TxCmdProtocolParamsConverstionError $ toLedgerPParams eon pp
let minValue = calculateMinimumUTxO eon out pp'
liftIO . IO.print $ minValue

runTransactionPolicyIdCmd :: ()
=> Cmd.TransactionPolicyIdCmdArgs
Expand Down
1 change: 0 additions & 1 deletion cardano-cli/src/Cardano/CLI/Json/Friendly.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
Expand Down
6 changes: 3 additions & 3 deletions cardano-cli/src/Cardano/CLI/Legacy/Commands/Transaction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ data LegacyTransactionCmds
-- ^ Read only reference inputs
[TxIn]
-- ^ Transaction inputs for collateral, only key witnesses, no scripts.
(Maybe TxOutAnyEra)
(Maybe TxOutShelleyBasedEra)
-- ^ Return collateral
(Maybe Lovelace)
-- ^ Total collateral
Expand Down Expand Up @@ -67,7 +67,7 @@ data LegacyTransactionCmds
-- ^ Required signers
[TxIn]
-- ^ Transaction inputs for collateral, only key witnesses, no scripts.
(Maybe TxOutAnyEra)
(Maybe TxOutShelleyBasedEra)
-- ^ Return collateral
(Maybe Lovelace)
-- ^ Total collateral
Expand Down Expand Up @@ -125,7 +125,7 @@ data LegacyTransactionCmds
| TransactionCalculateMinValueCmd
AnyCardanoEra
ProtocolParamsFile
TxOutAnyEra
TxOutShelleyBasedEra
| TransactionHashScriptDataCmd
ScriptDataOrFile
| TransactionTxIdCmd
Expand Down
2 changes: 1 addition & 1 deletion cardano-cli/src/Cardano/CLI/Legacy/Options.hs
Original file line number Diff line number Diff line change
Expand Up @@ -425,7 +425,7 @@ pTransaction envCli =
TransactionCalculateMinValueCmd
<$> pLegacyCardanoEra envCli
<*> pProtocolParamsFile
<*> pTxOut
<*> pTxOutShelleyBased

pTxHashScriptData :: Parser LegacyTransactionCmds
pTxHashScriptData =
Expand Down
Loading

0 comments on commit 090fb0f

Please sign in to comment.