diff --git a/eras/alonzo/impl/cardano-ledger-alonzo.cabal b/eras/alonzo/impl/cardano-ledger-alonzo.cabal index ce96ea0dd61..8a5665fa781 100644 --- a/eras/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/eras/alonzo/impl/cardano-ledger-alonzo.cabal @@ -86,7 +86,7 @@ library cardano-crypto-class, cardano-data ^>=1.2.1, cardano-ledger-allegra ^>=1.9, - cardano-ledger-binary ^>=1.7, + cardano-ledger-binary ^>=1.8, cardano-ledger-core:{cardano-ledger-core, internal} ^>=1.19, cardano-ledger-mary ^>=1.9, cardano-ledger-shelley ^>=1.17, diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs index 038a4f923c4..4ecc9199a95 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/BlockBody/Internal.hs @@ -42,7 +42,6 @@ import Cardano.Ledger.Binary ( encodeFoldableEncoder, encodeFoldableMapEncoder, encodePreEncoded, - encodedSizeExpr, serialize, withSlice, ) @@ -54,7 +53,6 @@ import Data.ByteString.Builder (Builder, shortByteString, toLazyByteString) import qualified Data.ByteString.Lazy as BSL import Data.Coerce (coerce) import Data.Maybe.Strict (maybeToStrictMaybe, strictMaybeToMaybe) -import Data.Proxy (Proxy (..)) import qualified Data.Sequence as Seq import Data.Sequence.Strict (StrictSeq) import qualified Data.Sequence.Strict as StrictSeq @@ -178,11 +176,6 @@ instance Era era => EncCBORGroup (AlonzoBlockBody era) where encodePreEncoded $ BSL.toStrict $ bodyBytes <> witsBytes <> metadataBytes <> invalidBytes - encodedGroupSizeExpr size _proxy = - encodedSizeExpr size (Proxy :: Proxy ByteString) - + encodedSizeExpr size (Proxy :: Proxy ByteString) - + encodedSizeExpr size (Proxy :: Proxy ByteString) - + encodedSizeExpr size (Proxy :: Proxy ByteString) listLen _ = 4 listLenBound _ = 4 diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs index f26d18a54d0..ba8bbcc4d4d 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs @@ -146,12 +146,7 @@ deriving anyclass instance (Era era, NoThunks (PredicateFailure (EraRule "LEDGERS" era))) => NoThunks (AlonzoBbodyPredFailure era) -instance - ( Typeable era - , EncCBOR (ShelleyBbodyPredFailure era) - ) => - EncCBOR (AlonzoBbodyPredFailure era) - where +instance EncCBOR (ShelleyBbodyPredFailure era) => EncCBOR (AlonzoBbodyPredFailure era) where encCBOR (ShelleyInAlonzoBbodyPredFailure x) = encode (Sum ShelleyInAlonzoBbodyPredFailure 0 !> To x) encCBOR (TooManyExUnits m) = encode (Sum TooManyExUnits 1 !> To m) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index b8f7cbeffd8..e8a4124701e 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs @@ -180,9 +180,7 @@ instance instance ( AlonzoEraScript era - , EncCBOR (TxCert era) , EncCBOR (PredicateFailure (EraRule "UTXO" era)) - , Typeable (TxAuxData era) ) => EncCBOR (AlonzoUtxowPredFailure era) where diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs index f4e0fcc4b71..08aac2fbf13 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs @@ -116,7 +116,7 @@ import qualified Data.Map.Strict as Map import Data.Maybe (fromJust, isJust) import Data.MemPack import Data.Typeable -import Data.Word (Word16, Word32, Word8) +import Data.Word (Word32) import GHC.Generics (Generic) import GHC.Stack import NoThunks.Class (NoThunks (..)) @@ -331,7 +331,6 @@ instance instance ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , Era era - , Typeable f , EncCBOR (TxCert era) ) => EncCBORGroup (AlonzoPlutusPurpose f era) @@ -343,9 +342,6 @@ instance AlonzoMinting p -> encodeWord8 1 <> encCBOR p AlonzoCertifying p -> encodeWord8 2 <> encCBOR p AlonzoRewarding p -> encodeWord8 3 <> encCBOR p - encodedGroupSizeExpr size_ _proxy = - encodedSizeExpr size_ (Proxy :: Proxy Word8) - + encodedSizeExpr size_ (Proxy :: Proxy Word16) instance ( forall a b. (DecCBOR a, DecCBOR b) => DecCBOR (f a b) @@ -368,7 +364,6 @@ deriving via instance ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , Era era - , Typeable f , EncCBOR (TxCert era) ) => EncCBOR (AlonzoPlutusPurpose f era) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index c282eaa45c9..bed3309c7e4 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -135,7 +135,6 @@ import qualified Data.MapExtras as Map (fromElems) import Data.Maybe (mapMaybe) import Data.Set (Set) import qualified Data.Set as Set -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Lens.Micro import NoThunks.Class (NoThunks) @@ -312,7 +311,7 @@ newtype TxDatsRaw era = TxDatsRaw {unTxDatsRaw :: Map DataHash (Data era)} deriving instance Show (TxDatsRaw era) -instance (Typeable era, EncCBOR (Data era)) => EncCBOR (TxDatsRaw era) where +instance EncCBOR (Data era) => EncCBOR (TxDatsRaw era) where encCBOR = encodeWithSetTag . Map.elems . unTxDatsRaw pattern TxDats' :: Map DataHash (Data era) -> TxDats era diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Twiddle.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Twiddle.hs index 4008a9ed02a..17772698248 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Twiddle.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Twiddle.hs @@ -21,7 +21,6 @@ import Cardano.Ledger.TxIn (TxIn) import Cardano.Ledger.Val (Val) import Codec.CBOR.Term (Term (..)) import Data.Maybe (catMaybes) -import Data.Typeable (Typeable) import Test.Cardano.Ledger.Alonzo.Arbitrary () import Test.Cardano.Ledger.Binary.Twiddle import Test.Cardano.Ledger.Common @@ -50,7 +49,7 @@ instance Twiddle MultiAsset where instance Twiddle ScriptIntegrityHash where twiddle v = twiddle v . toTerm v -instance Typeable t => Twiddle (KeyHash t) where +instance Twiddle (KeyHash t) where twiddle v = twiddle v . toTerm v instance Twiddle Network where diff --git a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs index bdecf2b743e..cff5ac778b0 100644 --- a/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs +++ b/eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Translation/TranslationInstance.hs @@ -177,7 +177,6 @@ instance DecCBOR VersionedTxInfo where instance ( Era era - , EncCBOR (PParams era) , EncCBOR (UTxO era) , EncCBOR (Core.Tx era) ) => diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs index 0d9d7750626..f875a200c2d 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxo.hs @@ -498,10 +498,7 @@ instance , EncCBOR (TxOut era) , EncCBOR (Value era) , EncCBOR (PredicateFailure (EraRule "UTXOS" era)) - , EncCBOR (PredicateFailure (EraRule "UTXO" era)) - , EncCBOR (Script era) , EncCBOR TxIn - , Typeable (TxAuxData era) ) => EncCBOR (BabbageUtxoPredFailure era) where diff --git a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs index f0d722fa252..168050bea40 100644 --- a/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs +++ b/eras/babbage/impl/src/Cardano/Ledger/Babbage/Rules/Utxow.hs @@ -157,12 +157,7 @@ deriving instance instance ( AlonzoEraScript era - , EncCBOR (TxOut era) - , EncCBOR (TxCert era) - , EncCBOR (Value era) - , EncCBOR (PredicateFailure (EraRule "UTXOS" era)) , EncCBOR (PredicateFailure (EraRule "UTXO" era)) - , Typeable (TxAuxData era) ) => EncCBOR (BabbageUtxowPredFailure era) where diff --git a/eras/byron/crypto/cardano-crypto-wrapper.cabal b/eras/byron/crypto/cardano-crypto-wrapper.cabal index 3e16f6e0c2f..0fcae8ddaa3 100644 --- a/eras/byron/crypto/cardano-crypto-wrapper.cabal +++ b/eras/byron/crypto/cardano-crypto-wrapper.cabal @@ -128,6 +128,7 @@ library testlib build-depends: base, bytestring, + cardano-binary:testlib, cardano-crypto, cardano-crypto-wrapper, cardano-ledger-binary:{cardano-ledger-binary, testlib}, diff --git a/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs b/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs index 9b571df265e..d193a671cfc 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Hashing.hs @@ -141,13 +141,13 @@ instance ToJSONKey (AbstractHash algo a) where instance (Typeable algo, Typeable a, HashAlgorithm algo) => ToCBOR (AbstractHash algo a) where toCBOR = toByronCBOR -instance (Typeable algo, Typeable a, HashAlgorithm algo) => EncCBOR (AbstractHash algo a) where - encCBOR (AbstractHash h) = encCBOR h - encodedSizeExpr _ _ = let realSz = hashDigestSize (panic "unused, I hope!" :: algo) in fromInteger (toInteger (withWordSize realSz + realSz)) +instance (Typeable algo, Typeable a, HashAlgorithm algo) => EncCBOR (AbstractHash algo a) where + encCBOR (AbstractHash h) = encCBOR h + instance (Typeable algo, Typeable a, HashAlgorithm algo) => FromCBOR (AbstractHash algo a) where fromCBOR = fromByronCBOR diff --git a/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs b/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs index 52a300b6db2..477d709c10d 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Orphans.hs @@ -64,25 +64,27 @@ instance ToJSON Ed25519.Signature where instance ToCBOR Ed25519.PublicKey where toCBOR = toByronCBOR + encodedSizeExpr _ _ = bsSize 32 instance FromCBOR Ed25519.PublicKey where fromCBOR = fromByronCBOR instance ToCBOR Ed25519.SecretKey where toCBOR = toByronCBOR + encodedSizeExpr _ _ = bsSize 64 instance FromCBOR Ed25519.SecretKey where fromCBOR = fromByronCBOR instance ToCBOR Ed25519.Signature where toCBOR = toByronCBOR + encodedSizeExpr _ _ = bsSize 64 instance FromCBOR Ed25519.Signature where fromCBOR = fromByronCBOR instance EncCBOR Ed25519.PublicKey where encCBOR = encodeBytes . toByteString - encodedSizeExpr _ _ = bsSize 32 instance DecCBOR Ed25519.PublicKey where decCBOR = do @@ -90,7 +92,6 @@ instance DecCBOR Ed25519.PublicKey where toCborError $ fromCryptoFailable "decCBOR Ed25519.PublicKey" res instance EncCBOR Ed25519.SecretKey where - encodedSizeExpr _ _ = bsSize 64 encCBOR sk = encodeBytes $ BS.append (toByteString sk) (toByteString $ Ed25519.toPublic sk) @@ -105,7 +106,6 @@ instance DecCBOR Ed25519.SecretKey where toCborError $ fromCryptoFailable "decCBOR Ed25519.SecretKey" res instance EncCBOR Ed25519.Signature where - encodedSizeExpr _ _ = bsSize 64 encCBOR = encodeBytes . toByteString instance DecCBOR Ed25519.Signature where diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Signature.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Signature.hs index 55454dbca3a..d27a2373145 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Signature.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/Signature.hs @@ -27,9 +27,7 @@ import Cardano.Ledger.Binary ( FromCBOR (..), ToCBOR (..), byronProtVer, - fromByronCBOR, serialize', - toByronCBOR, ) import Cardano.Prelude import qualified Crypto.PubKey.Ed25519 as Ed25519 @@ -41,13 +39,7 @@ import qualified Formatting.Buildable as B (Buildable (..)) type RedeemSignature :: Type -> Type newtype RedeemSignature a = RedeemSignature Ed25519.Signature - deriving (Eq, Show, Generic, NFData, DecCBOR, EncCBOR) - -instance EncCBOR a => ToCBOR (RedeemSignature a) where - toCBOR = toByronCBOR - -instance DecCBOR a => FromCBOR (RedeemSignature a) where - fromCBOR = fromByronCBOR + deriving (Eq, Show, Generic, NFData, DecCBOR, EncCBOR, ToCBOR, FromCBOR) -- Note that there is deliberately no Ord instance. The crypto libraries -- encourage using key /hashes/ not keys for things like sets, map etc. diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/SigningKey.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/SigningKey.hs index 7c47a9d8522..bc3038a15d0 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/SigningKey.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Redeem/SigningKey.hs @@ -18,8 +18,6 @@ import Cardano.Ledger.Binary ( EncCBOR, FromCBOR (..), ToCBOR (..), - fromByronCBOR, - toByronCBOR, ) import Cardano.Prelude import qualified Crypto.PubKey.Ed25519 as Ed25519 @@ -31,14 +29,12 @@ import NoThunks.Class (InspectHeap (..), NoThunks (..)) type RedeemSigningKey :: Type newtype RedeemSigningKey = RedeemSigningKey Ed25519.SecretKey - deriving (Eq, Show, Generic, NFData, DecCBOR, EncCBOR) + deriving (Eq, Show, Generic, NFData, ToCBOR, FromCBOR) deriving (NoThunks) via InspectHeap RedeemSigningKey -instance ToCBOR RedeemSigningKey where - toCBOR = toByronCBOR +instance EncCBOR RedeemSigningKey -instance FromCBOR RedeemSigningKey where - fromCBOR = fromByronCBOR +instance DecCBOR RedeemSigningKey -- Note that there is deliberately no Ord instance. The crypto libraries -- encourage using key /hashes/ not keys for things like sets, map etc. diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/Signature.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/Signature.hs index 7773aae9877..2100196d497 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/Signature.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/Signature.hs @@ -131,13 +131,13 @@ decCBORXSignature = toCborError . CC.xsignature =<< decCBOR instance Typeable a => ToCBOR (Signature a) where toCBOR = toByronCBOR + encodedSizeExpr _ _ = 66 instance Typeable a => FromCBOR (Signature a) where fromCBOR = fromByronCBOR instance Typeable a => EncCBOR (Signature a) where encCBOR (Signature a) = encCBORXSignature a - encodedSizeExpr _ _ = 66 instance Typeable a => DecCBOR (Signature a) where decCBOR = fmap Signature decCBORXSignature diff --git a/eras/byron/crypto/src/Cardano/Crypto/Signing/VerificationKey.hs b/eras/byron/crypto/src/Cardano/Crypto/Signing/VerificationKey.hs index c0a52910aa1..5855a90c9cd 100644 --- a/eras/byron/crypto/src/Cardano/Crypto/Signing/VerificationKey.hs +++ b/eras/byron/crypto/src/Cardano/Crypto/Signing/VerificationKey.hs @@ -77,13 +77,13 @@ instance MonadError SchemaError m => TJC.FromJSON m VerificationKey where instance ToCBOR VerificationKey where toCBOR = toByronCBOR + encodedSizeExpr _ _ = 66 instance FromCBOR VerificationKey where fromCBOR = fromByronCBOR instance EncCBOR VerificationKey where encCBOR (VerificationKey a) = encCBORXPub a - encodedSizeExpr _ _ = 66 instance DecCBOR VerificationKey where decCBOR = fmap VerificationKey decCBORXPub diff --git a/eras/byron/crypto/testlib/Test/Cardano/Crypto/CBOR.hs b/eras/byron/crypto/testlib/Test/Cardano/Crypto/CBOR.hs index d31d8a6bc52..899dd171783 100644 --- a/eras/byron/crypto/testlib/Test/Cardano/Crypto/CBOR.hs +++ b/eras/byron/crypto/testlib/Test/Cardano/Crypto/CBOR.hs @@ -26,15 +26,15 @@ import Cardano.Crypto ( sign, ) import Cardano.Crypto.Wallet (xprv, xpub) -import Cardano.Ledger.Binary (Dropper, EncCBOR, dropBytes, dropList, enforceSize) +import Cardano.Ledger.Binary (Dropper, ToCBOR, dropBytes, dropList, enforceSize) import Cardano.Prelude import Crypto.Hash (Blake2b_224, Blake2b_256, Blake2b_384, Blake2b_512, SHA1) import qualified Data.ByteArray as ByteArray import qualified Data.ByteString as BS import Hedgehog (Gen, Property) import qualified Hedgehog as H +import Test.Cardano.Binary.Helpers (SizeTestConfig (..), scfg, sizeTest) import Test.Cardano.Crypto.Gen -import Test.Cardano.Ledger.Binary.Vintage.Helpers (SizeTestConfig (..), scfg, sizeTest) import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( deprecatedGoldenDecode, goldenTestCBOR, @@ -266,7 +266,7 @@ constantByteString = sizeEstimates :: H.Group sizeEstimates = - let testPrecise :: forall a. (Show a, EncCBOR a) => Gen a -> Property + let testPrecise :: forall a. (Show a, ToCBOR a) => Gen a -> Property testPrecise g = sizeTest $ scfg {gen = g, precise = True} in H.Group "Encoded size bounds for crypto types." diff --git a/eras/byron/ledger/impl/CHANGELOG.md b/eras/byron/ledger/impl/CHANGELOG.md index 273f44f2eb4..9e699a6b55c 100644 --- a/eras/byron/ledger/impl/CHANGELOG.md +++ b/eras/byron/ledger/impl/CHANGELOG.md @@ -1,8 +1,9 @@ # Revision history for `cardano-ledger-byron` -## 1.2.0.1 +## 1.3.0.0 -* +* Add `ToCBOR` and `FromCBOR` instances for `KeyHash` and `GenesisHash` +* Rename `encodedSizeTestEncCBOR` to `encodedSizeTestToCBOR` ## 1.2.0.0 diff --git a/eras/byron/ledger/impl/cardano-ledger-byron.cabal b/eras/byron/ledger/impl/cardano-ledger-byron.cabal index d4f3fb57458..dbc206a1a85 100644 --- a/eras/byron/ledger/impl/cardano-ledger-byron.cabal +++ b/eras/byron/ledger/impl/cardano-ledger-byron.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-byron -version: 1.2.0.0 +version: 1.3.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -240,9 +240,10 @@ library binary, bytestring, canonical-json, + cardano-binary, cardano-crypto, cardano-crypto-wrapper >=1.6, - cardano-ledger-binary >=1.5, + cardano-ledger-binary >=1.8, cardano-prelude, cborg, containers, @@ -345,6 +346,7 @@ library testlib byron-spec-chain, byron-spec-ledger, bytestring, + cardano-binary:{cardano-binary, testlib} >=1.7.2, cardano-crypto, cardano-crypto-wrapper:{cardano-crypto-wrapper, testlib}, cardano-ledger-binary:{cardano-ledger-binary, testlib}, diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs index 713edc56d63..e2b2ce9e63e 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Header.hs @@ -666,6 +666,10 @@ instance ToJSON a => ToJSON (ABlockSignature a) instance ToCBOR BlockSignature where toCBOR = toByronCBOR + encodedSizeExpr size sig = + 3 + + encodedSizeExpr size (delegationCertificate <$> sig) + + encodedSizeExpr size (signature <$> sig) instance FromCBOR BlockSignature where fromCBOR = fromByronCBOR @@ -681,11 +685,6 @@ instance EncCBOR BlockSignature where <> encCBOR (2 :: Word8) <> (encodeListLen 2 <> encCBOR cert <> encCBOR sig) - encodedSizeExpr size sig = - 3 - + encodedSizeExpr size (delegationCertificate <$> sig) - + encodedSizeExpr size (signature <$> sig) - instance DecCBOR BlockSignature where decCBOR = void <$> decCBOR @(ABlockSignature ByteSpan) @@ -736,6 +735,13 @@ data ToSign = ToSign instance ToCBOR ToSign where toCBOR = toByronCBOR + encodedSizeExpr size ts = + 1 + + encodedSizeExpr size (tsHeaderHash <$> ts) + + encodedSizeExpr size (tsBodyProof <$> ts) + + encodedSizeExpr size (tsSlot <$> ts) + + encodedSizeExpr size (tsDifficulty <$> ts) + + encCBORBlockVersionsSize (tsProtocolVersion <$> ts) (tsSoftwareVersion <$> ts) instance FromCBOR ToSign where fromCBOR = fromByronCBOR @@ -749,14 +755,6 @@ instance EncCBOR ToSign where <> encCBOR (tsDifficulty ts) <> encCBORBlockVersions (tsProtocolVersion ts) (tsSoftwareVersion ts) - encodedSizeExpr size ts = - 1 - + encodedSizeExpr size (tsHeaderHash <$> ts) - + encodedSizeExpr size (tsBodyProof <$> ts) - + encodedSizeExpr size (tsSlot <$> ts) - + encodedSizeExpr size (tsDifficulty <$> ts) - + encCBORBlockVersionsSize (tsProtocolVersion <$> ts) (tsSoftwareVersion <$> ts) - instance DecCBOR ToSign where decCBOR = do enforceSize "ToSign" 5 diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Proof.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Proof.hs index afd5c96e5db..09114447a8d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Block/Proof.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Block/Proof.hs @@ -58,6 +58,12 @@ instance B.Buildable Proof where instance ToCBOR Proof where toCBOR = toByronCBOR + encodedSizeExpr size bc = + 1 + + encodedSizeExpr size (proofUTxO <$> bc) + + encodedSizeExpr size (proofSsc <$> bc) + + encodedSizeExpr size (proofDelegation <$> bc) + + encodedSizeExpr size (proofUpdate <$> bc) instance FromCBOR Proof where fromCBOR = fromByronCBOR @@ -73,13 +79,6 @@ instance EncCBOR Proof where <> encCBOR (proofDelegation bc) <> encCBOR (proofUpdate bc) - encodedSizeExpr size bc = - 1 - + encodedSizeExpr size (proofUTxO <$> bc) - + encodedSizeExpr size (proofSsc <$> bc) - + encodedSizeExpr size (proofDelegation <$> bc) - + encodedSizeExpr size (proofUpdate <$> bc) - instance DecCBOR Proof where decCBOR = do enforceSize "Proof" 4 diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/AddrSpendingData.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/AddrSpendingData.hs index bd2230dcc59..7fd129d4082 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/AddrSpendingData.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/AddrSpendingData.hs @@ -54,6 +54,11 @@ instance B.Buildable AddrSpendingData where instance ToCBOR AddrSpendingData where toCBOR = toByronCBOR + encodedSizeExpr size _ = + szCases + [ Case "VerKeyASD" $ size $ Proxy @(Word8, VerificationKey) + , Case "RedeemASD" $ size $ Proxy @(Word8, RedeemVerificationKey) + ] instance FromCBOR AddrSpendingData where fromCBOR = fromByronCBOR @@ -65,12 +70,6 @@ instance EncCBOR AddrSpendingData where RedeemASD redeemVK -> encodeListLen 2 <> encCBOR (2 :: Word8) <> encCBOR redeemVK - encodedSizeExpr size _ = - szCases - [ Case "VerKeyASD" $ size $ Proxy @(Word8, VerificationKey) - , Case "RedeemASD" $ size $ Proxy @(Word8, RedeemVerificationKey) - ] - instance DecCBOR AddrSpendingData where decCBOR = do len <- decodeListLenCanonical @@ -94,6 +93,7 @@ instance ToJSON AddrType instance ToCBOR AddrType where toCBOR = toByronCBOR + encodedSizeExpr size _ = encodedSizeExpr size (Proxy @Word8) instance FromCBOR AddrType where fromCBOR = fromByronCBOR @@ -105,8 +105,6 @@ instance EncCBOR AddrType where ATVerKey -> 0 ATRedeem -> 2 - encodedSizeExpr size _ = encodedSizeExpr size (Proxy @Word8) - instance DecCBOR AddrType where decCBOR = decodeWord8Canonical >>= \case diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs index f22c62d30eb..f13e58fd154 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Address.hs @@ -45,6 +45,9 @@ module Cardano.Chain.Common.Address ( makeRedeemAddress, ) where +import qualified Cardano.Binary as Plain ( + Encoding, + ) import Cardano.Chain.Common.AddrAttributes ( AddrAttributes (..), HDAddressPayload, @@ -153,15 +156,8 @@ data Address = Address instance Aeson.ToJSON Address instance ToCBOR Address where - toCBOR = toByronCBOR - -instance FromCBOR Address where - fromCBOR = fromByronCBOR - -instance EncCBOR Address where - encCBOR addr = + toCBOR addr = encodeCrcProtected (addrRoot addr, addrAttributes addr, addrType addr) - encodedSizeExpr size pxy = encodedCrcProtectedSizeExpr size $ (,,) @@ -169,6 +165,11 @@ instance EncCBOR Address where <*> (addrAttributes <$> pxy) <*> (addrType <$> pxy) +instance FromCBOR Address where + fromCBOR = fromByronCBOR + +instance EncCBOR Address + instance DecCBOR Address where decCBOR = do (root, attributes, addrType') <- decodeCrcProtected @@ -359,6 +360,6 @@ encCBORAddr addr = <> encCBOR (addrType addr) -encCBORAddrCRC32 :: Address -> Encoding +encCBORAddrCRC32 :: Address -> Plain.Encoding encCBORAddrCRC32 addr = encodeCrcProtected (addrRoot addr, addrAttributes addr, addrType addr) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/BlockCount.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/BlockCount.hs index 3d305267072..450c37fd792 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/BlockCount.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/BlockCount.hs @@ -24,13 +24,13 @@ newtype BlockCount = BlockCount instance ToCBOR BlockCount where toCBOR = toByronCBOR + encodedSizeExpr size pxy = size (unBlockCount <$> pxy) instance FromCBOR BlockCount where fromCBOR = fromByronCBOR instance EncCBOR BlockCount where encCBOR = encCBOR . unBlockCount - encodedSizeExpr size pxy = size (unBlockCount <$> pxy) instance DecCBOR BlockCount where decCBOR = BlockCount <$> decCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs index 57389073a91..2c233e6207f 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/CBOR.hs @@ -35,24 +35,28 @@ module Cardano.Chain.Common.CBOR ( decodeCrcProtected, ) where +import qualified Cardano.Binary as Plain ( + Encoding, + encodeListLen, + encodeNestedCborBytes, + nestedCborBytesSizeExpr, + nestedCborSizeExpr, + serialize, + ) import Cardano.Ledger.Binary ( DecCBOR (..), Decoder, EncCBOR (..), Encoding, Size, + ToCBOR (..), byronProtVer, cborError, decodeFull', decodeNestedCbor, decodeNestedCborBytes, - encodeListLen, encodeNestedCbor, - encodeNestedCborBytes, enforceSize, - nestedCborBytesSizeExpr, - nestedCborSizeExpr, - serialize, toCborError, ) import Cardano.Prelude hiding (cborError, toCborError) @@ -66,18 +70,18 @@ import Formatting (Format, sformat, shown) encodeKnownCborDataItem :: EncCBOR a => a -> Encoding encodeKnownCborDataItem = encodeNestedCbor --- | This is an alias for 'encodeNestedCborBytes', so all its details apply. +-- | This is an alias for 'Plain.encodeNestedCborBytes', so all its details apply. -- -- This function is used to handle the case of an unknown type, so it takes an -- opaque blob that is the representation of the value of the unknown type. -encodeUnknownCborDataItem :: LByteString -> Encoding -encodeUnknownCborDataItem = encodeNestedCborBytes +encodeUnknownCborDataItem :: LByteString -> Plain.Encoding +encodeUnknownCborDataItem = Plain.encodeNestedCborBytes knownCborDataItemSizeExpr :: Size -> Size -knownCborDataItemSizeExpr = nestedCborSizeExpr +knownCborDataItemSizeExpr = Plain.nestedCborSizeExpr unknownCborDataItemSizeExpr :: Size -> Size -unknownCborDataItemSizeExpr = nestedCborBytesSizeExpr +unknownCborDataItemSizeExpr = Plain.nestedCborBytesSizeExpr -- | This is an alias for 'decodeNestedCbor'. -- @@ -99,22 +103,22 @@ decodeUnknownCborDataItem = decodeNestedCborBytes -- | Encodes a value of type @a@, protecting it from accidental corruption by -- protecting it with a CRC. -encodeCrcProtected :: EncCBOR a => a -> Encoding +encodeCrcProtected :: ToCBOR a => a -> Plain.Encoding encodeCrcProtected x = - encodeListLen 2 <> encodeUnknownCborDataItem body <> encCBOR (crc32 body) + Plain.encodeListLen 2 <> encodeUnknownCborDataItem body <> toCBOR (crc32 body) where - body = serialize byronProtVer x + body = Plain.serialize x encodedCrcProtectedSizeExpr :: forall a. - EncCBOR a => - (forall t. EncCBOR t => Proxy t -> Size) -> + ToCBOR a => + (forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size encodedCrcProtectedSizeExpr size pxy = 2 + unknownCborDataItemSizeExpr (size pxy) - + size (pure $ crc32 (serialize byronProtVer (panic "unused" :: a))) + + size (pure $ crc32 (Plain.serialize (panic "unused" :: a))) -- | Decodes a CBOR blob into a value of type @a@, checking the serialised CRC -- corresponds to the computed one diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/ChainDifficulty.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/ChainDifficulty.hs index eda247540ee..41932b090bf 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/ChainDifficulty.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/ChainDifficulty.hs @@ -36,6 +36,7 @@ instance ToJSON ChainDifficulty instance ToCBOR ChainDifficulty where toCBOR = toByronCBOR + encodedSizeExpr f cd = 1 + encodedSizeExpr f (unChainDifficulty <$> cd) instance FromCBOR ChainDifficulty where fromCBOR = fromByronCBOR @@ -43,8 +44,6 @@ instance FromCBOR ChainDifficulty where instance EncCBOR ChainDifficulty where encCBOR cd = encodeListLen 1 <> encCBOR (unChainDifficulty cd) - encodedSizeExpr f cd = 1 + encodedSizeExpr f (unChainDifficulty <$> cd) - instance DecCBOR ChainDifficulty where decCBOR = do enforceSize "ChainDifficulty" 1 diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/KeyHash.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/KeyHash.hs index 9322adb8235..d04987da9b4 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/KeyHash.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/KeyHash.hs @@ -13,7 +13,7 @@ import Cardano.Chain.Common.AddressHash import Cardano.Crypto (decodeAbstractHash, hashHexF) import Cardano.Crypto.Signing (VerificationKey) import Cardano.HeapWords (HeapWords) -import Cardano.Ledger.Binary (DecCBOR, EncCBOR) +import Cardano.Ledger.Binary (DecCBOR, EncCBOR, FromCBOR, ToCBOR) import Cardano.Prelude import Formatting (formatToString) import Formatting.Buildable (Buildable) @@ -35,6 +35,8 @@ newtype KeyHash = KeyHash , Show , NFData , Buildable + , FromCBOR + , ToCBOR , DecCBOR , EncCBOR , HeapWords diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs index da5aa345d97..93c72fcb9ed 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Lovelace.hs @@ -96,13 +96,13 @@ instance ToJSON Lovelace instance ToCBOR Lovelace where toCBOR = toByronCBOR + encodedSizeExpr size pxy = size (unsafeGetLovelace <$> pxy) instance FromCBOR Lovelace where fromCBOR = fromByronCBOR instance EncCBOR Lovelace where encCBOR = encCBOR . unsafeGetLovelace - encodedSizeExpr size pxy = size (unsafeGetLovelace <$> pxy) instance DecCBOR Lovelace where decCBOR = do diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs index a52180f11f1..cb002dd005c 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Common/Merkle.hs @@ -75,15 +75,15 @@ instance Buildable (MerkleRoot a) where -- Used for debugging purposes only instance ToJSON a => ToJSON (MerkleRoot a) -instance EncCBOR a => ToCBOR (MerkleRoot a) where +instance (EncCBOR a, Typeable a) => ToCBOR (MerkleRoot a) where toCBOR = toByronCBOR + encodedSizeExpr size = encodedSizeExpr size . fmap getMerkleRoot instance DecCBOR a => FromCBOR (MerkleRoot a) where fromCBOR = fromByronCBOR instance EncCBOR a => EncCBOR (MerkleRoot a) where encCBOR = encCBOR . getMerkleRoot - encodedSizeExpr size = encodedSizeExpr size . fmap getMerkleRoot instance DecCBOR a => DecCBOR (MerkleRoot a) where decCBOR = MerkleRoot <$> decCBOR @@ -125,7 +125,7 @@ instance Foldable MerkleTree where instance Show a => Show (MerkleTree a) where show tree = "Merkle tree: " <> show (F.toList tree) -instance EncCBOR a => ToCBOR (MerkleTree a) where +instance (EncCBOR a, Typeable a) => ToCBOR (MerkleTree a) where toCBOR = toByronCBOR instance (DecCBOR a, EncCBOR a) => FromCBOR (MerkleTree a) where diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs index 3c5d2631937..1d0bffd0ded 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Delegation/Certificate.hs @@ -182,6 +182,12 @@ isValid pm UnsafeACertificate {aEpoch, issuerVK, delegateVK, signature} = instance ToCBOR Certificate where toCBOR = toByronCBOR + encodedSizeExpr size cert = + 1 + + encodedSizeExpr size (epoch <$> cert) + + encodedSizeExpr size (issuerVK <$> cert) + + encodedSizeExpr size (delegateVK <$> cert) + + encodedSizeExpr size (signature <$> cert) instance FromCBOR Certificate where fromCBOR = fromByronCBOR @@ -194,13 +200,6 @@ instance EncCBOR Certificate where <> encCBOR (delegateVK cert) <> encCBOR (signature cert) - encodedSizeExpr size cert = - 1 - + encodedSizeExpr size (epoch <$> cert) - + encodedSizeExpr size (issuerVK <$> cert) - + encodedSizeExpr size (delegateVK <$> cert) - + encodedSizeExpr size (signature <$> cert) - instance DecCBOR Certificate where decCBOR = void <$> decCBOR @(ACertificate ByteSpan) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Hash.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Hash.hs index d7b2676f81f..506674ec3f3 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Hash.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Genesis/Hash.hs @@ -9,7 +9,7 @@ module Cardano.Chain.Genesis.Hash ( import Cardano.Crypto.Hashing (Hash) import Cardano.Crypto.Raw (Raw) -import Cardano.Ledger.Binary (DecCBOR, EncCBOR) +import Cardano.Ledger.Binary (DecCBOR, EncCBOR, FromCBOR, ToCBOR) import Cardano.Prelude import Data.Aeson (ToJSON) import NoThunks.Class (NoThunks (..)) @@ -17,7 +17,7 @@ import NoThunks.Class (NoThunks (..)) newtype GenesisHash = GenesisHash { unGenesisHash :: Hash Raw } - deriving (Eq, Generic, NFData, DecCBOR, EncCBOR, NoThunks) + deriving (Eq, Generic, NFData, FromCBOR, ToCBOR, DecCBOR, EncCBOR, NoThunks) deriving instance Show GenesisHash diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs index 5b0113b2639..94a94e7fc80 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochAndSlotCount.hs @@ -51,16 +51,16 @@ instance B.Buildable EpochAndSlotCount where instance ToCBOR EpochAndSlotCount where toCBOR = toByronCBOR + encodedSizeExpr f eas = + 1 + + encodedSizeExpr f (epochNo <$> eas) + + encodedSizeExpr f (slotCount <$> eas) instance FromCBOR EpochAndSlotCount where fromCBOR = fromByronCBOR instance EncCBOR EpochAndSlotCount where encCBOR eas = encodeListLen 2 <> encCBOR (epochNo eas) <> encCBOR (slotCount eas) - encodedSizeExpr f eas = - 1 - + encodedSizeExpr f (epochNo <$> eas) - + encodedSizeExpr f (slotCount <$> eas) instance DecCBOR EpochAndSlotCount where decCBOR = do diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochNumber.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochNumber.hs index 8de651fd6ac..188db849b95 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochNumber.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/EpochNumber.hs @@ -57,13 +57,13 @@ instance Aeson.ToJSON EpochNumber instance ToCBOR EpochNumber where toCBOR = toByronCBOR + encodedSizeExpr size = encodedSizeExpr size . fmap getEpochNumber instance FromCBOR EpochNumber where fromCBOR = fromByronCBOR instance EncCBOR EpochNumber where encCBOR (EpochNumber epoch) = encCBOR epoch - encodedSizeExpr size = encodedSizeExpr size . fmap getEpochNumber instance DecCBOR EpochNumber where decCBOR = EpochNumber <$> decCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/SlotNumber.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/SlotNumber.hs index 734ebebd257..a9909bc576c 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/SlotNumber.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Slotting/SlotNumber.hs @@ -46,13 +46,13 @@ instance Aeson.ToJSON SlotNumber instance ToCBOR SlotNumber where toCBOR = toByronCBOR + encodedSizeExpr size = encodedSizeExpr size . fmap unSlotNumber instance FromCBOR SlotNumber where fromCBOR = fromByronCBOR instance EncCBOR SlotNumber where encCBOR = encCBOR . unSlotNumber - encodedSizeExpr size = encodedSizeExpr size . fmap unSlotNumber instance DecCBOR SlotNumber where decCBOR = SlotNumber <$> decCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Ssc.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Ssc.hs index 0480aac37b9..7fdd047d8ef 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Ssc.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Ssc.hs @@ -103,6 +103,10 @@ data SscProof instance ToCBOR SscProof where toCBOR = toByronCBOR + encodedSizeExpr size _ = + 1 + + encodedSizeExpr size (Proxy :: Proxy Word8) + + 34 instance FromCBOR SscProof where fromCBOR = fromByronCBOR @@ -156,11 +160,6 @@ instance EncCBOR SscProof where , 0x6c ] - encodedSizeExpr size _ = - 1 - + encodedSizeExpr size (Proxy :: Proxy Word8) - + 34 - instance DecCBOR SscProof where decCBOR = do dropSscProof diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/Tx.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/Tx.hs index d7d4b69b873..b609c909766 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/Tx.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/Tx.hs @@ -86,6 +86,12 @@ instance B.Buildable Tx where instance ToCBOR Tx where toCBOR = toByronCBOR + encodedSizeExpr size pxy = + 1 + + size (txInputs <$> pxy) + + size (txOutputs <$> pxy) + + size + (txAttributes <$> pxy) instance FromCBOR Tx where fromCBOR = fromByronCBOR @@ -101,13 +107,6 @@ instance EncCBOR Tx where <> encCBOR (txAttributes tx) - encodedSizeExpr size pxy = - 1 - + size (txInputs <$> pxy) - + size (txOutputs <$> pxy) - + size - (txAttributes <$> pxy) - instance DecCBOR Tx where decCBOR = do enforceSize "Tx" 3 @@ -154,6 +153,10 @@ instance ToJSON TxIn instance ToCBOR TxIn where toCBOR = toByronCBOR + encodedSizeExpr size _ = + 2 + + knownCborDataItemSizeExpr + (szCases [Case "TxInUtxo" $ size $ Proxy @(TxId, Word16)]) instance FromCBOR TxIn where fromCBOR = fromByronCBOR @@ -165,11 +168,6 @@ instance EncCBOR TxIn where <> encodeKnownCborDataItem (txInHash, txInIndex) - encodedSizeExpr size _ = - 2 - + knownCborDataItemSizeExpr - (szCases [Case "TxInUtxo" $ size $ Proxy @(TxId, Word16)]) - instance DecCBOR TxIn where decCBOR = do enforceSize "TxIn" 2 @@ -207,11 +205,10 @@ instance EncCBOR TxOut where encCBOR txOut = encodeListLen 2 <> encCBOR (txOutAddress txOut) <> encCBOR (txOutValue txOut) - encodedSizeExpr size pxy = - 1 + size (txOutAddress <$> pxy) + size (txOutValue <$> pxy) - instance ToCBOR TxOut where toCBOR = toByronCBOR + encodedSizeExpr size pxy = + 1 + size (txOutAddress <$> pxy) + size (txOutValue <$> pxy) instance FromCBOR TxOut where fromCBOR = fromByronCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxAux.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxAux.hs index 890c21ec735..f685d57a39d 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxAux.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxAux.hs @@ -91,6 +91,7 @@ instance B.Buildable TxAux where instance ToCBOR TxAux where toCBOR = toByronCBOR + encodedSizeExpr size pxy = 1 + size (taTx <$> pxy) + size (taWitness <$> pxy) instance FromCBOR TxAux where fromCBOR = fromByronCBOR @@ -98,8 +99,6 @@ instance FromCBOR TxAux where instance EncCBOR TxAux where encCBOR ta = encodeListLen 2 <> encCBOR (taTx ta) <> encCBOR (taWitness ta) - encodedSizeExpr size pxy = 1 + size (taTx <$> pxy) + size (taWitness <$> pxy) - instance DecCBOR TxAux where decCBOR = void <$> decCBOR @(ATxAux ByteSpan) diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxProof.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxProof.hs index 3d96e05d235..2a45c7e3757 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxProof.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxProof.hs @@ -63,6 +63,11 @@ instance B.Buildable TxProof where instance ToCBOR TxProof where toCBOR = toByronCBOR + encodedSizeExpr size proof = + 1 + + encodedSizeExpr size (txpNumber <$> proof) + + encodedSizeExpr size (txpRoot <$> proof) + + encodedSizeExpr size (txpWitnessesHash <$> proof) instance FromCBOR TxProof where fromCBOR = fromByronCBOR @@ -73,11 +78,6 @@ instance EncCBOR TxProof where <> encCBOR (txpNumber proof) <> encCBOR (txpRoot proof) <> encCBOR (txpWitnessesHash proof) - encodedSizeExpr size proof = - 1 - + encodedSizeExpr size (txpNumber <$> proof) - + encodedSizeExpr size (txpRoot <$> proof) - + encodedSizeExpr size (txpWitnessesHash <$> proof) instance DecCBOR TxProof where decCBOR = do diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs index 85f398daaf4..7ac8163f8b8 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/UTxO/TxWitness.hs @@ -86,6 +86,17 @@ instance B.Buildable TxInWitness where instance ToCBOR TxInWitness where toCBOR = toByronCBOR + encodedSizeExpr size _ = + 2 + + szCases + ( map + (fmap knownCborDataItemSizeExpr) + [ Case "VKWitness" $ size $ Proxy @(VerificationKey, TxSig) + , Case "RedeemWitness" + $ size + $ Proxy @(RedeemVerificationKey, RedeemSignature TxSigData) + ] + ) instance FromCBOR TxInWitness where fromCBOR = fromByronCBOR @@ -104,18 +115,6 @@ instance EncCBOR TxInWitness where <> encCBOR (2 :: Word8) <> encodeKnownCborDataItem (key, sig) - encodedSizeExpr size _ = - 2 - + szCases - ( map - (fmap knownCborDataItemSizeExpr) - [ Case "VKWitness" $ size $ Proxy @(VerificationKey, TxSig) - , Case "RedeemWitness" - $ size - $ Proxy @(RedeemVerificationKey, RedeemSignature TxSigData) - ] - ) - instance DecCBOR TxInWitness where decCBOR = do len <- decodeListLen @@ -145,13 +144,13 @@ instance ToJSON TxSigData instance ToCBOR TxSigData where toCBOR = toByronCBOR + encodedSizeExpr size pxy = size (txSigTxHash <$> pxy) instance FromCBOR TxSigData where fromCBOR = fromByronCBOR instance EncCBOR TxSigData where encCBOR txSigData = encCBOR (txSigTxHash txSigData) - encodedSizeExpr size pxy = size (txSigTxHash <$> pxy) instance DecCBOR TxSigData where decCBOR = TxSigData <$> decCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs index 9e0926f7148..cd1275fe344 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ApplicationName.hs @@ -44,12 +44,6 @@ newtype ApplicationName = ApplicationName instance ToCBOR ApplicationName where toCBOR = toByronCBOR - -instance FromCBOR ApplicationName where - fromCBOR = fromByronCBOR - -instance EncCBOR ApplicationName where - encCBOR appName = encCBOR (unApplicationName appName) encodedSizeExpr _ _ = 1 + szCases @@ -57,6 +51,12 @@ instance EncCBOR ApplicationName where , Case "maxBound" (fromInteger applicationNameMaxLength) ] +instance FromCBOR ApplicationName where + fromCBOR = fromByronCBOR + +instance EncCBOR ApplicationName where + encCBOR appName = encCBOR (unApplicationName appName) + instance DecCBOR ApplicationName where decCBOR = ApplicationName <$> decCBOR diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ProtocolVersion.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ProtocolVersion.hs index 3c87b78eb12..22268433d6f 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/ProtocolVersion.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/ProtocolVersion.hs @@ -45,6 +45,11 @@ instance ToJSON ProtocolVersion instance ToCBOR ProtocolVersion where toCBOR = toByronCBOR + encodedSizeExpr f pv = + 1 + + encodedSizeExpr f (pvMajor <$> pv) + + encodedSizeExpr f (pvMinor <$> pv) + + encodedSizeExpr f (pvAlt <$> pv) instance FromCBOR ProtocolVersion where fromCBOR = fromByronCBOR @@ -56,12 +61,6 @@ instance EncCBOR ProtocolVersion where <> encCBOR (pvMinor pv) <> encCBOR (pvAlt pv) - encodedSizeExpr f pv = - 1 - + encodedSizeExpr f (pvMajor <$> pv) - + encodedSizeExpr f (pvMinor <$> pv) - + encodedSizeExpr f (pvAlt <$> pv) - instance DecCBOR ProtocolVersion where decCBOR = do enforceSize "ProtocolVersion" 3 diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/SoftwareVersion.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/SoftwareVersion.hs index 7d79c8a6392..a1f6bfb9715 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/SoftwareVersion.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/SoftwareVersion.hs @@ -58,6 +58,10 @@ instance ToJSON SoftwareVersion instance ToCBOR SoftwareVersion where toCBOR = toByronCBOR + encodedSizeExpr f sv = + 1 + + encodedSizeExpr f (svAppName <$> sv) + + encodedSizeExpr f (svNumber <$> sv) instance FromCBOR SoftwareVersion where fromCBOR = fromByronCBOR @@ -65,11 +69,6 @@ instance FromCBOR SoftwareVersion where instance EncCBOR SoftwareVersion where encCBOR sv = encodeListLen 2 <> encCBOR (svAppName sv) <> encCBOR (svNumber sv) - encodedSizeExpr f sv = - 1 - + encodedSizeExpr f (svAppName <$> sv) - + encodedSizeExpr f (svNumber <$> sv) - instance DecCBOR SoftwareVersion where decCBOR = do enforceSize "SoftwareVersion" 2 diff --git a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs index e3a7424e62d..b37c738dae3 100644 --- a/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs +++ b/eras/byron/ledger/impl/src/Cardano/Chain/Update/Validation/Registration.hs @@ -298,7 +298,7 @@ data TooLarge n = TooLarge } deriving (Eq, Show) -instance EncCBOR n => ToCBOR (TooLarge n) where +instance (EncCBOR n, Typeable n) => ToCBOR (TooLarge n) where toCBOR = toByronCBOR instance DecCBOR n => FromCBOR (TooLarge n) where diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Block/Size.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Block/Size.hs index a80fec9a452..1cf501cd261 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Block/Size.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Block/Size.hs @@ -8,6 +8,7 @@ module Test.Cardano.Chain.Block.Size ( tests, ) where +import qualified Cardano.Binary as Plain import Cardano.Chain.Block import Cardano.Ledger.Binary hiding (label) import Cardano.Prelude @@ -26,7 +27,7 @@ import Test.Options (TSGroup, TSProperty, eachOfTS) encodedSizeTest :: forall a. Show a => - (a -> Encoding) -> + (a -> Plain.Encoding) -> (Proxy a -> Size) -> Gen a -> TSProperty @@ -70,80 +71,80 @@ encodedSizeTest encode encodedSize gen = eachOfTS else 1 s = lo + bucket * ((size - lo) `div` bucket) -encodedSizeTestEncCBOR :: +encodedSizeTestToCBOR :: forall a. - (EncCBOR a, Show a) => + (ToCBOR a, Show a) => Gen a -> TSProperty -encodedSizeTestEncCBOR = - encodedSizeTest encCBOR szGreedy +encodedSizeTestToCBOR = + encodedSizeTest toCBOR szGreedy ts_prop_sizeProtocolMagicId :: TSProperty ts_prop_sizeProtocolMagicId = - encodedSizeTestEncCBOR Crypto.genProtocolMagicId + encodedSizeTestToCBOR Crypto.genProtocolMagicId ts_prop_sizeEpochAndSlotCount :: TSProperty ts_prop_sizeEpochAndSlotCount = - encodedSizeTestEncCBOR (Slotting.genEpochSlots >>= Slotting.genEpochAndSlotCount) + encodedSizeTestToCBOR (Slotting.genEpochSlots >>= Slotting.genEpochAndSlotCount) ts_prop_sizeChainDifficulty :: TSProperty -ts_prop_sizeChainDifficulty = encodedSizeTestEncCBOR genChainDifficulty +ts_prop_sizeChainDifficulty = encodedSizeTestToCBOR genChainDifficulty ts_prop_sizeHeaderHash :: TSProperty -ts_prop_sizeHeaderHash = encodedSizeTestEncCBOR genHeaderHash +ts_prop_sizeHeaderHash = encodedSizeTestToCBOR genHeaderHash ts_prop_sizeSlotNumber :: TSProperty -ts_prop_sizeSlotNumber = encodedSizeTestEncCBOR Slotting.genSlotNumber +ts_prop_sizeSlotNumber = encodedSizeTestToCBOR Slotting.genSlotNumber ts_prop_sizeProtocolVersion :: TSProperty -ts_prop_sizeProtocolVersion = encodedSizeTestEncCBOR Update.genProtocolVersion +ts_prop_sizeProtocolVersion = encodedSizeTestToCBOR Update.genProtocolVersion ts_prop_sizeApplicationName :: TSProperty -ts_prop_sizeApplicationName = encodedSizeTestEncCBOR Update.genApplicationName +ts_prop_sizeApplicationName = encodedSizeTestToCBOR Update.genApplicationName ts_prop_sizeSoftwareVersion :: TSProperty -ts_prop_sizeSoftwareVersion = encodedSizeTestEncCBOR Update.genSoftwareVersion +ts_prop_sizeSoftwareVersion = encodedSizeTestToCBOR Update.genSoftwareVersion ts_prop_sizeProof :: TSProperty -ts_prop_sizeProof = encodedSizeTestEncCBOR (Crypto.genProtocolMagicId >>= genProof) +ts_prop_sizeProof = encodedSizeTestToCBOR (Crypto.genProtocolMagicId >>= genProof) ts_prop_sizeVerificationKey :: TSProperty -ts_prop_sizeVerificationKey = encodedSizeTestEncCBOR Crypto.genVerificationKey +ts_prop_sizeVerificationKey = encodedSizeTestToCBOR Crypto.genVerificationKey ts_prop_sizeToSign :: TSProperty ts_prop_sizeToSign = - encodedSizeTestEncCBOR + encodedSizeTestToCBOR $ ((,) <$> Crypto.genProtocolMagicId <*> Slotting.genEpochSlots) >>= uncurry genToSign ts_prop_sizeBlockVersions :: TSProperty ts_prop_sizeBlockVersions = encodedSizeTest - (uncurry encCBORBlockVersions) + (toPlainEncoding byronProtVer . uncurry encCBORBlockVersions) (uncurryP encCBORBlockVersionsSize) ((,) <$> Update.genProtocolVersion <*> Update.genSoftwareVersion) ts_prop_sizeEpochNumber :: TSProperty ts_prop_sizeEpochNumber = - encodedSizeTestEncCBOR Slotting.genEpochNumber + encodedSizeTestToCBOR Slotting.genEpochNumber -- | test @Signature EpochNumber@ which is a part of 'ACertificate' ts_prop_sizeEpochNumberSignature :: TSProperty ts_prop_sizeEpochNumberSignature = - encodedSizeTestEncCBOR + encodedSizeTestToCBOR $ Crypto.genProtocolMagicId >>= flip Crypto.genSignature Slotting.genEpochSlots ts_prop_sizeToSignSignature :: TSProperty ts_prop_sizeToSignSignature = - encodedSizeTestEncCBOR $ do + encodedSizeTestToCBOR $ do pm <- Crypto.genProtocolMagicId es <- Slotting.genEpochSlots Crypto.genSignature pm (genToSign pm es) ts_prop_sizeBlockSignature :: TSProperty ts_prop_sizeBlockSignature = - encodedSizeTestEncCBOR + encodedSizeTestToCBOR $ ((,) <$> Crypto.genProtocolMagicId <*> Slotting.genEpochSlots) >>= uncurry genBlockSignature @@ -154,7 +155,7 @@ ts_prop_sizeBlockSignature = ts_prop_sizeHeader :: TSProperty ts_prop_sizeHeader = encodedSizeTest - (uncurry encCBORHeader) + (toPlainEncoding byronProtVer . uncurry encCBORHeader) (uncurryP encCBORHeaderSize) $ do protocolMagicId <- Crypto.genProtocolMagicId @@ -167,12 +168,12 @@ ts_prop_sizeHeader = -- ts_prop_sizeGenesisHash :: TSProperty -ts_prop_sizeGenesisHash = encodedSizeTestEncCBOR Genesis.genGenesisHash +ts_prop_sizeGenesisHash = encodedSizeTestToCBOR Genesis.genGenesisHash ts_prop_sizeABoundaryHeader :: TSProperty ts_prop_sizeABoundaryHeader = encodedSizeTest - (uncurry encCBORABoundaryHeader) + (toPlainEncoding byronProtVer . uncurry encCBORABoundaryHeader) (uncurryP encCBORABoundaryHeaderSize) ( (,) <$> Crypto.genProtocolMagicId @@ -186,7 +187,7 @@ ts_prop_sizeABoundaryHeader = ts_prop_sizeABlockOrBoundaryHdr :: TSProperty ts_prop_sizeABlockOrBoundaryHdr = encodedSizeTest - encCBORABlockOrBoundaryHdr + (toPlainEncoding byronProtVer . encCBORABlockOrBoundaryHdr) encCBORABlockOrBoundaryHdrSize $ ((,) <$> Crypto.genProtocolMagicId <*> Slotting.genEpochSlots) >>= uncurry genABlockOrBoundaryHdr diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Byron/API.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Byron/API.hs index 0e0abf4d354..46362171a8c 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Byron/API.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Byron/API.hs @@ -52,6 +52,7 @@ import qualified Data.Set as Set import Hedgehog (Gen, Group (..), annotateShow, forAll, property, (===)) import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range +import Test.Cardano.Binary.Helpers.GoldenRoundTrip (roundTripsCBORShow) import Test.Cardano.Chain.Block.Model (elaborateAndUpdate, elaborateBlock) import qualified Test.Cardano.Chain.Delegation.Gen as Dlg import Test.Cardano.Chain.Elaboration.Block ( @@ -67,7 +68,6 @@ import Test.Cardano.Chain.UTxO.Model ( ) import qualified Test.Cardano.Chain.Update.Gen as UpdateIface import Test.Cardano.Crypto.Gen (feedPM) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (roundTripsCBORShow) import qualified Test.Control.State.Transition.Generator as STS import qualified Test.Control.State.Transition.Trace as STS import Test.Options (TSGroup, TSProperty, eachOfTS, withTestsTS) diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Common/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Common/CBOR.hs index 0eeafcc5101..bb1d43cb550 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Common/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Common/CBOR.hs @@ -36,8 +36,8 @@ import Cardano.Crypto ( import Cardano.Crypto.Raw (Raw (..)) import Cardano.Ledger.Binary ( Case (..), - EncCBOR, SizeOverride (..), + ToCBOR, byronProtVer, decodeFullDecoder, serialize, @@ -47,6 +47,12 @@ import Cardano.Prelude hiding (check) import qualified Data.Map as M import Hedgehog (Gen, Property, cover, forAll, property, (===)) import qualified Hedgehog as H +import Test.Cardano.Binary.Helpers (SizeTestConfig (..), scfg, sizeTest) +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( + goldenTestCBOR, + roundTripsCBORBuildable, + roundTripsCBORShow, + ) import Test.Cardano.Chain.Common.Example ( exampleAddrSpendingData_VerKey, exampleAddress, @@ -75,12 +81,6 @@ import Test.Cardano.Chain.Common.Gen ( ) import Test.Cardano.Crypto.CBOR (getBytes) import Test.Cardano.Crypto.Gen (genHashRaw) -import Test.Cardano.Ledger.Binary.Vintage.Helpers (SizeTestConfig (..), scfg, sizeTest) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( - goldenTestCBOR, - roundTripsCBORBuildable, - roundTripsCBORShow, - ) import Test.Cardano.Prelude import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) @@ -292,7 +292,7 @@ ts_roundTripMerkleRoot = -------------------------------------------------------------------------------- sizeEstimates :: H.Group sizeEstimates = - let check :: forall a. (Show a, EncCBOR a) => Gen a -> Property + let check :: forall a. (Show a, ToCBOR a) => Gen a -> Property check g = sizeTest $ scfg {gen = g} -- Explicit bounds for types, based on the generators from Gen. diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Delegation/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Delegation/CBOR.hs index 710bde64a97..2c1a5559d12 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Delegation/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Delegation/CBOR.hs @@ -8,6 +8,11 @@ import Cardano.Chain.Delegation (unsafePayload) import Cardano.Prelude import Data.List ((!!)) import Hedgehog (Property) +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( + goldenTestCBOR, + roundTripsCBORBuildable, + roundTripsCBORShow, + ) import Test.Cardano.Chain.Delegation.Example (exampleCertificates) import Test.Cardano.Chain.Delegation.Gen ( genCertificate, @@ -15,11 +20,6 @@ import Test.Cardano.Chain.Delegation.Gen ( genPayload, ) import Test.Cardano.Crypto.Gen (feedPM) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( - goldenTestCBOR, - roundTripsCBORBuildable, - roundTripsCBORShow, - ) import Test.Cardano.Prelude import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Genesis/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Genesis/CBOR.hs index 08f253cf12f..cea69ec9015 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Genesis/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Genesis/CBOR.hs @@ -5,12 +5,12 @@ module Test.Cardano.Chain.Genesis.CBOR ( ) where import Cardano.Prelude -import Test.Cardano.Chain.Genesis.Gen -import Test.Cardano.Crypto.Gen (genProtocolMagicId) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( roundTripsCBORBuildable, roundTripsCBORShow, ) +import Test.Cardano.Chain.Genesis.Gen +import Test.Cardano.Crypto.Gen (genProtocolMagicId) import Test.Cardano.Prelude (discoverRoundTripArg) import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Slotting/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Slotting/CBOR.hs index 1fd31181e24..4b930c7cbb5 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Slotting/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Slotting/CBOR.hs @@ -7,6 +7,10 @@ module Test.Cardano.Chain.Slotting.CBOR ( import Cardano.Chain.Slotting (EpochSlots (..), SlotNumber) import Cardano.Prelude import Hedgehog (Property) +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( + goldenTestCBOR, + roundTripsCBORBuildable, + ) import Test.Cardano.Chain.Slotting.Example ( exampleEpochAndSlotCount, exampleEpochNumber, @@ -18,10 +22,6 @@ import Test.Cardano.Chain.Slotting.Gen ( genEpochSlots, genSlotNumber, ) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( - goldenTestCBOR, - roundTripsCBORBuildable, - ) import Test.Cardano.Prelude import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/UTxO/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/UTxO/CBOR.hs index c4245affefb..36dc2e01f28 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/UTxO/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/UTxO/CBOR.hs @@ -17,12 +17,18 @@ import Cardano.Chain.UTxO ( taWitness, ) import Cardano.Crypto (ProtocolMagicId (..), SignTag (..), Signature, sign) -import Cardano.Ledger.Binary (Case (..), EncCBOR, LengthOf, SizeOverride (..), szCases) +import Cardano.Ledger.Binary (Case (..), LengthOf, SizeOverride (..), ToCBOR, szCases) import Cardano.Prelude import qualified Data.Map.Strict as M import Data.Vector (Vector) import Hedgehog (Gen, Property) import qualified Hedgehog as H +import Test.Cardano.Binary.Helpers (SizeTestConfig (..), scfg, sizeTest) +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( + goldenTestCBOR, + roundTripsCBORBuildable, + roundTripsCBORShow, + ) import Test.Cardano.Chain.UTxO.Example ( exampleHashTx, exampleRedeemSignature, @@ -65,12 +71,6 @@ import Test.Cardano.Crypto.Example ( exampleVerificationKey, ) import Test.Cardano.Crypto.Gen (feedPM) -import Test.Cardano.Ledger.Binary.Vintage.Helpers (SizeTestConfig (..), scfg, sizeTest) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( - goldenTestCBOR, - roundTripsCBORBuildable, - roundTripsCBORShow, - ) import Test.Cardano.Prelude import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) @@ -281,7 +281,7 @@ ts_roundTripUTxOConfiguration = sizeEstimates :: H.Group sizeEstimates = - let sizeTestGen :: (Show a, EncCBOR a) => Gen a -> Property + let sizeTestGen :: (Show a, ToCBOR a) => Gen a -> Property sizeTestGen g = sizeTest $ scfg {gen = g} pm = ProtocolMagicId 0 diff --git a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Update/CBOR.hs b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Update/CBOR.hs index b5474027c52..fe4cbb5d940 100644 --- a/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Update/CBOR.hs +++ b/eras/byron/ledger/impl/testlib/Test/Cardano/Chain/Update/CBOR.hs @@ -11,6 +11,11 @@ import Cardano.Crypto (Hash, abstractHash) import Cardano.Crypto.Raw (Raw (..)) import Cardano.Prelude import Hedgehog (Property) +import Test.Cardano.Binary.Helpers.GoldenRoundTrip ( + goldenTestCBOR, + roundTripsCBORBuildable, + roundTripsCBORShow, + ) import Test.Cardano.Chain.Update.Example ( exampleInstallerHash, examplePayload, @@ -43,11 +48,6 @@ import Test.Cardano.Chain.Update.Gen ( genVote, ) import Test.Cardano.Crypto.Gen (feedPM, genHashRaw) -import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip ( - goldenTestCBOR, - roundTripsCBORBuildable, - roundTripsCBORShow, - ) import Test.Cardano.Prelude import Test.Options (TSGroup, TSProperty, concatTSGroups, eachOfTS) diff --git a/eras/conway/impl/cardano-ledger-conway.cabal b/eras/conway/impl/cardano-ledger-conway.cabal index 17ded9278db..25c35ac69e0 100644 --- a/eras/conway/impl/cardano-ledger-conway.cabal +++ b/eras/conway/impl/cardano-ledger-conway.cabal @@ -99,7 +99,7 @@ library cardano-ledger-allegra ^>=1.9, cardano-ledger-alonzo ^>=1.15, cardano-ledger-babbage ^>=1.12, - cardano-ledger-binary ^>=1.7, + cardano-ledger-binary ^>=1.8, cardano-ledger-core:{cardano-ledger-core, internal} ^>=1.19, cardano-ledger-mary ^>=1.9, cardano-ledger-shelley ^>=1.17, diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs index e309dc2b1dc..ed4df370511 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Governance/Procedures.hs @@ -634,8 +634,7 @@ newtype GovPurposeId (p :: GovActionPurpose) = GovPurposeId type role GovPurposeId nominal -deriving newtype instance - Typeable p => EncCBOR (GovPurposeId (p :: GovActionPurpose)) +deriving newtype instance EncCBOR (GovPurposeId (p :: GovActionPurpose)) deriving newtype instance Typeable p => DecCBOR (GovPurposeId (p :: GovActionPurpose)) @@ -718,9 +717,7 @@ instance (GovRelation <$> decCBOR <*> decCBOR <*> decCBOR <*> decCBOR) instance - ( Typeable f - , (forall p. Typeable p => EncCBOR (f (GovPurposeId (p :: GovActionPurpose)))) - ) => + (forall p. Typeable p => EncCBOR (f (GovPurposeId (p :: GovActionPurpose)))) => EncCBOR (GovRelation f) where encCBOR govPurpose@(GovRelation _ _ _ _) = diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs index 82e48cffbfe..46221d22e59 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/PParams.hs @@ -587,13 +587,13 @@ instance NoThunks (HKD f a) => NoThunks (THKD t f a) where instance NFData (HKD f a) => NFData (THKD t f a) where rnf = rnf . unTHKD -instance (Typeable t, EncCBOR a) => EncCBOR (THKD t Identity a) where +instance EncCBOR a => EncCBOR (THKD t Identity a) where encCBOR = encCBOR . unTHKD instance (Typeable t, DecCBOR a) => DecCBOR (THKD t Identity a) where decCBOR = THKD <$> decCBOR -instance (Typeable t, EncCBOR a) => EncCBOR (THKD t StrictMaybe a) where +instance EncCBOR a => EncCBOR (THKD t StrictMaybe a) where encCBOR = encCBOR . unTHKD instance (Typeable t, DecCBOR a) => DecCBOR (THKD t StrictMaybe a) where diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs index ca57dd1d638..be2f6ffed92 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs @@ -265,8 +265,7 @@ instance wrapEvent = absurd instance - ( Typeable era - , EncCBOR (PredicateFailure (EraRule "DELEG" era)) + ( EncCBOR (PredicateFailure (EraRule "DELEG" era)) , EncCBOR (PredicateFailure (EraRule "POOL" era)) , EncCBOR (PredicateFailure (EraRule "GOVCERT" era)) ) => diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs index 91b76518a3c..71f49af77c0 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/Scripts.hs @@ -57,7 +57,7 @@ import Control.DeepSeq (NFData (..), rwhnf) import Data.Aeson (ToJSON (..), (.=)) import Data.MemPack import Data.Typeable -import Data.Word (Word16, Word32, Word8) +import Data.Word (Word32) import GHC.Generics import NoThunks.Class (NoThunks (..)) @@ -228,7 +228,6 @@ deriving via instance ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , EraPParams era - , Typeable f , EncCBOR (TxCert era) ) => EncCBOR (ConwayPlutusPurpose f era) @@ -266,7 +265,6 @@ instance instance ( forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , EraPParams era - , Typeable f , EncCBOR (TxCert era) ) => EncCBORGroup (ConwayPlutusPurpose f era) @@ -280,9 +278,6 @@ instance ConwayRewarding p -> encodeWord8 3 <> encCBOR p ConwayVoting p -> encodeWord8 4 <> encCBOR p ConwayProposing p -> encodeWord8 5 <> encCBOR p - encodedGroupSizeExpr size_ _proxy = - encodedSizeExpr size_ (Proxy :: Proxy Word8) - + encodedSizeExpr size_ (Proxy :: Proxy Word16) instance ( forall a b. (DecCBOR a, DecCBOR b) => DecCBOR (f a b) diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/State/Account.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/State/Account.hs index a8955f6de89..b675daabe3b 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/State/Account.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/State/Account.hs @@ -60,7 +60,7 @@ instance NoThunks (ConwayAccountState era) instance NFData (ConwayAccountState era) where rnf = rwhnf -instance Typeable era => EncCBOR (ConwayAccountState era) where +instance EncCBOR (ConwayAccountState era) where encCBOR cas@(ConwayAccountState _ _ _ _) = let ConwayAccountState {..} = cas in encodeListLen 4 diff --git a/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs b/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs index c6162097592..2ad7e55b654 100644 --- a/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs +++ b/eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs @@ -713,7 +713,7 @@ conwayTxCertDelegDecoder = \case instance (Era era, Val (Value era)) => ToCBOR (ConwayTxCert era) where toCBOR = toPlainEncoding (eraProtVerLow @era) . encCBOR -instance (Era era, Val (Value era)) => EncCBOR (ConwayTxCert era) where +instance Era era => EncCBOR (ConwayTxCert era) where encCBOR = \case ConwayTxCertDeleg delegCert -> encCBOR delegCert ConwayTxCertPool poolCert -> encodePoolCert poolCert diff --git a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal index 1ca9d5eaf40..367807f5715 100644 --- a/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal +++ b/eras/dijkstra/impl/cardano-ledger-dijkstra.cabal @@ -85,7 +85,7 @@ library cardano-ledger-allegra, cardano-ledger-alonzo ^>=1.15, cardano-ledger-babbage, - cardano-ledger-binary, + cardano-ledger-binary ^>=1.8, cardano-ledger-conway, cardano-ledger-core:{cardano-ledger-core, internal} >=1.19, cardano-ledger-mary, diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs index 6fc57ea9751..cfac37ddc98 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Scripts.hs @@ -53,7 +53,6 @@ import Cardano.Ledger.Binary ( ToCBOR (..), decodeWord8, encodeWord8, - encodedSizeExpr, ) import Cardano.Ledger.Binary.Coders ( Decode (..), @@ -87,8 +86,8 @@ import Data.Sequence.Strict (StrictSeq) import Data.Sequence.Strict as Seq (StrictSeq (Empty, (:<|))) import qualified Data.Sequence.Strict as SSeq import Data.Set as Set (Set, member) -import Data.Typeable (Proxy (..), Typeable) -import Data.Word (Word16, Word32, Word8) +import Data.Typeable (Typeable) +import Data.Word (Word32) import GHC.Generics (Generic) import NoThunks.Class (NoThunks) @@ -125,8 +124,7 @@ deriving via deriving via CBORGroup (DijkstraPlutusPurpose f era) instance - ( Typeable f - , EraPParams era + ( EraPParams era , forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , EraTxCert era ) => @@ -152,8 +150,7 @@ instance n -> fail $ "Unexpected tag for DijkstraPlutusPurpose: " <> show n instance - ( Typeable f - , EraPParams era + ( EraPParams era , forall a b. (EncCBOR a, EncCBOR b) => EncCBOR (f a b) , EncCBOR (TxCert era) ) => @@ -169,8 +166,6 @@ instance DijkstraVoting p -> encodeWord8 4 <> encCBOR p DijkstraProposing p -> encodeWord8 5 <> encCBOR p DijkstraGuarding p -> encodeWord8 6 <> encCBOR p - encodedGroupSizeExpr size_ _proxy = - encodedSizeExpr size_ (Proxy @Word8) + encodedSizeExpr size_ (Proxy @Word16) instance ( forall a b. (ToJSON a, ToJSON b) => ToJSON (f a b) diff --git a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxCert.hs b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxCert.hs index 96cb83d8702..4c4a5b8c7fc 100644 --- a/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxCert.hs +++ b/eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/TxCert.hs @@ -217,7 +217,7 @@ instance instance (Era era, Val (Value era)) => ToCBOR (DijkstraTxCert era) where toCBOR = toPlainEncoding (eraProtVerLow @era) . encCBOR -instance (Era era, Val (Value era)) => EncCBOR (DijkstraTxCert era) where +instance Era era => EncCBOR (DijkstraTxCert era) where encCBOR = \case DijkstraTxCertDeleg delegCert -> encCBOR delegCert DijkstraTxCertPool poolCert -> encodePoolCert poolCert diff --git a/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal b/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal index fbf816495d2..6c9882a13a8 100644 --- a/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal +++ b/eras/shelley-ma/test-suite/cardano-ledger-shelley-ma-test.cabal @@ -45,8 +45,8 @@ library base >=4.18 && <5, bytestring, cardano-ledger-allegra:{cardano-ledger-allegra, testlib} ^>=1.9, - cardano-ledger-binary:{cardano-ledger-binary, testlib} ^>=1.7, - cardano-ledger-core >=1.17, + cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.7, + cardano-ledger-core ^>=1.19, cardano-ledger-mary:{cardano-ledger-mary, testlib} ^>=1.9, cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.12, cardano-ledger-shelley-test >=1.6, diff --git a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs index 2fbb44f5aa3..a2c7b9417fa 100644 --- a/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs +++ b/eras/shelley-ma/test-suite/test/Test/Cardano/Ledger/ShelleyMA/Serialisation/Golden/Encoding.hs @@ -21,7 +21,7 @@ import Cardano.Ledger.Allegra.Scripts ( import Cardano.Ledger.Allegra.TxAuxData (pattern AllegraTxAuxData) import Cardano.Ledger.Allegra.TxBody (TxBody (..)) import Cardano.Ledger.BaseTypes (Network (..), StrictMaybe (..)) -import Cardano.Ledger.Binary (DecCBOR, ToCBOR) +import Cardano.Ledger.Binary (DecCBOR) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Credential (Credential (..), StakeReference (..)) import Cardano.Ledger.Mary (MaryEra) @@ -127,7 +127,6 @@ testUpdate = scriptGoldenTest :: forall era. ( AllegraEraScript era - , ToCBOR (NativeScript era) , DecCBOR (NativeScript era) ) => TestTree diff --git a/eras/shelley/impl/CHANGELOG.md b/eras/shelley/impl/CHANGELOG.md index 75186fabec2..57af3c6ad39 100644 --- a/eras/shelley/impl/CHANGELOG.md +++ b/eras/shelley/impl/CHANGELOG.md @@ -2,8 +2,6 @@ ## 1.17.1.0 -## 1.17.2.0 - * Added `Generic` instance to `ShelleyTxOut` ### `testlib` diff --git a/eras/shelley/impl/cardano-ledger-shelley.cabal b/eras/shelley/impl/cardano-ledger-shelley.cabal index a49196c294b..eb4f3e3f425 100644 --- a/eras/shelley/impl/cardano-ledger-shelley.cabal +++ b/eras/shelley/impl/cardano-ledger-shelley.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-shelley -version: 1.17.2.0 +version: 1.17.1.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -109,7 +109,7 @@ library cardano-crypto-class, cardano-crypto-wrapper, cardano-data ^>=1.2.2, - cardano-ledger-binary ^>=1.7, + cardano-ledger-binary ^>=1.8, cardano-ledger-byron, cardano-ledger-core:{cardano-ledger-core, internal} ^>=1.19, cardano-slotting, diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs index 11ee729862d..5a3188d7876 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/BlockBody/Internal.hs @@ -192,19 +192,11 @@ pattern ShelleyBlockBody xs <- {-# COMPLETE ShelleyBlockBody #-} -instance - forall era. - Era era => - EncCBORGroup (ShelleyBlockBody era) - where +instance Era era => EncCBORGroup (ShelleyBlockBody era) where encCBORGroup (ShelleyBlockBodyInternal _ _ bodyBytes witsBytes metadataBytes) = encodePreEncoded $ BSL.toStrict $ bodyBytes <> witsBytes <> metadataBytes - encodedGroupSizeExpr size _proxy = - encodedSizeExpr size (Proxy :: Proxy ByteString) - + encodedSizeExpr size (Proxy :: Proxy ByteString) - + encodedSizeExpr size (Proxy :: Proxy ByteString) listLen _ = 3 listLenBound _ = 3 diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs index 7a9dd5dcec8..6933ac09a92 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs @@ -147,10 +147,7 @@ instance NoThunks (ShelleyDelegPredFailure era) instance NFData (ShelleyDelegPredFailure era) -instance - (Era era, Typeable (Script era)) => - EncCBOR (ShelleyDelegPredFailure era) - where +instance Era era => EncCBOR (ShelleyDelegPredFailure era) where encCBOR = \case StakeKeyAlreadyRegisteredDELEG cred -> encodeListLen 2 <> encCBOR (0 :: Word8) <> encCBOR cred diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs index 7d7b2eb7e70..5cc456c451b 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs @@ -164,7 +164,6 @@ instance instance ( Era era - , Typeable (Script era) , EncCBOR (PredicateFailure (EraRule "DELPL" era)) ) => EncCBOR (ShelleyDelegsPredFailure era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs index 6c646784e2e..084b9363d7e 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs @@ -145,7 +145,6 @@ instance ( Era era , EncCBOR (PredicateFailure (EraRule "POOL" era)) , EncCBOR (PredicateFailure (EraRule "DELEG" era)) - , Typeable (Script era) ) => EncCBOR (ShelleyDelplPredFailure era) where diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs index cdd1516dc89..7130d21f452 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxo.hs @@ -98,6 +98,7 @@ import qualified Data.Map.Strict as Map import Data.MapExtras (extractKeys) import Data.Set (Set) import qualified Data.Set as Set +import Data.Typeable import Data.Word (Word32) import GHC.Generics (Generic) import Lens.Micro @@ -121,7 +122,7 @@ instance (EraPParams era, EraCertState era) => EncCBOR (UtxoEnv era) where !> To uePParams !> To ueCertState -instance (EraPParams era, EraCertState era) => DecCBOR (UtxoEnv era) where +instance (EraPParams era, EraCertState era, Typeable (CertState era)) => DecCBOR (UtxoEnv era) where decCBOR = decode $ RecD UtxoEnv diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs index 7ee4d8a2e53..0ae23df6d43 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Utxow.hs @@ -177,8 +177,6 @@ deriving stock instance instance ( Era era - , Typeable (Script era) - , Typeable (TxAuxData era) , EncCBOR (PredicateFailure (EraRule "UTXO" era)) ) => EncCBOR (ShelleyUtxowPredFailure era) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Account.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Account.hs index 855531441a8..33e6d08062f 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Account.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Account.hs @@ -57,7 +57,7 @@ instance NoThunks (ShelleyAccountState era) instance NFData (ShelleyAccountState era) where rnf = rwhnf -instance Typeable era => EncCBOR (ShelleyAccountState era) where +instance EncCBOR (ShelleyAccountState era) where encCBOR sas@(ShelleyAccountState _ _ _ _) = let ShelleyAccountState {..} = sas in encodeListLen 4 @@ -105,7 +105,7 @@ instance NFData (ShelleyAccounts era) where rnf (ShelleyAccounts accounts accountPtr) = accounts `deepseq` rnf accountPtr -instance Typeable era => EncCBOR (ShelleyAccounts era) where +instance EncCBOR (ShelleyAccounts era) where encCBOR ShelleyAccounts {saStates, saPtrs} = encodeListLen 2 <> encCBOR saStates <> encCBOR saPtrs diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Stake.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Stake.hs index 1f3203b07f7..330fb31fa9d 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Stake.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/State/Stake.hs @@ -43,7 +43,6 @@ import Data.Coerce import Data.Default (Default (..)) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) -import Data.Typeable import qualified Data.VMap as VMap import Data.Word (Word64) import GHC.Generics (Generic) @@ -61,7 +60,7 @@ instance NFData (ShelleyInstantStake era) instance NoThunks (ShelleyInstantStake era) -instance Typeable era => EncCBOR (ShelleyInstantStake era) where +instance EncCBOR (ShelleyInstantStake era) where encCBOR (ShelleyInstantStake credentialStake ptrStake) = encodeListLen 2 <> encCBOR credentialStake <> encCBOR ptrStake diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs index ea586ab5aa0..41256a8d9da 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs @@ -89,7 +89,6 @@ import qualified Data.Map.Strict as Map (fromList) import Data.Sequence.Strict (fromList) import qualified Data.Text as T (pack) import qualified Data.Text.Encoding as T (encodeUtf8) -import Data.Typeable (Proxy (Proxy)) import Data.Word (Word64) import Generic.Random (genericArbitraryU) import Test.Cardano.Chain.UTxO.Gen (genCompactTxOut) @@ -764,7 +763,6 @@ deriving newtype instance Arbitrary (TransitionConfig ShelleyEra) instance EncCBOR RawSeed where encCBOR (RawSeed w1 w2 w3 w4 w5) = encCBOR (w1, w2, w3, w4, w5) - encodedSizeExpr size _ = 1 + size (Proxy :: Proxy Word64) * 5 instance ( EraBlockBody era diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Era.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Era.hs index d6326ae8917..c7890558177 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Era.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Era.hs @@ -28,6 +28,7 @@ import Cardano.Ledger.Shelley.State import Cardano.Ledger.Shelley.Transition import Data.Default import qualified Data.Map.Strict as Map +import Data.Typeable import Lens.Micro import Test.Cardano.Ledger.Common import Test.Cardano.Ledger.Era @@ -51,6 +52,7 @@ class , DecCBOR (StashedAVVMAddresses era) , ToExpr (ScriptsNeeded era) , SafeToHash (TxWits era) + , Typeable (CertState era) ) => ShelleyEraTest era diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs index 12d4d3c85d1..48f20cec2f6 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Imp/PoolSpec.hs @@ -15,7 +15,7 @@ import Cardano.Ledger.Core import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Shelley.LedgerState import Cardano.Ledger.Shelley.Rules (ShelleyPoolPredFailure (..)) -import Cardano.Ledger.State (PoolMetadata (..), ppCostL, ppMetadataL, ppVrfL, spsVrf) +import Cardano.Ledger.State import qualified Data.Map.Strict as Map import Data.Proxy import Lens.Micro @@ -30,11 +30,11 @@ spec = describe "POOL" $ do (kh, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF minPoolCost <- getsPParams ppMinPoolCostL tooLowCost <- Coin <$> choose (0, unCoin minPoolCost) - let pps = (\p -> p & ppCostL .~ tooLowCost) <$> poolParams kh vrf - registerPoolTx <$> pps >>= \tx -> - submitFailingTx - tx - [injectFailure $ StakePoolCostTooLowPOOL $ Mismatch tooLowCost minPoolCost] + pps <- poolParams kh vrf + let tx = registerPoolTx (pps & ppCostL .~ tooLowCost) + submitFailingTx + tx + [injectFailure $ StakePoolCostTooLowPOOL $ Mismatch tooLowCost minPoolCost] it "register a pool with a reward account having the wrong network id" $ do pv <- getsPParams ppProtocolVersionL @@ -45,13 +45,13 @@ spec = describe "POOL" $ do , raCredential = rewardCredential } kh <- freshKeyHash - let pps = freshPoolParams kh badRewardAccount - registerPoolTx <$> pps >>= \tx -> - if pvMajor pv < natVersion @5 - then - submitTx_ tx - else - submitFailingTx tx [injectFailure $ WrongNetworkPOOL (Mismatch Mainnet Testnet) kh] + pps <- freshPoolParams kh badRewardAccount + let tx = registerPoolTx pps + if pvMajor pv < natVersion @5 + then + submitTx_ tx + else + submitFailingTx tx [injectFailure $ WrongNetworkPOOL (Mismatch Mainnet Testnet) kh] it "register a pool with too big metadata" $ do pv <- getsPParams ppProtocolVersionL let maxMetadataSize = sizeHash (Proxy :: Proxy HASH) @@ -60,13 +60,13 @@ spec = describe "POOL" $ do url <- arbitrary let metadata = PoolMetadata url metadataHash (kh, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF - let pps = (\p -> p & ppMetadataL .~ SJust metadata) <$> poolParams kh vrf - registerPoolTx <$> pps >>= \tx -> - if pvMajor pv < natVersion @5 - then - submitTx_ tx - else - submitFailingTx tx [injectFailure $ PoolMedataHashTooBig kh (fromIntegral tooBigSize)] + pps <- poolParams kh vrf + let tx = registerPoolTx (pps & ppMetadataL .~ SJust metadata) + if pvMajor pv < natVersion @5 + then + submitTx_ tx + else + submitFailingTx tx [injectFailure $ PoolMedataHashTooBig kh (fromIntegral tooBigSize)] it "register a new pool with an already registered VRF" $ do pv <- getsPParams ppProtocolVersionL @@ -313,7 +313,7 @@ spec = describe "POOL" $ do where registerNewPool = do (kh, vrf) <- (,) <$> freshKeyHash <*> freshKeyHashVRF - registerPoolTx <$> poolParams kh vrf >>= submitTx_ + submitTx_ . registerPoolTx =<< poolParams kh vrf expectPool kh (Just vrf) pure (kh, vrf) registerPoolTx pps = @@ -339,6 +339,10 @@ spec = describe "POOL" $ do expectVRFs vrfs = do whenMajorVersionAtLeast @11 $ Map.keysSet . psVRFKeyHashes <$> getPState `shouldReturn` vrfs + poolParams :: + KeyHash 'StakePool -> + VRFVerKeyHash 'StakePoolVRF -> + ImpTestM era PoolParams poolParams kh vrf = do pps <- registerRewardAccount >>= freshPoolParams kh pure $ pps & ppVrfL .~ vrf diff --git a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal index f3ebf2cb26a..bfd99efb760 100644 --- a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal +++ b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-shelley-test -version: 1.7.0.0 +version: 1.7.0.1 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -78,7 +78,7 @@ library cardano-crypto-class, cardano-crypto-wrapper, cardano-data >=1.2, - cardano-ledger-binary:{cardano-ledger-binary, testlib} ^>=1.7, + cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.7, cardano-ledger-byron, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.19, cardano-ledger-shelley:{cardano-ledger-shelley, testlib} >=1.17, diff --git a/libs/cardano-data/cardano-data.cabal b/libs/cardano-data/cardano-data.cabal index 13eb4f7d7a4..a761ec8ea22 100644 --- a/libs/cardano-data/cardano-data.cabal +++ b/libs/cardano-data/cardano-data.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-data -version: 1.2.4.1 +version: 1.2.4.2 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -39,7 +39,7 @@ library build-depends: aeson >=2.2, base >=4.18 && <5, - cardano-ledger-binary >=1.4, + cardano-ledger-binary >=1.8, cardano-strict-containers >=0.1.2.1, containers, data-default, diff --git a/libs/cardano-data/src/Data/OMap/Strict.hs b/libs/cardano-data/src/Data/OMap/Strict.hs index 59da4704c1a..08aca69f791 100644 --- a/libs/cardano-data/src/Data/OMap/Strict.hs +++ b/libs/cardano-data/src/Data/OMap/Strict.hs @@ -421,7 +421,7 @@ instance Ord k => Foldable (OMap k) where null = Map.null . omMap {-# INLINE null #-} -instance (Typeable k, EncCBOR v, Ord k) => EncCBOR (OMap k v) where +instance (EncCBOR v, Ord k) => EncCBOR (OMap k v) where encCBOR omap = encodeStrictSeq encCBOR (toStrictSeq omap) instance (Typeable k, HasOKey k v, DecCBOR v, Eq v) => DecCBOR (OMap k v) where diff --git a/libs/cardano-ledger-binary/CHANGELOG.md b/libs/cardano-ledger-binary/CHANGELOG.md index 58ffe52c73e..d780ab5e73b 100644 --- a/libs/cardano-ledger-binary/CHANGELOG.md +++ b/libs/cardano-ledger-binary/CHANGELOG.md @@ -1,8 +1,10 @@ # Version history for `cardano-ledger-binary` -## 1.7.0.1 +## 1.8.0.0 -* +* Remove `encodedSizeExpr` and `encodedListSizeExpr` from `EncCBOR` +* Remove `Typeable` superconstraint from `EncCBOR` +* Remove `Range`, `szEval`, `Size`, `Case`, `caseValue`, `LengthOf`, `SizeOverride`, `isTodo`, `szCases`, `szLazy`, `szGreedy`, `szForce`, `szWithCtx`, `szSimplify`, `apMono`, `szBounds`, `encodedVerKeyDSIGNSizeExpr`, `encodedSignKeyDSIGNSizeExpr`, `encodedSigDSIGNSizeExpr`, `encodedSignedDSIGNSizeExpr`, `encodedVerKeyKESSizeExpr`, `encodedSignKeyKESSizeExpr`, `encodedSigKESSizeExpr`, `encodedVerKeyVRFSizeExpr`, `encodedSignKeyVRFSizeExpr` and `encodedCertVRFSizeExpr` ## 1.7.0.0 diff --git a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal index ab1df592304..9c3f2dce941 100644 --- a/libs/cardano-ledger-binary/cardano-ledger-binary.cabal +++ b/libs/cardano-ledger-binary/cardano-ledger-binary.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: cardano-ledger-binary -version: 1.7.0.1 +version: 1.8.0.0 license: Apache-2.0 maintainer: operations@iohk.io author: IOHK @@ -62,7 +62,6 @@ library cardano-strict-containers >=0.1.2, cborg >=0.2.10, containers, - data-fix, deepseq, formatting, iproute, @@ -74,7 +73,6 @@ library plutus-ledger-api >=1.27.0, primitive, random >=1.2, - recursion-schemes, serialise, tagged, text, @@ -159,7 +157,6 @@ test-suite tests Test.Cardano.Ledger.Binary.Vintage.Failure Test.Cardano.Ledger.Binary.Vintage.RoundTrip Test.Cardano.Ledger.Binary.Vintage.Serialization - Test.Cardano.Ledger.Binary.Vintage.SizeBounds default-language: Haskell2010 ghc-options: diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs index af6175d0b94..76681635f81 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary.hs @@ -14,7 +14,28 @@ module Cardano.Ledger.Binary ( import Cardano.Ledger.Binary.Decoding import Cardano.Ledger.Binary.Encoding import Cardano.Ledger.Binary.Group -import Cardano.Ledger.Binary.Plain (FromCBOR (fromCBOR), ToCBOR (toCBOR)) +import Cardano.Ledger.Binary.Plain ( + Case (..), + FromCBOR (fromCBOR), + LengthOf (..), + Range (..), + Size, + SizeOverride (..), + ToCBOR (..), + apMono, + caseValue, + isTodo, + szBounds, + szCases, + szEval, + szForce, + szGreedy, + szLazy, + szSimplify, + szWithCtx, + toCBORMaybe, + withWordSize, + ) import qualified Cardano.Ledger.Binary.Plain as Plain import Cardano.Ledger.Binary.Version import qualified Codec.CBOR.Read as C (DeserialiseFailure (..)) diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding.hs index a0cfedd4841..06ef152bd8a 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding.hs @@ -19,8 +19,6 @@ module Cardano.Ledger.Binary.Encoding ( -- * Nested CBOR-in-CBOR encodeNestedCbor, encodeNestedCborBytes, - nestedCborSizeExpr, - nestedCborBytesSizeExpr, -- * Tools runByteBuilder, @@ -93,12 +91,6 @@ encodeNestedCbor value = encodeNestedCborBytes :: BSL.ByteString -> Encoding encodeNestedCborBytes x = encodeTag 24 <> encCBOR x -nestedCborSizeExpr :: Size -> Size -nestedCborSizeExpr x = 2 + apMono "withWordSize" withWordSize x + x - -nestedCborBytesSizeExpr :: Size -> Size -nestedCborBytesSizeExpr x = 2 + apMono "withWordSize" withWordSize x + x - -------------------------------------------------------------------------------- -- Tools -------------------------------------------------------------------------------- diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs index 44f57c92fc7..530be84063d 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/EncCBOR.hs @@ -21,39 +21,8 @@ module Cardano.Ledger.Binary.Encoding.EncCBOR ( EncCBOR (..), - withWordSize, PreEncoded (..), toByronCBOR, - - -- * Size of expressions - Range (..), - szEval, - Size, - Case (..), - caseValue, - LengthOf (..), - SizeOverride (..), - isTodo, - szCases, - szLazy, - szGreedy, - szForce, - szWithCtx, - szSimplify, - apMono, - szBounds, - - -- ** Crypto - encodedVerKeyDSIGNSizeExpr, - encodedSignKeyDSIGNSizeExpr, - encodedSigDSIGNSizeExpr, - encodedSignedDSIGNSizeExpr, - encodedVerKeyKESSizeExpr, - encodedSignKeyKESSizeExpr, - encodedSigKESSizeExpr, - encodedVerKeyVRFSizeExpr, - encodedSignKeyVRFSizeExpr, - encodedCertVRFSizeExpr, ) where import Cardano.Crypto.DSIGN.Class ( @@ -62,24 +31,15 @@ import Cardano.Crypto.DSIGN.Class ( SignKeyDSIGN, SignedDSIGN, VerKeyDSIGN, - sizeSigDSIGN, - sizeSignKeyDSIGN, - sizeVerKeyDSIGN, ) import Cardano.Crypto.Hash.Class ( Hash (..), HashAlgorithm, - hashToBytes, - sizeHash, ) import Cardano.Crypto.KES.Class ( KESAlgorithm, SigKES, - SignKeyKES, VerKeyKES, - sizeSigKES, - sizeSignKeyKES, - sizeVerKeyKES, ) import Cardano.Crypto.VRF.Class ( CertVRF, @@ -88,17 +48,13 @@ import Cardano.Crypto.VRF.Class ( SignKeyVRF, VRFAlgorithm, VerKeyVRF, - sizeCertVRF, - sizeOutputVRF, - sizeSignKeyVRF, - sizeVerKeyVRF, ) import Cardano.Crypto.VRF.Mock (MockVRF) import qualified Cardano.Crypto.VRF.Praos as Praos import Cardano.Crypto.VRF.Simple (SimpleVRF) import Cardano.Ledger.Binary.Crypto import Cardano.Ledger.Binary.Encoding.Encoder -import Cardano.Ledger.Binary.Version (Version, byronProtVer, getVersion64) +import Cardano.Ledger.Binary.Version (Version, byronProtVer) import Cardano.Slotting.Block (BlockNo (..)) import Cardano.Slotting.Slot ( EpochInterval (..), @@ -125,7 +81,6 @@ import Data.ByteString.Short.Internal (ShortByteString(SBS)) import qualified Cardano.Binary as Plain (Encoding, ToCBOR (..)) import Data.Fixed (Fixed (..)) import Data.Foldable (toList) -import Data.Functor.Foldable (cata, project) import Data.IP (IPv4, IPv6) import Data.Int (Int16, Int32, Int64, Int8) import Data.List.NonEmpty (NonEmpty) @@ -137,11 +92,8 @@ import qualified Data.Sequence as Seq import qualified Data.Sequence.Strict as SSeq import qualified Data.Set as Set import Data.Tagged (Tagged (..)) -import Data.Text (Text) import qualified Data.Text as Text -import Data.Text.Lazy.Builder (Builder) import Data.Time.Clock (UTCTime (..)) -import Data.Typeable (Proxy (..), TypeRep, Typeable, typeRep) import qualified Data.VMap as VMap import qualified Data.Vector as V import qualified Data.Vector.Primitive as VP @@ -149,48 +101,17 @@ import qualified Data.Vector.Storable as VS import qualified Data.Vector.Unboxed as VU import Data.Void (Void, absurd) import Data.Word (Word16, Word32, Word64, Word8) -import Foreign.Storable (sizeOf) -import Formatting (bprint, build, shown, stext) -import qualified Formatting.Buildable as B (Buildable (..)) import Numeric.Natural (Natural) import qualified PlutusLedgerApi.V1 as PV1 import qualified PlutusLedgerApi.V2 as PV2 import qualified PlutusLedgerApi.V3 as PV3 import Prelude hiding (encodeFloat, (.)) -#if MIN_VERSION_recursion_schemes(5,2,0) -import Data.Fix (Fix(..)) -#else -import Data.Functor.Foldable (Fix(..)) -#endif - -class Typeable a => EncCBOR a where +class EncCBOR a where encCBOR :: a -> Encoding default encCBOR :: Plain.ToCBOR a => a -> Encoding encCBOR = fromPlainEncoding . Plain.toCBOR - encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size - encodedSizeExpr = todo - - encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size - encodedListSizeExpr = defaultEncodedListSizeExpr - --- | A type used to represent the length of a value in 'Size' computations. -newtype LengthOf xs = LengthOf xs - -instance Typeable xs => EncCBOR (LengthOf xs) where - encCBOR = error "The `LengthOf` type cannot be encoded!" - --- | Default size expression for a list type. -defaultEncodedListSizeExpr :: - forall a. - EncCBOR a => - (forall t. EncCBOR t => Proxy t -> Size) -> - Proxy [a] -> - Size -defaultEncodedListSizeExpr size _ = - 2 + size (Proxy @(LengthOf [a])) * size (Proxy @a) - newtype PreEncoded = PreEncoded {unPreEncoded :: BS.ByteString} instance EncCBOR PreEncoded where @@ -198,323 +119,21 @@ instance EncCBOR PreEncoded where instance EncCBOR Version where encCBOR = encodeVersion - encodedSizeExpr f px = f (getVersion64 <$> px) -- | Convert a versioned `EncCBOR` instance to a plain `Plain.Encoding` using Byron -- protocol version. toByronCBOR :: EncCBOR a => a -> Plain.Encoding toByronCBOR = toPlainEncoding byronProtVer . encCBOR --------------------------------------------------------------------------------- --- Size expressions --------------------------------------------------------------------------------- - -(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d) -f .: g = \x y -> f (g x y) - --- | Expressions describing the statically-computed size bounds on --- a type's possible values. -type Size = Fix SizeF - --- | The base functor for @Size@ expressions. -data SizeF t - = -- | Sum of two sizes. - AddF t t - | -- | Product of two sizes. - MulF t t - | -- | Difference of two sizes. - SubF t t - | -- | Absolute value of a size. - AbsF t - | -- | Negation of a size. - NegF t - | -- | Signum of a size. - SgnF t - | -- | Case-selection for sizes. Used for sum types. - CasesF [Case t] - | -- | A constant value. - ValueF Natural - | -- | Application of a monotonic function to a size. - ApF Text (Natural -> Natural) t - | -- | A suspended size calculation ("thunk"). This is used to delay the - -- computation of a size until some later point, which is useful for - -- progressively building more detailed size estimates for a type - -- from the outside in. For example, `szLazy` can be followed by - -- applications of `szForce` to reveal more detailed expressions - -- describing the size bounds on a type. - forall a. EncCBOR a => TodoF (forall x. EncCBOR x => Proxy x -> Size) (Proxy a) - -instance Functor SizeF where - fmap f = \case - AddF x y -> AddF (f x) (f y) - MulF x y -> MulF (f x) (f y) - SubF x y -> SubF (f x) (f y) - AbsF x -> AbsF (f x) - NegF x -> NegF (f x) - SgnF x -> SgnF (f x) - CasesF xs -> CasesF (map (fmap f) xs) - ValueF x -> ValueF x - ApF n g x -> ApF n g (f x) - TodoF g x -> TodoF g x - -instance Num (Fix SizeF) where - (+) = Fix .: AddF - (*) = Fix .: MulF - (-) = Fix .: SubF - negate = Fix . NegF - abs = Fix . AbsF - signum = Fix . SgnF - fromInteger = Fix . ValueF . fromInteger - -instance B.Buildable t => B.Buildable (SizeF t) where - build x_ = - let showp2 :: (B.Buildable a, B.Buildable b) => a -> Text -> b -> Builder - showp2 = bprint ("(" . build . " " . stext . " " . build . ")") - in case x_ of - AddF x y -> showp2 x "+" y - MulF x y -> showp2 x "*" y - SubF x y -> showp2 x "-" y - NegF x -> bprint ("-" . build) x - AbsF x -> bprint ("|" . build . "|") x - SgnF x -> bprint ("sgn(" . build . ")") x - CasesF xs -> - bprint ("{ " . build . "}") $ foldMap (bprint (build . " ")) xs - ValueF x -> bprint shown (toInteger x) - ApF n _ x -> bprint (stext . "(" . build . ")") n x - TodoF _ x -> bprint ("(_ :: " . shown . ")") (typeRep x) - -instance B.Buildable (Fix SizeF) where - build x = bprint build (project @(Fix _) x) - --- | Create a case expression from individual cases. -szCases :: [Case Size] -> Size -szCases = Fix . CasesF - --- | An individual labeled case. -data Case t - = Case Text t - deriving (Functor) - --- | Discard the label on a case. -caseValue :: Case t -> t -caseValue (Case _ x) = x - -instance B.Buildable t => B.Buildable (Case t) where - build (Case n x) = bprint (stext . "=" . build) n x - --- | A range of values. Should satisfy the invariant @forall x. lo x <= hi x@. -data Range b = Range - { lo :: b - , hi :: b - } - --- | The @Num@ instance for @Range@ uses interval arithmetic. Note that the --- @signum@ method is not lawful: if the interval @x@ includes 0 in its --- interior but is not symmetric about 0, then @abs x * signum x /= x@. -instance (Ord b, Num b) => Num (Range b) where - x + y = Range {lo = lo x + lo y, hi = hi x + hi y} - x * y = - let products = [u * v | u <- [lo x, hi x], v <- [lo y, hi y]] - in Range {lo = minimum products, hi = maximum products} - x - y = Range {lo = lo x - hi y, hi = hi x - lo y} - negate x = Range {lo = negate (hi x), hi = negate (lo x)} - abs x = - if - | lo x <= 0 && hi x >= 0 -> Range {lo = 0, hi = max (hi x) (negate $ lo x)} - | lo x <= 0 && hi x <= 0 -> Range {lo = negate (hi x), hi = negate (lo x)} - | otherwise -> x - signum x = Range {lo = signum (lo x), hi = signum (hi x)} - fromInteger n = Range {lo = fromInteger n, hi = fromInteger n} - -instance B.Buildable (Range Natural) where - build r = bprint (shown . ".." . shown) (toInteger $ lo r) (toInteger $ hi r) - --- | Fully evaluate a size expression by applying the given function to any --- suspended computations. @szEval g@ effectively turns each "thunk" --- of the form @TodoF f x@ into @g x@, then evaluates the result. -szEval :: - (forall t. EncCBOR t => (Proxy t -> Size) -> Proxy t -> Range Natural) -> - Size -> - Range Natural -szEval doit = cata $ \case - AddF x y -> x + y - MulF x y -> x * y - SubF x y -> x - y - NegF x -> negate x - AbsF x -> abs x - SgnF x -> signum x - CasesF xs -> - Range - { lo = minimum (map (lo . caseValue) xs) - , hi = maximum (map (hi . caseValue) xs) - } - ValueF x -> Range {lo = x, hi = x} - ApF _ f x -> Range {lo = f (lo x), hi = f (hi x)} - TodoF f x -> doit f x - --- | Evaluate the expression lazily, by immediately creating a thunk --- that will evaluate its contents lazily. --- --- > ghci> putStrLn $ pretty $ szLazy (Proxy @TxAux) --- > (_ :: TxAux) -szLazy :: EncCBOR a => (Proxy a -> Size) -szLazy = todo (encodedSizeExpr szLazy) - --- | Evaluate an expression greedily. There may still be thunks in the --- result, for types that did not provide a custom 'encodedSizeExpr' method --- in their 'EncCBOR' instance. --- --- > ghci> putStrLn $ pretty $ szGreedy (Proxy @TxAux) --- > (0 + { TxAux=(2 + ((0 + (((1 + (2 + ((_ :: LengthOf [TxIn]) * (2 + { TxInUtxo=(2 + ((1 + 34) + { minBound=1 maxBound=5 })) })))) + (2 + ((_ :: LengthOf [TxOut]) * (0 + { TxOut=(2 + ((0 + ((2 + ((2 + withWordSize((((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + (((1 + 30) + (_ :: Attributes AddrAttributes)) + 1))) + { minBound=1 maxBound=5 })) + { minBound=1 maxBound=9 })) })))) + (_ :: Attributes ()))) + (_ :: Vector TxInWitness))) }) -szGreedy :: EncCBOR a => (Proxy a -> Size) -szGreedy = encodedSizeExpr szGreedy - --- | Is this expression a thunk? -isTodo :: Size -> Bool -isTodo (Fix (TodoF _ _)) = True -isTodo _ = False - --- | Create a "thunk" that will apply @f@ to @pxy@ when forced. -todo :: - forall a. - EncCBOR a => - (forall t. EncCBOR t => Proxy t -> Size) -> - Proxy a -> - Size -todo f pxy = Fix (TodoF f pxy) - --- | Apply a monotonically increasing function to the expression. --- There are three cases when applying @f@ to a @Size@ expression: --- * When applied to a value @x@, compute @f x@. --- * When applied to cases, apply to each case individually. --- * In all other cases, create a deferred application of @f@. -apMono :: Text -> (Natural -> Natural) -> Size -> Size -apMono n f = \case - Fix (ValueF x) -> Fix (ValueF (f x)) - Fix (CasesF cs) -> Fix (CasesF (map (fmap (apMono n f)) cs)) - x -> Fix (ApF n f x) - --- | Greedily compute the size bounds for a type, using the given context to --- override sizes for specific types. -szWithCtx :: EncCBOR a => Map.Map TypeRep SizeOverride -> Proxy a -> Size -szWithCtx ctx pxy = case Map.lookup (typeRep pxy) ctx of - Nothing -> normal - Just override -> case override of - SizeConstant sz -> sz - SizeExpression f -> f (szWithCtx ctx) - SelectCases names -> cata (selectCase names) normal - where - -- The non-override case - normal = encodedSizeExpr (szWithCtx ctx) pxy - - selectCase :: [Text] -> SizeF Size -> Size - selectCase names orig = case orig of - CasesF cs -> matchCase names cs (Fix orig) - _ -> Fix orig - - matchCase :: [Text] -> [Case Size] -> Size -> Size - matchCase names cs orig = - case filter (\(Case name _) -> name `elem` names) cs of - [] -> orig - [Case _ x] -> x - cs' -> Fix (CasesF cs') - --- | Override mechanisms to be used with 'szWithCtx'. -data SizeOverride - = -- | Replace with a fixed @Size@. - SizeConstant Size - | -- | Recursively compute the size. - SizeExpression ((forall a. EncCBOR a => Proxy a -> Size) -> Size) - | -- | Select only a specific case from a @CasesF@. - SelectCases [Text] - --- | Simplify the given @Size@, resulting in either the simplified @Size@ or, --- if it was fully simplified, an explicit upper and lower bound. -szSimplify :: Size -> Either Size (Range Natural) -szSimplify = cata $ \case - TodoF f pxy -> Left (todo f pxy) - ValueF x -> Right (Range {lo = x, hi = x}) - CasesF xs -> case mapM caseValue xs of - Right xs' -> - Right (Range {lo = minimum (map lo xs'), hi = maximum (map hi xs')}) - Left _ -> Left (szCases $ map (fmap toSize) xs) - AddF x y -> binOp (+) x y - MulF x y -> binOp (*) x y - SubF x y -> binOp (-) x y - NegF x -> unOp negate x - AbsF x -> unOp abs x - SgnF x -> unOp signum x - ApF _ f (Right x) -> Right (Range {lo = f (lo x), hi = f (hi x)}) - ApF n f (Left x) -> Left (apMono n f x) - where - binOp :: - (forall a. Num a => a -> a -> a) -> - Either Size (Range Natural) -> - Either Size (Range Natural) -> - Either Size (Range Natural) - binOp op (Right x) (Right y) = Right (op x y) - binOp op x y = Left (op (toSize x) (toSize y)) - - unOp :: - (forall a. Num a => a -> a) -> - Either Size (Range Natural) -> - Either Size (Range Natural) - unOp f = \case - Right x -> Right (f x) - Left x -> Left (f x) - - toSize :: Either Size (Range Natural) -> Size - toSize = \case - Left x -> x - Right r -> - if lo r == hi r - then fromIntegral (lo r) - else - szCases - [Case "lo" (fromIntegral $ lo r), Case "hi" (fromIntegral $ hi r)] - --- | Force any thunks in the given @Size@ expression. --- --- > ghci> putStrLn $ pretty $ szForce $ szLazy (Proxy @TxAux) --- > (0 + { TxAux=(2 + ((0 + (_ :: Tx)) + (_ :: Vector TxInWitness))) }) -szForce :: Size -> Size -szForce = cata $ \case - AddF x y -> x + y - MulF x y -> x * y - SubF x y -> x - y - NegF x -> negate x - AbsF x -> abs x - SgnF x -> signum x - CasesF xs -> Fix $ CasesF xs - ValueF x -> Fix (ValueF x) - ApF n f x -> apMono n f x - TodoF f x -> f x - -szBounds :: EncCBOR a => a -> Either Size (Range Natural) -szBounds = szSimplify . szGreedy . pure - --- | Compute encoded size of an integer -withWordSize :: (Integral s, Integral a) => s -> a -withWordSize x = - let s = fromIntegral x :: Integer - in if - | s <= 0x17 && s >= (-0x18) -> 1 - | s <= 0xff && s >= (-0x100) -> 2 - | s <= 0xffff && s >= (-0x10000) -> 3 - | s <= 0xffffffff && s >= (-0x100000000) -> 5 - | otherwise -> 9 - -------------------------------------------------------------------------------- -- Primitive types -------------------------------------------------------------------------------- instance EncCBOR () where encCBOR = const encodeNull - encodedSizeExpr _ _ = 1 instance EncCBOR Bool where encCBOR = encodeBool - encodedSizeExpr _ _ = 1 -------------------------------------------------------------------------------- -- Numeric data @@ -523,69 +142,46 @@ instance EncCBOR Bool where instance EncCBOR Integer where encCBOR = encodeInteger -encodedSizeRange :: forall a. (Integral a, Bounded a) => Proxy a -> Size -encodedSizeRange _ = - szCases - [ mkCase "minBound" 0 -- min, in absolute value - , mkCase "maxBound" maxBound - ] - where - mkCase :: Text -> a -> Case Size - mkCase n = Case n . fromInteger . withWordSize - instance EncCBOR Word where encCBOR = encodeWord - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Word8 where encCBOR = encodeWord8 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Word16 where encCBOR = encodeWord16 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Word32 where encCBOR = encodeWord32 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Word64 where encCBOR = encodeWord64 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Int where encCBOR = encodeInt - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Int8 where encCBOR = encodeInt8 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Int16 where encCBOR = encodeInt16 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Int32 where encCBOR = encodeInt32 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Int64 where encCBOR = encodeInt64 - encodedSizeExpr _ = encodedSizeRange instance EncCBOR Float where encCBOR = encodeFloat - encodedSizeExpr _ _ = 1 + fromIntegral (sizeOf (0 :: Float)) instance EncCBOR Double where encCBOR = encodeDouble - encodedSizeExpr _ _ = 1 + fromIntegral (sizeOf (0 :: Float)) instance EncCBOR a => EncCBOR (Ratio a) where encCBOR = encodeRatio encCBOR - encodedSizeExpr size _ = 1 + size (Proxy @a) + size (Proxy @a) -deriving newtype instance Typeable p => EncCBOR (Fixed p) +deriving newtype instance EncCBOR (Fixed p) instance EncCBOR Natural where encCBOR = encCBOR . toInteger @@ -619,11 +215,9 @@ instance EncCBOR (Tokens -> Tokens) where -- Tagged -------------------------------------------------------------------------------- -instance (Typeable s, EncCBOR a) => EncCBOR (Tagged s a) where +instance EncCBOR a => EncCBOR (Tagged s a) where encCBOR (Tagged a) = encCBOR a - encodedSizeExpr size _ = encodedSizeExpr size (Proxy @a) - -------------------------------------------------------------------------------- -- Containers -------------------------------------------------------------------------------- @@ -631,21 +225,13 @@ instance (Typeable s, EncCBOR a) => EncCBOR (Tagged s a) where instance (EncCBOR a, EncCBOR b) => EncCBOR (a, b) where encCBOR (a, b) = encodeListLen 2 <> encCBOR a <> encCBOR b - encodedSizeExpr size _ = 1 + size (Proxy @a) + size (Proxy @b) - instance (EncCBOR a, EncCBOR b, EncCBOR c) => EncCBOR (a, b, c) where encCBOR (a, b, c) = encodeListLen 3 <> encCBOR a <> encCBOR b <> encCBOR c - encodedSizeExpr size _ = - 1 + size (Proxy @a) + size (Proxy @b) + size (Proxy @c) - instance (EncCBOR a, EncCBOR b, EncCBOR c, EncCBOR d) => EncCBOR (a, b, c, d) where encCBOR (a, b, c, d) = encodeListLen 4 <> encCBOR a <> encCBOR b <> encCBOR c <> encCBOR d - encodedSizeExpr size _ = - 1 + size (Proxy @a) + size (Proxy @b) + size (Proxy @c) + size (Proxy @d) - instance (EncCBOR a, EncCBOR b, EncCBOR c, EncCBOR d, EncCBOR e) => EncCBOR (a, b, c, d, e) @@ -658,14 +244,6 @@ instance <> encCBOR d <> encCBOR e - encodedSizeExpr size _ = - 1 - + size (Proxy @a) - + size (Proxy @b) - + size (Proxy @c) - + size (Proxy @d) - + size (Proxy @e) - instance (EncCBOR a, EncCBOR b, EncCBOR c, EncCBOR d, EncCBOR e, EncCBOR f) => EncCBOR (a, b, c, d, e, f) @@ -679,15 +257,6 @@ instance <> encCBOR e <> encCBOR f - encodedSizeExpr size _ = - 1 - + size (Proxy @a) - + size (Proxy @b) - + size (Proxy @c) - + size (Proxy @d) - + size (Proxy @e) - + size (Proxy @f) - instance (EncCBOR a, EncCBOR b, EncCBOR c, EncCBOR d, EncCBOR e, EncCBOR f, EncCBOR g) => EncCBOR (a, b, c, d, e, f, g) @@ -702,29 +271,11 @@ instance <> encCBOR f <> encCBOR g - encodedSizeExpr size _ = - 1 - + size (Proxy @a) - + size (Proxy @b) - + size (Proxy @c) - + size (Proxy @d) - + size (Proxy @e) - + size (Proxy @f) - + size (Proxy @g) - instance EncCBOR BS.ByteString where encCBOR = encodeBytes - encodedSizeExpr size _ = - let len = size (Proxy @(LengthOf BS.ByteString)) - in apMono "withWordSize@Int" (withWordSize @Int . fromIntegral) len + len instance EncCBOR Text.Text where encCBOR = encodeString - encodedSizeExpr size _ = - let bsLength = - size (Proxy @(LengthOf Text)) - * szCases [Case "minChar" 1, Case "maxChar" 4] - in bsLength + apMono "withWordSize" withWordSize bsLength instance EncCBOR ByteArray where encCBOR = encCBOR . unBA @@ -742,48 +293,29 @@ instance EncCBOR ShortByteString where encCBOR sbs@(SBS ba) = encodeByteArray $ SBA (Prim.ByteArray ba) 0 (SBS.length sbs) - encodedSizeExpr size _ = - let len = size (Proxy @(LengthOf ShortByteString)) - in apMono "withWordSize@Int" (withWordSize @Int . fromIntegral) len + len - instance EncCBOR BS.Lazy.ByteString where encCBOR = encCBOR . BS.Lazy.toStrict - encodedSizeExpr size _ = - let len = size (Proxy @(LengthOf BS.Lazy.ByteString)) - in apMono "withWordSize@Int" (withWordSize @Int . fromIntegral) len + len instance EncCBOR a => EncCBOR [a] where encCBOR = encodeList encCBOR - encodedSizeExpr size _ = encodedListSizeExpr size (Proxy @[a]) instance (EncCBOR a, EncCBOR b) => EncCBOR (Either a b) where encCBOR (Left x) = encodeListLen 2 <> encodeWord 0 <> encCBOR x encCBOR (Right x) = encodeListLen 2 <> encodeWord 1 <> encCBOR x - encodedSizeExpr size _ = - szCases - [Case "Left" (2 + size (Proxy @a)), Case "Right" (2 + size (Proxy @b))] - instance EncCBOR a => EncCBOR (NonEmpty a) where encCBOR = encCBOR . toList - encodedSizeExpr size _ = size (Proxy @[a]) -- MN TODO make 0 count impossible instance EncCBOR a => EncCBOR (Maybe a) where encCBOR = encodeMaybe encCBOR - encodedSizeExpr size _ = - szCases [Case "Nothing" 1, Case "Just" (1 + size (Proxy @a))] - instance EncCBOR a => EncCBOR (SMaybe.StrictMaybe a) where encCBOR = encodeStrictMaybe encCBOR - encodedSizeExpr size _ = - szCases [Case "SNothing" 1, Case "SJust" (1 + size (Proxy @a))] - -instance (Ord k, EncCBOR k, EncCBOR v) => EncCBOR (Map.Map k v) where +instance (EncCBOR k, EncCBOR v) => EncCBOR (Map.Map k v) where encCBOR = encodeMap encCBOR encCBOR -instance (Ord a, EncCBOR a) => EncCBOR (Set.Set a) where +instance EncCBOR a => EncCBOR (Set.Set a) where encCBOR = encodeSet encCBOR instance EncCBOR a => EncCBOR (Seq.Seq a) where @@ -793,7 +325,7 @@ instance EncCBOR a => EncCBOR (SSeq.StrictSeq a) where encCBOR = encodeStrictSeq encCBOR instance - (Ord k, EncCBOR k, EncCBOR v, VMap.Vector kv k, VMap.Vector vv v, Typeable kv, Typeable vv) => + (EncCBOR k, EncCBOR v, VMap.Vector kv k, VMap.Vector vv v) => EncCBOR (VMap.VMap kv vv k v) where encCBOR = encodeVMap encCBOR encCBOR @@ -801,26 +333,18 @@ instance instance EncCBOR a => EncCBOR (V.Vector a) where encCBOR = encodeVector encCBOR {-# INLINE encCBOR #-} - encodedSizeExpr size _ = - 2 + size (Proxy @(LengthOf (V.Vector a))) * size (Proxy @a) instance (EncCBOR a, VP.Prim a) => EncCBOR (VP.Vector a) where encCBOR = encodeVector encCBOR {-# INLINE encCBOR #-} - encodedSizeExpr size _ = - 2 + size (Proxy @(LengthOf (VP.Vector a))) * size (Proxy @a) instance (EncCBOR a, VS.Storable a) => EncCBOR (VS.Vector a) where encCBOR = encodeVector encCBOR {-# INLINE encCBOR #-} - encodedSizeExpr size _ = - 2 + size (Proxy @(LengthOf (VS.Vector a))) * size (Proxy @a) instance (EncCBOR a, VU.Unbox a) => EncCBOR (VU.Vector a) where encCBOR = encodeVector encCBOR {-# INLINE encCBOR #-} - encodedSizeExpr size _ = - 2 + size (Proxy @(LengthOf (VU.Vector a))) * size (Proxy @a) -------------------------------------------------------------------------------- -- Time @@ -829,204 +353,69 @@ instance (EncCBOR a, VU.Unbox a) => EncCBOR (VU.Vector a) where instance EncCBOR UTCTime where encCBOR = encodeUTCTime --------------------------------------------------------------------------------- --- Crypto --------------------------------------------------------------------------------- - --- | 'Size' expression for 'VerKeyDSIGN' which is using 'sizeVerKeyDSIGN' --- encoded as 'Size'. -encodedVerKeyDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (VerKeyDSIGN v) -> Size -encodedVerKeyDSIGNSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeVerKeyDSIGN (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeVerKeyDSIGN (Proxy :: Proxy v)) - --- | 'Size' expression for 'SignKeyDSIGN' which is using 'sizeSignKeyDSIGN' --- encoded as 'Size'. -encodedSignKeyDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SignKeyDSIGN v) -> Size -encodedSignKeyDSIGNSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeSignKeyDSIGN (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeSignKeyDSIGN (Proxy :: Proxy v)) - --- | 'Size' expression for 'SigDSIGN' which is using 'sizeSigDSIGN' encoded as --- 'Size'. -encodedSigDSIGNSizeExpr :: forall v. DSIGNAlgorithm v => Proxy (SigDSIGN v) -> Size -encodedSigDSIGNSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeSigDSIGN (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeSigDSIGN (Proxy :: Proxy v)) - --- | 'Size' expression for 'SignedDSIGN' which uses `encodedSigDSIGNSizeExpr` -encodedSignedDSIGNSizeExpr :: forall v a. DSIGNAlgorithm v => Proxy (SignedDSIGN v a) -> Size -encodedSignedDSIGNSizeExpr _proxy = encodedSigDSIGNSizeExpr (Proxy :: Proxy (SigDSIGN v)) - -------------------------------------------------------------------------------- -- DSIGN -------------------------------------------------------------------------------- instance DSIGNAlgorithm v => EncCBOR (VerKeyDSIGN v) where encCBOR = encodeVerKeyDSIGN - encodedSizeExpr _ = encodedVerKeyDSIGNSizeExpr instance DSIGNAlgorithm v => EncCBOR (SignKeyDSIGN v) where encCBOR = encodeSignKeyDSIGN - encodedSizeExpr _ = encodedSignKeyDSIGNSizeExpr instance DSIGNAlgorithm v => EncCBOR (SigDSIGN v) where encCBOR = encodeSigDSIGN - encodedSizeExpr _ = encodedSigDSIGNSizeExpr -instance (DSIGNAlgorithm v, Typeable a) => EncCBOR (SignedDSIGN v a) where +instance DSIGNAlgorithm v => EncCBOR (SignedDSIGN v a) where encCBOR = encodeSignedDSIGN - encodedSizeExpr _ = encodedSignedDSIGNSizeExpr -------------------------------------------------------------------------------- -- Hash -------------------------------------------------------------------------------- -instance (HashAlgorithm h, Typeable a) => EncCBOR (Hash h a) where +instance HashAlgorithm h => EncCBOR (Hash h a) where encCBOR (UnsafeHash h) = encCBOR h - -- \| 'Size' expression for @Hash h a@, which is expressed using the 'EncCBOR' - -- instance for 'ByteString' (as is the above 'encCBOR' method). 'Size' - -- computation of length of the bytestring is passed as the first argument to - -- 'encodedSizeExpr'. The 'ByteString' instance will use it to calculate - -- @'size' ('Proxy' @('LengthOf' 'ByteString'))@. - encodedSizeExpr _size proxy = - encodedSizeExpr (const hashSize) (hashToBytes <$> proxy) - where - hashSize :: Size - hashSize = fromIntegral (sizeHash (Proxy :: Proxy h)) - --------------------------------------------------------------------------------- --- KES --------------------------------------------------------------------------------- - --- | 'Size' expression for 'VerKeyKES' which is using 'sizeVerKeyKES' encoded --- as 'Size'. -encodedVerKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (VerKeyKES v) -> Size -encodedVerKeyKESSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeVerKeyKES (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeVerKeyKES (Proxy :: Proxy v)) - --- | 'Size' expression for 'SignKeyKES' which is using 'sizeSignKeyKES' encoded --- as 'Size'. -encodedSignKeyKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SignKeyKES v) -> Size -encodedSignKeyKESSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeSignKeyKES (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeSignKeyKES (Proxy :: Proxy v)) - --- | 'Size' expression for 'SigKES' which is using 'sizeSigKES' encoded as --- 'Size'. -encodedSigKESSizeExpr :: forall v. KESAlgorithm v => Proxy (SigKES v) -> Size -encodedSigKESSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeSigKES (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeSigKES (Proxy :: Proxy v)) - instance KESAlgorithm k => EncCBOR (VerKeyKES k) where encCBOR = encodeVerKeyKES - encodedSizeExpr _size = encodedVerKeyKESSizeExpr instance KESAlgorithm k => EncCBOR (SigKES k) where encCBOR = encodeSigKES - encodedSizeExpr _size = encodedSigKESSizeExpr - --------------------------------------------------------------------------------- --- VRF --------------------------------------------------------------------------------- - --- | 'Size' expression for 'VerKeyVRF' which is using 'sizeVerKeyVRF' encoded as --- 'Size'. -encodedVerKeyVRFSizeExpr :: forall v. VRFAlgorithm v => Proxy (VerKeyVRF v) -> Size -encodedVerKeyVRFSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeVerKeyVRF (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeVerKeyVRF (Proxy :: Proxy v)) - --- | 'Size' expression for 'SignKeyVRF' which is using 'sizeSignKeyVRF' encoded --- as 'Size' -encodedSignKeyVRFSizeExpr :: forall v. VRFAlgorithm v => Proxy (SignKeyVRF v) -> Size -encodedSignKeyVRFSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeSignKeyVRF (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeSignKeyVRF (Proxy :: Proxy v)) - --- | 'Size' expression for 'CertVRF' which is using 'sizeCertVRF' encoded as --- 'Size'. -encodedCertVRFSizeExpr :: forall v. VRFAlgorithm v => Proxy (CertVRF v) -> Size -encodedCertVRFSizeExpr _proxy = - -- 'encodeBytes' envelope - fromIntegral ((withWordSize :: Word -> Integer) (sizeCertVRF (Proxy :: Proxy v))) - -- payload - + fromIntegral (sizeCertVRF (Proxy :: Proxy v)) instance EncCBOR (VerKeyVRF SimpleVRF) where encCBOR = encodeVerKeyVRF - encodedSizeExpr _size = encodedVerKeyVRFSizeExpr instance EncCBOR (SignKeyVRF SimpleVRF) where encCBOR = encodeSignKeyVRF - encodedSizeExpr _size = encodedSignKeyVRFSizeExpr instance EncCBOR (CertVRF SimpleVRF) where encCBOR = encodeCertVRF - encodedSizeExpr _size = encodedCertVRFSizeExpr instance EncCBOR (VerKeyVRF MockVRF) where encCBOR = encodeVerKeyVRF - encodedSizeExpr _size = encodedVerKeyVRFSizeExpr instance EncCBOR (SignKeyVRF MockVRF) where encCBOR = encodeSignKeyVRF - encodedSizeExpr _size = encodedSignKeyVRFSizeExpr instance EncCBOR (CertVRF MockVRF) where encCBOR = encodeCertVRF - encodedSizeExpr _size = encodedCertVRFSizeExpr -deriving instance Typeable v => EncCBOR (OutputVRF v) +deriving instance EncCBOR (OutputVRF v) -instance (VRFAlgorithm v, Typeable a) => EncCBOR (CertifiedVRF v a) where +instance VRFAlgorithm v => EncCBOR (CertifiedVRF v a) where encCBOR cvrf = encodeListLen 2 <> encCBOR (certifiedOutput cvrf) <> encodeCertVRF (certifiedProof cvrf) - encodedSizeExpr _size proxy = - 1 - + certifiedOutputSize (certifiedOutput <$> proxy) - + fromIntegral (sizeCertVRF (Proxy :: Proxy v)) - where - certifiedOutputSize :: Proxy (OutputVRF v) -> Size - certifiedOutputSize _proxy = - fromIntegral $ sizeOutputVRF (Proxy :: Proxy v) - instance EncCBOR Praos.Proof where encCBOR = encCBOR . Praos.proofBytes - encodedSizeExpr _ _ = - encodedSizeExpr (\_ -> fromIntegral Praos.certSizeVRF) (Proxy :: Proxy BS.ByteString) instance EncCBOR Praos.SignKey where encCBOR = encCBOR . Praos.skBytes - encodedSizeExpr _ _ = - encodedSizeExpr (\_ -> fromIntegral Praos.signKeySizeVRF) (Proxy :: Proxy BS.ByteString) instance EncCBOR Praos.VerKey where encCBOR = encCBOR . Praos.vkBytes - encodedSizeExpr _ _ = - encodedSizeExpr (\_ -> fromIntegral Praos.verKeySizeVRF) (Proxy :: Proxy BS.ByteString) deriving instance EncCBOR (VerKeyVRF Praos.PraosVRF) @@ -1041,9 +430,8 @@ deriving instance EncCBOR (CertVRF Praos.PraosVRF) -- TODO: Remove usage of 'serialise' package instance EncCBOR SlotNo where encCBOR = fromPlainEncoding . Serialise.encode - encodedSizeExpr size = encodedSizeExpr size . fmap unSlotNo -instance (Serialise.Serialise t, Typeable t) => EncCBOR (WithOrigin t) where +instance Serialise.Serialise t => EncCBOR (WithOrigin t) where encCBOR = fromPlainEncoding . Serialise.encode deriving instance EncCBOR EpochNo @@ -1054,7 +442,6 @@ deriving instance EncCBOR SystemStart instance EncCBOR BlockNo where encCBOR = fromPlainEncoding . Serialise.encode - encodedSizeExpr size = encodedSizeExpr size . fmap unBlockNo deriving instance EncCBOR EpochInterval diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs index c19f799ef19..32488476549 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Group.hs @@ -27,11 +27,6 @@ instance (DecCBORGroup a, EncCBORGroup a) => DecCBOR (CBORGroup a) where instance EncCBORGroup a => EncCBOR (CBORGroup a) where encCBOR (CBORGroup x) = encodeListLen (listLen x) <> encCBORGroup x - encodedSizeExpr size proxy = - fromInteger (withWordSize (listLenBound proxy')) - + encodedGroupSizeExpr size proxy' - where - proxy' = unCBORGroup <$> proxy groupRecord :: forall a s. (EncCBORGroup a, DecCBORGroup a) => Decoder s a groupRecord = decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . listLen) decCBORGroup @@ -40,12 +35,8 @@ groupRecord = decodeRecordNamed "CBORGroup" (fromIntegral . toInteger . listLen) -- EncCBORGroup -------------------------------------------------------------------------------- -class Typeable a => EncCBORGroup a where +class EncCBORGroup a where encCBORGroup :: a -> Encoding - encodedGroupSizeExpr :: - (forall x. EncCBOR x => Proxy x -> Size) -> - Proxy a -> - Size listLen :: a -> Word @@ -65,9 +56,6 @@ class Typeable a => DecCBORGroup a where instance EncCBOR a => EncCBORGroup (a, a) where encCBORGroup (x, y) = encCBOR x <> encCBOR y - encodedGroupSizeExpr size_ proxy = - encodedSizeExpr size_ (fst <$> proxy) - + encodedSizeExpr size_ (snd <$> proxy) listLen _ = 2 listLenBound _ = 2 diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Plain.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Plain.hs index 5b674587648..f5afbbc7b97 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Plain.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Plain.hs @@ -56,7 +56,7 @@ module Cardano.Ledger.Binary.Plain ( C.decodeCertVRF, ) where -import Cardano.Binary hiding (encodedSizeExpr) +import Cardano.Binary import qualified Cardano.Crypto.DSIGN.Class as C import qualified Cardano.Crypto.KES.Class as C import qualified Cardano.Crypto.VRF.Class as C diff --git a/libs/cardano-ledger-binary/test/Main.hs b/libs/cardano-ledger-binary/test/Main.hs index f9ec4ff6fd5..dd152015ce8 100644 --- a/libs/cardano-ledger-binary/test/Main.hs +++ b/libs/cardano-ledger-binary/test/Main.hs @@ -10,14 +10,12 @@ import qualified Test.Cardano.Ledger.Binary.Vintage.Drop as Vintage.Drop import qualified Test.Cardano.Ledger.Binary.Vintage.Failure as Vintage.Failure import qualified Test.Cardano.Ledger.Binary.Vintage.RoundTrip as Vintage.RoundTrip import qualified Test.Cardano.Ledger.Binary.Vintage.Serialization as Vintage.Serialization -import qualified Test.Cardano.Ledger.Binary.Vintage.SizeBounds as Vintage.SizeBounds import Test.Hspec spec :: Spec spec = do describe "Vintage Test Suite" $ do it "RoundTrip" $ Vintage.RoundTrip.tests `shouldReturn` True - it "SizeBounds" $ Vintage.SizeBounds.tests `shouldReturn` True it "Serialization" $ Vintage.Serialization.tests `shouldReturn` True it "Drop" $ Vintage.Drop.tests `shouldReturn` True it "Failure" $ Vintage.Failure.tests `shouldReturn` True diff --git a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/Failure.hs b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/Failure.hs index 558aed117fb..5ede808ac3d 100644 --- a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/Failure.hs +++ b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/Failure.hs @@ -4,7 +4,7 @@ module Test.Cardano.Ledger.Binary.Vintage.Failure (tests) where -import Cardano.Ledger.Binary hiding (Range) +import Cardano.Ledger.Binary import Data.List.NonEmpty (NonEmpty) import Data.Set (Set) import GHC.Stack (HasCallStack, withFrozenCallStack) diff --git a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/SizeBounds.hs b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/SizeBounds.hs deleted file mode 100644 index afe09627f6e..00000000000 --- a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/Vintage/SizeBounds.hs +++ /dev/null @@ -1,192 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Test.Cardano.Ledger.Binary.Vintage.SizeBounds (tests) where - -import Cardano.Ledger.Binary -import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as LBS -import qualified Data.Map as M -import Data.Proxy (Proxy (Proxy)) -import Data.Tagged (Tagged (..)) -import qualified Data.Text as T -import Data.Typeable (typeRep) -import Data.Word (Word32, Word8) -import Hedgehog (Gen, Group (..), checkParallel) -import qualified Hedgehog.Gen as Gen -import qualified Hedgehog.Range as Range -import Test.Cardano.Ledger.Binary.Vintage.Helpers - -tests :: IO Bool -tests = - let listOf :: Gen a -> Gen [a] - listOf = Gen.list (Range.linear 0 300) - in checkParallel $ - Group - "Encoded size bounds for core types." - [ ("()", sizeTest $ scfg {gen = pure (), precise = True}) - , ("Bool", sizeTest $ cfg {gen = Gen.bool, precise = True}) - , ("Word", sizeTest $ cfg {gen = Gen.word Range.exponentialBounded}) - , ("Word8", sizeTest $ cfg {gen = Gen.word8 Range.exponentialBounded}) - , ("Word16", sizeTest $ cfg {gen = Gen.word16 Range.exponentialBounded}) - , ("Word32", sizeTest $ cfg {gen = Gen.word32 Range.exponentialBounded}) - , ("Word64", sizeTest $ cfg {gen = Gen.word64 Range.exponentialBounded}) - , ("Int", sizeTest $ cfg {gen = Gen.int Range.exponentialBounded}) - , - ( "Int (precision)" - , sizeTest $ - cfg - { gen = Gen.int Range.exponentialBounded - , computedCtx = \x -> - M.fromList - [ - ( typeRep (Proxy @Int) - , SizeConstant $ fromIntegral (withWordSize x :: Integer) - ) - ] - , precise = True - } - ) - , - ( "Float" - , sizeTest $ - cfg {gen = Gen.float (Range.exponentialFloat (-1000000) 1000000)} - ) - , ("Int32", sizeTest $ cfg {gen = Gen.int32 Range.exponentialBounded}) - , ("Int64", sizeTest $ cfg {gen = Gen.int64 Range.exponentialBounded}) - , - ( "Tagged () Word32" - , sizeTest $ - (scfg @(Tagged () Word32)) - { gen = Tagged <$> Gen.word32 Range.exponentialBounded - } - ) - , - ( "(Bool, Bool)" - , sizeTest $ - scfg {gen = (,) <$> Gen.bool <*> Gen.bool, precise = True} - ) - , - ( "(Bool, Bool, Bool)" - , sizeTest $ - scfg - { gen = (,,) <$> Gen.bool <*> Gen.bool <*> Gen.bool - , precise = True - } - ) - , - ( "(Bool, Bool, Bool, Bool)" - , sizeTest $ - scfg - { gen = (,,,) <$> Gen.bool <*> Gen.bool <*> Gen.bool <*> Gen.bool - , precise = True - } - ) - , - ( "ByteString" - , sizeTest $ - (scfg @BS.ByteString) - { debug = show . (BS.unpack :: BS.ByteString -> [Word8]) - , gen = Gen.bytes (Range.linear 0 1000) - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf BS.ByteString)) - , SizeConstant $ fromIntegral $ BS.length bs - ) - ] - , precise = True - } - ) - , - ( "Lazy.ByteString" - , sizeTest $ - (scfg @LBS.ByteString) - { debug = show . (LBS.unpack :: LBS.ByteString -> [Word8]) - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf LBS.ByteString)) - , SizeConstant $ fromIntegral $ LBS.length bs - ) - ] - , gen = LBS.fromStrict <$> Gen.bytes (Range.linear 0 1000) - , precise = True - } - ) - , - ( "Text" - , sizeTest $ - cfg - { gen = Gen.text (Range.linear 0 1000) Gen.latin1 - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf T.Text)) - , SizeConstant $ fromIntegral $ T.length bs - ) - ] - } - ) - , - ( "Text 2" - , sizeTest $ - cfg - { gen = Gen.text (Range.linear 0 1000) Gen.unicode - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf T.Text)) - , SizeConstant $ fromIntegral $ T.length bs - ) - ] - } - ) - , - ( "[Bool]" - , sizeTest $ - scfg - { gen = listOf Gen.bool - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf [Bool])) - , SizeConstant $ fromIntegral $ length bs - ) - ] - , precise = True - } - ) - , - ( "NonEmpty Bool" - , sizeTest $ - scfg - { gen = listOf Gen.bool - , computedCtx = \bs -> - M.fromList - [ - ( typeRep (Proxy @(LengthOf [Bool])) - , SizeConstant $ fromIntegral $ length bs - ) - ] - , precise = True - } - ) - , - ( "Either Bool Bool" - , sizeTest $ - (scfg @(Either Bool Bool)) - { gen = Left <$> Gen.bool - , precise = True - } - ) - , - ( "Either Bool Bool" - , sizeTest $ - (scfg @(Either Bool Bool)) - { gen = Right <$> Gen.bool - , precise = True - } - ) - , ("Maybe Bool", sizeTest $ cfg {gen = Gen.bool, precise = True}) - ] diff --git a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cddl.hs b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cddl.hs index 39a60d8bf84..244f1c8f44e 100644 --- a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cddl.hs +++ b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cddl.hs @@ -213,7 +213,7 @@ cddlFailure diagCbor err = -- | Similar to `cddlRoundTripCborSpec`, but for Annotator. cddlRoundTripAnnCborSpec :: forall a. - (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a)) => + (HasCallStack, Eq a, Show a, EncCBOR a, DecCBOR (Annotator a), Typeable a) => -- | Serialization version Version -> -- | Cddl variable name diff --git a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs index 14534b11f77..319155d70f6 100644 --- a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs +++ b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Twiddle.hs @@ -45,7 +45,6 @@ import Data.Sequence.Strict (StrictSeq) import Data.Set (Set) import Data.Text (Text) import qualified Data.Text.Lazy as T -import Data.Typeable (Typeable) import Data.Void (Void, absurd) import GHC.Generics import Test.Cardano.Ledger.Binary.Arbitrary () @@ -127,7 +126,7 @@ instance Twiddle a => Twiddle (Seq a) where instance Twiddle a => Twiddle (StrictSeq a) where twiddle v = twiddle v . toList -instance Typeable a => EncCBOR (Twiddler a) where +instance EncCBOR (Twiddler a) where encCBOR (Twiddler _ _ x) = encodeTerm x instance (EncCBOR a, DecCBOR a) => DecCBOR (Twiddler a) where diff --git a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Vintage/Helpers.hs b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Vintage/Helpers.hs index 709534e0d3e..d881c293ae2 100644 --- a/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Vintage/Helpers.hs +++ b/libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Vintage/Helpers.hs @@ -15,43 +15,23 @@ module Test.Cardano.Ledger.Binary.Vintage.Helpers ( U24, extensionProperty, cborFlatTermValid, - - -- * Static size estimates - SizeTestConfig (..), - cfg, - scfg, - sizeTest, ) where import Cardano.Ledger.Binary ( DecCBOR (..), EncCBOR (..), - Range (..), - Size, - SizeOverride (..), byronProtVer, decodeListLenOf, decodeNestedCborBytes, encodeListLen, encodeNestedCborBytes, serialize, - szSimplify, - szWithCtx, unsafeDeserialize, ) import Cardano.Ledger.Binary.FlatTerm (toFlatTerm, validFlatTerm) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS -import qualified Data.Map as M -import Data.Text.Lazy (unpack) -import Data.Text.Lazy.Builder (toLazyText) -import Data.Typeable (TypeRep) import Data.Word (Word8) -import Formatting (Buildable, bprint, build) -import Hedgehog (annotate, failure, forAllWith, success) -import qualified Hedgehog as HH -import qualified Hedgehog.Gen as HH.Gen -import Numeric.Natural (Natural) import Test.Cardano.Ledger.Binary.Arbitrary () import Test.Hspec () import Test.Hspec.QuickCheck () @@ -164,99 +144,3 @@ extensionProperty = forAll @a (arbitrary :: Gen a) $ \input -> (u :: U) = unsafeDeserialize byronProtVer serialized -- Step 2 (encoded :: a) = unsafeDeserialize byronProtVer (serialize byronProtVer u) -- Step 3 in encoded === input - --------------------------------------------------------------------------------- --- Static size estimates --------------------------------------------------------------------------------- - -bshow :: Buildable a => a -> String -bshow = unpack . toLazyText . bprint build - --- | Configuration for a single test case. -data SizeTestConfig a = SizeTestConfig - { debug :: a -> String - -- ^ Pretty-print values - , gen :: HH.Gen a - -- ^ Generator - , precise :: Bool - -- ^ Must estimates be exact? - , addlCtx :: M.Map TypeRep SizeOverride - -- ^ Additional size overrides - , computedCtx :: a -> M.Map TypeRep SizeOverride - -- ^ Size overrides computed from a concrete instance. - } - --- | Default configuration, for @Buildable@ types. -cfg :: Buildable a => SizeTestConfig a -cfg = - SizeTestConfig - { debug = bshow - , gen = HH.Gen.discard - , precise = False - , addlCtx = M.empty - , computedCtx = const M.empty - } - --- | Default configuration, for @Show@able types. -scfg :: Show a => SizeTestConfig a -scfg = - SizeTestConfig - { debug = show - , gen = HH.Gen.discard - , precise = False - , addlCtx = M.empty - , computedCtx = const M.empty - } - --- | Create a test case from the given test configuration. -sizeTest :: forall a. EncCBOR a => SizeTestConfig a -> HH.Property -sizeTest SizeTestConfig {..} = HH.property $ do - x <- forAllWith debug gen - - let ctx = M.union (computedCtx x) addlCtx - - badBounds :: Natural -> Range Natural -> HH.PropertyT IO () - badBounds sz bounds = do - annotate ("Computed bounds: " <> bshow bounds) - annotate ("Actual size: " <> show sz) - annotate ("Value: " <> debug x) - - case szVerify ctx x of - Exact -> success - WithinBounds _ _ | not precise -> success - WithinBounds sz bounds -> do - badBounds sz bounds - annotate "Bounds were not exact." - failure - BoundsAreSymbolic bounds -> do - annotate ("Bounds are symbolic: " <> bshow bounds) - failure - OutOfBounds sz bounds -> do - badBounds sz bounds - annotate "Size fell outside of bounds." - failure - --- | The possible results from @szVerify@, describing various ways --- a size can or cannot be found within a certain range. -data ComparisonResult - = -- | Size matched the bounds, and the bounds were exact. - Exact - | -- | Size matched the bounds, but the bounds are not exact. - WithinBounds Natural (Range Natural) - | -- | The bounds could not be reduced to a numerical range. - BoundsAreSymbolic Size - | -- | The size fell outside of the bounds. - OutOfBounds Natural (Range Natural) - --- | For a given value @x :: a@ with @EncCBOR a@, check that the encoded size --- of @x@ falls within the statically-computed size range for @a@. -szVerify :: EncCBOR a => M.Map TypeRep SizeOverride -> a -> ComparisonResult -szVerify ctx x = case szSimplify (szWithCtx ctx (pure x)) of - Left bounds -> BoundsAreSymbolic bounds - Right range - | lo range <= sz && sz <= hi range -> - if lo range == hi range then Exact else WithinBounds sz range - Right range -> OutOfBounds sz range - where - sz :: Natural - sz = fromIntegral $ LBS.length $ serialize byronProtVer x diff --git a/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ExecSpecRule/Conway/Ledger.hs b/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ExecSpecRule/Conway/Ledger.hs index 2defd334b65..f5fca56f57a 100644 --- a/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ExecSpecRule/Conway/Ledger.hs +++ b/libs/cardano-ledger-conformance/src/Test/Cardano/Ledger/Conformance/ExecSpecRule/Conway/Ledger.hs @@ -87,9 +87,6 @@ instance ( EraPParams era , EraCertState era , EncCBOR (TxOut era) - , EncCBOR (TxBody era) - , EncCBOR (TxAuxData era) - , EncCBOR (TxWits era) , EncCBOR (Tx era) ) => EncCBOR (ConwayLedgerExecContext era) diff --git a/libs/cardano-ledger-core/cardano-ledger-core.cabal b/libs/cardano-ledger-core/cardano-ledger-core.cabal index 7d594cf157e..bdf44f6de2e 100644 --- a/libs/cardano-ledger-core/cardano-ledger-core.cabal +++ b/libs/cardano-ledger-core/cardano-ledger-core.cabal @@ -110,7 +110,7 @@ library cardano-crypto-class ^>=2.2, cardano-crypto-praos ^>=2.2, cardano-crypto-wrapper, - cardano-ledger-binary ^>=1.7, + cardano-ledger-binary ^>=1.8, cardano-ledger-byron, cardano-ledger-core:internal, cardano-slotting, diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs index 43589144b78..d3bd00c38f1 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/BaseTypes.hs @@ -106,7 +106,6 @@ import Cardano.Ledger.Binary ( FromCBOR, ToCBOR, cborError, - encodedSizeExpr, ifDecoderVersionAtLeast, ) import Cardano.Ledger.Binary.Coders ( @@ -225,12 +224,6 @@ instance FromJSON ProtVer where instance EncCBORGroup ProtVer where encCBORGroup (ProtVer x y) = encCBOR x <> encCBOR y - encodedGroupSizeExpr l proxy = - encodedSizeExpr l (pvMajor <$> proxy) - + encodedSizeExpr l (toWord . pvMinor <$> proxy) - where - toWord :: Natural -> Word - toWord = fromIntegral listLen _ = 2 listLenBound _ = 2 @@ -767,7 +760,7 @@ swapMismatch Mismatch {mismatchSupplied, mismatchExpected} = (mismatchExpected, unswapMismatch :: (a, a) -> Mismatch r a unswapMismatch (mismatchExpected, mismatchSupplied) = Mismatch {mismatchSupplied, mismatchExpected} -instance (EncCBOR a, Typeable r) => EncCBOR (Mismatch r a) where +instance EncCBOR a => EncCBOR (Mismatch r a) where encCBOR (Mismatch supplied expected) = encode $ Rec Mismatch @@ -781,11 +774,8 @@ instance (DecCBOR a, Typeable r) => DecCBOR (Mismatch r a) where EncCBORGroup (Mismatch r a) where +instance EncCBOR a => EncCBORGroup (Mismatch r a) where encCBORGroup Mismatch {..} = encCBOR mismatchSupplied <> encCBOR mismatchExpected - encodedGroupSizeExpr size_ proxy = - encodedSizeExpr size_ (mismatchSupplied <$> proxy) - + encodedSizeExpr size_ (mismatchExpected <$> proxy) listLen _ = 2 listLenBound _ = 2 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs index 6fbb55e1ecc..ea7010b8568 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Block.hs @@ -78,6 +78,7 @@ instance ( Era era , EncCBORGroup (BlockBody era) , EncCBOR h + , Typeable h ) => Plain.ToCBOR (Block h era) where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs index de8e9beeb43..c796470568b 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs @@ -126,6 +126,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) import qualified Data.Text as T +import Data.Typeable import Data.Word (Word32, Word64) import GHC.Stack (HasCallStack) import Lens.Micro @@ -522,6 +523,7 @@ class , Show (NativeScript era) , NFData (NativeScript era) , NoThunks (NativeScript era) + , ToCBOR (NativeScript era) , EncCBOR (NativeScript era) , DecCBOR (Annotator (NativeScript era)) ) => @@ -582,6 +584,7 @@ class ( EraTx era , Eq (BlockBody era) , Show (BlockBody era) + , Typeable (BlockBody era) , EncCBORGroup (BlockBody era) , DecCBOR (Annotator (BlockBody era)) ) => diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs index 02dfc70850a..70b81182cae 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Credential.hs @@ -321,11 +321,6 @@ instance EncCBORGroup Ptr where encCBOR sl <> encCBOR txIx <> encCBOR certIx - encodedGroupSizeExpr size_ proxy = - encodedSizeExpr size_ (ptrSlotNo <$> proxy) - + encodedSizeExpr size_ (ptrTxIx <$> proxy) - + encodedSizeExpr size_ (ptrCertIx <$> proxy) - listLen _ = 3 listLenBound _ = 3 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs index 35beec3d2d2..b56d02809da 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Data.hs @@ -83,7 +83,7 @@ import qualified PlutusLedgerApi.V1 as PV1 newtype PlutusData era = PlutusData PV1.Data deriving newtype (Eq, Generic, Show, NFData, NoThunks, Cborg.Serialise) -instance Typeable era => EncCBOR (PlutusData era) where +instance EncCBOR (PlutusData era) where encCBOR (PlutusData d) = fromPlainEncoding $ Cborg.encode d instance Typeable era => DecCBOR (PlutusData era) where @@ -148,7 +148,7 @@ newtype BinaryData era = BinaryData ShortByteString instance HashAnnotated (BinaryData era) EraIndependentData -instance Typeable era => EncCBOR (BinaryData era) where +instance EncCBOR (BinaryData era) where encCBOR (BinaryData sbs) = encodeTag 24 <> encCBOR sbs instance Era era => DecCBOR (BinaryData era) where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Language.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Language.hs index f8000370999..bec96e74bad 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Language.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/Plutus/Language.hs @@ -360,7 +360,7 @@ instance NFData PV2.ScriptContext where instance NFData PV3.ScriptContext where rnf = rnf . PV3.toData -instance (PlutusLanguage l, PV3.ToData (PlutusScriptContext l)) => EncCBOR (LegacyPlutusArgs l) where +instance PV3.ToData (PlutusScriptContext l) => EncCBOR (LegacyPlutusArgs l) where encCBOR = encCBOR . legacyPlutusArgsToData instance (PlutusLanguage l, PV3.FromData (PlutusScriptContext l)) => DecCBOR (LegacyPlutusArgs l) where diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs index b7240484061..353f089dcf1 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/State/Governance.hs @@ -145,7 +145,7 @@ deriving stock instance Show (PParams era) => Show (FuturePParams era) deriving via AllowThunk (FuturePParams era) instance NoThunks (FuturePParams era) -instance (Typeable era, EncCBOR (PParams era)) => EncCBOR (FuturePParams era) where +instance EncCBOR (PParams era) => EncCBOR (FuturePParams era) where encCBOR = encode . \case NoPParamsUpdate -> Sum NoPParamsUpdate 0 diff --git a/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs b/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs index 15211a59599..6f16171946b 100644 --- a/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs +++ b/libs/cardano-ledger-core/src/Cardano/Ledger/State/StakePool.hs @@ -69,19 +69,16 @@ import Cardano.Ledger.BaseTypes ( ) import Cardano.Ledger.Binary ( CBORGroup (..), - Case (..), DecCBOR (..), DecCBORGroup (..), DecShareCBOR (..), EncCBOR (..), EncCBORGroup (..), - Size, decodeNullMaybe, decodeRecordNamed, decodeRecordSum, encodeListLen, encodeNullMaybe, - szCases, ) import Cardano.Ledger.Binary.Coders ( Decode (..), @@ -104,7 +101,6 @@ import qualified Data.ByteString.Base16 as B16 import Data.Default (Default (..)) import Data.Foldable (asum) import Data.IP (IPv4, IPv6) -import Data.Proxy (Proxy (..)) import Data.Sequence.Strict (StrictSeq) import Data.Set (Set) import qualified Data.Text as Text @@ -467,29 +463,6 @@ instance EncCBORGroup PoolParams where <> encCBOR (ppOwners poolParams) <> encCBOR (ppRelays poolParams) <> encodeNullMaybe encCBOR (strictMaybeToMaybe (ppMetadata poolParams)) - - encodedGroupSizeExpr size' proxy = - encodedSizeExpr size' (ppId <$> proxy) - + encodedSizeExpr size' (ppVrf <$> proxy) - + encodedSizeExpr size' (ppPledge <$> proxy) - + encodedSizeExpr size' (ppCost <$> proxy) - + encodedSizeExpr size' (ppMargin <$> proxy) - + encodedSizeExpr size' (ppRewardAccount <$> proxy) - + 2 - + poolSize * encodedSizeExpr size' (elementProxy (ppOwners <$> proxy)) - + 2 - + relaySize * encodedSizeExpr size' (elementProxy (ppRelays <$> proxy)) - + szCases - [ Case "Nothing" 1 - , Case "Just" $ encodedSizeExpr size' (elementProxy (ppMetadata <$> proxy)) - ] - where - poolSize, relaySize :: Size - poolSize = size' (Proxy @SizeOfPoolOwners) - relaySize = size' (Proxy @SizeOfPoolRelays) - elementProxy :: Proxy (f a) -> Proxy a - elementProxy _ = Proxy - listLen _ = 9 listLenBound _ = 9 diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/RoundTrip.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/RoundTrip.hs index e3740e920ec..11d1d5db110 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/RoundTrip.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/RoundTrip.hs @@ -139,7 +139,7 @@ roundTripAnnEraTypeExpectation = roundTripAnnEraExpectation @era @(t era) -- | QuickCheck property spec that uses `roundTripShareEraExpectation` roundTripShareEraSpec :: forall era t. - (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t, Arbitrary t, HasCallStack) => + (Era era, Typeable t, Show t, Eq t, EncCBOR t, DecShareCBOR t, Arbitrary t, HasCallStack) => Spec roundTripShareEraSpec = prop (show (typeRep $ Proxy @t)) $ roundTripShareEraExpectation @era @t @@ -148,7 +148,7 @@ roundTripShareEraSpec = -- EncCBOR/DecShareCBOR. Requires TypeApplication of an @@era@ roundTripShareEraExpectation :: forall era t. - (Era era, Show t, Eq t, EncCBOR t, DecShareCBOR t, HasCallStack) => + (Era era, Typeable t, Show t, Eq t, EncCBOR t, DecShareCBOR t, HasCallStack) => t -> Expectation roundTripShareEraExpectation = @@ -161,6 +161,7 @@ roundTripShareEraExpectation = roundTripShareEraTypeSpec :: forall era t. ( Era era + , Typeable t , Show (t era) , Eq (t era) , EncCBOR (t era) @@ -177,7 +178,7 @@ roundTripShareEraTypeSpec = -- types of this function are unambiguous. roundTripShareEraTypeExpectation :: forall era t. - (Era era, Show (t era), Eq (t era), EncCBOR (t era), DecShareCBOR (t era), HasCallStack) => + (Era era, Typeable t, Show (t era), Eq (t era), EncCBOR (t era), DecShareCBOR (t era), HasCallStack) => t era -> Expectation roundTripShareEraTypeExpectation = roundTripShareEraExpectation @era @(t era) @@ -205,6 +206,7 @@ roundTripCoreEraTypesSpec :: , DecCBOR (TxWits era) , DecCBOR (TxBody era) , DecCBOR (Tx era) + , Typeable (CertState era) , HasCallStack ) => Spec diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs index 8d4ce347c06..f5bf14c6004 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs @@ -107,7 +107,7 @@ instance Uniform (KeyPair kd) where mkKeyPairWithSeed <$> uniformByteStringM (fromIntegral (DSIGN.seedSizeDSIGN (Proxy @DSIGN))) g -instance Typeable r => EncCBOR (KeyPair r) where +instance EncCBOR (KeyPair r) where encCBOR (KeyPair x y) = encode $ Coders.Rec KeyPair !> To x !> To y deriving instance Typeable r => Eq (KeyPair r) diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs index b933f3ea8d9..5586171e833 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Era.hs @@ -26,15 +26,7 @@ import Test.Cardano.Ledger.TreeDiff () class ( -- Core - EraTx era - , EraTxOut era - , EraTxBody era - , EraTxAuxData era - , EraTxWits era - , EraScript era - , EraPParams era - , EraBlockBody era - , EraTxCert era + EraBlockBody era , -- State EraCertState era , EraGov era diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs index b4029d9d0fc..e97e88982a6 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/Utxo.hs @@ -176,9 +176,6 @@ instance instance ( EraPParams era , EncCBOR (TxOut era) - , EncCBOR (TxBody era) - , EncCBOR (TxAuxData era) - , EncCBOR (TxWits era) , EncCBOR (Tx era) , EraCertState era ) => diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/WitnessUniverse.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/WitnessUniverse.hs index dcf56662dbf..631efe0d2d1 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/WitnessUniverse.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Conway/WitnessUniverse.hs @@ -585,7 +585,7 @@ genWitBlock :: (Era era, Ord t, HasWitness t era) => Int -> Gen (ProofType t era) -> Gen (WitBlock t era) genWitBlock n g = blockFromProofList <$> vectorOf n g -instance (Era era, Typeable t) => EncCBOR (WitBlock t era) where +instance Era era => EncCBOR (WitBlock t era) where encCBOR (WitBlock _ m) = encCBOR (Map.elems m) genWitUniv :: diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal index f6a9e9fbd93..c42c7b4a6fb 100644 --- a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal +++ b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal @@ -42,7 +42,7 @@ library cardano-ledger-allegra >=1.1, cardano-ledger-alonzo >=1.2, cardano-ledger-babbage >=1.1, - cardano-ledger-binary >=1.6, + cardano-ledger-binary >=1.8, cardano-ledger-conway >=1.1, cardano-ledger-core >=1.19, cardano-ledger-dijkstra >=0.1, diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs index 53a11b824e8..d6647d0acdf 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs @@ -61,7 +61,6 @@ import Cardano.Ledger.BaseTypes ( import Cardano.Ledger.BaseTypes.NonZero (nonZero, (%.)) import Cardano.Ledger.Binary ( Annotator, - Case (..), DecCBOR (decCBOR), DecCBORGroup (..), EncCBOR (..), @@ -71,13 +70,10 @@ import Cardano.Ledger.Binary ( decodeRecordNamed, encodeListLen, encodeNull, - encodedVerKeyVRFSizeExpr, listLenInt, peekTokenType, runByteBuilder, serialize', - szCases, - withWordSize, ) import Cardano.Ledger.Binary.Crypto import qualified Cardano.Ledger.Binary.Plain as Plain @@ -113,8 +109,7 @@ import Cardano.Slotting.Slot (WithOrigin (..)) import Control.DeepSeq (NFData) import qualified Data.ByteString.Builder as BS import qualified Data.ByteString.Builder.Extra as BS -import Data.Typeable -import Data.Word (Word32, Word64) +import Data.Word (Word32) import GHC.Generics (Generic) import NoThunks.Class (NoThunks (..)) import Numeric.Natural (Natural) @@ -128,13 +123,6 @@ instance NoThunks PrevHash instance EncCBOR PrevHash where encCBOR GenesisHash = encodeNull encCBOR (BlockHash h) = encCBOR h - encodedSizeExpr size _ = - szCases - [ Case "GenesisHash" 1 - , Case "BlockHash" (encodedSizeExpr size p) - ] - where - p = Proxy :: Proxy HashHeader instance DecCBOR PrevHash where decCBOR = do @@ -197,25 +185,6 @@ instance Crypto c => EncCBOR (BHBody c) where oc = bheaderOCert bhBody pv = bprotver bhBody - encodedSizeExpr size proxy = - fromInteger (withWordSize $ 9 + listLenBound oc + listLenBound pv) - + encodedSizeExpr size (bheaderBlockNo <$> proxy) - + encodedSizeExpr size (bheaderSlotNo <$> proxy) - + encodedSizeExpr size (bheaderPrev <$> proxy) - + encodedSizeExpr size (bheaderVk <$> proxy) - + encodedVerKeyVRFSizeExpr (bheaderVrfVk <$> proxy) - + encodedSizeExpr size (bheaderEta <$> proxy) - + encodedSizeExpr size (bheaderL <$> proxy) - + encodedSizeExpr size (toWord64 . bsize <$> proxy) - + encodedSizeExpr size (bhash <$> proxy) - + encodedSizeExpr size (bheaderOCert <$> proxy) - + encodedSizeExpr size (bprotver <$> proxy) - where - oc = bheaderOCert <$> proxy - pv = bprotver <$> proxy - toWord64 :: Word32 -> Word64 - toWord64 = fromIntegral - instance Crypto c => DecCBOR (BHBody c) where decCBOR = decodeRecordNamed "BHBody" bhBodySize $ do bheaderBlockNo <- decCBOR diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs index 60b5abae611..e4baecec78d 100644 --- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs +++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs @@ -31,8 +31,6 @@ import Cardano.Ledger.Binary ( EncCBORGroup (..), FromCBOR (..), ToCBOR (..), - encodedSigDSIGNSizeExpr, - encodedVerKeyKESSizeExpr, fromPlainDecoder, fromPlainEncoding, runByteBuilder, @@ -107,15 +105,6 @@ instance Crypto c => NoThunks (OCert c) instance Crypto c => EncCBORGroup (OCert c) where encCBORGroup = fromPlainEncoding . encodeOCertFields - encodedGroupSizeExpr size proxy = - encodedVerKeyKESSizeExpr (ocertVkHot <$> proxy) - + encodedSizeExpr size (toWord . ocertN <$> proxy) - + encodedSizeExpr size ((\(KESPeriod p) -> p) . ocertKESPeriod <$> proxy) - + encodedSigDSIGNSizeExpr ((\(DSIGN.SignedDSIGN sig) -> sig) . ocertSigma <$> proxy) - where - toWord :: Word64 -> Word - toWord = fromIntegral - listLen _ = 4 listLenBound _ = 4