{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -Wno-orphans  #-}

module Bcc.Node.Protocol.Bcc
  ( mkSomeConsensusProtocolBcc

    -- * Errors
  , BccProtocolInstantiationError(..)
  ) where

import           Prelude

import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT)

import qualified Bcc.Chain.Update as Cole

import           Shardagnostic.Consensus.Bcc
import qualified Shardagnostic.Consensus.Bcc as Consensus
import qualified Shardagnostic.Consensus.Bcc.CanHardFork as Consensus
import           Shardagnostic.Consensus.HardFork.Combinator.Condense ()

import           Shardagnostic.Consensus.Bcc.Condense ()
import qualified Shardagnostic.Consensus.Mempool.TxLimits as TxLimits

import           Bcc.Api
import           Bcc.Api.Orphans ()
import           Bcc.Api.Protocol.Types
import           Bcc.Node.Types

import           Bcc.Tracing.OrphanInstances.Cole ()
import           Bcc.Tracing.OrphanInstances.Sophie ()

import qualified Bcc.Node.Protocol.Aurum as Aurum
import qualified Bcc.Node.Protocol.Cole as Cole
import qualified Bcc.Node.Protocol.Sophie as Sophie

import           Bcc.Node.Protocol.Types

------------------------------------------------------------------------------
-- Real Bcc protocol
--

-- | Make 'SomeConsensusProtocol' using the Bcc instance.
--
-- The Bcc protocol instance is currently the sequential composition of
-- the Cole and Sophie protocols, and will likely be extended in future
-- with further sequentially composed protocol revisions.
--
-- The use of 'SomeConsensusProtocol' lets us handle multiple protocols in a
-- generic way.
--
-- This also serves a purpose as a sanity check that we have all the necessary
-- type class instances available.
--
mkSomeConsensusProtocolBcc
  :: NodeColeProtocolConfiguration
  -> NodeSophieProtocolConfiguration
  -> NodeAurumProtocolConfiguration
  -> NodeHardForkProtocolConfiguration
  -> Maybe ProtocolFilepaths
  -> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolBcc :: NodeColeProtocolConfiguration
