Skip to content

Commit 9abc97c

Browse files
qnikstqnikst
committed
Update serialisation procedure
1 parent 7e72d3f commit 9abc97c

File tree

3 files changed

+77
-41
lines changed

3 files changed

+77
-41
lines changed

‎cabal.project‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -101,16 +101,16 @@ source-repository-package
101101
type: git
102102
location: https://github.com/tweag/cardano-canonical-ledger.git
103103
subdir: scls-cbor
104-
tag: d622dd31d05006af9220af4cf4b0bf87fae2971b
104+
tag: 39d9d2a0bdc9e866f92568a62fbf51df3c089a25
105105

106106
source-repository-package
107107
type: git
108108
location: https://github.com/tweag/cardano-canonical-ledger.git
109109
subdir: scls-format
110-
tag: d622dd31d05006af9220af4cf4b0bf87fae2971b
110+
tag: 39d9d2a0bdc9e866f92568a62fbf51df3c089a25
111111

112112
source-repository-package
113113
type: git
114114
location: https://github.com/tweag/cardano-canonical-ledger.git
115115
subdir: merkle-tree-incremental
116-
tag: d622dd31d05006af9220af4cf4b0bf87fae2971b
116+
tag: 39d9d2a0bdc9e866f92568a62fbf51df3c089a25

‎eras/conway/impl/scls-export/src/Cardano/Ledger/Export/Namespace/UTxO.hs‎

Lines changed: 70 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE TypeApplications #-}
12
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE DataKinds #-}
34
{-# LANGUAGE StandaloneDeriving #-}
@@ -26,7 +27,7 @@ import Cardano.SCLS.CBOR.Canonical.Decoder
2627
import qualified Codec.CBOR.Encoding as E
2728
import qualified Codec.CBOR.Decoding as D
2829
import Cardano.Ledger.Conway (ConwayEra)
29-
import Cardano.Ledger.TxIn (TxIn(..))
30+
import Cardano.Ledger.TxIn (TxIn(..), TxId(..))
3031
import Cardano.Ledger.Core (TxOut(..))
3132
-- import Cardano.Ledger.TxOut (TxOut(..))
3233
import Cardano.Ledger.Compactible
@@ -37,6 +38,8 @@ import Cardano.Ledger.Hashes
3738
import Cardano.Ledger.Plutus.Data (Datum(..))
3839
import Cardano.Ledger.Plutus.Data (BinaryData)
3940
import Cardano.Ledger.Mary (MaryEra, MaryValue)
41+
import Cardano.Ledger.Coin (Coin)
42+
import qualified Cardano.Ledger.Coin as Coin
4043
import Cardano.SCLS.Internal.Entry
4144
import Cardano.SCLS.Internal.Version
4245
import Data.Typeable (Typeable)
@@ -45,8 +48,8 @@ import qualified Cardano.Ledger.Babbage.TxOut as Babbage
4548
import Cardano.Ledger.Allegra.Scripts (Timelock(..))
4649
import Data.MemPack
4750
import Data.Word (Word8, Word16)
48-
import Cardano.Ledger.Alonzo.TxOut (DataHash32, Addr28Extra)
49-
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose, AsItem, AlonzoScript)
51+
import Cardano.Ledger.Alonzo.TxOut (DataHash32, Addr28Extra, decodeAddress28)
52+
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose, AsItem, AlonzoScript(..))
5053

5154
-- | Helper that allows us to deriving instances via internal CBOR representation
5255
newtype LedgerCBOR (v::Version) a = LedgerCBOR { unLedgerCBOR :: a }
@@ -70,31 +73,23 @@ instance (MemPack a) => FromCanonicalCBOR V1 (MemPackCBOR a) where
7073
-- | Input wrapper for the keys that are used in utxo namespace
7174
data UtxoKey
7275
= UtxoKeyIn TxIn
73-
-- | UtxoKeyScript ScriptUtxoIn
76+
deriving (Show)
7477

7578
instance Eq UtxoKey where
7679
(UtxoKeyIn txIn1) == (UtxoKeyIn txIn2) = txIn1 == txIn2
77-
-- (UtxoKeyScript script1) == (UtxoKeyScript script2) = undefined script1 script2
78-
-- _ == _ = False
7980

