weaken FromCBOR for TxOut to Annotator TxOut

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -111,6 +111,19 @@ instance
       dec 1 = SumD TooManyExUnits <! From <! From
       dec n = Invalid n
 
+instance
+  ( Typeable era,
+    FromCBOR (Annotator (BbodyPredicateFailure era)) -- TODO why is there no FromCBOR for (BbodyPredicateFailure era)
+  ) =>
+  FromCBOR (Annotator (AlonzoBbodyPredFail era))
+  where
+  fromCBOR = decode (Summands "AlonzoBbodyPredFail" dec)
+    where
+      dec :: (Word -> Decode 'Open (Annotator (AlonzoBbodyPredFail era)))
+      dec 0 = SumD (pure ShelleyInAlonzoPredFail) <*! From
+      dec 1 = Ann $ SumD TooManyExUnits <! From <! From
+      dec n = Invalid n
+
 -- ========================================
 -- The STS instance
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -13,7 +13,7 @@
 
 module Cardano.Ledger.Alonzo.Rules.Utxo where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..), serialize)
+import Cardano.Binary (Annotator (Annotator), FromCBOR (..), ToCBOR (..), serialize)
 import Cardano.Ledger.Address
   ( Addr (..),
     RewardAcnt,
@@ -76,12 +76,14 @@ import Data.Coders
     Encode (..),
     Wrapped (Open),
     decode,
+    decodeAnnList,
     decodeList,
     decodeSet,
     encode,
     encodeFoldable,
     (!>),
     (<!),
+    (<*!),
   )
 import Data.Coerce (coerce)
 import Data.Foldable (foldl', toList)
@@ -609,3 +611,52 @@ instance
   FromCBOR (UtxoPredicateFailure era)
   where
   fromCBOR = decode (Summands "UtxoPredicateFailure" decFail)
+
+decFailA ::
+  ( Era era,
+    FromCBOR (Annotator (Core.TxOut era)),
+    FromCBOR (Core.Value era),
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "UTXOS" era)))
+  ) =>
+  Word ->
+  Decode 'Open (Annotator (UtxoPredicateFailure era))
+decFailA 0 = Ann $ SumD BadInputsUTxO <! D (decodeSet fromCBOR)
+decFailA 1 = Ann $ SumD OutsideValidityIntervalUTxO <! From <! From
+decFailA 2 = Ann $ SumD MaxTxSizeUTxO <! From <! From
+decFailA 3 = Ann $ SumD InputSetEmptyUTxO
+decFailA 4 = Ann $ SumD FeeTooSmallUTxO <! From <! From
+decFailA 5 = Ann $ SumD ValueNotConservedUTxO <! From <! From
+decFailA 6 = SumD (pure OutputTooSmallUTxO) <*! D (decodeAnnList fromCBOR)
+decFailA 7 = SumD (pure UtxosFailure) <*! From
+decFailA 8 = Ann $ SumD WrongNetwork <! From <! D (decodeSet fromCBOR)
+decFailA 9 = Ann $ SumD WrongNetworkWithdrawal <! From <! D (decodeSet fromCBOR)
+decFailA 10 = SumD (pure OutputBootAddrAttrsTooBig) <*! D (decodeAnnList fromCBOR)
+decFailA 11 = Ann $ SumD TriesToForgeADA
+decFailA 12 =
+  SumD (pure OutputTooBigUTxO)
+    <*! D
+      ( do
+          xs <- decodeAnnList $ do
+            (a, b, Annotator fc) <- fromCBOR
+            pure $ Annotator $ \fbs -> (a, b, fc fbs)
+          pure xs
+      )
+decFailA 13 = Ann $ SumD InsufficientCollateral <! From <! From
+decFailA 14 = SumD (pure ScriptsNotPaidUTxO) <*! From
+decFailA 15 = Ann $ SumD ExUnitsTooBigUTxO <! From <! From
+decFailA 16 = Ann $ SumD CollateralContainsNonADA <! From
+decFailA 17 = Ann $ SumD WrongNetworkInTxBody <! From <! From
+decFailA 18 = Ann $ SumD OutsideForecast <! From
+decFailA 19 = Ann $ SumD TooManyCollateralInputs <! From <! From
+decFailA 20 = Ann $ SumD NoCollateralInputs
+decFailA n = Invalid n
+
+instance
+  ( Era era,
+    FromCBOR (Annotator (Core.TxOut era)),
+    FromCBOR (Core.Value era),
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "UTXOS" era)))
+  ) =>
+  FromCBOR (Annotator (UtxoPredicateFailure era))
+  where
+  fromCBOR = decode (Summands "UtxoPredicateFailure" decFailA)

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -4,6 +4,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -349,6 +350,19 @@ instance
       dec 2 = SumD UpdateFailure <! From
       dec n = Invalid n
 
