Skip to content

Commit 02e34f6

Browse files
qnikstqnikst
committed
WIP
1 parent 4b8d55d commit 02e34f6

File tree

3 files changed

+202
-0
lines changed

3 files changed

+202
-0
lines changed

‎cabal.project‎

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -96,3 +96,27 @@ if impl(ghc >=9.12)
9696
allow-newer:
9797
-- Unique: https://github.com/kapralVV/Unique/issues/11
9898
, Unique:hashable
99+
100+
source-repository-package
101+
type: git
102+
location: https://github.com/tweag/cardano-canonical-ledger.git
103+
subdir: scls-cbor
104+
allow-older:
105+
, merkle-tree-incremental:bytestring
106+
tag: 1e4d0ae357ca9a215653aa46784644dd1407101d
107+
108+
source-repository-package
109+
type: git
110+
location: https://github.com/tweag/cardano-canonical-ledger.git
111+
subdir: scls-format
112+
allow-older:
113+
, merkle-tree-incremental:bytestring
114+
tag: 1e4d0ae357ca9a215653aa46784644dd1407101d
115+
116+
source-repository-package
117+
type: git
118+
location: https://github.com/tweag/cardano-canonical-ledger.git
119+
subdir: merkle-tree-incremental
120+
allow-older:
121+
, bytestring
122+
tag: 1e4d0ae357ca9a215653aa46784644dd1407101d

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

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -206,6 +206,54 @@ library testlib
206206
text,
207207
time,
208208

209+
library scls-export
210+
exposed-modules:
211+
Cardano.Ledger.Export.Namespace.UTxO
212+
visibility: public
213+
hs-source-dirs: scls-export
214+
default-language: Haskell2010
215+
ghc-options:
216+
-Wall
217+
-Wcompat
218+
-Wincomplete-record-updates
219+
-Wincomplete-uni-patterns
220+
-Wpartial-fields
221+
-Wredundant-constraints
222+
-Wunused-packages
223+
224+
build-depends:
225+
-- cardano-data:{cardano-data},
226+
cardano-ledger-allegra,
227+
cardano-ledger-alonzo:{cardano-ledger-alonzo},
228+
cardano-ledger-babbage:{cardano-ledger-babbage},
229+
cardano-ledger-binary:{cardano-ledger-binary},
230+
cardano-ledger-byron:{cardano-ledger-byron},
231+
-- cardano-ledger-conway,
232+
cardano-ledger-core:{cardano-ledger-core},
233+
cardano-ledger-mary:{cardano-ledger-mary},
234+
cardano-ledger-shelley:{cardano-ledger-shelley},
235+
-- cardano-slotting:{cardano-slotting},
236+
-- cardano-strict-containers,
237+
cborg,
238+
-- containers,
239+
-- cuddle >=0.4,
240+
-- data-default,
241+
-- deepseq,
242+
-- generic-random,
243+
-- heredoc,
244+
-- kmicrolens,
245+
mempack,
246+
-- microlens-mtl,
247+
-- mtl,
248+
-- plutus-ledger-api,
249+
-- prettyprinter,
250+
-- small-steps >=1.1,
251+
-- text,
252+
base,
253+
scls-cbor,
254+
scls-format,
255+
-- time
256+
209257
executable huddle-cddl
210258
main-is: Main.hs
211259
hs-source-dirs: huddle-cddl

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

