Merge remote-tracking branch 'origin/master' into fix-flake-inputs-re…

…cursion

Makefile

@@ -52,7 +52,7 @@ ci-targets:  $(CI_TARGETS)
 shell:                                           ## Nix shell, (workbench from /nix/store), vars: PROFILE, CMD, RUN
 	nix-shell -A 'workbench-shell' --max-jobs 8 --cores 0 --show-trace --argstr profileName ${PROFILE} --argstr backendName ${BACKEND} ${ARGS} ${if ${CMD},--command "${CMD}"} ${if ${RUN},--run "${RUN}"}
 shell-dev shell-prof shell-nix: shell
-shell-nix: ARGS += --arg 'workbenchDevMode' false ## Nix shell, (workbench from Nix store), vars: PROFILE, CMD, RUN
+shell-nix: ARGS += --arg 'useCabalRun' false ## Nix shell, (workbench from Nix store), vars: PROFILE, CMD, RUN
 shell-prof: ARGS += --arg 'profiled' true        ## Nix shell, everything Haskell built profiled
 
 analyse: RUN := wb analyse std ${TAG}

cardano-api/src/Cardano/Api.hs

@@ -541,6 +541,8 @@ module Cardano.Api (
     envSecurityParam,
     LedgerState(..),
     initialLedgerState,
+    encodeLedgerState,
+    decodeLedgerState,
     applyBlock,
     ValidationMode(..),
 

cardano-api/src/Cardano/Api/LedgerEvent.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE PartialTypeSignatures #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -21,35 +22,59 @@ import           Cardano.Api.Block (EpochNo)
 import           Cardano.Api.Certificate (Certificate)
 import           Cardano.Api.Keys.Shelley (Hash (StakePoolKeyHash), StakePoolKey)
 import           Cardano.Api.Value (Lovelace, fromShelleyDeltaLovelace, fromShelleyLovelace)
+import           Cardano.Ledger.Alonzo (AlonzoEra)
+import Cardano.Ledger.Alonzo.Rules
+  ( AlonzoBbodyEvent (..),
+    AlonzoUtxoEvent (..),
+    AlonzoUtxosEvent
+      ( FailedPlutusScriptsEvent,
+        SuccessfulPlutusScriptsEvent
+      ),
+    AlonzoUtxowEvent (..),
+  )
+import           Cardano.Ledger.Alonzo.TxInfo (PlutusDebug)
+import           Cardano.Ledger.Babbage (BabbageEra)
 import qualified Cardano.Ledger.Coin as Ledger
 import qualified Cardano.Ledger.Core as Ledger.Core
 import qualified Cardano.Ledger.Credential as Ledger
 import           Cardano.Ledger.Crypto (StandardCrypto)
 import           Cardano.Ledger.Era (Crypto)
 import qualified Cardano.Ledger.Keys as Ledger
 import           Cardano.Ledger.Shelley.API (InstantaneousRewards (InstantaneousRewards))
-import           Cardano.Ledger.Shelley.Rewards
-
-import           Cardano.Ledger.Shelley.Rules.Tick (ShelleyTickEvent (NewEpochEvent))
-import           Cardano.Ledger.Shelley.Rules.NewEpoch (ShelleyNewEpochEvent (..))
+import Cardano.Ledger.Shelley.Rewards ( Reward )
+import Cardano.Ledger.Shelley.Rules.Bbody
+  ( ShelleyBbodyEvent (LedgersEvent),
+  )
 import           Cardano.Ledger.Shelley.Rules.Epoch (ShelleyEpochEvent (..))
-import           Cardano.Ledger.Shelley.Rules.PoolReap (ShelleyPoolreapEvent (..))
+import qualified Cardano.Ledger.Shelley.Rules.Ledger as Shelley (ShelleyLedgerEvent (UtxowEvent))
+import qualified Cardano.Ledger.Shelley.Rules.Ledgers as Shelley (ShelleyLedgersEvent (LedgerEvent))
 import           Cardano.Ledger.Shelley.Rules.Mir (ShelleyMirEvent (..))
+import           Cardano.Ledger.Shelley.Rules.NewEpoch (ShelleyNewEpochEvent (..))
+import           Cardano.Ledger.Shelley.Rules.PoolReap (ShelleyPoolreapEvent (..))
 import           Cardano.Ledger.Shelley.Rules.Rupd (RupdEvent (..))
-
+import           Cardano.Ledger.Shelley.Rules.Tick (ShelleyTickEvent (NewEpochEvent))
+import           Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUtxowEvent (UtxoEvent))
 import           Control.State.Transition (Event)