-> NodeSophieProtocolConfiguration
-> NodeAurumProtocolConfiguration
-> NodeHardForkProtocolConfiguration
-> Maybe ProtocolFilepaths
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
mkSomeConsensusProtocolBcc NodeColeProtocolConfiguration {
                             GenesisFile
npcColeGenesisFile :: NodeColeProtocolConfiguration -> GenesisFile
npcColeGenesisFile :: GenesisFile
npcColeGenesisFile,
                             Maybe GenesisHash
npcColeGenesisFileHash :: NodeColeProtocolConfiguration -> Maybe GenesisHash
npcColeGenesisFileHash :: Maybe GenesisHash
npcColeGenesisFileHash,
                             RequiresNetworkMagic
npcColeReqNetworkMagic :: NodeColeProtocolConfiguration -> RequiresNetworkMagic
npcColeReqNetworkMagic :: RequiresNetworkMagic
npcColeReqNetworkMagic,
                             Maybe Double
npcColePbftSignatureThresh :: NodeColeProtocolConfiguration -> Maybe Double
npcColePbftSignatureThresh :: Maybe Double
npcColePbftSignatureThresh,
                             ApplicationName
npcColeApplicationName :: NodeColeProtocolConfiguration -> ApplicationName
npcColeApplicationName :: ApplicationName
npcColeApplicationName,
                             NumSoftwareVersion
npcColeApplicationVersion :: NodeColeProtocolConfiguration -> NumSoftwareVersion
npcColeApplicationVersion :: NumSoftwareVersion
npcColeApplicationVersion,
                             Word16
npcColeSupportedProtocolVersionMajor :: NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionMajor :: Word16
npcColeSupportedProtocolVersionMajor,
                             Word16
npcColeSupportedProtocolVersionSentry :: NodeColeProtocolConfiguration -> Word16
npcColeSupportedProtocolVersionSentry :: Word16
npcColeSupportedProtocolVersionSentry
                           }
                           NodeSophieProtocolConfiguration {
                             GenesisFile
npcSophieGenesisFile :: NodeSophieProtocolConfiguration -> GenesisFile
npcSophieGenesisFile :: GenesisFile
npcSophieGenesisFile,
                             Maybe GenesisHash
npcSophieGenesisFileHash :: NodeSophieProtocolConfiguration -> Maybe GenesisHash
npcSophieGenesisFileHash :: Maybe GenesisHash
npcSophieGenesisFileHash
                           }
                           NodeAurumProtocolConfiguration {
                             GenesisFile
npcAurumGenesisFile :: NodeAurumProtocolConfiguration -> GenesisFile
npcAurumGenesisFile :: GenesisFile
npcAurumGenesisFile,
                             Maybe GenesisHash
npcAurumGenesisFileHash :: NodeAurumProtocolConfiguration -> Maybe GenesisHash
npcAurumGenesisFileHash :: Maybe GenesisHash
npcAurumGenesisFileHash
                           }
                           NodeHardForkProtocolConfiguration {
                            -- npcTestEnableDevelopmentHardForkEras,
                            -- During testing of the Aurum era, we conditionally declared that we
                            -- knew about the Aurum era. We do so only when a config option for
                            -- testing development/unstable eras is used. This lets us include
                            -- not-yet-ready eras in released node versions without mainnet nodes
                            -- prematurely advertising that they could hard fork into the new era.
                             Maybe EpochNo
npcTestSophieHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestSophieHardForkAtEpoch :: Maybe EpochNo
npcTestSophieHardForkAtEpoch,
                             Maybe Word
npcTestSophieHardForkAtVersion :: NodeHardForkProtocolConfiguration -> Maybe Word
npcTestSophieHardForkAtVersion :: Maybe Word
npcTestSophieHardForkAtVersion,
                             Maybe EpochNo
npcTestEvieHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestEvieHardForkAtEpoch :: Maybe EpochNo
npcTestEvieHardForkAtEpoch,
                             Maybe Word
npcTestEvieHardForkAtVersion :: NodeHardForkProtocolConfiguration -> Maybe Word
npcTestEvieHardForkAtVersion :: Maybe Word
npcTestEvieHardForkAtVersion,
                             Maybe EpochNo
npcTestJenHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestJenHardForkAtEpoch :: Maybe EpochNo
npcTestJenHardForkAtEpoch,
                             Maybe Word
npcTestJenHardForkAtVersion :: NodeHardForkProtocolConfiguration -> Maybe Word
npcTestJenHardForkAtVersion :: Maybe Word
npcTestJenHardForkAtVersion,
                             Maybe EpochNo
npcTestAurumHardForkAtEpoch :: NodeHardForkProtocolConfiguration -> Maybe EpochNo
npcTestAurumHardForkAtEpoch :: Maybe EpochNo
npcTestAurumHardForkAtEpoch,
                             Maybe Word
npcTestAurumHardForkAtVersion :: NodeHardForkProtocolConfiguration -> Maybe Word
npcTestAurumHardForkAtVersion :: Maybe Word
npcTestAurumHardForkAtVersion
                           }
                           Maybe ProtocolFilepaths
files = do
    Config
coleGenesis <-
      (ColeProtocolInstantiationError -> BccProtocolInstantiationError)
-> ExceptT ColeProtocolInstantiationError IO Config
-> ExceptT BccProtocolInstantiationError IO Config
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeProtocolInstantiationError -> BccProtocolInstantiationError
BccProtocolInstantiationErrorCole (ExceptT ColeProtocolInstantiationError IO Config
 -> ExceptT BccProtocolInstantiationError IO Config)
-> ExceptT ColeProtocolInstantiationError IO Config
-> ExceptT BccProtocolInstantiationError IO Config
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> RequiresNetworkMagic
-> ExceptT ColeProtocolInstantiationError IO Config
Cole.readGenesis GenesisFile
npcColeGenesisFile
                          Maybe GenesisHash
npcColeGenesisFileHash
                          RequiresNetworkMagic
npcColeReqNetworkMagic

    Maybe ColeLeaderCredentials
