Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Split compatible transaction building and signing #750

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions cardano-api/src/Cardano/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -461,7 +461,9 @@ module Cardano.Api
, makeByronKeyWitness
, ShelleyWitnessSigningKey (..)
, makeShelleyKeyWitness
, makeShelleyKeyWitnessForLedgerBody
, makeShelleyBootstrapWitness
, makeShelleyBasedBootstrapWitness

-- * Transaction metadata

Expand Down
61 changes: 38 additions & 23 deletions cardano-api/src/Cardano/Api/Internal/Tx/Compatible.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@
module Cardano.Api.Internal.Tx.Compatible
( AnyProtocolUpdate (..)
, AnyVote (..)
, createCompatibleSignedTx
, createCompatibleTx
, Cardano.Api.Internal.Tx.Compatible.makeSignedTransaction
)
where

Expand All @@ -25,7 +26,7 @@ import Cardano.Api.Internal.Eon.ShelleyToBabbageEra
import Cardano.Api.Internal.Eras
import Cardano.Api.Internal.ProtocolParameters
import Cardano.Api.Internal.Script
import Cardano.Api.Internal.Tx.Body
import Cardano.Api.Internal.Tx.Body hiding (txMetadata)
import Cardano.Api.Internal.Tx.Sign
import Cardano.Api.Internal.Value

Expand Down Expand Up @@ -60,19 +61,19 @@ data AnyVote era where
-> AnyVote era
NoVotes :: AnyVote era

createCompatibleSignedTx
-- | Create a transaction in any shelley based era
createCompatibleTx
:: forall era
. ShelleyBasedEra era
-> [TxIn]
-> [TxOut CtxTx era]
-> [KeyWitness era]
-> Lovelace
-- ^ Fee
-> AnyProtocolUpdate era
-> AnyVote era
-> TxCertificates BuildTx era
-> Either ProtocolParametersConversionError (Tx era)
createCompatibleSignedTx sbe ins outs witnesses txFee' anyProtocolUpdate anyVote txCertificates' =
createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates' =
shelleyBasedEraConstraints sbe $ do
(updateTxBody, extraScriptWitnesses) <-
case anyProtocolUpdate of
Expand Down Expand Up @@ -125,7 +126,7 @@ createCompatibleSignedTx sbe ins outs witnesses txFee' anyProtocolUpdate anyVote
. ShelleyTx sbe
$ L.mkBasicTx txbody
& L.witsTxL
.~ allWitnesses (apiScriptWitnesses <> extraScriptWitnesses) allShelleyToBabbageWitnesses
%~ setScriptWitnesses (apiScriptWitnesses <> extraScriptWitnesses)
& updateVotingProcedures
where
era = toCardanoEra sbe
Expand Down Expand Up @@ -164,11 +165,11 @@ createCompatibleSignedTx sbe ins outs witnesses txFee' anyProtocolUpdate anyVote
:: [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
indexedTxCerts = indexTxCertificates txCertificates'

allWitnesses
setScriptWitnesses
:: [(ScriptWitnessIndex, AnyScriptWitness era)]
-> L.TxWits (ShelleyLedgerEra era)
-> L.TxWits (ShelleyLedgerEra era)
allWitnesses scriptWitnesses =
setScriptWitnesses scriptWitnesses =
appEndos
[ monoidForEraInEon
era
Expand All @@ -191,21 +192,6 @@ createCompatibleSignedTx sbe ins outs witnesses txFee' anyProtocolUpdate anyVote
)
]

allShelleyToBabbageWitnesses
:: L.EraTxWits (ShelleyLedgerEra era)
=> L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
=> L.TxWits (ShelleyLedgerEra era)
allShelleyToBabbageWitnesses = do
let shelleyKeywitnesses =
fromList [w | ShelleyKeyWitness _ w <- witnesses]
let shelleyBootstrapWitnesses =
fromList [w | ShelleyBootstrapWitness _ w <- witnesses]
L.mkBasicTxWits
& L.addrTxWitsL
.~ shelleyKeywitnesses
& L.bootAddrTxWitsL
.~ shelleyBootstrapWitnesses

createCommonTxBody
:: HasCallStack
=> ShelleyBasedEra era
Expand All @@ -224,3 +210,32 @@ createCommonTxBody era ins outs txFee' =
.~ Seq.fromList txOuts'
& L.feeTxBodyL
.~ txFee'

-- | Sign a transaction body
-- TODO rename to signTransaction
makeSignedTransaction
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'ts a 1-1 copy from Cardano.Api.Internal.Tx.Sign. I imagine that we'll be deprecating eras and simplifying Cardano.Api.Internal.Tx.Sign so we won't be able to reuse code easily.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This will sit in a separate command group in cardano-cli. We need access to all the eras, so we won't be deprecating any eras. Remember QA has a hardforking test where they submit protocol parameter updates across all eras.

Copy link
Contributor Author

@carbolymer carbolymer Feb 13, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We need access to all the eras, so we won't be deprecating any eras.

But we will be supporting only current and next eras so only Cardano.Api.Internal.Compatible will support older eras, right?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Cardano.Api.Internal.Compatible has to support all Shelley based eras only for the functionality QA needs.

