{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Tools.DBAnalyser.Block.Shelley
  ( Args (..)
  , ShelleyBlockArgs
  ) where

import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Alonzo (AlonzoEra)
import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo
import qualified Cardano.Ledger.Alonzo.Tx as Alonzo
import Cardano.Ledger.Babbage (BabbageEra)
import qualified Cardano.Ledger.BaseTypes as CL (natVersion)
import Cardano.Ledger.Conway (ConwayEra)
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley (ShelleyEra)
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Shelley.RewardUpdate as SL
import Cardano.Tools.DBAnalyser.HasAnalysis
import qualified Data.Aeson as Aeson
import Data.Foldable as Foldable (foldl', toList)
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, maybeToList)
import Data.Maybe.Strict
import Data.Monoid (Sum (..))
import Data.Sequence.Strict (StrictSeq)
import Data.Word (Word64)
import Lens.Micro ((^.))
import Lens.Micro.Extras (view)
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Protocol.TPraos (TPraos)
import Ouroboros.Consensus.Shelley.Eras (DijkstraEra, StandardCrypto)
import Ouroboros.Consensus.Shelley.HFEras ()
import Ouroboros.Consensus.Shelley.Ledger
  ( ShelleyCompatible
  , shelleyLedgerState
  )
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import qualified Ouroboros.Consensus.Shelley.Ledger.Block as Shelley
import Ouroboros.Consensus.Shelley.Node
  ( Nonce (..)
  , ProtocolParamsShelleyBased (..)
  , ShelleyGenesis
  , protocolInfoShelley
  )
import Ouroboros.Network.SizeInBytes (SizeInBytes (SizeInBytes))
import TextBuilder (decimal)

-- | Usable for each Shelley-based era
instance
  ( ShelleyCompatible proto era
  , PerEraAnalysis era
  ) =>
  HasAnalysis (ShelleyBlock proto era)
  where
  countTxOutputs :: ShelleyBlock proto era -> Int
countTxOutputs ShelleyBlock proto era
blk = case ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
Shelley.shelleyBlockRaw ShelleyBlock proto era
blk of
    SL.Block ShelleyProtocolHeader proto
_ BlockBody era
body -> Sum Int -> Int
forall a. Sum a -> a
getSum (Sum Int -> Int) -> Sum Int -> Int
forall a b. (a -> b) -> a -> b
$ (Tx TopTx era -> Sum Int) -> StrictSeq (Tx TopTx era) -> Sum Int
forall m a. Monoid m => (a -> m) -> StrictSeq a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Int -> Sum Int
forall a. a -> Sum a
Sum (Int -> Sum Int)
-> (Tx TopTx era -> Int) -> Tx TopTx era -> Sum Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx TopTx era -> Int
countOutputs) (BlockBody era
body BlockBody era
-> Getting
     (StrictSeq (Tx TopTx era))
     (BlockBody era)
     (StrictSeq (Tx TopTx era))
-> StrictSeq (Tx TopTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (Tx TopTx era))
  (BlockBody era)
  (StrictSeq (Tx TopTx era))
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Core.txSeqBlockBodyL)
   where
    countOutputs :: Core.Tx Core.TopTx era -> Int
    countOutputs :: Tx TopTx era -> Int