coleLeaderCredentials <-
      (ColeProtocolInstantiationError -> BccProtocolInstantiationError)
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
-> ExceptT
     BccProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ColeProtocolInstantiationError -> BccProtocolInstantiationError
BccProtocolInstantiationErrorCole (ExceptT
   ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
 -> ExceptT
      BccProtocolInstantiationError IO (Maybe ColeLeaderCredentials))
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
-> ExceptT
     BccProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
forall a b. (a -> b) -> a -> b
$
        Config
-> Maybe ProtocolFilepaths
-> ExceptT
     ColeProtocolInstantiationError IO (Maybe ColeLeaderCredentials)
Cole.readLeaderCredentials Config
coleGenesis Maybe ProtocolFilepaths
files

    (SophieGenesis StandardSophie
sophieGenesis, GenesisHash
sophieGenesisHash) <-
      (GenesisReadError -> BccProtocolInstantiationError)
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
-> ExceptT
     BccProtocolInstantiationError
     IO
     (SophieGenesis StandardSophie, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> BccProtocolInstantiationError
BccProtocolInstantiationSophieGenesisReadError (ExceptT
   GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
 -> ExceptT
      BccProtocolInstantiationError
      IO
      (SophieGenesis StandardSophie, GenesisHash))
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
-> ExceptT
     BccProtocolInstantiationError
     IO
     (SophieGenesis StandardSophie, GenesisHash)
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> ExceptT
     GenesisReadError IO (SophieGenesis StandardSophie, GenesisHash)
Sophie.readGenesis GenesisFile
npcSophieGenesisFile
                            Maybe GenesisHash
npcSophieGenesisFileHash

    (AurumGenesis
aurumGenesis, GenesisHash
_aurumGenesisHash) <-
      (GenesisReadError -> BccProtocolInstantiationError)
-> ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
-> ExceptT
     BccProtocolInstantiationError IO (AurumGenesis, GenesisHash)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT GenesisReadError -> BccProtocolInstantiationError
BccProtocolInstantiationAurumGenesisReadError (ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
 -> ExceptT
      BccProtocolInstantiationError IO (AurumGenesis, GenesisHash))
-> ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
-> ExceptT
     BccProtocolInstantiationError IO (AurumGenesis, GenesisHash)
forall a b. (a -> b) -> a -> b
$
        GenesisFile
-> Maybe GenesisHash
-> ExceptT GenesisReadError IO (AurumGenesis, GenesisHash)
Aurum.readGenesis GenesisFile
npcAurumGenesisFile
                           Maybe GenesisHash
npcAurumGenesisFileHash

    [TOptimumLeaderCredentials StandardCrypto]
sophieLeaderCredentials <-
      (OptimumLeaderCredentialsError -> BccProtocolInstantiationError)
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     BccProtocolInstantiationError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT OptimumLeaderCredentialsError -> BccProtocolInstantiationError
BccProtocolInstantiationOptimumLeaderCredentialsError (ExceptT
   OptimumLeaderCredentialsError
   IO
   [TOptimumLeaderCredentials StandardCrypto]
 -> ExceptT
      BccProtocolInstantiationError
      IO
      [TOptimumLeaderCredentials StandardCrypto])
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
-> ExceptT
     BccProtocolInstantiationError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
forall a b. (a -> b) -> a -> b
$
        Maybe ProtocolFilepaths
-> ExceptT
     OptimumLeaderCredentialsError
     IO
     [TOptimumLeaderCredentials StandardCrypto]
Sophie.readLeaderCredentials Maybe ProtocolFilepaths
files

    --TODO: all these protocol versions below are confusing and unnecessary.
    -- It could and should all be automated and these config entries eliminated.
    SomeConsensusProtocol
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeConsensusProtocol
 -> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol)
-> SomeConsensusProtocol
-> ExceptT BccProtocolInstantiationError IO SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$!
      BlockType (HardForkBlock (BccEras StandardCrypto))
-> ProtocolInfoArgs IO (HardForkBlock (BccEras StandardCrypto))
-> SomeConsensusProtocol
forall blk.
(Protocol IO blk, HasKESMetricsData blk, HasKESInfo blk,
 TraceConstraints blk) =>
