Skip to content

Split compatible transaction building and signing #750

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.

Sign up for GitHub

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

Merged
merged 1 commit into from
Feb 20, 2025
Merged

Split compatible transaction building and signing #750

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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: 1 addition & 1 deletion cardano-api/cardano-api.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -179,6 +179,7 @@ library
other-modules:
Cardano.Api.Internal.Anchor
Cardano.Api.Internal.Certificate
Cardano.Api.Internal.Compatible.Tx
Cardano.Api.Internal.Convenience.Construction
Cardano.Api.Internal.Convenience.Query
Cardano.Api.Internal.DeserialiseAnyOf
Expand Down Expand Up @@ -247,7 +248,6 @@ library
Cardano.Api.Internal.SpecialByron
Cardano.Api.Internal.StakePoolMetadata
Cardano.Api.Internal.Tx.Body
Cardano.Api.Internal.Tx.Compatible
Cardano.Api.Internal.Tx.UTxO
Cardano.Api.Internal.TxIn
Cardano.Api.Internal.TxMetadata
Expand Down
2 changes: 2 additions & 0 deletions cardano-api/src/Cardano/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -461,7 +461,9 @@ module Cardano.Api
, makeByronKeyWitness
, ShelleyWitnessSigningKey (..)
, makeShelleyKeyWitness
, makeShelleyKeyWitness'
, makeShelleyBootstrapWitness
, makeShelleyBasedBootstrapWitness

-- * Transaction metadata

Expand Down
4 changes: 2 additions & 2 deletions cardano-api/src/Cardano/Api/Compatible.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
module Cardano.Api.Compatible
( module Cardano.Api.Internal.Tx.Compatible
( module Cardano.Api.Internal.Compatible.Tx
)
where

import Cardano.Api.Internal.Tx.Compatible
import Cardano.Api.Internal.Compatible.Tx
60 changes: 37 additions & 23 deletions ...src/Cardano/Api/Internal/Tx/Compatible.hs → ...src/Cardano/Api/Internal/Compatible/Tx.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,10 +7,11 @@

-- | This module provides a way to construct a simple transaction over all eras.
-- It is exposed for testing purposes only.
module Cardano.Api.Internal.Tx.Compatible
module Cardano.Api.Internal.Compatible.Tx
( AnyProtocolUpdate (..)
, AnyVote (..)
, createCompatibleSignedTx
, createCompatibleTx
, addWitnesses
)
where

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,31 @@ createCommonTxBody era ins outs txFee' =
.~ Seq.fromList txOuts'
& L.feeTxBodyL
.~ txFee'

-- | Add provided witnesses to the transaction
addWitnesses
:: forall era
. [KeyWitness era]
-> Tx era
-> Tx era
-- ^ a signed transaction
addWitnesses 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])
)
)
51 changes: 29 additions & 22 deletions cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs
View file
Open in desktop
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,10 @@ module Cardano.Api.Internal.Tx.Sign
, makeByronKeyWitness
, ShelleyWitnessSigningKey (..)
, makeShelleyKeyWitness
, makeShelleyKeyWitness'
, WitnessNetworkIdOrByronAddress (..)
, makeShelleyBootstrapWitness
, makeShelleyBasedBootstrapWitness
, makeShelleySignature
, getShelleyKeyWitnessVerificationKey
, getTxBodyAndWitnesses
Expand Down Expand Up @@ -127,6 +126,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 +754,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 +1105,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 _ _ _ _) =
makeShelleyKeyWitness' sbe txBody

makeShelleyKeyWitness'
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'm not sure what's the best approach here to naming and the argument for the version of this function working on ledger's tx body, so I went with this.

Copy link
Contributor

Choose a reason for hiding this comment

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

I would suggest changing the directory name space from: Cardano.Api.Internal.Tx.Compatible to Cardano.Api.Internal.Compatible.Tx. Then you can create Cardano.Api.Internal.Compatible.Witness and add the witness related functions there.

Copy link
Contributor Author

@carbolymer carbolymer Feb 20, 2025 •
edited
Loading

Choose a reason for hiding this comment

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

I've created Cardano.Api.Internal.Compatible.Tx, but no Cardano.Api.Internal.Compatible.Witness. It would require copying almost half of the cardano-api/src/Cardano/Api/Internal/Tx/Sign.hs into the new compatible module, which I think is not what we want. I think we need to figure out how to isolate this function, but I don't have any idea how to do it elegantly yet.

I'm leaving this out of scope of this PR.

:: forall era
. ()
=> ShelleyBasedEra era
-> L.TxBody (ShelleyLedgerEra era)
-> ShelleyWitnessSigningKey
-> KeyWitness era
makeShelleyKeyWitness' 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