+instance
+  ( Era era,
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "PPUP" era)))
+  ) =>
+  FromCBOR (Annotator (UtxosPredicateFailure era))
+  where
+  fromCBOR = decode (Summands "UtxosPredicateFailure" dec)
+    where
+      dec 0 = Ann $ SumD ValidationTagMismatch <! From <! From
+      dec 1 = Ann $ SumD (CollectErrors @era) <! From
+      dec 2 = SumD (pure UpdateFailure) <*! From
+      dec n = Ann $ Invalid n
+
 deriving stock instance
   ( Shelley.TransUTxOState Show era,
     Show (PredicateFailure (Core.EraRule "PPUP" era))

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -193,6 +193,34 @@ decodePredFail 6 = SumD UnspendableUTxONoDatumHash <! From
 decodePredFail 7 = SumD ExtraRedeemers <! From
 decodePredFail n = Invalid n
 
+instance
+  ( Era era,
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "UTXO" era))),
+    Typeable (Core.Script era),
+    Typeable (Core.AuxiliaryData era)
+  ) =>
+  FromCBOR (Annotator (AlonzoPredFail era))
+  where
+  fromCBOR = decode (Summands "(AlonzoPredFail" decodePredFailA)
+
+decodePredFailA ::
+  ( Era era,
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "UTXO" era))), -- TODO, we should be able to get rid of this constraint
+    Typeable (Core.Script era),
+    Typeable (Core.AuxiliaryData era)
+  ) =>
+  Word ->
+  Decode 'Open (Annotator (AlonzoPredFail era))
+decodePredFailA 0 = SumD (pure WrappedShelleyEraFailure) <*! D fromCBOR
+decodePredFailA 1 = Ann $ SumD MissingRedeemers <! From
+decodePredFailA 2 = Ann $ SumD MissingRequiredDatums <! From <! From
+decodePredFailA 3 = Ann $ SumD NonOutputSupplimentaryDatums <! From <! From
+decodePredFailA 4 = Ann $ SumD PPViewHashesDontMatch <! From <! From
+decodePredFailA 5 = Ann $ SumD MissingRequiredSigners <! From
+decodePredFailA 6 = Ann $ SumD UnspendableUTxONoDatumHash <! From
+decodePredFailA 7 = Ann $ SumD ExtraRedeemers <! From
+decodePredFailA n = Ann $ Invalid n
+
 -- =============================================
 
 -- | given the "txscripts" field of the Witnesses, compute the set of languages used in a transaction

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxBody.hs

@@ -275,7 +275,8 @@ viewCompactTxOut txOut = case txOut of
         toCompactValue adaVal,
         SJust (decodeDataHash32 e f g h)
       )
-  _ -> error "Impossible: Compacted and address or hash of non-standard size"
+  TxOut_AddrHash28_AdaOnly {} -> error "Impossible: Compacted and address or hash of non-standard size"
+  TxOut_AddrHash28_AdaOnly_DataHash32 {} -> error "Impossible: Compacted and address or hash of non-standard size"
   where
     toCompactValue :: CompactForm Coin -> CompactForm (Core.Value era)
     toCompactValue ada =
@@ -304,7 +305,8 @@ viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 stakeRef a b c d adaVal e f g h)
   | Just Refl <- sameNat (Proxy @(SizeHash (CC.ADDRHASH (Crypto era)))) (Proxy @28),
     Just Refl <- sameNat (Proxy @(SizeHash (CC.HASH (Crypto era)))) (Proxy @32) =
     (decodeAddress28 stakeRef a b c d, inject (fromCompact adaVal), SJust (decodeDataHash32 e f g h))