BlockType blk -> ProtocolInfoArgs IO blk -> SomeConsensusProtocol
SomeConsensusProtocol BlockType (HardForkBlock (BccEras StandardCrypto))
BccBlockType (ProtocolInfoArgs IO (HardForkBlock (BccEras StandardCrypto))
 -> SomeConsensusProtocol)
-> ProtocolInfoArgs IO (HardForkBlock (BccEras StandardCrypto))
-> SomeConsensusProtocol
forall a b. (a -> b) -> a -> b
$ ProtocolParamsCole
-> ProtocolParamsSophieBased StandardSophie
-> ProtocolParamsSophie StandardCrypto
-> ProtocolParamsEvie StandardCrypto
-> ProtocolParamsJen StandardCrypto
-> ProtocolParamsAurum StandardCrypto
-> ProtocolTransitionParamsSophieBased StandardSophie
-> ProtocolTransitionParamsSophieBased StandardEvie
-> ProtocolTransitionParamsSophieBased StandardJen
-> ProtocolTransitionParamsSophieBased StandardAurum
-> ProtocolInfoArgs IO (HardForkBlock (BccEras StandardCrypto))
forall (m :: * -> *).
ProtocolParamsCole
-> ProtocolParamsSophieBased StandardSophie
-> ProtocolParamsSophie StandardCrypto
-> ProtocolParamsEvie StandardCrypto
-> ProtocolParamsJen StandardCrypto
-> ProtocolParamsAurum StandardCrypto
-> ProtocolTransitionParamsSophieBased StandardSophie
-> ProtocolTransitionParamsSophieBased StandardEvie
-> ProtocolTransitionParamsSophieBased StandardJen
-> ProtocolTransitionParamsSophieBased StandardAurum
-> ProtocolInfoArgs m (HardForkBlock (BccEras StandardCrypto))
ProtocolInfoArgsBcc
        ProtocolParamsCole :: Config
-> Maybe PBftSignatureThreshold
-> ProtocolVersion
-> SoftwareVersion
-> Maybe ColeLeaderCredentials
-> Overrides ColeBlock
-> ProtocolParamsCole
Consensus.ProtocolParamsCole {
          $sel:coleGenesis:ProtocolParamsCole :: Config
coleGenesis = Config
coleGenesis,
          $sel:colePbftSignatureThreshold:ProtocolParamsCole :: Maybe PBftSignatureThreshold
colePbftSignatureThreshold =
            Double -> PBftSignatureThreshold
PBftSignatureThreshold (Double -> PBftSignatureThreshold)
-> Maybe Double -> Maybe PBftSignatureThreshold
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Double
npcColePbftSignatureThresh,

          -- This is /not/ the Cole protocol version. It is the protocol
          -- version that this node will use in blocks it creates. It is used
          -- in the Cole update mechanism to signal that this block-producing
          -- node is ready to move to the new protocol. For example, when the
          -- protocol version (according to the ledger state) is 0, this setting
          -- should be 1 when we are ready to move. Similarly when the current
          -- protocol version is 1, this should be 2 to indicate we are ready
          -- to move into the Sophie era.
          $sel:coleProtocolVersion:ProtocolParamsCole :: ProtocolVersion
coleProtocolVersion =
            Word16 -> Word16 -> ProtocolVersion
Cole.ProtocolVersion
              Word16
npcColeSupportedProtocolVersionMajor
              Word16
npcColeSupportedProtocolVersionSentry,
          $sel:coleSoftwareVersion:ProtocolParamsCole :: SoftwareVersion
coleSoftwareVersion =
            ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Cole.SoftwareVersion
              ApplicationName
npcColeApplicationName
              NumSoftwareVersion
npcColeApplicationVersion,
          $sel:coleLeaderCredentials:ProtocolParamsCole :: Maybe ColeLeaderCredentials
coleLeaderCredentials =
            Maybe ColeLeaderCredentials
coleLeaderCredentials,
          $sel:coleMaxTxCapacityOverrides:ProtocolParamsCole :: Overrides ColeBlock
coleMaxTxCapacityOverrides =
            TxMeasure ColeBlock -> Overrides ColeBlock
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure ColeBlock
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }
        ProtocolParamsSophieBased :: forall era.
