Skip to content

Commit b68c914

Browse files
qnikstqnikst
committed
WIP
1 parent 1ae6a65 commit b68c914

File tree

7 files changed

+90
-55
lines changed

7 files changed

+90
-55
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: 7e0344dad0ff156d4a3932f1c73dc54379a50c51
104+
tag: 09f2b80d6d0c7419053e3f9e70ff57acbcff0eec
105105

106106
source-repository-package
107107
type: git
108108
location: https://github.com/tweag/cardano-canonical-ledger.git
109109
subdir: scls-format
110-
tag: 7e0344dad0ff156d4a3932f1c73dc54379a50c51
110+
tag: 09f2b80d6d0c7419053e3f9e70ff57acbcff0eec
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: 7e0344dad0ff156d4a3932f1c73dc54379a50c51
116+
tag: 09f2b80d6d0c7419053e3f9e70ff57acbcff0eec

‎eras/conway/impl/cardano-ledger-conway.cabal‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -227,8 +227,8 @@ library scls-export
227227
cardano-ledger-alonzo:{cardano-ledger-alonzo},
228228
cardano-ledger-babbage:{cardano-ledger-babbage},
229229
cardano-ledger-binary:{cardano-ledger-binary},
230-
cardano-ledger-byron:{cardano-ledger-byron},
231-
-- cardano-ledger-conway:{cardano-ledger-conway},
230+
-- cardano-ledger-byron:{cardano-ledger-byron},
231+
cardano-ledger-conway:{cardano-ledger-conway},
232232
cardano-ledger-core:{cardano-ledger-core},
233233
cardano-ledger-mary:{cardano-ledger-mary},
234234
cardano-ledger-shelley:{cardano-ledger-shelley},

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

