decodeSparseKeyed for more types #5847
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -56,6 +56,7 @@ module Cardano.Ledger.Alonzo.TxWits ( | |
| ) where | ||
|
|
||
| import Cardano.Base.Proxy (asProxy) | ||
| import Cardano.Base.Typeable (TypeName (TypeName)) | ||
| import Cardano.Ledger.Alonzo.Era (AlonzoEra) | ||
| import Cardano.Ledger.Alonzo.Scripts ( | ||
| AlonzoEraScript (..), | ||
|
|
@@ -75,6 +76,7 @@ import Cardano.Ledger.Binary ( | |
| ToCBOR (..), | ||
| TokenType (..), | ||
| allowTag, | ||
| decodeAccA, | ||
| decodeList, | ||
| decodeListLenOrIndef, | ||
| decodeListLikeWithCount, | ||
|
|
@@ -83,6 +85,7 @@ import Cardano.Ledger.Binary ( | |
| decodeNonEmptyList, | ||
| decodeNonEmptySetLikeEnforceNoDuplicates, | ||
| decodeNonEmptySetLikeEnforceNoDuplicatesAnn, | ||
| decodeSparseKeyed, | ||
| encodeFoldableEncoder, | ||
| encodeListLen, | ||
| encodeTag, | ||
|
|
@@ -129,8 +132,10 @@ import qualified Data.Map.Strict as Map | |
| import Data.MapExtras (fromElems) | ||
| import qualified Data.MapExtras as Map (fromElems) | ||
| import Data.Maybe (mapMaybe) | ||
| import Data.Proxy (Proxy (..)) | ||
| import Data.Set (Set) | ||
| import qualified Data.Set as Set | ||
| import Data.Typeable (typeRep) | ||
| import GHC.Generics (Generic) | ||
| import Lens.Micro | ||
| import NoThunks.Class (NoThunks) | ||
|
|
@@ -601,13 +606,12 @@ instance | |
| DecCBOR (Annotator (AlonzoTxWitsRaw era)) | ||
| where | ||
| decCBOR = | ||
| ifDecoderVersionAtLeast | ||
| (natVersion @12) | ||
| (decodeSparseKeyed TypeName [] (pure emptyTxWitsRaw) decoderByKey) | ||
| (decode $ SparseKeyed name (pure emptyTxWitsRaw) txWitnessField []) | ||
| where | ||
| name = show . typeRep $ Proxy @(AlonzoTxWitsRaw era) | ||
| addrWitsSetDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a) | ||
| addrWitsSetDecoder = do | ||
| let | ||
|
|
@@ -621,6 +625,30 @@ instance | |
| ifDecoderVersionAtLeast (natVersion @12) nonEmptyNoDuplicatesDecoder nonEmptyDecoder | ||
| {-# INLINE addrWitsSetDecoder #-} | ||
|
|
||
| setOrListWitsDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a) | ||
| setOrListWitsDecoder = | ||
| ifDecoderVersionAtLeast | ||
| (natVersion @9) | ||
| addrWitsSetDecoder | ||
| (Set.fromList <$> decodeList decCBOR) | ||
| {-# INLINE setOrListWitsDecoder #-} | ||
|
|
||
| decoderByKey :: | ||
| Annotator (AlonzoTxWitsRaw era) -> | ||
| Word -> | ||
| Maybe (Decoder s (Annotator (AlonzoTxWitsRaw era))) | ||
| decoderByKey acc = \case | ||
| 0 -> Just $ decodeAccA acc (\x w -> w {atwrAddrTxWits = x}) (pure <$> setOrListWitsDecoder) | ||
| 1 -> Just $ decodeAccA acc addScriptsTxWitsRaw nativeScriptsDecoder | ||
| 2 -> Just $ decodeAccA acc (\x w -> w {atwrBootAddrTxWits = x}) (pure <$> setOrListWitsDecoder) | ||
| 3 -> Just $ decodeAccA acc addScriptsTxWitsRaw (pure <$> alonzoPlutusScriptDecoder SPlutusV1) | ||
| 4 -> Just $ decodeAccA acc (\x w -> w {atwrDatsTxWits = x}) decCBOR | ||
| 5 -> Just $ decodeAccA acc (\x w -> w {atwrRdmrsTxWits = x}) decCBOR | ||
| 6 -> Just $ decodeAccA acc addScriptsTxWitsRaw (pure <$> alonzoPlutusScriptDecoder SPlutusV2) | ||
| 7 -> Just $ decodeAccA acc addScriptsTxWitsRaw (pure <$> alonzoPlutusScriptDecoder SPlutusV3) | ||
| _ -> Nothing | ||
| {-# INLINE decoderByKey #-} | ||
|
|
||
| txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era)) | ||
| txWitnessField 0 = | ||
| fieldA | ||
|
|
@@ -698,14 +726,20 @@ decodeAlonzoPlutusScript :: | |
| (AlonzoEraScript era, PlutusLanguage l) => | ||
| SLanguage l -> | ||
| Decode (Closed Dense) (Map ScriptHash (Script era)) | ||
| decodeAlonzoPlutusScript slang = D (alonzoPlutusScriptDecoder slang) | ||
| {-# INLINE decodeAlonzoPlutusScript #-} | ||
|
|
||
| alonzoPlutusScriptDecoder :: | ||
| (AlonzoEraScript era, PlutusLanguage l) => | ||
| SLanguage l -> | ||
| Decoder s (Map ScriptHash (Script era)) | ||
| alonzoPlutusScriptDecoder slang = | ||
| ifDecoderVersionAtLeast | ||
| (natVersion @9) | ||
| (scriptDecoderV9 (fromPlutusScript <$> decodePlutusScript slang)) | ||
| (scriptDecoder (fromPlutusScript <$> decodePlutusScript slang)) | ||
| {-# INLINE alonzoPlutusScriptDecoder #-} | ||
|
|
||
| scriptDecoderV9 :: | ||
| EraScript era => | ||
| Decoder s (Script era) -> | ||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change | ||||
|---|---|---|---|---|---|---|
|
|
@@ -15,16 +15,18 @@ module Test.Cardano.Ledger.Alonzo.Binary.Golden ( | |||||
| ) where | ||||||
|
|
||||||
| import Cardano.Ledger.Alonzo.Core (EraTxWits (..), ShelleyEraTxCert) | ||||||
| import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWitsRaw) | ||||||
| import Cardano.Ledger.Binary ( | ||||||
| Annotator, | ||||||
| DecoderError (..), | ||||||
| DeserialiseFailure (..), | ||||||
| Tokens (..), | ||||||
| Version, | ||||||
| natVersion, | ||||||
| ) | ||||||
| import qualified Cardano.Ledger.Binary as Binary | ||||||
| import Cardano.Ledger.MemoBytes (EqRaw (..)) | ||||||
| import Data.Data (Proxy (..), typeRep) | ||||||
| import Data.Void (Void) | ||||||
| import Test.Cardano.Ledger.Allegra.Binary.Golden hiding (spec) | ||||||
| import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest) | ||||||
|
|
@@ -77,13 +79,16 @@ txWitsDecodingFailsOnInvalidField version validFields = | |||||
| DecoderErrorDeserialiseFailure | ||||||
| lbl | ||||||
| ( DeserialiseFailure (if n >= 24 then 3 else 2) $ | ||||||
| if version >= natVersion @12 | ||||||
| then typeName <> ":Unknown field key " <> show n | ||||||
|
Collaborator
There was a problem hiding this comment. IMHO an error message like this "Type:Unknown .." looks ugly. Why don't you add a space after
Suggested change
|
||||||
| -- TODO fix the `occured` typo in the produced value | ||||||
| else "An error occured while decoding (Int,Void) not a valid key:.\nError: " <> show n | ||||||
| ) | ||||||
| else | ||||||
| DecoderErrorDeserialiseFailure lbl (DeserialiseFailure 1 "expected word") | ||||||
| where | ||||||
| lbl = Binary.label $ Proxy @(Annotator (TxWits era)) | ||||||
| typeName = show (typeRep (Proxy @(Annotator (AlonzoTxWitsRaw era)))) | ||||||
|
|
||||||
| spec :: | ||||||
| forall era. | ||||||
|
|
||||||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -89,10 +89,11 @@ library | |
| aeson >=2.2, | ||
| base >=4.18 && <5, | ||
| bytestring, | ||
| cardano-base >=0.1.4, | ||
| cardano-data >=1.2, | ||
| cardano-ledger-allegra ^>=1.10, | ||
| cardano-ledger-alonzo ^>=1.16, | ||
| cardano-ledger-binary >=1.9, | ||
| cardano-ledger-core:{cardano-ledger-core, internal} >=1.20, | ||
| cardano-ledger-mary ^>=1.11, | ||
| cardano-ledger-shelley ^>=1.19, | ||
|
|
@@ -146,7 +147,7 @@ executable generate-cddl | |
|
|
||
| build-depends: | ||
| base, | ||
| cardano-ledger-binary:testlib >=1.9, | ||
| cddl, | ||
|
|
||
| library testlib | ||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -42,6 +42,7 @@ module Cardano.Ledger.Babbage.TxOut ( | |
| internBabbageTxOut, | ||
| ) where | ||
|
|
||
| import Cardano.Base.Typeable (TypeName (TypeName)) | ||
| import Cardano.Ledger.Address ( | ||
| CompactAddr, | ||
| compactAddr, | ||
|
|
@@ -116,7 +117,7 @@ import qualified Data.ByteString.Lazy as LBS | |
| import Data.Maybe (fromMaybe) | ||
| import Data.MemPack | ||
| import qualified Data.Text as T | ||
| import Data.Typeable (Proxy (..), typeRep) | ||
| import GHC.Generics (Generic) | ||
| import GHC.Stack (HasCallStack) | ||
| import Lens.Micro (Lens', lens, to, (^.)) | ||
|
|
@@ -610,48 +611,49 @@ decodeTxOut decAddr = do | |
| dtxo <- | ||
| ifDecoderVersionAtLeast | ||
| (natVersion @12) | ||
| (decodeSparseKeyed TypeName requiredFields initial decoderByKey) | ||
| (decode $ SparseKeyed name initial bodyFields requiredFields) | ||
| case dtxo of | ||
| DecodingTxOut SNothing _ _ _ -> | ||
| cborError $ DecoderErrorCustom "BabbageTxOut" "Impossible: no Addr" | ||
| DecodingTxOut (SJust (addr, cAddr)) val d script -> | ||
| pure $ mkTxOut addr cAddr val d script | ||
| where | ||
| name = show . typeRep $ Proxy @(BabbageTxOut era) | ||
| initial :: DecodingTxOut era | ||
| initial = DecodingTxOut SNothing mempty NoDatum SNothing | ||
| decoderByKey :: DecodingTxOut era -> Word -> Maybe (Decoder s (DecodingTxOut era)) | ||
| decoderByKey txOut = \case | ||
| 0 -> Just $ do | ||
| !x <- decAddr | ||
| pure txOut {decodingTxOutAddr = SJust x} | ||
| 1 -> Just $ do | ||
| !x <- decCBOR | ||
| pure txOut {decodingTxOutVal = x} | ||
| 2 -> Just $ do | ||
| !x <- decCBOR | ||
| pure txOut {decodingTxOutDatum = x} | ||
| 3 -> Just $ do | ||
| !x <- decodeCIC "Script" | ||
| pure txOut {decodingTxOutScript = SJust x} | ||
| _ -> Nothing | ||
| {-# INLINE decoderByKey #-} | ||
| bodyFields :: (Word -> Field (DecodingTxOut era)) | ||
| bodyFields 0 = | ||
| field | ||
| (\x txOut -> txOut {decodingTxOutAddr = SJust x}) | ||
| (D decAddr) | ||
| bodyFields 1 = | ||
| field | ||
| (\x txOut -> txOut {decodingTxOutVal = x}) | ||
| From | ||
| bodyFields 2 = | ||
| field | ||
| (\x txOut -> txOut {decodingTxOutDatum = x}) | ||
| (D decCBOR) | ||
| bodyFields 3 = | ||
| ofield | ||
| (\x txOut -> txOut {decodingTxOutScript = x}) | ||
| (D $ decodeCIC "Script") | ||
| bodyFields n = invalidField n | ||
| {-# INLINE bodyFields #-} | ||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -105,6 +105,7 @@ library | |
| aeson, | ||
| base >=4.14 && <5, | ||
| bytestring, | ||
| cardano-base >=0.1.4, | ||
| cardano-crypto-class, | ||
| cardano-data ^>=1.3, | ||
| cardano-ledger-allegra, | ||
|
|
||
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
We can't merge PR's with SRPs in them.
cardano-basehas already been released on CHaP, so please update index-state and use the functionality that you introduced in IntersectMBO/cardano-base#660