Once we can provide what QA needs, we can consider parameterizing functions in Cardano.Api.Internal.Compatible on CardanoEra era however the Byron/Shelley split in the code makes things cleaner.

:: forall era
. [KeyWitness era]
-> Tx era
-> Tx era
-- ^ a signed transaction
makeSignedTransaction witnesses (ShelleyTx sbe tx) =
shelleyBasedEraConstraints sbe $
ShelleyTx sbe txCommon
where
txCommon
:: forall ledgerera
. ShelleyLedgerEra era ~ ledgerera
=> L.EraCrypto ledgerera ~ L.StandardCrypto
=> L.EraTx ledgerera
=> L.Tx ledgerera
txCommon =
tx
& L.witsTxL
%~ ( ( L.addrTxWitsL
%~ (<> fromList [w | ShelleyKeyWitness _ w <- witnesses])
)
. ( L.bootAddrTxWitsL
%~ (<> fromList [w | ShelleyBootstrapWitness _ w <- witnesses])
)
)
52 changes: 30 additions & 22 deletions cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
Expand All @@ -14,8 +13,6 @@
-- not export any from this API. We also use them unticked as nature intended.
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

{- HLINT ignore "Avoid lambda using `infix`" -}

-- | Complete, signed transactions
module Cardano.Api.Internal.Tx.Sign
( -- * Signing transactions
Expand Down Expand Up @@ -43,8 +40,11 @@ module Cardano.Api.Internal.Tx.Sign
, makeByronKeyWitness
, ShelleyWitnessSigningKey (..)
, makeShelleyKeyWitness
, makeShelleyKeyWitnessForLedgerBody
, WitnessNetworkIdOrByronAddress (..)
, makeShelleyBootstrapWitness
-- TOOD rename
, makeShelleyBasedBootstrapWitness
, makeShelleySignature
, getShelleyKeyWitnessVerificationKey
, getTxBodyAndWitnesses
Expand Down Expand Up @@ -127,6 +127,12 @@ data Tx era where
-> L.Tx (ShelleyLedgerEra era)
-> Tx era

-- | This pattern will be deprecated in the future. We advise against introducing new usage of it.
pattern Tx :: TxBody era -> [KeyWitness era] -> Tx era
pattern Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws))
where
Tx txbody ws = makeSignedTransaction ws txbody

instance Show (InAnyCardanoEra Tx) where
show (InAnyCardanoEra _ tx) = show tx

Expand Down Expand Up @@ -749,12 +755,6 @@ instance IsCardanoEra era => HasTextEnvelope (KeyWitness era) where
getTxBodyAndWitnesses :: Tx era -> (TxBody era, [KeyWitness era])
getTxBodyAndWitnesses tx = (getTxBody tx, getTxWitnesses tx)

-- | This pattern will be deprecated in the future. We advise against introducing new usage of it.
pattern Tx :: TxBody era -> [KeyWitness era] -> Tx era
pattern Tx txbody ws <- (getTxBodyAndWitnesses -> (txbody, ws))
where
Tx txbody ws = makeSignedTransaction ws txbody

{-# COMPLETE Tx #-}

data ShelleyWitnessSigningKey
Expand Down Expand Up @@ -1106,19 +1106,27 @@ makeShelleyKeyWitness
-> TxBody era
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness sbe = \case
ShelleyTxBody _ txbody _ _ _ _ ->
shelleyBasedEraConstraints sbe $
let txhash :: Shelley.Hash StandardCrypto Ledger.EraIndependentTxBody
txhash = Ledger.extractHash @StandardCrypto (Ledger.hashAnnotated txbody)
in -- To allow sharing of the txhash computation across many signatures we
-- define and share the txhash outside the lambda for the signing key:
\wsk ->
let sk = toShelleySigningKey wsk
vk = getShelleyKeyWitnessVerificationKey sk
signature = makeShelleySignature txhash sk
in ShelleyKeyWitness sbe $
L.WitVKey vk signature
makeShelleyKeyWitness sbe (ShelleyTxBody _ txBody _ _ _ _) =
makeShelleyKeyWitnessForLedgerBody sbe txBody

makeShelleyKeyWitnessForLedgerBody
:: forall era
. ()
=> ShelleyBasedEra era
-> Ledger.TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitnessForLedgerBody sbe txBody wsk =
shelleyBasedEraConstraints sbe $ do
let txhash :: Shelley.Hash StandardCrypto Ledger.EraIndependentTxBody
txhash = Ledger.extractHash @StandardCrypto (Ledger.hashAnnotated txBody)
-- To allow sharing of the txhash computation across many signatures we
-- define and share the txhash outside the lambda for the signing key:
sk = toShelleySigningKey wsk
vk = getShelleyKeyWitnessVerificationKey sk
signature = makeShelleySignature txhash sk
ShelleyKeyWitness sbe $
L.WitVKey vk signature

toShelleySigningKey :: ShelleyWitnessSigningKey -> ShelleySigningKey
toShelleySigningKey key = case key of
Expand Down
Loading