Lines changed: 63 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
{-# LANGUAGE FlexibleInstances #-}
88
{-# LANGUAGE FlexibleContexts #-}
99
{-# LANGUAGE KindSignatures #-}
10+
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1011
{-# OPTIONS_GHC -Wno-orphans #-}
1112
-- | UTxO namespace export.
1213
module Cardano.Ledger.Export.Namespace.UTxO
@@ -24,7 +25,10 @@ import Cardano.Ledger.Binary (decodeMemPack, encodeMemPack, EncCBOR(..), DecCBOR
2425
import Cardano.SCLS.CBOR.Canonical.Decoder
2526
import qualified Codec.CBOR.Encoding as E
2627
import qualified Codec.CBOR.Decoding as D
27-
import Cardano.Chain.UTxO (TxIn(..))
28+
import Cardano.Ledger.Conway (ConwayEra)
29+
import Cardano.Ledger.TxIn (TxIn(..))
30+
import Cardano.Ledger.Core (TxOut(..))
31+
-- import Cardano.Ledger.TxOut (TxOut(..))
2832
import Cardano.Ledger.Compactible
2933
import Cardano.Ledger.Address
3034
import Cardano.Ledger.Credential
@@ -33,6 +37,7 @@ import Cardano.Ledger.Hashes
3337
import Cardano.Ledger.Plutus.Data (Datum(..))
3438
import Cardano.Ledger.Plutus.Data (BinaryData)
3539
import Cardano.Ledger.Mary (MaryEra, MaryValue)
40+
import Cardano.SCLS.Internal.Entry
3641
import Cardano.SCLS.Internal.Version
3742
import Data.Typeable (Typeable)
3843
import qualified Cardano.Ledger.Shelley.TxOut as Shelley
@@ -41,7 +46,7 @@ import Cardano.Ledger.Allegra.Scripts (Timelock(..))
4146
import Data.MemPack
4247
import Data.Word (Word8, Word16)
4348
import Cardano.Ledger.Alonzo.TxOut (DataHash32, Addr28Extra)
44-
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose, AsItem)
49+
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose, AsItem, AlonzoScript)
4550

4651
-- | Helper that allows us to deriving instances via internal CBOR representation
4752
newtype LedgerCBOR (v::Version) a = LedgerCBOR { unLedgerCBOR :: a }
@@ -65,7 +70,34 @@ instance (MemPack a) => FromCanonicalCBOR V1 (MemPackCBOR a) where
6570
-- | Input wrapper for the keys that are used in utxo namespace
6671
data UtxoKey
6772
= UtxoKeyIn TxIn
68-
| UtxoKeyScript ScriptUtxoIn
73+
-- | UtxoKeyScript ScriptUtxoIn
74+
75+
instance Eq UtxoKey where
76+
(UtxoKeyIn txIn1) == (UtxoKeyIn txIn2) = txIn1 == txIn2
77+
-- (UtxoKeyScript script1) == (UtxoKeyScript script2) = undefined script1 script2
78+
-- _ == _ = False
79+
80+
instance Ord UtxoKey where
81+
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
85+
86+
instance IsKey UtxoKey where
87+
keySize = 34
88+
packKeyM (UtxoKeyIn (TxIn a b)) = do
89+
packM a
90+
packM b
91+
-- packKeyM (UtxoKeyScript (ScriptUtxoIn purpose hash)) = do
92+
-- undefined purpose hash
93+
unpackKeyM = do
94+
a <- unpackM
95+
b <- unpackM
96+
return $ UtxoKeyIn (TxIn a b)
97+
-- toKeyBytes v key = toStrictByteString $ toCanonicalCBOR v key
98+
99+
newtype Out = Out (TxOut ConwayEra)
100+
deriving newtype (ToCanonicalCBOR V1, FromCanonicalCBOR V1)
69101

70102
data AddrUtxoIn = AddrUtxoIn { addrUtxoInAddress :: DataHash32, addrUtxoInIndex :: Word16 }
71103
data ScriptUtxoIn = ScriptUtxoIn { scriptUtxoInPurpose :: AlonzoPlutusPurpose AsItem MaryEra, scriptUtxoInHash :: ScriptHash }
@@ -81,7 +113,7 @@ data UtxoOut
81113

82114
instance ToCanonicalCBOR V1 UtxoKey where
83115
toCanonicalCBOR v (UtxoKeyIn txIn) = E.encodeTag 0 <> toCanonicalCBOR v txIn
84-
toCanonicalCBOR v (UtxoKeyScript script) = E.encodeTag 1 <> toCanonicalCBOR v script
116+
-- toCanonicalCBOR v (UtxoKeyScript script) = E.encodeTag 1 <> toCanonicalCBOR v script
85117

86118

87119
instance ToCanonicalCBOR V1 AddrUtxoIn where
@@ -101,7 +133,7 @@ instance FromCanonicalCBOR V1 UtxoKey where
101133
tag <- fromCanonicalCBOR
102134
case unVer tag :: Word8 of
103135
0 -> fmap UtxoKeyIn <$> fromCanonicalCBOR
104-
1 -> fmap UtxoKeyScript <$> fromCanonicalCBOR
136+
-- 1 -> fmap UtxoKeyScript <$> fromCanonicalCBOR
105137
_ -> fail "Unknown UtxoKey tag"
106138

107139
instance ToCanonicalCBOR V1 UtxoOut where
@@ -118,6 +150,24 @@ instance FromCanonicalCBOR V1 UtxoOut where
118150
3 -> fmap UtxoValue <$> fromCanonicalCBOR
119151
t -> fail $ "Unknown UtxoOut tag: " <> show t
120152

153+
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)
160+
161+
instance FromCanonicalCBOR V1 (Babbage.BabbageTxOut ConwayEra) where
162+
fromCanonicalCBOR = do
163+
D.decodeTag >>= \case
164+
0 -> fmap (\(c, f) -> Babbage.TxOutCompact' c f) <$> fromCanonicalCBOR
165+
1 -> fmap (\(a,b,c) -> Babbage.TxOutCompactDH' a b c) <$> fromCanonicalCBOR
166+
2 -> fmap (\(a,b,c) -> Babbage.TxOutCompactDatum a b c) <$> fromCanonicalCBOR
167+
3 -> fmap (\(a,b,c,d) -> Babbage.TxOutCompactRefScript a b c d) <$> fromCanonicalCBOR
168+
4 -> fmap (\(a,b,c) -> Babbage.TxOut_AddrHash28_AdaOnly a b c) <$> fromCanonicalCBOR
169+
5 -> fmap (\(a,b,c,d) -> Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 a b c d) <$> fromCanonicalCBOR
170+
t -> fail $ "Unknown BabbageTxOut tag: " <> show t
121171

122172
instance ToCanonicalCBOR V1 (Babbage.BabbageTxOut MaryEra) where
123173
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) = E.encodeTag 0 <> toCanonicalCBOR v (cAddr, form)
@@ -155,6 +205,10 @@ deriving via (LedgerCBOR v (Shelley.ShelleyTxOut MaryEra)) instance ToCanonicalC
155205
deriving via (LedgerCBOR v (Shelley.ShelleyTxOut MaryEra)) instance FromCanonicalCBOR v (Shelley.ShelleyTxOut MaryEra)
156206
deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem MaryEra)) instance ToCanonicalCBOR v (AlonzoPlutusPurpose AsItem MaryEra)
157207
deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem MaryEra)) instance FromCanonicalCBOR v (AlonzoPlutusPurpose AsItem MaryEra)
208+
deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)) instance ToCanonicalCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)
209+
deriving via (LedgerCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)) instance FromCanonicalCBOR v (AlonzoPlutusPurpose AsItem ConwayEra)
210+
deriving via (MemPackCBOR (AlonzoScript ConwayEra)) instance ToCanonicalCBOR V1 (AlonzoScript ConwayEra)
211+
deriving via (MemPackCBOR (AlonzoScript ConwayEra)) instance FromCanonicalCBOR V1 (AlonzoScript ConwayEra)
158212
deriving via (MemPackCBOR (CompactForm a)) instance (MemPack (CompactForm a)) => ToCanonicalCBOR V1 (CompactForm a)
159213
deriving via (MemPackCBOR (CompactForm a)) instance (MemPack (CompactForm a)) => FromCanonicalCBOR V1 (CompactForm a)
160214
deriving via (MemPackCBOR CompactAddr) instance FromCanonicalCBOR V1 CompactAddr
@@ -177,8 +231,12 @@ deriving via (LedgerCBOR v (ScriptHash)) instance FromCanonicalCBOR v ScriptHash
177231
deriving via (LedgerCBOR v (ScriptHash)) instance ToCanonicalCBOR v ScriptHash
178232
deriving via (LedgerCBOR v (Datum MaryEra)) instance ToCanonicalCBOR v (Datum MaryEra)
179233
deriving via (LedgerCBOR v (Datum MaryEra)) instance FromCanonicalCBOR v (Datum MaryEra)
234+
deriving via (LedgerCBOR v (Datum ConwayEra)) instance ToCanonicalCBOR v (Datum ConwayEra)
235+
deriving via (LedgerCBOR v (Datum ConwayEra)) instance FromCanonicalCBOR v (Datum ConwayEra)
180236
deriving via (LedgerCBOR v (BinaryData MaryEra)) instance ToCanonicalCBOR v (BinaryData MaryEra)
181237
deriving via (LedgerCBOR v (BinaryData MaryEra)) instance FromCanonicalCBOR v (BinaryData MaryEra)
238+
deriving via (LedgerCBOR v (BinaryData ConwayEra)) instance ToCanonicalCBOR v (BinaryData ConwayEra)
239+
deriving via (LedgerCBOR v (BinaryData ConwayEra)) instance FromCanonicalCBOR v (BinaryData ConwayEra)
182240
deriving via (LedgerCBOR v (SafeHash EraIndependentData)) instance ToCanonicalCBOR v ((SafeHash EraIndependentData))
183241
deriving via (LedgerCBOR v (SafeHash EraIndependentData)) instance FromCanonicalCBOR v ((SafeHash EraIndependentData))
184242