SophieGenesis era
-> Nonce
-> [TOptimumLeaderCredentials (EraCrypto era)]
-> ProtocolParamsSophieBased era
Consensus.ProtocolParamsSophieBased {
          $sel:sophieBasedGenesis:ProtocolParamsSophieBased :: SophieGenesis StandardSophie
sophieBasedGenesis           = SophieGenesis StandardSophie
sophieGenesis,
          $sel:sophieBasedInitialNonce:ProtocolParamsSophieBased :: Nonce
sophieBasedInitialNonce      = GenesisHash -> Nonce
Sophie.genesisHashToOptimumNonce
                                            GenesisHash
sophieGenesisHash,
          $sel:sophieBasedLeaderCredentials:ProtocolParamsSophieBased :: [TOptimumLeaderCredentials (EraCrypto StandardSophie)]
sophieBasedLeaderCredentials = [TOptimumLeaderCredentials StandardCrypto]
[TOptimumLeaderCredentials (EraCrypto StandardSophie)]
sophieLeaderCredentials
        }
        ProtocolParamsSophie :: forall c.
ProtVer
-> Overrides (SophieBlock (SophieEra c)) -> ProtocolParamsSophie c
Consensus.ProtocolParamsSophie {
          -- This is /not/ the Sophie protocol version. It is the protocol
          -- version that this node will declare that it understands, when it
          -- is in the Sophie era. That is, it is the version of protocol
          -- /after/ Sophie, i.e. Evie.
          $sel:sophieProtVer:ProtocolParamsSophie :: ProtVer
sophieProtVer =
            Natural -> Natural -> ProtVer
ProtVer Natural
3 Natural
0,
          $sel:sophieMaxTxCapacityOverrides:ProtocolParamsSophie :: Overrides (SophieBlock StandardSophie)
sophieMaxTxCapacityOverrides =
            TxMeasure (SophieBlock StandardSophie)
-> Overrides (SophieBlock StandardSophie)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (SophieBlock StandardSophie)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }
        ProtocolParamsEvie :: forall c.
ProtVer
-> Overrides (SophieBlock (EvieEra c)) -> ProtocolParamsEvie c
Consensus.ProtocolParamsEvie {
          -- This is /not/ the Evie protocol version. It is the protocol
          -- version that this node will declare that it understands, when it
          -- is in the Evie era. That is, it is the version of protocol
          -- /after/ Evie, i.e. Jen.
          $sel:evieProtVer:ProtocolParamsEvie :: ProtVer
evieProtVer =
            Natural -> Natural -> ProtVer
ProtVer Natural
4 Natural
0,
          $sel:evieMaxTxCapacityOverrides:ProtocolParamsEvie :: Overrides (SophieBlock StandardEvie)
evieMaxTxCapacityOverrides =
            TxMeasure (SophieBlock StandardEvie)
-> Overrides (SophieBlock StandardEvie)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (SophieBlock StandardEvie)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }
        ProtocolParamsJen :: forall c.
ProtVer
-> Overrides (SophieBlock (JenEra c)) -> ProtocolParamsJen c
Consensus.ProtocolParamsJen {
          -- This is /not/ the Jen protocol version. It is the protocol
          -- version that this node will declare that it understands, when it
          -- is in the Jen era. That is, it is the version of protocol
          -- /after/ Jen, i.e. Aurum.
          $sel:jenProtVer:ProtocolParamsJen :: ProtVer
jenProtVer = Natural -> Natural -> ProtVer
ProtVer Natural
5 Natural
0,
          $sel:jenMaxTxCapacityOverrides:ProtocolParamsJen :: Overrides (SophieBlock StandardJen)
jenMaxTxCapacityOverrides =
            TxMeasure (SophieBlock StandardJen)
-> Overrides (SophieBlock StandardJen)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (SophieBlock StandardJen)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }
        ProtocolParamsAurum :: forall c.
