{-# 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.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 (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           Text.Builder (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
_ TxSeq era
body -> StrictSeq Int -> Int
forall a. Num a => StrictSeq a -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (StrictSeq Int -> Int) -> StrictSeq Int -> Int
forall a b. (a -> b) -> a -> b
$ (Tx era -> Int) -> StrictSeq (Tx era) -> StrictSeq Int
forall a b. (a -> b) -> StrictSeq a -> StrictSeq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx era -> Int
countOutputs (forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
Core.fromTxSeq @era TxSeq era
body)
    where
      countOutputs :: Core.Tx era -> Int
      countOutputs :: Tx era -> Int
countOutputs Tx 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 era
tx Tx era
-> Getting (StrictSeq (TxOut era)) (Tx era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. (TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
-> Tx era -> Const (StrictSeq (TxOut era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
Core.bodyTxL ((TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
 -> Tx era -> Const (StrictSeq (TxOut era)) (Tx era))
-> ((StrictSeq (TxOut era)
     -> Const (StrictSeq (TxOut era)) (StrictSeq (TxOut era)))
    -> TxBody era -> Const (StrictSeq (TxOut era)) (TxBody era))
-> Getting (StrictSeq (TxOut era)) (Tx 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 era -> Const (StrictSeq (TxOut era)) (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody 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
_ TxSeq 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 era -> SizeInBytes)
-> StrictSeq (Tx 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 (Integer -> SizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> SizeInBytes)
-> (Tx era -> Integer) -> Tx era -> SizeInBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Integer (Tx era) Integer -> Tx era -> Integer
forall a s. Getting a s a -> s -> a
view Getting Integer (Tx era) Integer
forall era. EraTx era => SimpleGetter (Tx era) Integer
SimpleGetter (Tx era) Integer
Core.sizeTxF) (forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
Core.fromTxSeq @era TxSeq era
body)

  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)
lsb LedgerState (ShelleyBlock proto era)
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) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) -> EpochNo)
-> LedgerState (ShelleyBlock proto era) -> EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
lsb
          ae :: EpochNo
ae = NewEpochState era -> EpochNo
forall era. NewEpochState era -> EpochNo
SL.nesEL (NewEpochState era -> EpochNo)
-> (LedgerState (ShelleyBlock proto era) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> EpochNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era) -> EpochNo)
-> LedgerState (ShelleyBlock proto era) -> EpochNo
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
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) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era)
 -> StrictMaybe PulsingRewUpdate)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
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) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe PulsingRewUpdate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerState (ShelleyBlock proto era) -> NewEpochState era
forall proto era.
LedgerState (ShelleyBlock proto era) -> NewEpochState era
shelleyLedgerState (LedgerState (ShelleyBlock proto era)
 -> StrictMaybe PulsingRewUpdate)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe PulsingRewUpdate
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
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 -> [Builder]
blockStats ShelleyBlock proto era
blk =
      [ Int -> Builder
forall a. Integral a => a -> Builder
decimal (Int -> Builder) -> Int -> Builder
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 -> Builder
forall a. Integral a => a -> Builder
decimal (SizeInBytes -> Builder) -> SizeInBytes -> Builder
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
      ]
      [Builder] -> [Builder] -> [Builder]
forall a. [a] -> [a] -> [a]
++
      [ Word64 -> Builder
forall a. Integral a => a -> Builder
decimal (Word64 -> Builder) -> Word64 -> Builder
forall a b. (a -> b) -> a -> b
$ (Word64 -> Tx era -> Word64)
-> Word64 -> StrictSeq (Tx 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 era
tx -> Word64
acc Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Tx era -> Word64
f Tx era
tx) Word64
0 StrictSeq (Tx era)
txs
      | Tx era -> Word64
f <- Maybe (Tx era -> Word64) -> [Tx era -> Word64]
forall a. Maybe a -> [a]
maybeToList Maybe (Tx era -> Word64)
forall era. PerEraAnalysis era => Maybe (Tx era -> Word64)
txExUnitsSteps
      ]
    where
      txs :: StrictSeq (Core.Tx era)
      txs :: StrictSeq (Tx 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
_ TxSeq era
body -> forall era. EraSegWits era => TxSeq era -> StrictSeq (Tx era)
Core.fromTxSeq @era TxSeq era
body

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

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

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

instance PerEraAnalysis AlonzoEra where
    txExUnitsSteps :: Maybe (Tx AlonzoEra -> Word64)
txExUnitsSteps = (Tx AlonzoEra -> Word64) -> Maybe (Tx AlonzoEra -> Word64)
forall a. a -> Maybe a
Just ((Tx AlonzoEra -> Word64) -> Maybe (Tx AlonzoEra -> Word64))
-> (Tx AlonzoEra -> Word64) -> Maybe (Tx AlonzoEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx AlonzoEra
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx AlonzoEra -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx 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 BabbageEra -> Word64)
txExUnitsSteps = (Tx BabbageEra -> Word64) -> Maybe (Tx BabbageEra -> Word64)
forall a. a -> Maybe a
Just ((Tx BabbageEra -> Word64) -> Maybe (Tx BabbageEra -> Word64))
-> (Tx BabbageEra -> Word64) -> Maybe (Tx BabbageEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx BabbageEra
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx BabbageEra -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx 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 ConwayEra -> Word64)
txExUnitsSteps = (Tx ConwayEra -> Word64) -> Maybe (Tx ConwayEra -> Word64)
forall a. a -> Maybe a
Just ((Tx ConwayEra -> Word64) -> Maybe (Tx ConwayEra -> Word64))
-> (Tx ConwayEra -> Word64) -> Maybe (Tx ConwayEra -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx ConwayEra
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx ConwayEra -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx 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

-- | 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
    ShelleyGenesis
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
    ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> IO
     (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
 -> IO
      (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)))
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
-> IO
     (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis
-> Nonce
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
mkShelleyProtocolInfo ShelleyGenesis
config Nonce
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),
 IO
   [BlockForging
      IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a, b) -> a
fst ((ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra),
  IO
    [BlockForging
       IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
 -> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra))
-> (ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra),
    IO
      [BlockForging
         IO (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)])
-> ProtocolInfo (ShelleyBlock (TPraos StandardCrypto) ShelleyEra)
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) c.
(IOLike m, ShelleyCompatible (TPraos c) ShelleyEra,
 TxLimits (ShelleyBlock (TPraos c) ShelleyEra)) =>
ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging 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)