Lines changed: 130 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE RecordWildCards #-}
3+
{-# LANGUAGE MultiParamTypeClasses #-}
4+
{-# LANGUAGE FlexibleInstances #-}
5+
{-# LANGUAGE FlexibleContexts #-}
6+
{-# OPTIONS_GHC -Wno-orphans #-}
7+
-- | UTxO namespace export.
8+
module Cardano.Ledger.Export.Namespace.UTxO
9+
( UtxoIn(..)
10+
, UtxoOut(..)
11+
) where
12+
13+
import Cardano.SCLS.CBOR.Canonical.Encoder
14+
import Cardano.Ledger.Binary
15+
import Cardano.SCLS.CBOR.Canonical.Decoder
16+
-- import Cardano.Ledger.Binary.Version
17+
import Cardano.Ledger.Compactible
18+
import Cardano.Ledger.Address
19+
import Cardano.Ledger.Credential
20+
import Cardano.Ledger.Keys
21+
import Cardano.Ledger.Hashes
22+
-- import Cardano.Ledger.Coin
23+
import Cardano.Ledger.Plutus.Data (Datum(..))
24+
import Cardano.Ledger.Plutus.Data (BinaryData)
25+
import Cardano.Ledger.Mary (MaryEra)
26+
-- import Cardano.Ledger
27+
import Cardano.SCLS.Internal.Version
28+
-- import Cardano.Ledger.Mary.Value (MaryValue)
29+
import Data.Typeable (Typeable)
30+
import qualified Cardano.Ledger.Shelley.TxOut as Shelley
31+
import qualified Cardano.Ledger.Babbage.TxOut as Babbage
32+
import Cardano.Ledger.Allegra.Scripts (Timelock(..))
33+
import Data.MemPack
34+
import qualified Codec.CBOR.Encoding as E
35+
import Data.Word (Word8, Word16)
36+
import Cardano.Ledger.Alonzo.TxOut (DataHash32, Addr28Extra)
37+
38+
-- | Input wrapper for the keys that are used in utxo namespace
39+
data UtxoIn = UtxoIn { utxoInAddress :: DataHash32, utxoInIndex :: Word16 }
40+
41+
-- | Output key that is used in utxo namespace
42+
--
43+
-- Here we follow the current spec, but after benchmarks we can decide that this representation
44+
-- is not efficient and we can replace it with the implementation based on the compact values
45+
data UtxoOut
46+
= UtxoOutShelley (Shelley.ShelleyTxOut MaryEra)
47+
| UtxoOutBabbage (Babbage.BabbageTxOut MaryEra)
48+
49+
instance ToCanonicalCBOR V1 UtxoIn where
50+
toCanonicalCBOR v UtxoIn{..} = toCanonicalCBOR v (utxoInAddress, utxoInIndex)
51+
52+
instance FromCanonicalCBOR V1 UtxoIn where
53+
fromCanonicalCBOR = do
54+
fmap (uncurry UtxoIn) <$> fromCanonicalCBOR
55+
56+
instance ToCanonicalCBOR V1 UtxoOut where
57+
toCanonicalCBOR v (UtxoOutShelley shelleyOut) = toCanonicalCBOR v (1::Word8, shelleyOut)
58+
toCanonicalCBOR v (UtxoOutBabbage babbageOut) = toCanonicalCBOR v (2::Word8, babbageOut)
59+
60+
instance FromCanonicalCBOR V1 UtxoOut where
61+
fromCanonicalCBOR = do
62+
tag <- fromCanonicalCBOR
63+
case unVer tag :: Word8 of
64+
1 -> fmap UtxoOutShelley <$> fromCanonicalCBOR
65+
2 -> fmap UtxoOutBabbage <$> fromCanonicalCBOR
66+
t -> fail $ "Unknown UtxoOut tag: " <> show t
67+
68+
instance ToCanonicalCBOR V1 (Shelley.ShelleyTxOut MaryEra) where
69+
toCanonicalCBOR v (Shelley.TxOutCompact cAddr cValue) =
70+
toCanonicalCBOR v (cAddr, cValue) -- TODO: differ from spec as it uses compact representation
71+
instance FromCanonicalCBOR V1 (Shelley.ShelleyTxOut MaryEra) where
72+
fromCanonicalCBOR = undefined -- fmap (uncurry Shelley.TxOutCompact) <$> fromCanonicalCBOR
73+
74+
instance ToCanonicalCBOR V1 (Babbage.BabbageTxOut MaryEra) where
75+
toCanonicalCBOR v (Babbage.TxOutCompact' cAddr form) = toCanonicalCBOR v (cAddr, form)
76+
toCanonicalCBOR v (Babbage.TxOutCompactDH' cAddr form dataHash) = toCanonicalCBOR v (cAddr, form, dataHash)
77+
toCanonicalCBOR v (Babbage.TxOutCompactDatum cAddr form inlineDatum) = toCanonicalCBOR v (cAddr, form, inlineDatum)
78+
toCanonicalCBOR v (Babbage.TxOutCompactRefScript cAddr form datum script) = toCanonicalCBOR v (cAddr, form, datum, script)
79+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly staking hash28 compact) = toCanonicalCBOR v (staking, hash28, compact)
80+
toCanonicalCBOR v (Babbage.TxOut_AddrHash28_AdaOnly_DataHash32 staking hash28 compact dataHash) = toCanonicalCBOR v (staking, hash28, compact, dataHash)
81+
82+
instance FromCanonicalCBOR V1 (Babbage.BabbageTxOut MaryEra) where
83+
fromCanonicalCBOR = undefined
84+
-- Versioned (addr, value, mDataHash) <- fromCanonicalCBOR
85+
-- pure $! Versioned (Babbage.TxOutCompact addr value mDataHash)
86+
87+
instance EncCBOR (CompactForm a) => ToCanonicalCBOR V1 (CompactForm a) where
88+
toCanonicalCBOR _ a = toPlainEncoding shelleyProtVer (encCBOR a)
89+
90+
instance ToCanonicalCBOR V1 (CompactAddr) where
91+
toCanonicalCBOR v s = toCanonicalCBOR v (unCompactAddr s)
92+
93+
instance FromCanonicalCBOR V1 (CompactAddr) where
94+
fromCanonicalCBOR = undefined
95+
96+
instance ToCanonicalCBOR V1 DataHash32 where
97+
toCanonicalCBOR _ hash32 = E.encodeBytes $ packByteString hash32
98+
99+
instance FromCanonicalCBOR V1 DataHash32 where
100+
fromCanonicalCBOR = undefined
101+
{-
102+
Versioned bytes <- fromCanonicalCBOR
103+
case decodeDataHash32 (bytes) of
104+
dh -> pure $! Versioned (encodeDataHash32 dh)
105+
-}
106+
107+
instance Typeable kr => ToCanonicalCBOR V1 (Credential kr) where
108+
toCanonicalCBOR v (ScriptHashObj sh) = toCanonicalCBOR v (0::Word8, sh)
109+
toCanonicalCBOR v (KeyHashObj kh) = toCanonicalCBOR v (1::Word8, kh)
110+
111+
instance Typeable kr => ToCanonicalCBOR V1 (KeyHash kr) where
112+
toCanonicalCBOR _ = toPlainEncoding shelleyProtVer . encCBOR
113+
114+
instance ToCanonicalCBOR V1 ScriptHash where
115+
toCanonicalCBOR _ = toPlainEncoding shelleyProtVer . encCBOR
116+
117+
instance ToCanonicalCBOR V1 Addr28Extra where
118+
toCanonicalCBOR _ = E.encodeBytes . packByteString
119+
120+
instance ToCanonicalCBOR V1 (Timelock MaryEra) where
121+
toCanonicalCBOR _v = toPlainEncoding shelleyProtVer . encCBOR
122+
123+
instance ToCanonicalCBOR V1 (Datum MaryEra) where
124+
toCanonicalCBOR _v = toPlainEncoding shelleyProtVer . encCBOR
125+
126+
instance ToCanonicalCBOR V1 (BinaryData MaryEra) where
127+
toCanonicalCBOR _v = toPlainEncoding shelleyProtVer . encCBOR
128+
129+
instance ToCanonicalCBOR V1 (SafeHash EraIndependentData) where
130+
toCanonicalCBOR _v = toPlainEncoding shelleyProtVer . encCBOR

0 commit comments

Comments
 (0)