8081
instance Ord UtxoKey where
8182
compare (UtxoKeyIn txIn1) (UtxoKeyIn txIn2) = compare txIn1 txIn2
82-
-- compare (UtxoKeyScript script1) (UtxoKeyScript script2) = undefined script1 script2
83-
-- compare (UtxoKeyIn _) (UtxoKeyScript _) = LT
84-
-- compare (UtxoKeyScript _) (UtxoKeyIn _) = GT
8583

8684
instance IsKey UtxoKey where
8785
keySize = 34
88-
packKeyM (UtxoKeyIn (TxIn a b)) = do
89-
packM a
86+
packKeyM (UtxoKeyIn (TxIn (TxId a) b)) = do
87+
packByteStringM (originalBytes a)
9088
packM b
91-
-- packKeyM (UtxoKeyScript (ScriptUtxoIn purpose hash)) = do
92-
-- undefined purpose hash
9389
unpackKeyM = do
94-
a <- unpackM
90+
a <- unpackM -- FIXME read bytestirng and create unsafe hash
9591
b <- unpackM
9692
return $ UtxoKeyIn (TxIn a b)
97-
-- toKeyBytes v key = toStrictByteString $ toCanonicalCBOR v key
9893

9994
newtype Out = Out (TxOut ConwayEra)
10095
deriving newtype (ToCanonicalCBOR V1, FromCanonicalCBOR V1)
@@ -108,11 +103,11 @@ data ScriptUtxoIn = ScriptUtxoIn { scriptUtxoInPurpose :: AlonzoPlutusPurpose As
108103
-- is not efficient and we can replace it with the implementation based on the compact values
109104
data UtxoOut
110105
= UtxoOutShelley (Shelley.ShelleyTxOut MaryEra)
111-
| UtxoOutBabbage (Babbage.BabbageTxOut MaryEra)
106+
| UtxoOutBabbage (Babbage.BabbageTxOut ConwayEra)
112107
| UtxoValue MaryValue
113108

114109
instance ToCanonicalCBOR V1 UtxoKey where
115-
toCanonicalCBOR v (UtxoKeyIn txIn) = E.encodeTag 0 <> toCanonicalCBOR v txIn
110+
toCanonicalCBOR v (UtxoKeyIn txIn) = E.encodeInt 0 <> toCanonicalCBOR v txIn
116111
-- toCanonicalCBOR v (UtxoKeyScript script) = E.encodeTag 1 <> toCanonicalCBOR v script
117112

118113

@@ -137,9 +132,9 @@ instance FromCanonicalCBOR V1 UtxoKey where
137132
_ -> fail "Unknown UtxoKey tag"
138133

139134
instance ToCanonicalCBOR V1 UtxoOut where
140-
toCanonicalCBOR v (UtxoOutShelley shelleyOut) = E.encodeTag 1 <> toCanonicalCBOR v shelleyOut
141-
toCanonicalCBOR v (UtxoOutBabbage babbageOut) = E.encodeTag 2 <> toCanonicalCBOR v babbageOut
142-
toCanonicalCBOR v (UtxoValue value) = E.encodeTag 3 <> toCanonicalCBOR v value
135+
toCanonicalCBOR v (UtxoOutShelley shelleyOut) = toCanonicalCBOR v (E.encodeInt 0, toCanonicalCBOR v shelleyOut)
136+
toCanonicalCBOR v (UtxoOutBabbage babbageOut) = toCanonicalCBOR v (E.encodeInt 1, toCanonicalCBOR v babbageOut)
137+
toCanonicalCBOR v (UtxoValue value) = toCanonicalCBOR v (E.encodeInt 2, toCanonicalCBOR v value)
143138

144139
instance FromCanonicalCBOR V1 UtxoOut where
145140
fromCanonicalCBOR = do
@@ -151,12 +146,47 @@ instance FromCanonicalCBOR V1 UtxoOut where
151146
t -> fail $ "Unknown UtxoOut tag: " <> show t
152147

153148
instance ToCanonicalCBOR V1 (Babbage.BabbageTxOut ConwayEra) where
154-
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) = E.encodeTag 0 <> toCanonicalCBOR v (cAddr, form)
155-
toCanonicalCBOR v (Babbage.TxOutCompactDH' cAddr form dataHash) = E.encodeTag 1 <> toCanonicalCBOR v (cAddr, form, dataHash)
156-
toCanonicalCBOR v (Babbage.TxOutCompactDatum cAddr form inlineDatum) = E.encodeTag 2 <> toCanonicalCBOR v (cAddr, form, inlineDatum)
157-
toCanonicalCBOR v (Babbage.TxOutCompactRefScript cAddr form datum script) = E.encodeTag 3 <> toCanonicalCBOR v (cAddr, form, datum, script)
158-
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly staking hash28 compact) = E.encodeTag 4 <> toCanonicalCBOR v (staking, hash28, compact)
159-
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 staking hash28 compact dataHash) = E.encodeTag 5 <> toCanonicalCBOR v (staking, hash28, compact, dataHash)
149+
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) =
150+
E.encodeMapLen 2
151+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
152+
<> E.encodeInt 1 <> toCanonicalCBOR v form
153+
toCanonicalCBOR v (Babbage.TxOutCompactDH' cAddr form datum) =
154+
E.encodeMapLen 3
155+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
156+
<> E.encodeInt 1 <> toCanonicalCBOR v form
157+
<> E.encodeInt 2
158+
<> case datum of
159+
hash_ -> toCanonicalCBOR v (0::Int, originalBytes hash_)
160+
toCanonicalCBOR v (Babbage.TxOutCompactDatum cAddr form inlineDatum) =
161+
E.encodeMapLen 3
162+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
163+
<> E.encodeInt 1 <> toCanonicalCBOR v form
164+
<> E.encodeInt 2
165+
<> case inlineDatum of
166+
binaryData -> toCanonicalCBOR v (1::Int, toCanonicalCBOR v (LedgerCBOR @V1 binaryData))
167+
toCanonicalCBOR v (Babbage.TxOutCompactRefScript cAddr form datum script) =
168+
let datumEncoding = case datum of
169+
NoDatum -> (Nothing)
170+
DatumHash dh -> Just (toCanonicalCBOR v (0::Int, originalBytes dh))
171+
Datum binaryData -> Just (toCanonicalCBOR v (1:: Int, toCanonicalCBOR v (LedgerCBOR @V1 binaryData)))
172+
in E.encodeMapLen (3 + (case datumEncoding of Just{} -> 1 ; Nothing -> 0))
173+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
174+
<> E.encodeInt 1 <> toCanonicalCBOR v form
175+
<> case datumEncoding of
176+
Nothing -> mempty
177+
Just enc -> E.encodeInt 2 <> enc
178+
<> E.encodeInt 3 <> toCanonicalCBOR v (LedgerCBOR @V1 script)
179+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly staking hash28 compactForm) =
180+
let cAddr = unCompactAddr (compactAddr (decodeAddress28 staking hash28))
181+
in E.encodeMapLen 2
182+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
183+
<> E.encodeInt 1 <> toCanonicalCBOR v compactForm
184+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 staking hash28 compact dataHash) =
185+
let cAddr = unCompactAddr (compactAddr (decodeAddress28 staking hash28))
186+
in E.encodeMapLen 3
187+
<> E.encodeInt 0 <> toCanonicalCBOR v cAddr
188+
<> E.encodeInt 1 <> toCanonicalCBOR v compact
189+
<> E.encodeInt 2 <> toCanonicalCBOR v (0::Int, dataHash)
160190