ProtVer
-> Overrides (SophieBlock (AurumEra c)) -> ProtocolParamsAurum c
Consensus.ProtocolParamsAurum {
          -- This is /not/ the Aurum protocol version. It is the protocol
          -- version that this node will declare that it understands, when it
          -- is in the Aurum era. Since Aurum is currently the last known
          -- protocol version then this is also the Aurum protocol version.
          $sel:aurumProtVer:ProtocolParamsAurum :: ProtVer
aurumProtVer = Natural -> Natural -> ProtVer
ProtVer Natural
6 Natural
0,
          $sel:aurumMaxTxCapacityOverrides:ProtocolParamsAurum :: Overrides (SophieBlock StandardAurum)
aurumMaxTxCapacityOverrides =
            TxMeasure (SophieBlock StandardAurum)
-> Overrides (SophieBlock StandardAurum)
forall blk. TxMeasure blk -> Overrides blk
TxLimits.mkOverrides TxMeasure (SophieBlock StandardAurum)
forall a. BoundedMeasure a => a
TxLimits.noOverridesMeasure
        }

        -- ProtocolParamsTransition specifies the parameters needed to transition between two eras
        -- The comments below also apply for the Sophie -> Evie and Evie -> Jen hard forks.
        -- Cole to Sophie hard fork parameters
        ProtocolTransitionParamsSophieBased :: forall era.
TranslationContext era
-> TriggerHardFork -> ProtocolTransitionParamsSophieBased era
Consensus.ProtocolTransitionParamsSophieBased {
          transitionTranslationContext :: TranslationContext StandardSophie
transitionTranslationContext = (),
          transitionTrigger :: TriggerHardFork
transitionTrigger =
            -- What will trigger the Cole -> Sophie hard fork?
            case Maybe EpochNo
npcTestSophieHardForkAtEpoch of

               -- This specifies the major protocol version number update that will
               -- trigger us moving to the Sophie protocol.
               --
               -- Version 0 is Cole with Shardagnostic classic
               -- Version 1 is Cole with Shardagnostic Permissive BFT
               -- Version 2 is Sophie
               -- Version 3 is Evie
               -- Version 4 is Jen
               -- Version 5 is Aurum
               --
               -- But we also provide an override to allow for simpler test setups
               -- such as triggering at the 0 -> 1 transition .
               --
               Maybe EpochNo
Nothing -> Word16 -> TriggerHardFork
Consensus.TriggerHardForkAtVersion
                            (Word16 -> (Word -> Word16) -> Maybe Word -> Word16
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word16
2 Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word
npcTestSophieHardForkAtVersion)

               -- Alternatively, for testing we can transition at a specific epoch.
               --
               Just EpochNo
epochNo -> EpochNo -> TriggerHardFork
Consensus.TriggerHardForkAtEpoch EpochNo
epochNo
        }
        -- Sophie to Evie hard fork parameters
        ProtocolTransitionParamsSophieBased :: forall era.
TranslationContext era
-> TriggerHardFork -> ProtocolTransitionParamsSophieBased era
Consensus.ProtocolTransitionParamsSophieBased {
          transitionTranslationContext :: TranslationContext StandardEvie
transitionTranslationContext = (),
          transitionTrigger :: TriggerHardFork
transitionTrigger =
            case Maybe EpochNo
npcTestEvieHardForkAtEpoch of
               Maybe EpochNo
Nothing -> Word16 -> TriggerHardFork
Consensus.TriggerHardForkAtVersion
                            (Word16 -> (Word -> Word16) -> Maybe Word -> Word16
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word16
3 Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word
npcTestEvieHardForkAtVersion)
               Just EpochNo
epochNo -> EpochNo -> TriggerHardFork
Consensus.TriggerHardForkAtEpoch EpochNo
epochNo
        }
        -- Evie to Jen hard fork parameters
        ProtocolTransitionParamsSophieBased :: forall era.
