/
TxInfo.hs
105 lines (101 loc) · 3.71 KB
/
TxInfo.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Ledger.Conway.TxInfo (conwayTxInfo) where
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.TxInfo (
TranslationError (..),
VersionedTxInfo (..),
)
import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo
import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits (..), unRedeemers, unTxDats)
import Cardano.Ledger.Babbage.TxBody (
AllegraEraTxBody (..),
AlonzoEraTxBody (..),
BabbageEraTxBody (..),
MaryEraTxBody (..),
ShelleyEraTxBody (..),
)
import Cardano.Ledger.Babbage.TxInfo (babbageTxInfoV1, babbageTxInfoV2)
import qualified Cardano.Ledger.Babbage.TxInfo as B
import Cardano.Ledger.Core hiding (TranslationError)
import Cardano.Ledger.Mary.Value (MaryValue (..))
import Cardano.Ledger.SafeHash (hashAnnotated)
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Ledger.Val (Val (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.Arrow (left)
import Control.Monad (zipWithM)
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Text (Text)
import Lens.Micro
import qualified PlutusLedgerApi.V3 as PV3
conwayTxInfo ::
forall era.
( EraTx era
, BabbageEraTxBody era
, Value era ~ MaryValue (EraCrypto era)
) =>
PParams era ->
Language ->
EpochInfo (Either Text) ->
SystemStart ->
UTxO era ->
Tx era ->
Either (TranslationError (EraCrypto era)) VersionedTxInfo
conwayTxInfo pp lang ei sysS utxo tx = do
timeRange <- left TimeTranslationPastHorizon $ Alonzo.transVITime pp ei sysS interval
case lang of
PlutusV1 -> babbageTxInfoV1 timeRange tx utxo
PlutusV2 -> babbageTxInfoV2 timeRange tx utxo
PlutusV3 -> conwayTxInfoV3 timeRange tx utxo
where
interval = tx ^. bodyTxL ^. vldtTxBodyL
conwayTxInfoV3 ::
forall era.
( EraTx era
, BabbageEraTxBody era
, Value era ~ MaryValue (EraCrypto era)
) =>
PV3.POSIXTimeRange ->
Tx era ->
UTxO era ->
Either (TranslationError (EraCrypto era)) VersionedTxInfo
conwayTxInfoV3 timeRange tx utxo = do
inputs <- mapM (B.txInfoInV2 utxo) (Set.toList (txBody ^. inputsTxBodyL))
refInputs <- mapM (B.txInfoInV2 utxo) (Set.toList (txBody ^. referenceInputsTxBodyL))
outputs <-
zipWithM
(B.txInfoOutV2 . Alonzo.TxOutFromOutput)
[minBound ..]
(foldr (:) [] outs)
rdmrs' <- mapM (B.transRedeemerPtr txBody) rdmrs
pure . TxInfoPV3 $
PV3.TxInfo -- TODO Add relevant CIP-1694 data to PV3.TxInfo
{ PV3.txInfoInputs = inputs
, PV3.txInfoOutputs = outputs
, PV3.txInfoReferenceInputs = refInputs
, PV3.txInfoFee = Alonzo.transValue (inject @(MaryValue (EraCrypto era)) fee)
, PV3.txInfoMint = Alonzo.transMintValue multiAsset
, PV3.txInfoDCert = foldr (\c ans -> Alonzo.transDCert c : ans) [] (txBody ^. certsTxBodyG)
, PV3.txInfoWdrl = PV3.fromList $ Map.toList (Alonzo.transWithdrawals (txBody ^. withdrawalsTxBodyL))
, PV3.txInfoValidRange = timeRange
, PV3.txInfoSignatories =
map Alonzo.transKeyHash (Set.toList (txBody ^. reqSignerHashesTxBodyL))
, PV3.txInfoRedeemers = PV3.fromList rdmrs'
, PV3.txInfoData = PV3.fromList $ map Alonzo.transDataPair datpairs
, PV3.txInfoId = PV3.TxId (Alonzo.transSafeHash (hashAnnotated txBody))
}
where
txBody = tx ^. bodyTxL
witnesses = tx ^. witsTxL
outs = txBody ^. outputsTxBodyL
fee = txBody ^. feeTxBodyL
multiAsset = txBody ^. mintTxBodyL
datpairs = Map.toList (unTxDats $ witnesses ^. datsTxWitsL)
rdmrs = Map.toList (unRedeemers $ witnesses ^. rdmrsTxWitsL)