+import           Data.List.NonEmpty (NonEmpty)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Set (Set)
 import           Data.SOP.Strict
 import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
 import           Ouroboros.Consensus.Cardano.Block (HardForkBlock)
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (getOneEraLedgerEvent)
-import           Ouroboros.Consensus.Ledger.Abstract (LedgerState)
 import           Ouroboros.Consensus.Ledger.Basics (AuxLedgerEvent)
-import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
-                   ShelleyLedgerEvent (ShelleyLedgerEventTICK))
-import           Ouroboros.Consensus.TypeFamilyWrappers
+import Ouroboros.Consensus.Shelley.Ledger
+  ( LedgerState,
+    ShelleyBlock,
+    ShelleyLedgerEvent
+      ( ShelleyLedgerEventBBODY,
+        ShelleyLedgerEventTICK
+      ),
+  )
+import Ouroboros.Consensus.TypeFamilyWrappers
+  ( WrapLedgerEvent (unwrapLedgerEvent),
+  )
 
 data LedgerEvent
   = -- | The given pool is being registered for the first time on chain.
@@ -64,6 +89,10 @@ data LedgerEvent
     MIRDistribution MIRDistributionDetails
   | -- | Pools have been reaped and deposits refunded.
     PoolReap PoolReapDetails
+    -- | A number of succeeded Plutus script evaluations.
+  | SuccessfulPlutusScript (NonEmpty PlutusDebug)
+    -- | A number of failed Plutus script evaluations.
+  | FailedPlutusScript (NonEmpty PlutusDebug)
 
 class ConvertLedgerEvent blk where
   toLedgerEvent :: WrapLedgerEvent blk -> Maybe LedgerEvent
@@ -81,16 +110,22 @@ instance
     Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent (Crypto ledgerera)
   ) =>
   ConvertLedgerEvent (ShelleyBlock protocol ledgerera)