countOutputs Tx TopTx era
tx = StrictSeq (TxOut era) -> Int
forall a. StrictSeq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (StrictSeq (TxOut era) -> Int) -> StrictSeq (TxOut era) -> Int
forall a b. (a -> b) -> a -> b
$ Tx TopTx era
tx Tx TopTx era
-> Getting
     (StrictSeq (TxOut era)) (Tx TopTx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. (TxBody TopTx era
 -> Const (StrictSeq (TxOut era)) (TxBody TopTx era))
-> Tx TopTx era -> Const (StrictSeq (TxOut era)) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
Core.bodyTxL ((TxBody TopTx era
  -> Const (StrictSeq (TxOut era)) (TxBody TopTx era))
 -> Tx TopTx era -> Const (StrictSeq (TxOut era)) (Tx TopTx era))
-> ((StrictSeq (TxOut era)
     -> Const (StrictSeq (TxOut era)) (StrictSeq (TxOut era)))
    -> TxBody TopTx era
    -> Const (StrictSeq (TxOut era)) (TxBody TopTx era))
-> Getting
     (StrictSeq (TxOut era)) (Tx TopTx era) (StrictSeq (TxOut era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era)
 -> Const (StrictSeq (TxOut era)) (StrictSeq (TxOut era)))
-> TxBody TopTx era
-> Const (StrictSeq (TxOut era)) (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
Core.outputsTxBodyL

  blockTxSizes :: ShelleyBlock proto era -> [SizeInBytes]
blockTxSizes ShelleyBlock proto era
blk = case ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
Shelley.shelleyBlockRaw ShelleyBlock proto era
blk of
    SL.Block ShelleyProtocolHeader proto
_ BlockBody era
body ->
      StrictSeq SizeInBytes -> [SizeInBytes]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (StrictSeq SizeInBytes -> [SizeInBytes])
-> StrictSeq SizeInBytes -> [SizeInBytes]
forall a b. (a -> b) -> a -> b
$
        (Tx TopTx era -> SizeInBytes)
-> StrictSeq (Tx TopTx era) -> StrictSeq SizeInBytes
forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word32 -> SizeInBytes
SizeInBytes (Word32 -> SizeInBytes)
-> (Tx TopTx era -> Word32) -> Tx TopTx era -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Word32 (Tx TopTx era) Word32 -> Tx TopTx era -> Word32
forall a s. Getting a s a -> s -> a
view Getting Word32 (Tx TopTx era) Word32
forall era (l :: TxLevel).
(EraTx era, HasCallStack) =>
SimpleGetter (Tx l era) Word32
SimpleGetter (Tx TopTx era) Word32
forall (l :: TxLevel).
HasCallStack =>
SimpleGetter (Tx l era) Word32
Core.sizeTxF) (BlockBody era
body BlockBody era
-> Getting
     (StrictSeq (Tx TopTx era))
     (BlockBody era)
     (StrictSeq (Tx TopTx era))
-> StrictSeq (Tx TopTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (Tx TopTx era))
  (BlockBody era)
  (StrictSeq (Tx TopTx era))
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Core.txSeqBlockBodyL)

  knownEBBs :: forall (proxy :: * -> *).
proxy (ShelleyBlock proto era)
-> Map
     (HeaderHash (ShelleyBlock proto era))
     (ChainHash (ShelleyBlock proto era))
knownEBBs = Map ShelleyHash (ChainHash (ShelleyBlock proto era))
-> proxy (ShelleyBlock proto era)
-> Map ShelleyHash (ChainHash (ShelleyBlock proto era))
forall a b. a -> b -> a
const Map ShelleyHash (ChainHash (ShelleyBlock proto era))
forall k a. Map k a
Map.empty

  emitTraces :: WithLedgerState (ShelleyBlock proto era) -> [String]
emitTraces (WithLedgerState ShelleyBlock proto era
_blk LedgerState (ShelleyBlock proto era) ValuesMK
lsb LedgerState (ShelleyBlock proto era) ValuesMK
lsa) =
    [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes
      [ let be :: EpochNo
be = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL (NewEpochState era -> EpochNo)
-> (LedgerState (ShelleyBlock proto era) ValuesMK
    -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) ValuesMK -> EpochNo)
-> LedgerState (ShelleyBlock proto era) ValuesMK -> EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) ValuesMK
lsb
            ae :: EpochNo
ae = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL (NewEpochState era -> EpochNo)
-> (LedgerState (ShelleyBlock proto era) ValuesMK
    -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) ValuesMK -> EpochNo)
-> LedgerState (ShelleyBlock proto era) ValuesMK -> EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) ValuesMK
lsa
         in if EpochNo
be EpochNo -> EpochNo -> Bool
forall a. Eq a => a -> a -> Bool
/= EpochNo
ae
              then
                String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"EPOCH_START_" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> EpochNo -> String
forall a. Show a => a -> String
show EpochNo
ae
              else Maybe String