-viewTxOut _ = error "Impossible: Compacted and address or hash of non-standard size"
+viewTxOut (TxOut_AddrHash28_AdaOnly {}) = error "Impossible: Compacted and address or hash of non-standard size"
+viewTxOut (TxOut_AddrHash28_AdaOnly_DataHash32 {}) = error "Impossible: Compacted and address or hash of non-standard size"
 
 instance
   ( Era era,
@@ -636,6 +638,27 @@ instance
   where
   fromCBOR = fromNotSharedCBOR
 
+instance
+  ( Era era,
+    DecodeNonNegative (Core.Value era),
+    Show (Core.Value era),
+    Compactible (Core.Value era)
+  ) =>
+  FromCBOR (Annotator (TxOut era))
+  where
+  fromCBOR = pure <$> fromCBOR
+
+instance
+  ( Era era,
+    DecodeNonNegative (Core.Value era),
+    Show (Core.Value era),
+    Compactible (Core.Value era)
+  ) =>
+  FromSharedCBOR (Annotator (TxOut era))
+  where
+  type Share (Annotator (TxOut era)) = Share (TxOut era)
+  fromSharedCBOR x = pure <$> fromSharedCBOR x
+
 instance
   ( Era era,
     DecodeNonNegative (Core.Value era),

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs

@@ -15,7 +15,7 @@
 
 module Cardano.Ledger.ShelleyMA.Rules.Utxo where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeListLen, serialize)
+import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..), encodeListLen, serialize)
 import Cardano.Ledger.Address
   ( Addr (AddrBootstrap),
     bootstrapAddressAttrsSize,
@@ -501,3 +501,58 @@ instance
           outs <- decodeList fromCBOR
           pure (2, OutputTooBigUTxO outs)
         k -> invalidKey k
+
+instance
+  ( TransValue FromCBOR era,
+    Shelley.TransUTxO FromCBOR era,
+    Val.DecodeNonNegative (Core.Value era),
+    Show (Core.Value era),
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "PPUP" era)))
+  ) =>
+  FromCBOR (Annotator (UtxoPredicateFailure era))
+  where
+  fromCBOR =
+    decodeRecordSum "PredicateFailureUTXO" $
+      \case
+        0 -> do
+          ins <- decodeSet fromCBOR
+          pure (2, pure @Annotator $ BadInputsUTxO ins) -- The (2,..) indicates the number of things decoded, INCLUDING the tags, which are decoded by decodeRecordSumNamed
+        1 -> do
+          a <- fromCBOR
+          b <- fromCBOR
+          pure (3, pure $ OutsideValidityIntervalUTxO a b)
+        2 -> do
+          a <- fromCBOR
+          b <- fromCBOR
+          pure (3, pure $ MaxTxSizeUTxO a b)
+        3 -> pure (1, pure InputSetEmptyUTxO)
+        4 -> do
+          a <- fromCBOR
+          b <- fromCBOR
+          pure (3, pure $ FeeTooSmallUTxO a b)
+        5 -> do
+          a <- fromCBOR
+          b <- fromCBOR
+          pure (3, pure $ ValueNotConservedUTxO a b)
+        6 -> do
+          outs <- decodeList fromCBOR
+          pure (2, pure $ OutputTooSmallUTxO outs)
+        7 -> do
+          a <- fromCBOR
+          pure (2, fmap UpdateFailure a)
+        8 -> do
+          right <- fromCBOR
+          wrongs <- decodeSet fromCBOR
+          pure (3, pure $ WrongNetwork right wrongs)
+        9 -> do
+          right <- fromCBOR
+          wrongs <- decodeSet fromCBOR
+          pure (3, pure $ WrongNetworkWithdrawal right wrongs)
+        10 -> do
+          outs <- decodeList fromCBOR
+          pure (2, pure $ OutputBootAddrAttrsTooBig outs)
+        11 -> pure (1, pure TriesToForgeADA)
+        12 -> do
+          outs <- decodeList fromCBOR
+          pure (2, pure $ OutputTooBigUTxO outs)
+        k -> invalidKey k

eras/shelley-ma/test-suite/src/Test/Cardano/Ledger/ShelleyMA/Serialisation/Roundtrip.hs

@@ -87,7 +87,7 @@ allprops =
       testProperty "Metadata" $ propertyAnn @(Core.AuxiliaryData e),
       testProperty "Value" $ property @(Core.Value e),
       testProperty "Script" $ propertyAnn @(Core.Script e),
-      testProperty "ApplyTxError" $ property @(ApplyTxError e)
+      testProperty "ApplyTxError" $ propertyAnn @(ApplyTxError e)
     ]
 
 allEraRoundtripTests :: TestTree

