Skip to content

Commit a435e9b

Browse files
SoupstrawSoupstraw
committed
Added sizedCollateralReturnTxBodyF
1 parent b1512f7 commit a435e9b

File tree

12 files changed

+118
-45
lines changed

12 files changed

+118
-45
lines changed

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -465,7 +465,7 @@ validateTooManyCollateralInputs pp txBody =
465465
where
466466
maxColl, numColl :: Natural
467467
maxColl = pp ^. ppMaxCollateralInputsL
468-
numColl = fromIntegral . Set.size $ txBody ^. collateralInputsTxBodyL
468+
numColl = fromIntegral . Set.size $ txBody ^. collateralInputsTxBodyF
469469

470470
-- ================================================================
471471

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -105,6 +105,7 @@ import Cardano.Ledger.MemoBytes (
105105
Memoized (..),
106106
getMemoRawType,
107107
getMemoSafeHash,
108+
getterMemoRawType,
108109
lensMemoRawType,
109110
mkMemoizedEra,
110111
)
@@ -128,7 +129,9 @@ import NoThunks.Class (InspectHeap (..), NoThunks (..))
128129
type ScriptIntegrityHash = SafeHash EraIndependentScriptIntegrity
129130

130131
class (MaryEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where
131-
collateralInputsTxBodyL :: Lens' (TxBody l era) (Set TxIn)
132+
collateralInputsTxBodyL :: Lens' (TxBody TopTx era) (Set TxIn)
133+
134+
collateralInputsTxBodyF :: SimpleGetter (TxBody l era) (Set TxIn)
132135

133136
reqSignerHashesTxBodyL :: AtMostEra "Conway" era => Lens' (TxBody l era) (Set (KeyHash 'Witness))
134137