forall a. Maybe a
Nothing
      , let brp :: StrictMaybe PulsingRewUpdate
brp = NewEpochState era -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
SL.nesRu (NewEpochState era -> StrictMaybe PulsingRewUpdate)
-> (LedgerState (ShelleyBlock proto era) ValuesMK
    -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> StrictMaybe PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) ValuesMK
 -> StrictMaybe PulsingRewUpdate)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> StrictMaybe PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) ValuesMK
lsb
            arp :: StrictMaybe PulsingRewUpdate
arp = NewEpochState era -> StrictMaybe PulsingRewUpdate
forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
SL.nesRu (NewEpochState era -> StrictMaybe PulsingRewUpdate)
-> (LedgerState (ShelleyBlock proto era) ValuesMK
    -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> StrictMaybe PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) ValuesMK -> NewEpochState era
forall proto era (mk :: MapKind).
LedgerState (ShelleyBlock proto era) mk -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) ValuesMK
 -> StrictMaybe PulsingRewUpdate)
-> LedgerState (ShelleyBlock proto era) ValuesMK
-> StrictMaybe PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era) ValuesMK
lsa
         in case (StrictMaybe PulsingRewUpdate
brp, StrictMaybe PulsingRewUpdate
arp) of
              (StrictMaybe PulsingRewUpdate
SNothing, SJust PulsingRewUpdate
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_START"
              (SJust (SL.Pulsing RewardSnapShot
_ Pulser
_), SJust (SL.Complete RewardUpdate
_)) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_COMPLETE"
              (SJust PulsingRewUpdate
_, StrictMaybe PulsingRewUpdate
SNothing) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_RESET"
              (StrictMaybe PulsingRewUpdate
_, StrictMaybe PulsingRewUpdate
_) -> Maybe String
forall a. Maybe a
Nothing
      ]

  blockStats :: ShelleyBlock proto era -> [TextBuilder]
blockStats ShelleyBlock proto era
blk =
    [ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Int -> TextBuilder) -> Int -> TextBuilder
forall a b. (a -> b) -> a -> b
$ [SizeInBytes] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([SizeInBytes] -> Int) -> [SizeInBytes] -> Int
forall a b. (a -> b) -> a -> b
$ ShelleyBlock proto era -> [SizeInBytes]
forall blk. HasAnalysis blk => blk -> [SizeInBytes]
blockTxSizes ShelleyBlock proto era
blk
    , SizeInBytes -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (SizeInBytes -> TextBuilder) -> SizeInBytes -> TextBuilder
forall a b. (a -> b) -> a -> b
$ [SizeInBytes] -> SizeInBytes
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([SizeInBytes] -> SizeInBytes) -> [SizeInBytes] -> SizeInBytes
forall a b. (a -> b) -> a -> b
$ ShelleyBlock proto era -> [SizeInBytes]
forall blk. HasAnalysis blk => blk -> [SizeInBytes]
blockTxSizes ShelleyBlock proto era
blk
    ]
      [TextBuilder] -> [TextBuilder] -> [TextBuilder]
forall a. [a] -> [a] -> [a]
++ [ Word64 -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal (Word64 -> TextBuilder) -> Word64 -> TextBuilder
forall a b. (a -> b) -> a -> b
$ (Word64 -> Tx TopTx era -> Word64)
-> Word64 -> StrictSeq (Tx TopTx era) -> Word64
forall b a. (b -> a -> b) -> b -> StrictSeq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (\Word64
acc Tx TopTx era
tx -> Word64
acc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Tx TopTx era -> Word64
f Tx TopTx era
tx) Word64
0 StrictSeq (Tx TopTx era)
txs
         | Tx TopTx era -> Word64
f <- Maybe (Tx TopTx era -> Word64) -> [Tx TopTx era -> Word64]
forall a. Maybe a -> [a]
maybeToList Maybe (Tx TopTx era -> Word64)
forall era. PerEraAnalysis era => Maybe (Tx TopTx era -> Word64)
txExUnitsSteps
         ]
   where
    txs :: StrictSeq (Core.Tx Core.TopTx era)
    txs :: StrictSeq (Tx TopTx era)
