Skip to content

Commit 29cd6fa

Browse files
Jimbo4350Jimbo4350
committed
Move UnsignedTx to its own module
1 parent 198fe58 commit 29cd6fa

File tree

2 files changed

+79
-149
lines changed
  • cardano-api/src/Cardano/Api/Experimental

2 files changed

+79
-149
lines changed

‎cardano-api/src/Cardano/Api/Experimental/Tx.hs‎

Lines changed: 11 additions & 149 deletions
Original file line numberDiff line numberDiff line change
@@ -146,27 +146,28 @@ module Cardano.Api.Experimental.Tx
146146
)
147147
where
148148

149-
import Cardano.Api.Era.Internal.Core (ToCardanoEra (toCardanoEra), forEraInEon)
150-
import Cardano.Api.Era.Internal.Eon.Convert
149+
import Cardano.Api.Era.Internal.Core qualified as Api
151150
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
152-
import Cardano.Api.Era.Internal.Feature
153151
import Cardano.Api.Experimental.Era
154152
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
155-
import Cardano.Api.Experimental.Tx.Internal.Body
153+
import Cardano.Api.Experimental.Tx.Internal.BodyContent.Old
154+
( extractAllIndexedPlutusScriptWitnesses
155+
, makeUnsignedTx
156+
)
156157
import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
158+
import Cardano.Api.Experimental.Tx.Internal.Type
157159
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
158-
import Cardano.Api.Ledger.Internal.Reexport (StrictMaybe (..), maybeToStrictMaybe)
159160
import Cardano.Api.Ledger.Internal.Reexport qualified as L
160161
import Cardano.Api.Pretty (docToString, pretty)
162+
import Cardano.Api.ProtocolParameters
161163
import Cardano.Api.Serialise.Raw
162164
( SerialiseAsRawBytes (..)
163165
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
164166
)
165-
import Cardano.Api.Tx.Internal.Body
166167
import Cardano.Api.Tx.Internal.Sign
167168

168169
import Cardano.Crypto.Hash qualified as Hash
169-
import Cardano.Ledger.Alonzo.TxBody qualified as L
170+
import Cardano.Ledger.Alonzo.Tx qualified as L
170171
import Cardano.Ledger.Api qualified as L
171172
import Cardano.Ledger.Binary qualified as Ledger
172173
import Cardano.Ledger.Core qualified as Ledger
@@ -176,150 +177,11 @@ import Control.Exception (displayException)
176177
import Data.Bifunctor (bimap)
177178
import Data.ByteString.Lazy (fromStrict)
178179
import Data.Set qualified as Set
179-
import GHC.Exts (IsList (..))
180180
import GHC.Stack
181181
import Lens.Micro
182182

