-
Notifications
You must be signed in to change notification settings - Fork 155
/
TxAuxData.hs
191 lines (159 loc) · 5.7 KB
/
TxAuxData.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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Allegra.TxAuxData (
AllegraTxAuxData (AllegraTxAuxData),
AllegraTxAuxDataRaw,
metadataAllegraTxAuxDataL,
-- * Deprecations
AuxiliaryData,
)
where
import Cardano.Crypto.Hash (HashAlgorithm)
import Cardano.Ledger.Allegra.Era (AllegraEra)
import Cardano.Ledger.Allegra.Scripts (Timelock)
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..))
import Cardano.Ledger.Binary (
Annotator (..),
DecCBOR (..),
EncCBOR (..),
ToCBOR,
peekTokenType,
)
import Cardano.Ledger.Binary.Coders
import Cardano.Ledger.Core (
Era (..),
EraTxAuxData (..),
)
import Cardano.Ledger.Crypto (Crypto (HASH))
import Cardano.Ledger.Hashes (EraIndependentTxAuxData)
import Cardano.Ledger.MemoBytes (
EqRaw,
Mem,
MemoBytes,
MemoHashIndex,
Memoized (RawType),
getMemoRawType,
getMemoSafeHash,
lensMemoRawType,
mkMemoized,
)
import Cardano.Ledger.SafeHash (HashAnnotated, SafeToHash, hashAnnotated)
import Cardano.Ledger.Shelley.TxAuxData (Metadatum, ShelleyTxAuxData (..), validMetadatum)
import Codec.CBOR.Decoding (
TokenType (
TypeListLen,
TypeListLen64,
TypeListLenIndef,
TypeMapLen,
TypeMapLen64,
TypeMapLenIndef
),
)
import Control.DeepSeq (NFData, deepseq)
import Data.Map.Strict (Map)
import Data.Sequence.Strict (StrictSeq)
import qualified Data.Sequence.Strict as StrictSeq
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro (Lens')
import NoThunks.Class (NoThunks)
-- =======================================
-- | Raw, un-memoised metadata type
data AllegraTxAuxDataRaw era = AllegraTxAuxDataRaw
{ atadrMetadata :: !(Map Word64 Metadatum)
-- ^ Structured transaction metadata
, atadrTimelock :: !(StrictSeq (Timelock era))
-- ^ Pre-images of script hashes found within the TxBody, but which are not
-- required as witnesses. Examples include:
-- - Token policy IDs appearing in transaction outputs
-- - Pool reward account registrations
}
deriving (Generic, Eq)
instance Crypto c => EraTxAuxData (AllegraEra c) where
type TxAuxData (AllegraEra c) = AllegraTxAuxData (AllegraEra c)
mkBasicTxAuxData = AllegraTxAuxData mempty mempty
metadataTxAuxDataL = metadataAllegraTxAuxDataL
upgradeTxAuxData (ShelleyTxAuxData md) = AllegraTxAuxData md mempty
validateTxAuxData _ (AllegraTxAuxData md as) = as `deepseq` all validMetadatum md
hashTxAuxData aux = AuxiliaryDataHash (hashAnnotated aux)
metadataAllegraTxAuxDataL :: Era era => Lens' (AllegraTxAuxData era) (Map Word64 Metadatum)
metadataAllegraTxAuxDataL =
lensMemoRawType atadrMetadata $ \txAuxDataRaw md -> txAuxDataRaw {atadrMetadata = md}
deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (AllegraTxAuxDataRaw era)
deriving instance Era era => NoThunks (AllegraTxAuxDataRaw era)
instance NFData (AllegraTxAuxDataRaw era)
newtype AllegraTxAuxData era = AuxiliaryDataWithBytes (MemoBytes AllegraTxAuxDataRaw era)
deriving (Generic)
deriving newtype (Eq, ToCBOR, SafeToHash)
instance Memoized AllegraTxAuxData where
type RawType AllegraTxAuxData = AllegraTxAuxDataRaw
type instance MemoHashIndex AllegraTxAuxDataRaw = EraIndependentTxAuxData
instance c ~ EraCrypto era => HashAnnotated (AllegraTxAuxData era) EraIndependentTxAuxData c where
hashAnnotated = getMemoSafeHash
deriving newtype instance
HashAlgorithm (HASH (EraCrypto era)) =>
Show (AllegraTxAuxData era)
deriving newtype instance Era era => NoThunks (AllegraTxAuxData era)
deriving newtype instance NFData (AllegraTxAuxData era)
instance EqRaw (AllegraTxAuxData era)
pattern AllegraTxAuxData ::
Era era =>
Map Word64 Metadatum ->
StrictSeq (Timelock era) ->
AllegraTxAuxData era
pattern AllegraTxAuxData blob sp <- (getMemoRawType -> AllegraTxAuxDataRaw blob sp)
where
AllegraTxAuxData blob sp = mkMemoized $ AllegraTxAuxDataRaw blob sp
{-# COMPLETE AllegraTxAuxData #-}
type AuxiliaryData = AllegraTxAuxData
{-# DEPRECATED AuxiliaryData "Use `AllegraTxAuxData` instead" #-}
--------------------------------------------------------------------------------
-- Serialisation
--------------------------------------------------------------------------------
instance Era era => EncCBOR (AllegraTxAuxDataRaw era) where
encCBOR (AllegraTxAuxDataRaw blob sp) =
encode (Rec AllegraTxAuxDataRaw !> To blob !> To sp)
-- | Encodes memoized bytes created upon construction.
instance Era era => EncCBOR (AllegraTxAuxData era)
instance Era era => DecCBOR (Annotator (AllegraTxAuxDataRaw era)) where
decCBOR =
peekTokenType >>= \case
TypeMapLen -> decodeFromMap
TypeMapLen64 -> decodeFromMap
TypeMapLenIndef -> decodeFromMap
TypeListLen -> decodeFromList
TypeListLen64 -> decodeFromList
TypeListLenIndef -> decodeFromList
_ -> error "Failed to decode AuxiliaryData"
where
decodeFromMap =
decode
( Ann (Emit AllegraTxAuxDataRaw)
<*! Ann From
<*! Ann (Emit StrictSeq.empty)
)
decodeFromList =
decode
( Ann (RecD AllegraTxAuxDataRaw)
<*! Ann From
<*! D (sequence <$> decCBOR)
)
deriving via
(Mem AllegraTxAuxDataRaw era)
instance
Era era => DecCBOR (Annotator (AllegraTxAuxData era))