{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Node.Common
( ProtocolParamsShelleyBased (..)
, ShelleyEraWithCrypto
, ShelleyLeaderCredentials (..)
, shelleyBlockIssuerVKey
) where
import Cardano.Crypto.KES (UnsoundPureSignKeyKES)
import Cardano.Ledger.BaseTypes (unNonZero)
import qualified Cardano.Ledger.Keys as SL
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.Slot
import Cardano.Protocol.Crypto
import Data.Text (Text)
import Ouroboros.Consensus.Block
( CannotForge
, ForgeStateInfo
, ForgeStateUpdateError
)
import Ouroboros.Consensus.Config (maxRollbacks)
import Ouroboros.Consensus.Config.SupportsNode
import Ouroboros.Consensus.Ledger.SupportsMempool (TxLimits)
import Ouroboros.Consensus.Node.InitStorage
import qualified Ouroboros.Consensus.Protocol.Ledger.HotKey as HotKey
import Ouroboros.Consensus.Protocol.Praos.Common
( PraosCanBeLeader (praosCanBeLeaderColdVerKey)
)
import Ouroboros.Consensus.Shelley.Ledger
( ShelleyBlock
, ShelleyCompatible
, shelleyNetworkMagic
, shelleyStorageConfigSecurityParam
, shelleyStorageConfigSlotsPerKESPeriod
, shelleySystemStart
, verifyBlockIntegrity
)
import Ouroboros.Consensus.Shelley.Protocol.Abstract
( ProtoCrypto
, ProtocolHeaderSupportsProtocol (CannotForgeError)
)
import Ouroboros.Consensus.Storage.ImmutableDB
data ShelleyLeaderCredentials c = ShelleyLeaderCredentials
{ forall c.
ShelleyLeaderCredentials c -> UnsoundPureSignKeyKES (KES c)
shelleyLeaderCredentialsInitSignKey :: UnsoundPureSignKeyKES (KES c)
, forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c
, forall c. ShelleyLeaderCredentials c -> Text
shelleyLeaderCredentialsLabel :: Text
}
shelleyBlockIssuerVKey ::
ShelleyLeaderCredentials c -> SL.VKey 'SL.BlockIssuer
shelleyBlockIssuerVKey :: forall c. ShelleyLeaderCredentials c -> VKey 'BlockIssuer
shelleyBlockIssuerVKey =
PraosCanBeLeader c -> VKey 'BlockIssuer
forall c. PraosCanBeLeader c -> VKey 'BlockIssuer
praosCanBeLeaderColdVerKey (PraosCanBeLeader c -> VKey 'BlockIssuer)
-> (ShelleyLeaderCredentials c -> PraosCanBeLeader c)
-> ShelleyLeaderCredentials c
-> VKey 'BlockIssuer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLeaderCredentials c -> PraosCanBeLeader c
forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader
type instance CannotForge (ShelleyBlock proto era) = CannotForgeError proto
type instance ForgeStateInfo (ShelleyBlock proto era) = HotKey.KESInfo
type instance ForgeStateUpdateError (ShelleyBlock proto era) = HotKey.KESEvolutionError
class
(ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), ProtoCrypto proto ~ c) =>
ShelleyEraWithCrypto c proto era
instance
(ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), ProtoCrypto proto ~ c) =>
ShelleyEraWithCrypto c proto era
instance ConfigSupportsNode (ShelleyBlock proto era) where
getSystemStart :: BlockConfig (ShelleyBlock proto era) -> SystemStart
getSystemStart = BlockConfig (ShelleyBlock proto era) -> SystemStart
forall proto era.
BlockConfig (ShelleyBlock proto era) -> SystemStart
shelleySystemStart
getNetworkMagic :: BlockConfig (ShelleyBlock proto era) -> NetworkMagic
getNetworkMagic = BlockConfig (ShelleyBlock proto era) -> NetworkMagic
forall proto era.
BlockConfig (ShelleyBlock proto era) -> NetworkMagic
shelleyNetworkMagic
instance ShelleyCompatible proto era => NodeInitStorage (ShelleyBlock proto era) where
nodeImmutableDbChunkInfo :: StorageConfig (ShelleyBlock proto era) -> ChunkInfo
nodeImmutableDbChunkInfo =
EpochSize -> ChunkInfo
simpleChunkInfo
(EpochSize -> ChunkInfo)
-> (StorageConfig (ShelleyBlock proto era) -> EpochSize)
-> StorageConfig (ShelleyBlock proto era)
-> ChunkInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> EpochSize
EpochSize
(Word64 -> EpochSize)
-> (StorageConfig (ShelleyBlock proto era) -> Word64)
-> StorageConfig (ShelleyBlock proto era)
-> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10)
(Word64 -> Word64)
-> (StorageConfig (ShelleyBlock proto era) -> Word64)
-> StorageConfig (ShelleyBlock proto era)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero
(NonZero Word64 -> Word64)
-> (StorageConfig (ShelleyBlock proto era) -> NonZero Word64)
-> StorageConfig (ShelleyBlock proto era)
-> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityParam -> NonZero Word64
maxRollbacks
(SecurityParam -> NonZero Word64)
-> (StorageConfig (ShelleyBlock proto era) -> SecurityParam)
-> StorageConfig (ShelleyBlock proto era)
-> NonZero Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StorageConfig (ShelleyBlock proto era) -> SecurityParam
forall proto era.
StorageConfig (ShelleyBlock proto era) -> SecurityParam
shelleyStorageConfigSecurityParam
nodeCheckIntegrity :: StorageConfig (ShelleyBlock proto era)
-> ShelleyBlock proto era -> Bool
nodeCheckIntegrity StorageConfig (ShelleyBlock proto era)
cfg =
Word64 -> ShelleyBlock proto era -> Bool
forall proto era.
ShelleyCompatible proto era =>
Word64 -> ShelleyBlock proto era -> Bool
verifyBlockIntegrity (StorageConfig (ShelleyBlock proto era) -> Word64
forall proto era. StorageConfig (ShelleyBlock proto era) -> Word64
shelleyStorageConfigSlotsPerKESPeriod StorageConfig (ShelleyBlock proto era)
cfg)
data ProtocolParamsShelleyBased c = ProtocolParamsShelleyBased
{ forall c. ProtocolParamsShelleyBased c -> Nonce
shelleyBasedInitialNonce :: SL.Nonce
, forall c.
ProtocolParamsShelleyBased c -> [ShelleyLeaderCredentials c]
shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials c]
}