183-
-- | A transaction that can contain everything
184-
-- except key witnesses.
185-
data UnsignedTx era
186-
= L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
187-
188-
instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
189-
data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
190-
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
191-
proxyToAsType _ = AsUnsignedTx (asType @era)
192-
193-
instance
194-
( HasTypeProxy era
195-
, L.EraTx (LedgerEra era)
196-
)
197-
=> SerialiseAsRawBytes (UnsignedTx era)
198-
where
199-
serialiseToRawBytes (UnsignedTx tx) =
200-
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
201-
deserialiseFromRawBytes _ =
202-
bimap wrapError UnsignedTx
203-
. Ledger.decodeFullAnnotator
204-
(Ledger.eraProtVerHigh @(LedgerEra era))
205-
"UnsignedTx"
206-
Ledger.decCBOR
207-
. fromStrict
208-
where
209-
wrapError
210-
:: Ledger.DecoderError -> SerialiseAsRawBytesError
211-
wrapError = SerialiseAsRawBytesError . displayException
212-
213-
deriving instance Eq (UnsignedTx era)
214-
215-
deriving instance Show (UnsignedTx era)
216-
217183
newtype UnsignedTxError
218-
= UnsignedTxError TxBodyError
219-
220-
makeUnsignedTx
221-
:: Era era
222-
-> TxBodyContent BuildTx era
223-
-> Either TxBodyError (UnsignedTx era)
224-
makeUnsignedTx DijkstraEra _ = error "makeUnsignedTx: Dijkstra era not supported yet"
225-
makeUnsignedTx era@ConwayEra bc = obtainCommonConstraints era $ do
226-
let sbe = convert era
227-
aeon = convert era
228-
TxScriptWitnessRequirements languages scripts datums redeemers <-
229-
shelleyBasedEraConstraints sbe $
230-
collectTxBodyScriptWitnessRequirements (convert era) bc
231-
232-
-- cardano-api types
233-
let apiTxOuts = txOuts bc
234-
apiScriptValidity = txScriptValidity bc
235-
apiMintValue = txMintValue bc
236-
apiProtocolParameters = txProtocolParams bc
237-
apiCollateralTxIns = txInsCollateral bc
238-
apiReferenceInputs = txInsReference bc
239-
apiExtraKeyWitnesses = txExtraKeyWits bc
240-
apiReturnCollateral = txReturnCollateral bc
241-
apiTotalCollateral = txTotalCollateral bc
242-
243-
-- Ledger types
244-
txins = convTxIns $ txIns bc
245-
collTxIns = convCollateralTxIns apiCollateralTxIns
246-
refTxIns = convReferenceInputs apiReferenceInputs
247-
outs = convTxOuts sbe apiTxOuts
248-
fee = convTransactionFee sbe $ txFee bc
249-
withdrawals = convWithdrawals $ txWithdrawals bc
250-
returnCollateral = convReturnCollateral sbe apiReturnCollateral
251-
totalCollateral = convTotalCollateral apiTotalCollateral
252-
certs = convCertificates sbe $ txCertificates bc
253-
txAuxData = toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc)
254-
scriptIntegrityHash =
255-
convPParamsToScriptIntegrityHash
256-
aeon
257-
apiProtocolParameters
258-
redeemers
259-
datums
260-
languages
261-
262-
let setMint = convMintValue apiMintValue
263-
setReqSignerHashes = convExtraKeyWitnesses apiExtraKeyWitnesses
264-
ledgerTxBody =
265-
L.mkBasicTxBody
266-
& L.inputsTxBodyL .~ txins
267-
& L.collateralInputsTxBodyL .~ collTxIns
268-
& L.referenceInputsTxBodyL .~ refTxIns
269-
& L.outputsTxBodyL .~ outs
270-
& L.totalCollateralTxBodyL .~ totalCollateral
271-
& L.collateralReturnTxBodyL .~ returnCollateral
272-
& L.feeTxBodyL .~ fee
273-
& L.vldtTxBodyL . L.invalidBeforeL .~ convValidityLowerBound (txValidityLowerBound bc)
274-
& L.vldtTxBodyL . L.invalidHereAfterL .~ convValidityUpperBound sbe (txValidityUpperBound bc)
275-
& L.reqSignerHashesTxBodyL .~ setReqSignerHashes
276-
& L.scriptIntegrityHashTxBodyL .~ scriptIntegrityHash
277-
& L.withdrawalsTxBodyL .~ withdrawals
278-
& L.certsTxBodyL .~ certs
279-
& L.mintTxBodyL .~ setMint
280-
& L.auxDataHashTxBodyL .~ maybe SNothing (SJust . Ledger.hashTxAuxData) txAuxData
281-
282-
scriptWitnesses =
283-
L.mkBasicTxWits
284-
& L.scriptTxWitsL
285-
.~ fromList
286-
[ (L.hashScript sw, sw)
287-
| sw <- scripts
288-
]
289-
& L.datsTxWitsL .~ datums
290-
& L.rdmrsTxWitsL .~ redeemers
291-
292-
let eraSpecificTxBody = eraSpecificLedgerTxBody era ledgerTxBody bc
293-
294-
return . UnsignedTx $
295-
L.mkBasicTx eraSpecificTxBody
296-
& L.witsTxL .~ scriptWitnesses
297-
& L.auxDataTxL .~ maybeToStrictMaybe (toAuxiliaryData sbe (txMetadata bc) (txAuxScripts bc))
298-
& L.isValidTxL .~ txScriptValidityToIsValid apiScriptValidity
299-
300-
eraSpecificLedgerTxBody
301-
:: Era era
302-
-> Ledger.TxBody (LedgerEra era)
303-
-> TxBodyContent BuildTx era
304-
-> Ledger.TxBody (LedgerEra era)
305-
eraSpecificLedgerTxBody era ledgerbody bc =
306-
body era
307-
where
308-
body e =
309-
let propProcedures = txProposalProcedures bc
310-
voteProcedures = txVotingProcedures bc
311-
treasuryDonation = txTreasuryDonation bc
312-
currentTresuryValue = txCurrentTreasuryValue bc
313-
in obtainCommonConstraints e $
314-
ledgerbody
315-
& L.proposalProceduresTxBodyL
316-
.~ convProposalProcedures (maybe TxProposalProceduresNone unFeatured propProcedures)
317-
& L.votingProceduresTxBodyL
318-
.~ convVotingProcedures (maybe TxVotingProceduresNone unFeatured voteProcedures)
319-
& L.treasuryDonationTxBodyL
320-
.~ maybe (L.Coin 0) unFeatured treasuryDonation
321-
& L.currentTreasuryValueTxBodyL
322-
.~ L.maybeToStrictMaybe (unFeatured =<< currentTresuryValue)
184+
= UnsignedTxError String
323185