+  where
+  toLedgerEvent = toLedgerEventShelley
+
+instance {-# OVERLAPPING #-} ConvertLedgerEvent (ShelleyBlock protocol (AlonzoEra StandardCrypto))
+  where
+  toLedgerEvent evt = case unwrapLedgerEvent evt of
+    LEPlutusSuccess ds -> Just $ SuccessfulPlutusScript ds
+    LEPlutusFailure ds -> Just $ FailedPlutusScript ds
+    _ -> toLedgerEventShelley evt
+
+instance {-# OVERLAPPING #-} ConvertLedgerEvent (ShelleyBlock protocol (BabbageEra StandardCrypto))
   where
   toLedgerEvent evt = case unwrapLedgerEvent evt of
-    LEDeltaRewardEvent e m -> Just $ IncrementalRewardsDistribution e m
-    LERewardEvent e m -> Just $ RewardsDistribution e m
-    LEMirTransfer rp rt rtt ttr ->
-      Just $
-        MIRDistribution $
-          MIRDistributionDetails rp rt rtt ttr
-    LERetiredPools r u e -> Just $ PoolReap $ PoolReapDetails e r u
-    _ -> Nothing
+    LEPlutusSuccess ds -> Just $ SuccessfulPlutusScript ds
+    LEPlutusFailure ds -> Just $ FailedPlutusScript ds
+    _ -> toLedgerEventShelley evt
 
 instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) where
   toLedgerEvent =
@@ -99,6 +134,27 @@ instance All ConvertLedgerEvent xs => ConvertLedgerEvent (HardForkBlock xs) wher
       . getOneEraLedgerEvent
       . unwrapLedgerEvent
 
+toLedgerEventShelley ::
+  ( Crypto ledgerera ~ StandardCrypto,
+    Event (Ledger.Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera,
+    Event (Ledger.Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera,
+    Event (Ledger.Core.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera,
+    Event (Ledger.Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera,
+    Event (Ledger.Core.EraRule "MIR" ledgerera) ~ ShelleyMirEvent ledgerera,
+    Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent (Crypto ledgerera)
+  ) =>
+  WrapLedgerEvent (ShelleyBlock protocol ledgerera) ->
+  Maybe LedgerEvent
+toLedgerEventShelley evt = case unwrapLedgerEvent evt of
+  LEDeltaRewardEvent e m -> Just $ IncrementalRewardsDistribution e m
+  LERewardEvent e m -> Just $ RewardsDistribution e m
+  LEMirTransfer rp rt rtt ttr ->
+    Just $
+      MIRDistribution $
+        MIRDistributionDetails rp rt rtt ttr
+  LERetiredPools r u e -> Just $ PoolReap $ PoolReapDetails e r u
+  _ -> Nothing
+
 --------------------------------------------------------------------------------
 -- Event details
 --------------------------------------------------------------------------------
@@ -206,6 +262,66 @@ pattern LERetiredPools r u e <-
           )
       )
 
+pattern LEPlutusSuccess ::
+  ( Crypto ledgerera ~ StandardCrypto,
+    Event (Ledger.Core.EraRule "BBODY" ledgerera) ~ AlonzoBbodyEvent ledgerera,
+    Event (Ledger.Core.EraRule "LEDGERS" ledgerera) ~ Shelley.ShelleyLedgersEvent ledgerera,
+    Event (Ledger.Core.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera
+  ) =>
+  NonEmpty PlutusDebug ->
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
+pattern LEPlutusSuccess ds <-
+  ShelleyLedgerEventBBODY
+    ( ShelleyInAlonzoEvent
+        ( LedgersEvent
+            ( Shelley.LedgerEvent
+                ( Shelley.UtxowEvent
+                    ( WrappedShelleyEraEvent
+                        ( UtxoEvent
+                            ( UtxosEvent
+                                ( SuccessfulPlutusScriptsEvent ds
+                                  )
+                              )
+                          )
+                      )
+                  )
+              )
+          )
+      )
+
+pattern LEPlutusFailure ::
+  ( Crypto ledgerera ~ StandardCrypto,
+    Event (Ledger.Core.EraRule "BBODY" ledgerera) ~ AlonzoBbodyEvent ledgerera,
+    Event (Ledger.Core.EraRule "LEDGERS" ledgerera) ~ Shelley.ShelleyLedgersEvent ledgerera,
+    Event (Ledger.Core.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera,
+    Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera
+  ) =>
+  NonEmpty PlutusDebug ->
+  AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera))
+pattern LEPlutusFailure ds <-
+  ShelleyLedgerEventBBODY
+    ( ShelleyInAlonzoEvent
+        ( LedgersEvent
+            ( Shelley.LedgerEvent
+                ( Shelley.UtxowEvent
+                    ( WrappedShelleyEraEvent
+                        ( UtxoEvent
+                            ( UtxosEvent
+                                ( FailedPlutusScriptsEvent ds
+                                  )
+                              )
+                          )
+                      )
+                  )
+              )
+          )
+      )
+
 convertRetiredPoolsMap ::
      Map (Ledger.StakeCredential StandardCrypto) (Map (Ledger.KeyHash Ledger.StakePool StandardCrypto) Ledger.Coin)
   -> Map StakeCredential (Map (Hash StakePoolKey) Lovelace)

cardano-api/src/Cardano/Api/LedgerState.hs

@@ -24,6 +24,8 @@ module Cardano.Api.LedgerState
       , LedgerStateMary
       , LedgerStateAlonzo
       )
+  , encodeLedgerState
+  , decodeLedgerState
   , initialLedgerState
   , applyBlock
   , ValidationMode(..)
@@ -52,6 +54,7 @@ module Cardano.Api.LedgerState
   )
   where
 
+import qualified Cardano.Binary as CBOR
 import           Control.Exception
 import           Control.Monad (when)
 import           Control.Monad.Trans.Class
@@ -78,7 +81,7 @@ import qualified Data.Sequence as Seq
 import           Data.Set (Set)
 import qualified Data.Set as Set
 import           Data.Sharing (FromSharedCBOR, Interns, Share)
-import           Data.SOP.Strict (NP (..))
+import           Data.SOP.Strict (K (..), NP (..), fn, (:.:) (Comp))
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
@@ -142,6 +145,7 @@ import           Cardano.Slotting.Slot (WithOrigin (At, Origin))
 import qualified Cardano.Slotting.Slot as Slot
 import qualified Ouroboros.Consensus.Block.Abstract as Consensus
 import qualified Ouroboros.Consensus.Byron.Ledger.Block as Byron
+import qualified Ouroboros.Consensus.Byron.Ledger.Ledger as Byron
 import qualified Ouroboros.Consensus.Cardano as Consensus
 import qualified Ouroboros.Consensus.Cardano.Block as Consensus
 import qualified Ouroboros.Consensus.Cardano.CanHardFork as Consensus
@@ -150,6 +154,7 @@ import qualified Ouroboros.Consensus.Config as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator as Consensus
 import qualified Ouroboros.Consensus.HardFork.Combinator.AcrossEras as HFC
 import qualified Ouroboros.Consensus.HardFork.Combinator.Basics as HFC
+import qualified Ouroboros.Consensus.HardFork.Combinator.Serialisation.Common as HFC
 import qualified Ouroboros.Consensus.Ledger.Abstract as Ledger
 import           Ouroboros.Consensus.Ledger.Basics (LedgerResult (lrEvents), lrResult)
 import qualified Ouroboros.Consensus.Ledger.Extended as Ledger
@@ -866,6 +871,31 @@ newtype LedgerState = LedgerState
                     (Consensus.CardanoEras Consensus.StandardCrypto))
   }
 
