Update eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs

Co-authored-by: Alexey Kuleshevich <alexey.kuleshevich@iohk.io>

Author: Soupstraw

eras/allegra/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.9.0.0
 
+* Add `invalidBeforeL`, `invalidHereAfterL`
 * Add `basicAllegraTxBody`
 * Add `TxLevel` argument to `Tx` and `TxBody`
 * Add `HasEraTxLevel` instances for `Tx` and `TxBody`

eras/allegra/impl/src/Cardano/Ledger/Allegra/Scripts.hs

@@ -55,6 +55,8 @@ module Cardano.Ledger.Allegra.Scripts (
   upgradeMultiSig,
   lteNegInfty,
   ltePosInfty,
+  invalidBeforeL,
+  invalidHereAfterL,
 ) where
 
 import Cardano.Ledger.Allegra.Era (AllegraEra)
@@ -109,6 +111,7 @@ import Data.Sequence.Strict as Seq (StrictSeq (Empty, (:<|)))
 import qualified Data.Sequence.Strict as SSeq
 import qualified Data.Set as Set (Set, member)
 import GHC.Generics (Generic)
+import Lens.Micro (Lens', lens)
 import NoThunks.Class (NoThunks (..))
 
 -- | ValidityInterval is a half open interval. Closed on the bottom, open on the top.
@@ -119,6 +122,32 @@ data ValidityInterval = ValidityInterval
   }
   deriving (Ord, Eq, Generic, Show, NoThunks, NFData)
 
+-- | Lens to access the 'invalidBefore' field of a 'ValidityInterval' as a 'Maybe SlotNo'.
+invalidBeforeL :: Lens' ValidityInterval (Maybe SlotNo)
+invalidBeforeL = lens g s
+  where
+    g :: ValidityInterval -> Maybe SlotNo
+    g (ValidityInterval ma _) =
+      case ma of
+        SNothing -> Nothing
+        SJust a -> Just a
+
+    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
+    s (ValidityInterval _ b) a = ValidityInterval (maybe SNothing SJust a) b
+
+-- | Lens to access the 'invalidHereAfter' field of a 'ValidityInterval' as a 'Maybe SlotNo'.
+invalidHereAfterL :: Lens' ValidityInterval (Maybe SlotNo)
+invalidHereAfterL = lens g s
+  where
+    g :: ValidityInterval -> Maybe SlotNo
+    g (ValidityInterval _ mb) =
+      case mb of
+        SNothing -> Nothing
+        SJust b -> Just b
+
+    s :: ValidityInterval -> Maybe SlotNo -> ValidityInterval
+    s (ValidityInterval ma _) = ValidityInterval ma . maybe SNothing SJust
+
 encodeVI :: ValidityInterval -> Encode ('Closed 'Dense) ValidityInterval
 encodeVI (ValidityInterval f t) = Rec ValidityInterval !> To f !> To t
 

eras/allegra/impl/src/Cardano/Ledger/Allegra/Translation.hs

@@ -31,7 +31,6 @@ import Cardano.Ledger.Shelley.TxOut (ShelleyTxOut)
 import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits)
 import Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
-import Data.Typeable (Typeable)
 
 --------------------------------------------------------------------------------
 -- Translation from Shelley to Allegra
@@ -72,8 +71,8 @@ instance TranslateEra AllegraEra NewEpochState where
           stashedAVVMAddresses = ()
         }
 
-instance Typeable l => TranslateEra AllegraEra (Tx l) where
-  type TranslationError AllegraEra (Tx l) = DecoderError
+instance TranslateEra AllegraEra (Tx TopTx) where
+  type TranslationError AllegraEra (Tx TopTx) = DecoderError
   translateEra _ctx = translateEraThroughCBOR "ShelleyTx"
 
 --------------------------------------------------------------------------------

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

@@ -127,7 +127,7 @@ type ScriptIntegrityHash = SafeHash EraIndependentScriptIntegrity
 class (MaryEraTxBody era, AlonzoEraTxOut era) => AlonzoEraTxBody era where
   collateralInputsTxBodyL :: Lens' (TxBody TopTx era) (Set TxIn)
 
-  reqSignerHashesTxBodyL :: AtMostEra "Conway" era => Lens' (TxBody l era) (Set (KeyHash 'Witness))
+  reqSignerHashesTxBodyL :: AtMostEra "Conway" era => Lens' (TxBody l era) (Set (KeyHash 'Guard))
 
   reqSignerHashesTxBodyG ::
     SimpleGetter (TxBody l era) (Set (KeyHash Guard))

eras/babbage/impl/src/Cardano/Ledger/Babbage/Translation.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
@@ -28,7 +29,6 @@ import Cardano.Ledger.Shelley.LedgerState (
 import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
 import Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
-import Data.Typeable (Typeable)
 import Lens.Micro
 
 --------------------------------------------------------------------------------
@@ -59,25 +59,24 @@ instance TranslateEra BabbageEra NewEpochState where
         , stashedAVVMAddresses = ()
         }
 