txs = case ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
forall proto era.
ShelleyBlock proto era -> Block (ShelleyProtocolHeader proto) era
Shelley.shelleyBlockRaw ShelleyBlock proto era
blk of
      SL.Block ShelleyProtocolHeader proto
_ BlockBody era
body -> BlockBody era
body BlockBody era
-> Getting
     (StrictSeq (Tx TopTx era))
     (BlockBody era)
     (StrictSeq (Tx TopTx era))
-> StrictSeq (Tx TopTx era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (Tx TopTx era))
  (BlockBody era)
  (StrictSeq (Tx TopTx era))
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Lens' (BlockBody era) (StrictSeq (Tx TopTx era))
Core.txSeqBlockBodyL

  -- For the time being we do not support any block application
  -- metrics for Shelley-only eras.
  blockApplicationMetrics :: [(TextBuilder,
  WithLedgerState (ShelleyBlock proto era) -> IO TextBuilder)]
blockApplicationMetrics = []

class PerEraAnalysis era where
  txExUnitsSteps :: Maybe (Core.Tx Core.TopTx era -> Word64)

instance PerEraAnalysis ShelleyEra where txExUnitsSteps :: Maybe (Tx TopTx ShelleyEra -> Word64)
txExUnitsSteps = Maybe (Tx TopTx ShelleyEra -> Word64)
forall a. Maybe a
Nothing
instance PerEraAnalysis AllegraEra where txExUnitsSteps :: Maybe (Tx TopTx AllegraEra -> Word64)
txExUnitsSteps = Maybe (Tx TopTx AllegraEra -> Word64)
forall a. Maybe a
Nothing
instance PerEraAnalysis MaryEra where txExUnitsSteps :: Maybe (Tx TopTx MaryEra -> Word64)
txExUnitsSteps = Maybe (Tx TopTx MaryEra -> Word64)
forall a. Maybe a
Nothing

instance PerEraAnalysis AlonzoEra where
  txExUnitsSteps :: Maybe (Tx TopTx AlonzoEra -> Word64)
txExUnitsSteps = (Tx TopTx AlonzoEra -> Word64)
-> Maybe (Tx TopTx AlonzoEra -> Word64)
forall a. a -> Maybe a
Just ((Tx TopTx AlonzoEra -> Word64)
 -> Maybe (Tx TopTx AlonzoEra -> Word64))