@@ -228,7 +231,7 @@ instance EraTxBody AlonzoEra where
228231
{-# INLINE spendableInputsTxBodyF #-}
229232

230233
allInputsTxBodyF =
231-
to $ \txBody -> (txBody ^. inputsTxBodyL) `Set.union` (txBody ^. collateralInputsTxBodyL)
234+
to $ \txBody -> (txBody ^. inputsTxBodyL) `Set.union` (txBody ^. collateralInputsTxBodyF)
232235
{-# INLINEABLE allInputsTxBodyF #-}
233236

234237
withdrawalsTxBodyL =
@@ -272,6 +275,10 @@ instance AlonzoEraTxBody AlonzoEra where
272275
\txBodyRaw collateral_ -> txBodyRaw {atbrCollateral = collateral_}
273276
{-# INLINEABLE collateralInputsTxBodyL #-}
274277

278+
collateralInputsTxBodyF =
279+
getterMemoRawType (\AlonzoTxBodyRaw {atbrCollateral} -> atbrCollateral)
280+
{-# INLINEABLE collateralInputsTxBodyF #-}
281+
275282
reqSignerHashesTxBodyL =
276283
lensMemoRawType @AlonzoEra (\AlonzoTxBodyRaw {atbrReqSignerHashes} -> atbrReqSignerHashes) $
277284
\txBodyRaw reqSignerHashes_ -> txBodyRaw {atbrReqSignerHashes = reqSignerHashes_}

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -141,8 +141,8 @@ makeCollateralInput = do
141141

142142
addCollateralInput ::
143143
AlonzoEraImp era =>
144-
Tx l era ->
145-
ImpTestM era (Tx l era)
144+
Tx TopTx era ->
145+
ImpTestM era (Tx TopTx era)
146146
addCollateralInput tx
147147
| not (null (tx ^. bodyTxL . collateralInputsTxBodyL)) = pure tx
148148
| otherwise = do
@@ -526,7 +526,7 @@ impAlonzoExpectTxSuccess ::
526526
impAlonzoExpectTxSuccess tx = do
527527
utxo <- getsNES utxoL
528528
let inputs = tx ^. bodyTxL . inputsTxBodyL
529-
collaterals = tx ^. bodyTxL . collateralInputsTxBodyL
529+
collaterals = tx ^. bodyTxL . collateralInputsTxBodyF
530530
outputs = Map.toList . unUTxO . txouts $ tx ^. bodyTxL
531531
if tx ^. isValidTxL == IsValid True
532532
then do

‎eras/babbage/impl/src/Cardano/Ledger/Babbage/Collateral.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ collAdaBalance ::
3434
Map.Map TxIn (TxOut era) ->
3535
DeltaCoin
3636
collAdaBalance txBody utxoCollateral = toDeltaCoin $
37-
case txBody ^. collateralReturnTxBodyL of
37+
case txBody ^. collateralReturnTxBodyF of
3838
SNothing -> colbal
3939
SJust txOut -> colbal <-> (txOut ^. coinTxOutL @era)
4040
where
@@ -45,7 +45,7 @@ collOuts ::
4545
TxBody l era ->
4646
UTxO era
4747
collOuts txBody =
48-
case txBody ^. collateralReturnTxBodyL of
48+
case txBody ^. collateralReturnTxBodyF of
4949
SNothing -> UTxO Map.empty
5050
SJust txOut -> UTxO (Map.singleton (mkCollateralTxIn txBody) txOut)
5151

‎eras/babbage/impl/src/Cardano/Ledger/Babbage/TxBody.hs‎

Lines changed: 18 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,7 @@ import Cardano.Ledger.MemoBytes (
9090
eqRaw,
9191
getMemoRawType,
9292
getMemoSafeHash,
93+
getterMemoRawType,
9394
lensMemoRawType,
9495
mkMemoizedEra,
9596
zipMemoRawType,
@@ -117,8 +118,12 @@ class (AlonzoEraTxBody era, BabbageEraTxOut era) => BabbageEraTxBody era where
117118

118119
collateralReturnTxBodyL :: Lens' (TxBody TopTx era) (StrictMaybe (TxOut era))
119120

121+
collateralReturnTxBodyF :: SimpleGetter (TxBody l era) (StrictMaybe (TxOut era))
122+
120123
sizedCollateralReturnTxBodyL :: Lens' (TxBody TopTx era) (StrictMaybe (Sized (TxOut era)))
121124

125+
sizedCollateralReturnTxBodyF :: SimpleGetter (TxBody l era) (StrictMaybe (Sized (TxOut era)))
126+
122127
allSizedOutputsTxBodyF :: SimpleGetter (TxBody l era) (StrictSeq (Sized (TxOut era)))
123128

124129
-- ======================================
@@ -210,15 +215,15 @@ babbageSpendableInputsTxBodyF ::
210215
babbageSpendableInputsTxBodyF =
211216
to $ \txBody ->
212217
(txBody ^. inputsTxBodyL)
213-
`Set.union` (txBody ^. collateralInputsTxBodyL)
218+
`Set.union` (txBody ^. collateralInputsTxBodyF)
214219
{-# INLINEABLE babbageSpendableInputsTxBodyF #-}
215220

216221
babbageAllInputsTxBodyF ::
217222
BabbageEraTxBody era => SimpleGetter (TxBody l era) (Set TxIn)
218223
babbageAllInputsTxBodyF =
219224
to $ \txBody ->
220225
(txBody ^. inputsTxBodyL)
221-
`Set.union` (txBody ^. collateralInputsTxBodyL)
226+
`Set.union` (txBody ^. collateralInputsTxBodyF)
222227
`Set.union` (txBody ^. referenceInputsTxBodyL)
223228
{-# INLINEABLE babbageAllInputsTxBodyF #-}
224229

@@ -228,7 +233,7 @@ allSizedOutputsBabbageTxBodyF ::
228233
allSizedOutputsBabbageTxBodyF =
229234
to $ \txBody ->
230235
let txOuts = txBody ^. sizedOutputsTxBodyL
231-
in case txBody ^. sizedCollateralReturnTxBodyL of
236+
in case txBody ^. sizedCollateralReturnTxBodyF of
232237
SNothing -> txOuts
233238
SJust collTxOut -> txOuts |> collTxOut
234239
{-# INLINEABLE allSizedOutputsBabbageTxBodyF #-}
@@ -311,6 +316,9 @@ instance AlonzoEraTxBody BabbageEra where
311316
txBodyRaw {btbrCollateralInputs = collateral}
312317
{-# INLINE collateralInputsTxBodyL #-}
313318

319+
collateralInputsTxBodyF =
320+
getterMemoRawType (\BabbageTxBodyRaw {btbrCollateralInputs} -> btbrCollateralInputs)
321+
314322
reqSignerHashesTxBodyL =
315323
lensMemoRawType @BabbageEra (\BabbageTxBodyRaw {btbrReqSignerHashes} -> btbrReqSignerHashes) $ \txBodyRaw reqSignerHashes ->
316324
txBodyRaw {btbrReqSignerHashes = reqSignerHashes}
@@ -351,11 +359,18 @@ instance BabbageEraTxBody BabbageEra where
351359
txBodyRaw {btbrCollateralReturn = mkSized (eraProtVerLow @BabbageEra) <$> collateralReturn}
352360
{-# INLINE collateralReturnTxBodyL #-}
353361

362+
collateralReturnTxBodyF =
363+
getterMemoRawType (\BabbageTxBodyRaw {btbrCollateralReturn} -> sizedValue <$> btbrCollateralReturn)
364+
354365
sizedCollateralReturnTxBodyL =
355366
lensMemoRawType @BabbageEra (\BabbageTxBodyRaw {btbrCollateralReturn} -> btbrCollateralReturn) $ \txBodyRaw collateralReturn ->
356367
txBodyRaw {btbrCollateralReturn = collateralReturn}
357368
{-# INLINE sizedCollateralReturnTxBodyL #-}
358369

370+
sizedCollateralReturnTxBodyF =
371+
getterMemoRawType (\BabbageTxBodyRaw {btbrCollateralReturn} -> btbrCollateralReturn)
372+
{-# INLINE sizedCollateralReturnTxBodyF #-}
373+
359374
allSizedOutputsTxBodyF = allSizedOutputsBabbageTxBodyF
360375
{-# INLINE allSizedOutputsTxBodyF #-}
361376

‎eras/babbage/impl/testlib/Test/Cardano/Ledger/Babbage/ImpTest.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -90,8 +90,8 @@ fixupCollateralReturn ::
9090
( ShelleyEraImp era
9191
, BabbageEraTxBody era
9292
) =>
93-
Tx l era ->
94-
ImpTestM era (Tx l era)
93+
Tx TopTx era ->
94+
ImpTestM era (Tx TopTx era)
9595
fixupCollateralReturn tx = do
9696
pp <- getsNES $ nesEsL . curPParamsEpochStateL
9797
pure $ tx & bodyTxL . collateralReturnTxBodyL %~ fmap (ensureMinCoinTxOut pp)

‎eras/conway/impl/src/Cardano/Ledger/Conway/TxBody.hs‎

Lines changed: 14 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,7 @@ import Cardano.Ledger.MemoBytes (
103103
Memoized (..),
104104
getMemoRawType,
105105
getMemoSafeHash,
106+
getterMemoRawType,
106107
lensMemoRawType,
107108
mkMemoizedEra,
108109
)
@@ -392,6 +393,10 @@ instance AlonzoEraTxBody ConwayEra where
392393
\txb x -> txb {ctbrCollateralInputs = x}
393394
{-# INLINE collateralInputsTxBodyL #-}
394395

396+
collateralInputsTxBodyF =
397+
getterMemoRawType (\ConwayTxBodyRaw {ctbrCollateralInputs} -> ctbrCollateralInputs)
398+
{-# INLINE collateralInputsTxBodyF #-}
399+
395400
reqSignerHashesTxBodyL =
396401
lensMemoRawType @ConwayEra (\ConwayTxBodyRaw {ctbrReqSignerHashes} -> ctbrReqSignerHashes) $
397402
\txb x -> txb {ctbrReqSignerHashes = x}
@@ -431,11 +436,20 @@ instance BabbageEraTxBody ConwayEra where
431436
$ \txb x -> txb {ctbrCollateralReturn = mkSized (eraProtVerLow @ConwayEra) <$> x}
432437
{-# INLINE collateralReturnTxBodyL #-}
433438

439+
collateralReturnTxBodyF =
440+
getterMemoRawType
441+
(fmap sizedValue . (\ConwayTxBodyRaw {ctbrCollateralReturn} -> ctbrCollateralReturn))
442+
{-# INLINE collateralReturnTxBodyF #-}
443+
434444
sizedCollateralReturnTxBodyL =
435445
lensMemoRawType @ConwayEra (\ConwayTxBodyRaw {ctbrCollateralReturn} -> ctbrCollateralReturn) $
436446
\txb x -> txb {ctbrCollateralReturn = x}
437447
{-# INLINE sizedCollateralReturnTxBodyL #-}
438448

449+
sizedCollateralReturnTxBodyF =
450+
getterMemoRawType (\ConwayTxBodyRaw {ctbrCollateralReturn} -> ctbrCollateralReturn)
451+
{-# INLINE sizedCollateralReturnTxBodyF #-}
452+
439453
allSizedOutputsTxBodyF = allSizedOutputsBabbageTxBodyF
440454
{-# INLINE allSizedOutputsTxBodyF #-}
441455

‎eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Translation.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -51,11 +51,12 @@ import Data.Coerce (coerce)
5151
import Data.Default (Default (..))
5252
import qualified Data.Map.Strict as Map
5353
import Lens.Micro ((&), (.~), (^.))
54+
import Data.Typeable (Typeable)
5455

5556
type instance TranslationContext DijkstraEra = DijkstraGenesis
5657

57-
instance TranslateEra DijkstraEra Tx where
58-
type TranslationError DijkstraEra Tx = DecoderError
58+
instance Typeable l => TranslateEra DijkstraEra (Tx l) where
59+
type TranslationError DijkstraEra (Tx l) = DecoderError
5960
translateEra _ctxt tx = do
6061
-- Note that this does not preserve the hidden bytes field of the transaction.
6162
-- This is under the premise that this is irrelevant for TxInBlocks, which are

‎eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
{-# LANGUAGE FlexibleInstances #-}
55
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
66
{-# LANGUAGE LambdaCase #-}
7+
{-# LANGUAGE MultiParamTypeClasses #-}
78
{-# LANGUAGE PatternSynonyms #-}
89
{-# LANGUAGE TypeFamilies #-}
910
{-# LANGUAGE TypeOperators #-}
@@ -43,12 +44,16 @@ import Cardano.Ledger.Keys.WitVKey (witVKeyHash)
4344
import Cardano.Ledger.MemoBytes (EqRaw (..))
4445
import Control.DeepSeq (NFData)
4546
import qualified Data.Set as Set
47+
import Data.Typeable (Typeable)
4648
import GHC.Generics (Generic)
4749
import Lens.Micro (Lens', lens, (^.))
4850
import NoThunks.Class (NoThunks)
4951

52+
instance HasEraTxLevel Tx DijkstraEra where
53+
toSTxLevel = undefined
54+
5055
instance EraTx DijkstraEra where
51-
newtype Tx DijkstraEra = MkDijkstraTx {unDijkstraTx :: AlonzoTx DijkstraEra}
56+
newtype Tx l DijkstraEra = MkDijkstraTx {unDijkstraTx :: AlonzoTx l DijkstraEra}
5257
deriving newtype (Eq, Show, NFData, NoThunks, ToCBOR, EncCBOR)
5358
deriving (Generic)
5459

@@ -71,17 +76,17 @@ instance EraTx DijkstraEra where
7176

7277
getMinFeeTx = getConwayMinFeeTx
7378

74-
instance EqRaw (Tx DijkstraEra) where
79+
instance EqRaw (Tx l DijkstraEra) where
7580
eqRaw = alonzoTxEqRaw
7681

77-
dijkstraTxL :: Lens' (Tx DijkstraEra) (AlonzoTx DijkstraEra)
82+
dijkstraTxL :: Lens' (Tx l DijkstraEra) (AlonzoTx l DijkstraEra)
7883
dijkstraTxL = lens unDijkstraTx (\x y -> x {unDijkstraTx = y})
7984

8085
instance AlonzoEraTx DijkstraEra where
8186
isValidTxL = dijkstraTxL . isValidAlonzoTxL
8287
{-# INLINE isValidTxL #-}
8388

84-
instance DecCBOR (Annotator (Tx DijkstraEra)) where
89+
instance Typeable l => DecCBOR (Annotator (Tx l DijkstraEra)) where
8590
decCBOR = fmap MkDijkstraTx <$> decCBOR
8691

8792
validateDijkstraNativeScript ::
@@ -90,7 +95,7 @@ validateDijkstraNativeScript ::
9095
, DijkstraEraScript era
9196
, NativeScript era ~ DijkstraNativeScript era
9297
) =>
93-
Tx era -> NativeScript era -> Bool
98+
Tx l era -> NativeScript era -> Bool
9499
validateDijkstraNativeScript tx =
95100
evalDijkstraNativeScript vhks (tx ^. bodyTxL . vldtTxBodyL) (tx ^. bodyTxL . guardsTxBodyL)
96101
where

0 commit comments

Comments
 (0)