+encodeLedgerState :: LedgerState -> CBOR.Encoding
+encodeLedgerState (LedgerState (HFC.HardForkLedgerState st)) =
+  HFC.encodeTelescope
+    (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* Nil)
+    st
+  where
+    byron = fn (K . Byron.encodeByronLedgerState)
+    shelley = fn (K . Shelley.encodeShelleyLedgerState)
+    allegra = fn (K . Shelley.encodeShelleyLedgerState)
+    mary = fn (K . Shelley.encodeShelleyLedgerState)
+    alonzo = fn (K . Shelley.encodeShelleyLedgerState)
+    babbage = fn (K . Shelley.encodeShelleyLedgerState)
+
+decodeLedgerState :: forall s. CBOR.Decoder s LedgerState
+decodeLedgerState =
+  LedgerState . HFC.HardForkLedgerState
+    <$> HFC.decodeTelescope (byron :* shelley :* allegra :* mary :* alonzo :* babbage :* Nil)
+  where
+    byron = Comp Byron.decodeByronLedgerState
+    shelley = Comp Shelley.decodeShelleyLedgerState
+    allegra = Comp Shelley.decodeShelleyLedgerState
+    mary = Comp Shelley.decodeShelleyLedgerState
+    alonzo = Comp Shelley.decodeShelleyLedgerState
+    babbage = Comp Shelley.decodeShelleyLedgerState
+
 type LedgerStateEvents = (LedgerState, [LedgerEvent])
 
 toLedgerStateEvents ::