{-# 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.Crypto (Crypto)
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,
                     StandardShelley)
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 (ProtoCrypto proto))
  (ChainHash (ShelleyBlock proto era))
-> proxy (ShelleyBlock proto era)
-> Map
     (ShelleyHash (ProtoCrypto proto))
     (ChainHash (ShelleyBlock proto era))
forall a b. a -> b -> a
const Map
  (ShelleyHash (ProtoCrypto proto))
  (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 (ProtoCrypto proto))
brp = NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
NewEpochState era
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
SL.nesRu (NewEpochState era
 -> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto)))
-> (LedgerState (ShelleyBlock proto era) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
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 (ProtoCrypto proto)))
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
lsb
          arp :: StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
arp = NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
NewEpochState era
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
SL.nesRu (NewEpochState era
 -> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto)))
-> (LedgerState (ShelleyBlock proto era) -> NewEpochState era)
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
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 (ProtoCrypto proto)))
-> LedgerState (ShelleyBlock proto era)
-> StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
forall a b. (a -> b) -> a -> b
$ LedgerState (ShelleyBlock proto era)
lsa
      in case (StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
brp, StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
arp) of
        (StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
SNothing, SJust PulsingRewUpdate (ProtoCrypto proto)
_) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_START"
        (SJust (SL.Pulsing RewardSnapShot (ProtoCrypto proto)
_ Pulser (ProtoCrypto proto)
_), SJust (SL.Complete RewardUpdate (ProtoCrypto proto)
_)) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_COMPLETE"
        (SJust PulsingRewUpdate (ProtoCrypto proto)
_, StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
SNothing) -> String -> Maybe String
forall a. a -> Maybe a
Just String
"RWDPULSER_RESET"
        (StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
_, StrictMaybe (PulsingRewUpdate (ProtoCrypto proto))
_) -> 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 c) where txExUnitsSteps :: Maybe (Tx (ShelleyEra c) -> Word64)
txExUnitsSteps = Maybe (Tx (ShelleyEra c) -> Word64)
Maybe (ShelleyTx (ShelleyEra c) -> Word64)
forall a. Maybe a
Nothing
instance PerEraAnalysis (AllegraEra c) where txExUnitsSteps :: Maybe (Tx (AllegraEra c) -> Word64)
txExUnitsSteps = Maybe (Tx (AllegraEra c) -> Word64)
Maybe (ShelleyTx (AllegraEra c) -> Word64)
forall a. Maybe a
Nothing
instance PerEraAnalysis (MaryEra    c) where txExUnitsSteps :: Maybe (Tx (MaryEra c) -> Word64)
txExUnitsSteps = Maybe (Tx (MaryEra c) -> Word64)
Maybe (ShelleyTx (MaryEra c) -> Word64)
forall a. Maybe a
Nothing

instance (Crypto c)
      => PerEraAnalysis (AlonzoEra c) where
    txExUnitsSteps :: Maybe (Tx (AlonzoEra c) -> Word64)
txExUnitsSteps = (Tx (AlonzoEra c) -> Word64) -> Maybe (Tx (AlonzoEra c) -> Word64)
forall a. a -> Maybe a
Just ((Tx (AlonzoEra c) -> Word64)
 -> Maybe (Tx (AlonzoEra c) -> Word64))
-> (Tx (AlonzoEra c) -> Word64)
-> Maybe (Tx (AlonzoEra c) -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx (AlonzoEra c)
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx (AlonzoEra c) -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx (AlonzoEra c)
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 (Crypto c)
      => PerEraAnalysis (BabbageEra c) where
    txExUnitsSteps :: Maybe (Tx (BabbageEra c) -> Word64)
txExUnitsSteps = (Tx (BabbageEra c) -> Word64)
-> Maybe (Tx (BabbageEra c) -> Word64)
forall a. a -> Maybe a
Just ((Tx (BabbageEra c) -> Word64)
 -> Maybe (Tx (BabbageEra c) -> Word64))
-> (Tx (BabbageEra c) -> Word64)
-> Maybe (Tx (BabbageEra c) -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx (BabbageEra c)
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx (BabbageEra c) -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx (BabbageEra c)
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 (Crypto c)
      => PerEraAnalysis (ConwayEra c) where
    txExUnitsSteps :: Maybe (Tx (ConwayEra c) -> Word64)
txExUnitsSteps = (Tx (ConwayEra c) -> Word64) -> Maybe (Tx (ConwayEra c) -> Word64)
forall a. a -> Maybe a
Just ((Tx (ConwayEra c) -> Word64)
 -> Maybe (Tx (ConwayEra c) -> Word64))
-> (Tx (ConwayEra c) -> Word64)
-> Maybe (Tx (ConwayEra c) -> Word64)
forall a b. (a -> b) -> a -> b
$ \Tx (ConwayEra c)
tx ->
        let (Alonzo.ExUnits Natural
_mem Natural
steps) = Tx (ConwayEra c) -> ExUnits
forall era. (EraTx era, AlonzoEraTxWits era) => Tx era -> ExUnits
Alonzo.totExUnits Tx (ConwayEra c)
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) StandardShelley) where
  data Args (ShelleyBlock (TPraos StandardCrypto) StandardShelley) = ShelleyBlockArgs {
        Args
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
configFileShelley :: FilePath
      , Args
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> Nonce
initialNonce      :: Nonce
      }
    deriving (Int
-> Args
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
-> String
[Args
   (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))]
-> String -> String
Args
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
(Int
 -> Args
      (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
 -> String
 -> String)
-> (Args
      (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
    -> String)
-> ([Args
       (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))]
    -> String -> String)
-> Show
     (Args
        (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto)))
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int
-> Args
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
-> String
showsPrec :: Int
-> Args
     (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
-> String
$cshow :: Args
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
show :: Args
  (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))
-> String
$cshowList :: [Args
   (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))]
-> String -> String
showList :: [Args
   (ShelleyBlock (TPraos StandardCrypto) (ShelleyEra StandardCrypto))]
-> String -> String
Show)

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

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

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