161191
instance FromCanonicalCBOR V1 (Babbage.BabbageTxOut ConwayEra) where
162192
fromCanonicalCBOR = do
@@ -170,12 +200,12 @@ instance FromCanonicalCBOR V1 (Babbage.BabbageTxOut ConwayEra) where
170200
t -> fail $ "Unknown BabbageTxOut tag: " <> show t
171201

172202
instance ToCanonicalCBOR V1 (Babbage.BabbageTxOut MaryEra) where
173-
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) = E.encodeTag 0 <> toCanonicalCBOR v (cAddr, form)
174-
toCanonicalCBOR v (Babbage.TxOutCompactDH' cAddr form dataHash) = E.encodeTag 1 <> toCanonicalCBOR v (cAddr, form, dataHash)
175-
toCanonicalCBOR v (Babbage.TxOutCompactDatum cAddr form inlineDatum) = E.encodeTag 2 <> toCanonicalCBOR v (cAddr, form, inlineDatum)
176-
toCanonicalCBOR v (Babbage.TxOutCompactRefScript cAddr form datum script) = E.encodeTag 3 <> toCanonicalCBOR v (cAddr, form, datum, script)
177-
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly staking hash28 compact) = E.encodeTag 4 <> toCanonicalCBOR v (staking, hash28, compact)
178-
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 staking hash28 compact dataHash) = E.encodeTag 5 <> toCanonicalCBOR v (staking, hash28, compact, dataHash)
203+
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) = E.encodeInt 0 <> toCanonicalCBOR v (cAddr, form)
204+
toCanonicalCBOR v (Babbage.TxOutCompactDH' cAddr form dataHash) = E.encodeInt 1 <> toCanonicalCBOR v (cAddr, form, dataHash)
205+
toCanonicalCBOR v (Babbage.TxOutCompactDatum cAddr form inlineDatum) = E.encodeInt 2 <> toCanonicalCBOR v (cAddr, form, inlineDatum)
206+
toCanonicalCBOR v (Babbage.TxOutCompactRefScript cAddr form datum script) = E.encodeInt 3 <> toCanonicalCBOR v (cAddr, form, datum, script)
207+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly staking hash28 compact) = E.encodeInt 4 <> toCanonicalCBOR v (staking, hash28, compact)
208+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 staking hash28 compact dataHash) = E.encodeInt 5 <> toCanonicalCBOR v (staking, hash28, compact, dataHash)
179209