TranslationContext era
-> TriggerHardFork -> ProtocolTransitionParamsSophieBased era
Consensus.ProtocolTransitionParamsSophieBased {
          transitionTranslationContext :: TranslationContext StandardJen
transitionTranslationContext = (),
          transitionTrigger :: TriggerHardFork
transitionTrigger =
            case Maybe EpochNo
npcTestJenHardForkAtEpoch of
               Maybe EpochNo
Nothing -> Word16 -> TriggerHardFork
Consensus.TriggerHardForkAtVersion
                            (Word16 -> (Word -> Word16) -> Maybe Word -> Word16
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word16
4 Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word
npcTestJenHardForkAtVersion)
               Just EpochNo
epochNo -> EpochNo -> TriggerHardFork
Consensus.TriggerHardForkAtEpoch EpochNo
epochNo
        }
        -- Jen to Aurum hard fork parameters
        ProtocolTransitionParamsSophieBased :: forall era.
TranslationContext era
-> TriggerHardFork -> ProtocolTransitionParamsSophieBased era
Consensus.ProtocolTransitionParamsSophieBased {
          transitionTranslationContext :: TranslationContext StandardAurum
transitionTranslationContext = AurumGenesis
TranslationContext StandardAurum
aurumGenesis,
          transitionTrigger :: TriggerHardFork
transitionTrigger =
            case Maybe EpochNo
npcTestAurumHardForkAtEpoch of
               Maybe EpochNo
Nothing -> Word16 -> TriggerHardFork
Consensus.TriggerHardForkAtVersion
                            (Word16 -> (Word -> Word16) -> Maybe Word -> Word16
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word16
5 Word -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Word
npcTestAurumHardForkAtVersion)
               Just EpochNo
epochNo -> EpochNo -> TriggerHardFork
Consensus.TriggerHardForkAtEpoch EpochNo
epochNo
        }


------------------------------------------------------------------------------
-- Errors
--

data BccProtocolInstantiationError =
       BccProtocolInstantiationErrorCole
         Cole.ColeProtocolInstantiationError

     | BccProtocolInstantiationSophieGenesisReadError
         Sophie.GenesisReadError

     | BccProtocolInstantiationAurumGenesisReadError
         Sophie.GenesisReadError

     | BccProtocolInstantiationOptimumLeaderCredentialsError
         Sophie.OptimumLeaderCredentialsError

     | BccProtocolInstantiationErrorAurum
         Aurum.AurumProtocolInstantiationError
  deriving Int -> BccProtocolInstantiationError -> ShowS
[BccProtocolInstantiationError] -> ShowS
BccProtocolInstantiationError -> String
(Int -> BccProtocolInstantiationError -> ShowS)
-> (BccProtocolInstantiationError -> String)
-> ([BccProtocolInstantiationError] -> ShowS)
-> Show BccProtocolInstantiationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BccProtocolInstantiationError] -> ShowS
$cshowList :: [BccProtocolInstantiationError] -> ShowS
show :: BccProtocolInstantiationError -> String
$cshow :: BccProtocolInstantiationError -> String
showsPrec :: Int -> BccProtocolInstantiationError -> ShowS
$cshowsPrec :: Int -> BccProtocolInstantiationError -> ShowS
Show

instance Error BccProtocolInstantiationError where
  displayError :: BccProtocolInstantiationError -> String
displayError (BccProtocolInstantiationErrorCole ColeProtocolInstantiationError
err) =
    ColeProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError ColeProtocolInstantiationError
err
  displayError (BccProtocolInstantiationSophieGenesisReadError GenesisReadError
err) =
    String
"Sophie related: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisReadError -> String
forall e. Error e => e -> String
displayError GenesisReadError
err
  displayError (BccProtocolInstantiationAurumGenesisReadError GenesisReadError
err) =
    String
"Aurum related: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> GenesisReadError -> String
forall e. Error e => e -> String
displayError GenesisReadError
err
  displayError (BccProtocolInstantiationOptimumLeaderCredentialsError OptimumLeaderCredentialsError
err) =
    OptimumLeaderCredentialsError -> String
forall e. Error e => e -> String
displayError OptimumLeaderCredentialsError
err
  displayError (BccProtocolInstantiationErrorAurum AurumProtocolInstantiationError
err) =
    AurumProtocolInstantiationError -> String
forall e. Error e => e -> String
displayError AurumProtocolInstantiationError
err