Merge #3933

3933: Account for new ledger refactor. r=lehins a=lehins

Recent PR to ledger: IntersectMBO/cardano-ledger#2901 introduced
a lot of breaking changes. This PR accounts for those changes.

# Description

<!-- CI flakiness -- delete this before opening a PR

Sadly, some CI checks are currently flaky. Right now, this includes:

 - GH Actions Windows job runs out of memory, e.g. in https://github.com/input-output-hk/ouroboros-network/runs/7231748864?check_suite_focus=true

 - The Hydra check for test-storage on Windows (mingwW64) fails with inscrutable malloc-related error messages: https://hydra.iohk.io/build/16260881/nixlog/1

 - The tests in WallClock.delay* can fail under load (quite rarely): https://hydra.iohk.io/build/16723452/nixlog/76

If you encounter one of these, try restarting the job to see if the failure vanishes. If it does not or when in doubt, consider posting in the #network or #consensus channels on Slack.
-->

_description of the pull request, if it fixes a particular issue it should link
the PR to a particular issue, see
[ref](https://docs.github.com/en/issues/tracking-your-work-with-issues/linking-a-pull-request-to-an-issue#linking-a-pull-request-to-an-issue-using-a-keyword=)_

Co-authored-by: Alexey Kuleshevich <[email protected]>

Author: 2 people

cabal.project

@@ -226,8 +226,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cardano-ledger
-  tag: 389b266d6226dedf3d2aec7af640b3ca4984c5ea
-  --sha256: 0i9zirl5pll9bwfp3l1zy8lhivmfmm8jpaprfx5jdjcnyha3ixrx
+  tag: 49613f11e034485c8377945c86c0465726c0860c
+  --sha256: 0gxb9xghsacr0qaljhq3qzvmb2f1wwmly89prwqy4fdm9mvqiq95
   subdir:
     eras/alonzo/impl
     eras/alonzo/test-suite

ouroboros-consensus-cardano-test/src/Test/ThreadNet/TxGen/Cardano.hs

@@ -36,11 +36,11 @@ import qualified Cardano.Chain.Common as Byron
 import           Cardano.Chain.Genesis (GeneratedSecrets (..))
 
 import qualified Cardano.Ledger.Address as SL (BootstrapAddress (..))
+import qualified Cardano.Ledger.Core as SL (TxBody, TxOut)
 import qualified Cardano.Ledger.Hashes as SL
+import qualified Cardano.Ledger.Keys.Bootstrap as SL (makeBootstrapWitness)
 import qualified Cardano.Ledger.SafeHash as SL
-import qualified Cardano.Ledger.Shelley.API as SL
-import qualified Cardano.Ledger.Shelley.Address.Bootstrap as SL
-                     (makeBootstrapWitness)
+import qualified Cardano.Ledger.Shelley.API as SL hiding (TxBody, TxOut)
 import qualified Cardano.Ledger.Shelley.Tx as SL (WitnessSetHKD (..))
 import qualified Cardano.Ledger.Shelley.UTxO as SL (makeWitnessVKey)
 import           Cardano.Ledger.Val ((<->))
@@ -143,12 +143,12 @@ migrateUTxO migrationInfo curSlot lcfg lst
     let picked :: Map (SL.TxIn c) (SL.TxOut (ShelleyEra c))
         picked = Map.filter pick $ SL.unUTxO utxo
           where
-            pick (SL.TxOut addr _) =
+            pick (SL.ShelleyTxOut addr _) =
                 addr == SL.AddrBootstrap (SL.BootstrapAddress byronAddr)
 
         -- Total held by 'byronAddr'
         pickedCoin :: SL.Coin
-        pickedCoin = foldMap (\(SL.TxOut _ coin) -> coin) picked
+        pickedCoin = foldMap (\(SL.ShelleyTxOut _ coin) -> coin) picked
 
         -- NOTE: The Cardano ThreadNet tests use the
         -- ouroboros-consensus-shelley-test infra's genesis config, which sets
@@ -164,7 +164,7 @@ migrateUTxO migrationInfo curSlot lcfg lst
             pickedCoin <-> spentCoin
 
         body :: SL.TxBody (ShelleyEra c)
-        body = SL.TxBody
+        body = SL.ShelleyTxBody
           { SL._certs    = StrictSeq.fromList $
               [ SL.DCertDeleg $ SL.RegKey $ Shelley.mkCredential stakingSK
               , SL.DCertPool  $ SL.RegPool $ poolParams unspentCoin
@@ -176,7 +176,7 @@ migrateUTxO migrationInfo curSlot lcfg lst
           , SL._inputs   = Map.keysSet picked
           , SL._mdHash   = SL.SNothing
           , SL._outputs  =
-              StrictSeq.singleton $ SL.TxOut shelleyAddr unspentCoin
+              StrictSeq.singleton $ SL.ShelleyTxOut shelleyAddr unspentCoin
           , SL._ttl      = SlotNo maxBound
           , SL._txUpdate = SL.SNothing
           , SL._txfee    = fee
@@ -209,7 +209,7 @@ migrateUTxO migrationInfo curSlot lcfg lst
     in
     if Map.null picked then Nothing else
     (Just . GenTxShelley. mkShelleyTx) $
-    SL.Tx
+    SL.ShelleyTx
       { SL.body          = body
       , SL.auxiliaryData = SL.SNothing
       , SL.wits          = SL.WitnessSet

ouroboros-consensus-cardano-tools/ouroboros-consensus-cardano-tools.cabal

@@ -50,6 +50,7 @@ library
                      , deepseq
                      , directory
                      , filepath
+                     , microlens
                      , mtl
                      , nothunks
                      , serialise

ouroboros-consensus-cardano-tools/src/Cardano/Tools/DBAnalyser/Block/Shelley.hs

@@ -19,8 +19,8 @@ import           Data.Foldable (toList)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (catMaybes)
 import           Data.Maybe.Strict
-import           Data.Sequence.Strict (StrictSeq)
-import           GHC.Records (HasField, getField)
+import           Lens.Micro ((^.))
+import           Lens.Micro.Extras (view)
 
 import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Era as CL
@@ -46,20 +46,18 @@ import           Ouroboros.Consensus.Shelley.Node (Nonce (..),
 import           Cardano.Tools.DBAnalyser.HasAnalysis
 
 -- | Usable for each Shelley-based era
-instance ( ShelleyCompatible proto era
-         , HasField "outputs" (Core.TxBody era) (StrictSeq (Core.TxOut era))
-         ) => HasAnalysis (ShelleyBlock proto era) where
+instance ShelleyCompatible proto era => HasAnalysis (ShelleyBlock proto era) where
 
   countTxOutputs blk = case Shelley.shelleyBlockRaw blk of
       SL.Block _ body -> sum $ fmap countOutputs (CL.fromTxSeq @era body)
     where
       countOutputs :: Core.Tx era -> Int
-      countOutputs = length . getField @"outputs" . getField @"body"
+      countOutputs tx = length $ tx ^. Core.bodyTxL . Core.outputsTxBodyL
 
   blockTxSizes blk = case Shelley.shelleyBlockRaw blk of
       SL.Block _ body ->
           toList
-        $ fmap (fromIntegral . (getField @"txsize")) (CL.fromTxSeq @era body)
+        $ fmap (fromIntegral . view Core.sizeTxF) (CL.fromTxSeq @era body)
 
   knownEBBs = const Map.empty
 

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/Generators.hs

@@ -19,6 +19,7 @@ import           Ouroboros.Consensus.Ledger.Query
 import           Ouroboros.Consensus.Ledger.SupportsMempool
 
 import qualified Cardano.Ledger.Shelley.API as SL
+import qualified Cardano.Ledger.Shelley.PParams as SL
 
 import           Ouroboros.Consensus.Protocol.TPraos (PraosCrypto, TPraos,
                      TPraosState (..))
@@ -207,7 +208,7 @@ instance ShelleyBasedEra era
   Generators for cardano-ledger-specs
 -------------------------------------------------------------------------------}
 
-instance Arbitrary (SL.PParams' SL.StrictMaybe era) where
+instance Arbitrary (SL.ShelleyPParamsUpdate era) where
   arbitrary = genericArbitraryU
   shrink    = genericShrink
 

ouroboros-consensus-shelley-test/src/Test/Consensus/Shelley/MockCrypto.hs

@@ -22,7 +22,6 @@ import           Cardano.Crypto.VRF (MockVRF)
 import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (Crypto (..))
 import qualified Cardano.Ledger.Shelley.API as SL
-import qualified Cardano.Ledger.Shelley.Tx as SL (ValidateScript)
 import qualified Cardano.Protocol.TPraos.API as SL
 import           Control.State.Transition.Extended (PredicateFailure)
 
@@ -65,15 +64,15 @@ type CanMock proto era =
   , LedgerSupportsProtocol (ShelleyBlock proto era)
   , SL.Mock (EraCrypto era)
   , Praos.PraosCrypto (EraCrypto era)
-  , SL.ValidateScript era
+  , Core.EraTx era
   , Arbitrary (Core.AuxiliaryData era)
   , Arbitrary (Core.PParams era)
   , Arbitrary (Core.Script era)
   , Arbitrary (Core.TxBody era)
   , Arbitrary (Core.Tx era)
   , Arbitrary (Core.TxOut era)
   , Arbitrary (Core.Value era)
-  , Arbitrary (PredicateFailure (SL.UTXOW era))
+  , Arbitrary (PredicateFailure (SL.ShelleyUTXOW era))
   , Arbitrary (Core.Witnesses era)
   , Arbitrary (StashedAVVMAddresses era)
   )

ouroboros-consensus-shelley-test/src/Test/ThreadNet/Infra/Shelley.hs

@@ -76,14 +76,13 @@ import           Test.Util.Time (dawnOfTime)
 import           Cardano.Ledger.BaseTypes (boundRational)
 import qualified Cardano.Ledger.Core as Core
 import           Cardano.Ledger.Crypto (Crypto, DSIGN, HASH, KES, VRF)
-import qualified Cardano.Ledger.Era as Core
 import           Cardano.Ledger.Hashes (EraIndependentTxBody)
 import qualified Cardano.Ledger.Keys
 import           Cardano.Ledger.SafeHash (HashAnnotated (..), SafeHash,
                      hashAnnotated)
 import qualified Cardano.Ledger.Shelley.API as SL
-import qualified Cardano.Ledger.Shelley.PParams as SL (emptyPParams,
-                     emptyPParamsUpdate)
+import qualified Cardano.Ledger.Shelley.PParams as SL (ShelleyPParamsUpdate,
+                     emptyPParams, emptyPParamsUpdate)
 import qualified Cardano.Ledger.Shelley.Tx as SL (WitnessSetHKD (..))
 import qualified Cardano.Ledger.Shelley.UTxO as SL (makeWitnessesVKey)
 import qualified Cardano.Ledger.ShelleyMA.TxBody as MA
@@ -333,7 +332,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes =
       where
         nbCoreNodes = fromIntegral (length coreNodes)
 
-    pparams :: SL.PParams era
+    pparams :: SL.ShelleyPParams era
     pparams = SL.emptyPParams
       { SL._d               =
           unsafeBoundRational (decentralizationParamToRational d)
@@ -449,7 +448,7 @@ mkSetDecentralizationParamTxs ::
 mkSetDecentralizationParamTxs coreNodes pVer ttl dNew =
     (:[]) $
     mkShelleyTx $
-    SL.Tx
+    SL.ShelleyTx
       { body            = body
       , wits            = witnessSet
       , auxiliaryData   = SL.SNothing
@@ -477,8 +476,8 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew =
 
     -- Nothing but the parameter update and the obligatory touching of an
     -- input.
-    body :: SL.TxBody (ShelleyEra c)
-    body = SL.TxBody
+    body :: Core.TxBody (ShelleyEra c)
+    body = SL.ShelleyTxBody
       { _certs    = Seq.empty
       , _inputs   = Set.singleton (fst touchCoins)
       , _mdHash   = SL.SNothing
@@ -494,12 +493,12 @@ mkSetDecentralizationParamTxs coreNodes pVer ttl dNew =
     -- We use the input of the first node, but we just put it all right back.
     --
     -- ASSUMPTION: This transaction runs in the first slot.
-    touchCoins :: (SL.TxIn c, SL.TxOut (ShelleyEra c))
+    touchCoins :: (SL.TxIn c, Core.TxOut (ShelleyEra c))
     touchCoins = case coreNodes of
         []   -> error "no nodes!"
         cn:_ ->
             ( SL.initialFundsPseudoTxIn addr
-            , SL.TxOut addr coin
+            , SL.ShelleyTxOut addr coin
             )
           where
             addr = SL.Addr networkId
@@ -563,10 +562,10 @@ networkId = SL.Testnet
 mkMASetDecentralizationParamTxs ::
      forall proto era.
      ( ShelleyBasedEra era
-     , Core.Tx era ~ SL.Tx era
-     , Core.TxBody era ~ MA.TxBody era
-     , Core.PParams era ~ SL.PParams era
-     , Core.PParamsDelta era ~ SL.PParams' SL.StrictMaybe era
+     , MA.ShelleyMAEraTxBody era
+     , Core.Tx era ~ SL.ShelleyTx era
+     , Core.TxBody era ~ MA.MATxBody era
+     , Core.PParamsUpdate era ~ SL.ShelleyPParamsUpdate era
      , Core.Witnesses era ~ SL.WitnessSet era
      )
   => [CoreNode (Core.Crypto era)]
@@ -577,7 +576,7 @@ mkMASetDecentralizationParamTxs ::
 mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew =
     (:[]) $
     mkShelleyTx $
-    SL.Tx
+    SL.ShelleyTx
       { body          = body
       , wits          = witnessSet
       , auxiliaryData = SL.SNothing
@@ -605,8 +604,8 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew =
 
     -- Nothing but the parameter update and the obligatory touching of an
     -- input.
-    body :: MA.TxBody era
-    body = MA.TxBody
+    body :: MA.MATxBody era
+    body = MA.MATxBody
         inputs
         outputs
         certs
@@ -635,12 +634,12 @@ mkMASetDecentralizationParamTxs coreNodes pVer ttl dNew =
     -- We use the input of the first node, but we just put it all right back.
     --
     -- ASSUMPTION: This transaction runs in the first slot.
-    touchCoins :: (SL.TxIn (Core.Crypto era), SL.TxOut era)
+    touchCoins :: (SL.TxIn (Core.Crypto era), SL.ShelleyTxOut era)
     touchCoins = case coreNodes of
         []   -> error "no nodes!"
         cn:_ ->
             ( SL.initialFundsPseudoTxIn addr
-            , SL.TxOut addr coin
+            , SL.ShelleyTxOut addr coin
             )
           where
             addr = SL.Addr networkId

ouroboros-consensus-shelley/ouroboros-consensus-shelley.cabal

@@ -68,6 +68,7 @@ library
                      , data-default-class
                      , deepseq
                      , measures
+                     , microlens
                      , mtl               >=2.2   && <2.3
                      , nothunks
                      , orphans-deriving-via