180210
instance FromCanonicalCBOR V1 (Babbage.BabbageTxOut MaryEra) where
181211
fromCanonicalCBOR = do
@@ -209,7 +239,14 @@ deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)) instance ToCa
209239
deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)) instance FromCanonicalCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)
210240
deriving via (MemPackCBOR (AlonzoScript ConwayEra)) instance ToCanonicalCBOR V1 (AlonzoScript ConwayEra)
211241
deriving via (MemPackCBOR (AlonzoScript ConwayEra)) instance FromCanonicalCBOR V1 (AlonzoScript ConwayEra)
212-
deriving via (MemPackCBOR (CompactForm a)) instance (MemPack (CompactForm a)) => ToCanonicalCBOR V1 (CompactForm a)
242+
-- deriving via (MemPackCBOR (CompactForm a)) instance {-# OVERLAPPABLE #-} (MemPack (CompactForm a)) => ToCanonicalCBOR V1 (CompactForm a)
243+
244+
instance {-# OVERLAPPING #-} ToCanonicalCBOR version (CompactForm MaryValue) where
245+
toCanonicalCBOR version v = toCanonicalCBOR version (fromCompact v)
246+
247+
instance {-# OVERLAPPING #-} ToCanonicalCBOR v (CompactForm Coin) where
248+
toCanonicalCBOR v (Coin.CompactCoin ci) = toCanonicalCBOR v ci
249+
213250
deriving via (MemPackCBOR (CompactForm a)) instance (MemPack (CompactForm a)) => FromCanonicalCBOR V1 (CompactForm a)
214251
deriving via (MemPackCBOR CompactAddr) instance FromCanonicalCBOR V1 CompactAddr
215252
deriving via (MemPackCBOR CompactAddr) instance ToCanonicalCBOR V1 CompactAddr

‎libs/ledger-state/app-canonical/Main.hs‎

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -116,14 +116,13 @@ main = do
116116
(SlotNo 1)
117117
(defaultSerializationPlan & addChunks
118118
(S.each
119-
[ "utxo" S.:>
120-
S.each
119+
[ "utxo/v0" S.:>
120+
(S.each
121121
[ ChunkEntry
122122
(UtxoKeyIn txin)
123-
(RawBytes $ toStrictByteString $ toCanonicalCBOR (Proxy :: Proxy V1) $ txout
124-
)
123+
(RawBytes $ toStrictByteString $ toCanonicalCBOR (Proxy :: Proxy V1) $ UtxoOutBabbage txout)
125124
| (txin, txout) <- Map.toList utxo
126-
]
125+
])
127126
]))
128127

129128
data TxIn' = TxIn' TxId Word16

0 commit comments

Comments
 (0)