-instance Typeable l => TranslateEra BabbageEra (Tx l) where
-  type TranslationError BabbageEra (Tx l) = DecoderError
+instance TranslateEra BabbageEra (Tx TopTx) where
+  type TranslationError BabbageEra (Tx TopTx) = DecoderError
   translateEra _ctxt tx =
-    withTopTxLevelOnly tx $ \tx' ->
-      do
-        -- Note that this does not preserve the hidden bytes field of the transaction.
-        -- This is under the premise that this is irrelevant for TxInBlocks, which are
-        -- not transmitted as contiguous chunks.
-        txBody <- translateEraThroughCBOR "TxBody" $ tx' ^. bodyTxL
-        txWits <- translateEraThroughCBOR "TxWitness" $ tx' ^. witsTxL
-        auxData <- case tx' ^. auxDataTxL of
-          SNothing -> pure SNothing
-          SJust auxData -> SJust <$> translateEraThroughCBOR "AuxData" auxData
-        let validating = tx' ^. isValidTxL
-        pure . asSTxTopLevel $
-          mkBasicTx txBody
-            & witsTxL .~ txWits
-            & auxDataTxL .~ auxData
-            & isValidTxL .~ validating
+    withTopTxLevelOnly tx $ \tx' -> do
+      -- Note that this does not preserve the hidden bytes field of the transaction.
+      -- This is under the premise that this is irrelevant for TxInBlocks, which are
+      -- not transmitted as contiguous chunks.
+      txBody <- translateEraThroughCBOR "TxBody" $ tx' ^. bodyTxL
+      txWits <- translateEraThroughCBOR "TxWitness" $ tx' ^. witsTxL
+      auxData <- case tx' ^. auxDataTxL of
+        SNothing -> pure SNothing
+        SJust auxData -> SJust <$> translateEraThroughCBOR "AuxData" auxData
+      let validating = tx' ^. isValidTxL
+      pure . asSTxTopLevel $
+        mkBasicTx txBody
+          & witsTxL .~ txWits
+          & auxDataTxL .~ auxData
+          & isValidTxL .~ validating
 
 --------------------------------------------------------------------------------
 -- Auxiliary instances and functions

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs

@@ -365,11 +365,9 @@ ledgerTransition ::
   , State (EraRule "UTXOW" era) ~ UTxOState era
   , State (EraRule "CERTS" era) ~ CertState era
   , State (EraRule "GOV" era) ~ Proposals era
-  , State (someLEDGER era) ~ LedgerState era
   , Environment (EraRule "UTXOW" era) ~ UtxoEnv era
   , Environment (EraRule "GOV" era) ~ GovEnv era
   , Environment (EraRule "CERTS" era) ~ CertsEnv era
-  , Environment (someLEDGER era) ~ LedgerEnv era
   , Signal (EraRule "UTXOW" era) ~ Tx TopTx era
   , Signal (EraRule "CERTS" era) ~ Seq (TxCert era)
   , Signal (EraRule "GOV" era) ~ GovSignal era
@@ -378,7 +376,6 @@ ledgerTransition ::
   , ConwayEraCertState era
   , EraRule "LEDGER" era ~ someLEDGER era
   , InjectRuleFailure "LEDGER" ShelleyLedgerPredFailure era
-  , PredicateFailure (someLEDGER era) ~ ConwayLedgerPredFailure era
   ) =>
   TransitionRule (someLEDGER era)
 ledgerTransition = do

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Translation.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -50,13 +51,12 @@ import Cardano.Ledger.Shelley.LedgerState (
 import Data.Coerce (coerce)
 import Data.Default (Default (..))
 import qualified Data.Map.Strict as Map
-import Data.Typeable (Typeable)
 import Lens.Micro ((&), (.~), (^.))
 
 type instance TranslationContext DijkstraEra = DijkstraGenesis
 
-instance Typeable l => TranslateEra DijkstraEra (Tx l) where
-  type TranslationError DijkstraEra (Tx l) = DecoderError
+instance TranslateEra DijkstraEra (Tx TopTx) where
+  type TranslationError DijkstraEra (Tx TopTx) = DecoderError
   translateEra _ctxt tx = case toSTxLevel tx of
     STopTxOnly -> do
       -- Note that this does not preserve the hidden bytes field of the transaction.

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs

@@ -44,6 +44,7 @@ import Cardano.Ledger.Binary (
   decodeNullMaybe,
   encodeListLen,
   encodeNullMaybe,
+  encodeNullStrictMaybe,
   serialize,
  )
 import Cardano.Ledger.Binary.Coders (Decode (..), Encode (..), decode, encode, (!>), (<*!))
@@ -335,10 +336,10 @@ toCBORForMempoolSubmission = \case
         !> To dtBody
         !> To dtWits
         !> To dtIsValid
-        !> E (encodeNullMaybe encCBOR . strictMaybeToMaybe) dtAuxData
+        !> E (encodeNullStrictMaybe encCBOR) dtAuxData
   DijkstraSubTx {dstBody, dstWits, dstAuxData} ->
     encode $
       Rec DijkstraSubTx
         !> To dstBody
         !> To dstWits
-        !> E (encodeNullMaybe encCBOR . strictMaybeToMaybe) dstAuxData
+        !> E (encodeNullStrictMaybe encCBOR) dstAuxData