-> (Tx TopTx AlonzoEra -> Word64)
-> Maybe (Tx TopTx AlonzoEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx TopTx AlonzoEra
tx ->
    let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx TopTx AlonzoEra -> ExUnits
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
Alonzo.totExUnits Tx TopTx AlonzoEra
tx
     in Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
steps

instance PerEraAnalysis BabbageEra where
  txExUnitsSteps :: Maybe (Tx TopTx BabbageEra -> Word64)
txExUnitsSteps = (Tx TopTx BabbageEra -> Word64)
-> Maybe (Tx TopTx BabbageEra -> Word64)
forall a. a -> Maybe a
Just ((Tx TopTx BabbageEra -> Word64)
 -> Maybe (Tx TopTx BabbageEra -> Word64))
-> (Tx TopTx BabbageEra -> Word64)
-> Maybe (Tx TopTx BabbageEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx TopTx BabbageEra
tx ->
    let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx TopTx BabbageEra -> ExUnits
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
Alonzo.totExUnits Tx TopTx BabbageEra
tx
     in Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
steps

instance PerEraAnalysis ConwayEra where
  txExUnitsSteps :: Maybe (Tx TopTx ConwayEra -> Word64)
txExUnitsSteps = (Tx TopTx ConwayEra -> Word64)
-> Maybe (Tx TopTx ConwayEra -> Word64)
forall a. a -> Maybe a
Just ((Tx TopTx ConwayEra -> Word64)
 -> Maybe (Tx TopTx ConwayEra -> Word64))
-> (Tx TopTx ConwayEra -> Word64)
-> Maybe (Tx TopTx ConwayEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx TopTx ConwayEra
tx ->
    let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx TopTx ConwayEra -> ExUnits
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
Alonzo.totExUnits Tx TopTx ConwayEra
tx
     in Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
steps

instance PerEraAnalysis DijkstraEra where
  txExUnitsSteps :: Maybe (Tx TopTx DijkstraEra -> Word64)
txExUnitsSteps = (Tx TopTx DijkstraEra -> Word64)
-> Maybe (Tx TopTx DijkstraEra -> Word64)
forall a. a -> Maybe a
Just ((Tx TopTx DijkstraEra -> Word64)
 -> Maybe (Tx TopTx DijkstraEra -> Word64))
-> (Tx TopTx DijkstraEra -> Word64)
-> Maybe (Tx TopTx DijkstraEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx TopTx DijkstraEra
tx ->
    let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx TopTx DijkstraEra -> ExUnits
forall era (l :: TxLevel).
(EraTx era, AlonzoEraTxWits era) =>
Tx l era -> ExUnits
Alonzo.totExUnits Tx TopTx DijkstraEra
tx
     in Int -> Word64
forall a. Enum a => Int -> a
toEnum (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
steps

-- | Shelley-era specific
instance HasProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) where
  data Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) = ShelleyBlockArgs
    { Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> String
configFileShelley :: FilePath
    , Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> Nonce
initialNonce :: Nonce
    }
    deriving Int
-> Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> String
-> String
[Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)]
-> String -> String
Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> String
(Int
 -> Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
 -> String
 -> String)
-> (Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
    -> String)
-> ([Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)]
    -> String -> String)
-> Show (Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int
-> Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> String
-> String
showsPrec :: Int
-> Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> String
-> String
$cshow :: Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> String
show :: Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> String
$cshowList :: [Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)]
-> String -> String
showList :: [Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)]
-> String -> String
Show

  mkProtocolInfo :: Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> IO
     (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
mkProtocolInfo ShelleyBlockArgs{String
configFileShelley :: Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> String
configFileShelley :: String
configFileShelley, Nonce
initialNonce :: Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra) -> Nonce
initialNonce :: Nonce
initialNonce} = do
    config <-
      (String -> IO ShelleyGenesis)
-> (ShelleyGenesis -> IO ShelleyGenesis)
-> Either String ShelleyGenesis
-> IO ShelleyGenesis
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IO ShelleyGenesis
forall a. HasCallStack => String -> a
error (String -> IO ShelleyGenesis)
-> (String -> String) -> String -> IO ShelleyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) ShelleyGenesis -> IO ShelleyGenesis
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Either String ShelleyGenesis -> IO ShelleyGenesis)
-> IO (Either String ShelleyGenesis) -> IO ShelleyGenesis
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO (Either String ShelleyGenesis)
forall a. FromJSON a => String -> IO (Either String a)
Aeson.eitherDecodeFileStrict' String
configFileShelley
    return $ mkShelleyProtocolInfo config initialNonce

type ShelleyBlockArgs = Args (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)

mkShelleyProtocolInfo ::
  ShelleyGenesis ->
  Nonce ->
  ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
mkShelleyProtocolInfo :: ShelleyGenesis
-> Nonce
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
mkShelleyProtocolInfo ShelleyGenesis
genesis Nonce
initialNonce =
  (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra),
 Tracer IO KESAgentClientTrace
 -> IO
      [MkBlockForging
         IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a, b) -> a
fst ((ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra),
  Tracer IO KESAgentClientTrace
  -> IO
       [MkBlockForging
          IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
 -> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra),
    Tracer IO KESAgentClientTrace
    -> IO
         [MkBlockForging
            IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) c.
(IOLike m, AgentCrypto c, ShelleyCompatible (TPraos c) ShelleyEra,
 TxLimits (ShelleyBlock (TPraos c) ShelleyEra), MonadKESAgent m) =>
ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    Tracer m KESAgentClientTrace
    -> m [MkBlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
protocolInfoShelley @IO
      ShelleyGenesis
genesis
      ProtocolParamsShelleyBased
        { shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = Nonce
initialNonce
        , shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials StandardCrypto]
shelleyBasedLeaderCredentials = []
        }
      (Version -> Natural -> ProtVer
SL.ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
CL.natVersion @2) Natural
0)