324186
hashTxBody
325187
:: L.HashAnnotated (Ledger.TxBody era) L.EraIndependentTxBody
@@ -398,8 +260,8 @@ signTx era bootstrapWits shelleyKeyWits (UnsignedTx unsigned) =
398260
convertTxBodyToUnsignedTx
399261
:: HasCallStack => ShelleyBasedEra era -> TxBody era -> UnsignedTx era
400262
convertTxBodyToUnsignedTx sbe txbody =
401-
forEraInEon
402-
(toCardanoEra sbe)
263+
Api.forEraInEon
264+
(Api.toCardanoEra sbe)
403265
(error $ "convertTxBodyToUnsignedTx: Error - unsupported era " <> docToString (pretty sbe))
404266
( \w -> do
405267
let ShelleyTx _ unsignedLedgerTx = makeSignedTransaction [] txbody

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/Type.hs‎

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
{-# LANGUAGE ConstraintKinds #-}
2+
{-# LANGUAGE DataKinds #-}
3+
{-# LANGUAGE FlexibleContexts #-}
4+
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE GADTs #-}
6+
{-# LANGUAGE InstanceSigs #-}
7+
{-# LANGUAGE RankNTypes #-}
8+
{-# LANGUAGE ScopedTypeVariables #-}
9+
{-# LANGUAGE StandaloneDeriving #-}
10+
{-# LANGUAGE TypeApplications #-}
11+
{-# LANGUAGE TypeFamilies #-}
12+
{-# LANGUAGE UndecidableInstances #-}
13+
14+
module Cardano.Api.Experimental.Tx.Internal.Type
15+
( UnsignedTx (..)
16+
)
17+
where
18+
19+
20+
import Cardano.Api.Experimental.Era
21+
22+
import Cardano.Api.HasTypeProxy (HasTypeProxy (..), Proxy, asType)
23+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
24+
import Cardano.Api.ProtocolParameters
25+
import Cardano.Api.Serialise.Raw
26+
( SerialiseAsRawBytes (..)
27+
, SerialiseAsRawBytesError (SerialiseAsRawBytesError)
28+
)
29+
import Cardano.Ledger.Binary qualified as Ledger
30+
import Cardano.Ledger.Core qualified as Ledger
31+
import Control.Exception (displayException)
32+
import Data.Bifunctor (bimap)
33+
import Data.ByteString.Lazy (fromStrict)
34+
35+
36+
-- | A transaction that can contain everything
37+
-- except key witnesses.
38+
data UnsignedTx era
39+
= L.EraTx (LedgerEra era) => UnsignedTx (Ledger.Tx (LedgerEra era))
40+
41+
instance HasTypeProxy era => HasTypeProxy (UnsignedTx era) where
42+
data AsType (UnsignedTx era) = AsUnsignedTx (AsType era)
43+
proxyToAsType :: Proxy (UnsignedTx era) -> AsType (UnsignedTx era)
44+
proxyToAsType _ = AsUnsignedTx (asType @era)
45+
46+
instance
47+
( HasTypeProxy era
48+
, L.EraTx (LedgerEra era)
49+
)
50+
=> SerialiseAsRawBytes (UnsignedTx era)
51+
where
52+
serialiseToRawBytes (UnsignedTx tx) =
53+
Ledger.serialize' (Ledger.eraProtVerHigh @(LedgerEra era)) tx
54+
deserialiseFromRawBytes _ =
55+
bimap wrapError UnsignedTx
56+
. Ledger.decodeFullAnnotator
57+
(Ledger.eraProtVerHigh @(LedgerEra era))
58+
"UnsignedTx"
59+
Ledger.decCBOR
60+
. fromStrict
61+
where
62+
wrapError
63+
:: Ledger.DecoderError -> SerialiseAsRawBytesError
64+
wrapError = SerialiseAsRawBytesError . displayException
65+
66+
deriving instance Eq (UnsignedTx era)
67+
68+
deriving instance Show (UnsignedTx era)

0 commit comments

Comments
 (0)