‎libs/cardano-ledger-test/bench/Bench/Cardano/Ledger/StakeDistr.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -108,6 +108,9 @@ readNewEpochState = do
108108
case Plain.decodeFullDecoder lbl fromCBOR lazyBytes of
109109
Left err -> error (show err)
110110
Right (nes :: NewEpochState CurrentEra) -> pure nes
111+
-- case Aeson.eitherDecode lazyBytes of
112+
-- Left err -> error (show err)
113+
-- Right (nes :: NewEpochState CurrentEra) -> pure nes
111114
Nothing ->
112115
bogusNewEpochState <$ do
113116
putStrLn $

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

Lines changed: 15 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -2,12 +2,16 @@
22
{-# LANGUAGE DataKinds #-}
33
{-# LANGUAGE BangPatterns #-}
44
{-# LANGUAGE PackageImports #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
56
{-# LANGUAGE OverloadedStrings #-}
7+
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
8+
{-# OPTIONS_GHC -fno-warn-deprecations #-}
69
module Main where
710

811
-- import Cardano.Ledger.Shelley.LedgerState
912
-- import Cardano.Ledger.State.Query
1013
-- import Cardano.Ledger.State.UTxO
14+
1115
import Control.Exception (throwIO)
1216
import Data.Bifunctor (first)
1317
import Control.Monad
@@ -18,7 +22,9 @@ import Cardano.Ledger.Mary (MaryEra)
1822
import qualified Data.ByteString.Base16.Lazy as Base16
1923
import Cardano.Ledger.Binary.Plain as Plain
2024
import Options.Applicative
25+
import Cardano.Ledger.Api.Era
2126
import Cardano.Ledger.Export.Namespace.UTxO
27+
import Cardano.Ledger.State -- Core (UTxO (..))
2228
-- import Cardano.Ledger.UTxO
2329
-- import Cardano.Ledger.State.UTxO (CurrentEra) -- , readHexUTxO, readNewEpochState)
2430
import Cardano.Chain.UTxO (TxIn, TxId) -- , TxOut)
@@ -31,7 +37,11 @@ import Data.Word (Word16)
3137
-- import qualified GHC.Exts as GHC
3238
import qualified GHC.Generics as GHC
3339

40+
import Cardano.Ledger.Export.Namespace.UTxO
41+
-- import Cardano.Ledger.Conway.Era
42+
3443
import qualified Cardano.SCLS.Internal.Serializer.External.Impl as External (serialize)
44+
import Cardano.SCLS.Internal.Entry
3545
import Cardano.SCLS.Internal.Serializer.MemPack
3646
import Cardano.Types.Network (NetworkId (..))
3747
import Cardano.Types.SlotNo (SlotNo (..))
@@ -94,11 +104,7 @@ main = do
94104
CmdCreateFile utxoFilePath _outputFile -> do
95105
putStrLn "Creating file..."
96106
putStrLn $ "Reading UTxO from " ++ utxoFilePath
97-
UTxO utxo <- localReadHexUTxO utxoFilePath
98-
99-
for_ (Map.toList utxo) $ \(tin, txout) -> do
100-
putStrLn $ show tin ++ " -> " ++ show txout
101-
print $ toCanonicalCBOR (Proxy :: Proxy V1) $ UtxoKeyIn tin
107+
UTxO utxo <- localReadDecCBORHex utxoFilePath
102108

103109
let fileName = "scls-utxo.scls"
104110

@@ -109,56 +115,22 @@ main = do
109115
$ S.each
110116
[ "utxo" S.:>
111117
S.each
112-
[ RawBytes $ toStrictByteString $ toCanonicalCBOR (Proxy :: Proxy V1)
113-
( toCanonicalCBOR (Proxy :: Proxy V1) $ UtxoKeyIn txin
114-
-- , toCanonicalCBOR (Proxy :: Proxy V1) $ UtxoOutShelley txout
115-
, toCanonicalCBOR (Proxy :: Proxy V1) $ UtxoOutBabbage txout
118+
[ ChunkEntry
119+
(UtxoKeyIn txin)
120+
(RawBytes $ toStrictByteString $ toCanonicalCBOR (Proxy :: Proxy V1) $ txout
116121
)
117122
| (txin, txout) <- Map.toList utxo
118123
]
119124
]
120125

121-
-- newtype UTxO = UTxO { unUTxO :: Map.Map TxIn (Shelley.ShelleyTxOut MaryEra) }
122-
-- deriving (Eq, Show)
123-
124-
newtype UTxO = UTxO { unUTxO :: Map.Map TxIn (Babbage.BabbageTxOut MaryEra) }
125-
deriving (Eq, Show)
126-
127126
data TxIn' = TxIn' TxId Word16
128127

129128
instance FromCBOR TxIn' where
130129
fromCBOR = decodeRecordNamed "TxIn"
131130
(const 2)
132131
(TxIn' <$> fromCBOR <*> fromCBOR)
133132

134-
instance FromCBOR UTxO where
135-
fromCBOR = do
136-
() <- Plain.decodeMapLenIndef
137-
asList <-
138-
Plain.decodeSequenceLenIndef
139-
(\acc x -> x : acc)
140-
[]
141-
id
142-
decodeEntry
143-
pure $ UTxO $ Map.fromList asList
144-
where
145-
decodeEntry = do
146-
traceM "Decoding entry"
147-
TxIn' i w <- fromCBOR
148-
let txin = GHC.to (GHC.M1 (GHC.M1 (GHC.M1 (GHC.K1 i) GHC.:*: GHC.M1 (GHC.K1 w))))
149-
traceM (show txin)
150-
traceM " about to decode txout"
151-
txout <- fromCBOR
152-
traceM ("TxOut: " ++ show txout)
153-
pure (txin, txout)
154-
155-
localReadHexUTxO ::
156-
FilePath ->
157-
IO UTxO
158-
localReadHexUTxO = localReadDecCBORHex
159-
160-
161-
localReadDecCBORHex :: FromCBOR a => FilePath -> IO a
133+
localReadDecCBORHex :: FilePath -> IO (UTxO ConwayEra)
162134
localReadDecCBORHex = either throwIO pure . decodeFullHex <=< LBS.readFile
163135
where
164136
decodeFullHex =

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -79,6 +79,7 @@ main = do
7979
)
8080
(header "ledger-state - Tool for analyzing ledger state")
8181
forM_ (optsNewEpochStateBinaryFile opts) $ \binFp -> do
82+
putStrLn $ "Reading NewEpochState from " ++ binFp
8283
nes <- readNewEpochState binFp
8384
case optsSqliteDbFile opts of
8485
Nothing -> printNewEpochStateStats $ countNewEpochStateStats nes

‎libs/ledger-state/ledger-state.cabal‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -92,7 +92,6 @@ executable canonical-ledger
9292
-Wincomplete-record-updates
9393
-Wincomplete-uni-patterns
9494
-Wredundant-constraints
95-
-Wunused-packages
9695
-O2
9796
-threaded
9897
-rtsopts
@@ -103,9 +102,11 @@ executable canonical-ledger
103102
cardano-ledger-shelley:{cardano-ledger-shelley},
104103
cardano-ledger-babbage:{cardano-ledger-babbage},
105104
cardano-ledger-byron:{cardano-ledger-byron},
106-
cardano-ledger-conway:{scls-export},
105+
cardano-ledger-conway:{scls-export,cardano-ledger-conway},
107106
cardano-ledger-mary:{cardano-ledger-mary},
107+
cardano-ledger-api,
108108
cardano-ledger-binary,
109+
cardano-ledger-core,
109110
-- cardano-ledger-core,
110111
-- ledger-state,
111112
base16-bytestring,

0 commit comments

Comments
 (0)