eras/shelley/impl/src/Cardano/Ledger/Shelley/API.hs

@@ -33,6 +33,7 @@ import Cardano.Ledger.Shelley.Constraints
     UsesValue,
   )
 import Control.State.Transition (State)
+import Data.Coders (Annotator)
 import Data.Sharing (FromSharedCBOR, Interns, Share)
 
 class
@@ -49,8 +50,8 @@ class
     DSignable (Crypto era) (Hash (Crypto era) EraIndependentTxBody),
     ChainData (State (Core.EraRule "PPUP" era)),
     SerialisableData (State (Core.EraRule "PPUP" era)),
-    Share (Core.TxOut era) ~ Interns (Credential 'Staking (Crypto era)),
-    FromSharedCBOR (Core.TxOut era)
+    Share (Annotator (Core.TxOut era)) ~ Interns (Credential 'Staking (Crypto era)),
+    FromSharedCBOR (Annotator (Core.TxOut era))
   ) =>
   ShelleyBasedEra era
 

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Mempool.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -36,9 +37,9 @@ module Cardano.Ledger.Shelley.API.Mempool
   )
 where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..))
+import Cardano.Binary (Annotator, FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.BaseTypes (Globals, ShelleyBase)
-import Cardano.Ledger.Core (AnnotatedData, ChainData, SerialisableData)
+import Cardano.Ledger.Core (AnnotatedData, ChainData)
 import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era
   ( Crypto,
@@ -69,6 +70,7 @@ import Control.State.Transition.Extended
     TRC (..),
     applySTS,
   )
+import Data.Coders (decodeAnnList)
 import Data.Coerce (Coercible, coerce)
 import Data.Functor ((<&>))
 import Data.Sequence (Seq)
@@ -109,7 +111,7 @@ class
     Eq (ApplyTxError era),
     Show (ApplyTxError era),
     Typeable (ApplyTxError era),
-    SerialisableData (ApplyTxError era),
+    AnnotatedData (ApplyTxError era),
     STS (Core.EraRule "LEDGER" era),
     BaseM (Core.EraRule "LEDGER" era) ~ ShelleyBase,
     Environment (Core.EraRule "LEDGER" era) ~ LedgerEnv era,
@@ -261,6 +263,14 @@ instance
   where
   fromCBOR = ApplyTxError <$> fromCBOR
 
+instance
+  ( Era era,
+    FromCBOR (Annotator (PredicateFailure (Core.EraRule "LEDGER" era)))
+  ) =>
+  FromCBOR (Annotator (ApplyTxError era))
+  where
+  fromCBOR = (fmap . fmap) ApplyTxError (decodeAnnList fromCBOR)
+
 -- | Old 'applyTxs'
 applyTxs ::
   ApplyTx era =>

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Validation.hs

@@ -28,7 +28,7 @@ import Cardano.Ledger.BHeaderView (BHeaderView)
 import Cardano.Ledger.BaseTypes (Globals (..), ShelleyBase)
 import Cardano.Ledger.Block (Block)
 import qualified Cardano.Ledger.Chain as STS
-import Cardano.Ledger.Core (ChainData, SerialisableData)
+import Cardano.Ledger.Core (AnnotatedData, ChainData)
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Crypto, TxSeq)
@@ -55,7 +55,7 @@ import NoThunks.Class (NoThunks (..))
 
 class
   ( ChainData (NewEpochState era),
-    SerialisableData (NewEpochState era),
+    AnnotatedData (NewEpochState era),
     ChainData (BlockTransitionError era),
     ChainData (STS.ChainPredicateFailure era),
     STS (Core.EraRule "TICK" era),

eras/shelley/impl/src/Cardano/Ledger/Shelley/Constraints.hs

@@ -6,7 +6,6 @@
 
 module Cardano.Ledger.Shelley.Constraints where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..))
 import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.AuxiliaryData (ValidateAuxiliaryData)
 import Cardano.Ledger.Compactible (Compactible (..))
@@ -57,8 +56,7 @@ class
 class
   ( Era era,
     ChainData (TxOut era),
-    ToCBOR (TxOut era),
-    FromCBOR (TxOut era),
+    AnnotatedData (TxOut era),
     HasField "address" (TxOut era) (Addr (Crypto era)),
     HasField "compactAddress" (TxOut era) (CompactAddr (Crypto era)),
     HasField "value" (TxOut era) (Value era)