{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE DeriveGeneric           #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE GADTs                   #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE PolyKinds               #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Node configuration common to all (era, protocol) combinations deriving from
-- Shelley.
module Ouroboros.Consensus.Shelley.Node.Common (
    ProtocolParamsShelleyBased (..)
  , ShelleyEraWithCrypto
  , ShelleyLeaderCredentials (..)
  , shelleyBlockIssuerVKey
  ) where

import qualified Cardano.Ledger.Keys as SL
import qualified Cardano.Ledger.Shelley.API as SL
import           Cardano.Ledger.Slot
import           Data.Text (Text)
import           Ouroboros.Consensus.Block (CannotForge, ForgeStateInfo,
                     ForgeStateUpdateError)
import           Ouroboros.Consensus.Config (maxRollbacks)
import           Ouroboros.Consensus.Config.SupportsNode
import           Ouroboros.Consensus.Mempool.TxLimits (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.Eras (EraCrypto)
import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                     ShelleyCompatible, shelleyNetworkMagic,
                     shelleyStorageConfigSecurityParam,
                     shelleyStorageConfigSlotsPerKESPeriod, shelleySystemStart,
                     verifyBlockIntegrity)
import           Ouroboros.Consensus.Shelley.Protocol.Abstract
                     (ProtocolHeaderSupportsProtocol (CannotForgeError))
import           Ouroboros.Consensus.Storage.ImmutableDB

{-------------------------------------------------------------------------------
  Credentials
-------------------------------------------------------------------------------}

data ShelleyLeaderCredentials c = ShelleyLeaderCredentials
  { -- | The unevolved signing KES key (at evolution 0).
    --
    -- Note that this is not inside 'ShelleyCanBeLeader' since it gets evolved
    -- automatically, whereas 'ShelleyCanBeLeader' does not change.
    ShelleyLeaderCredentials c -> SignKeyKES c
shelleyLeaderCredentialsInitSignKey :: SL.SignKeyKES c,
    ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c,
    -- | Identifier for this set of credentials.
    --
    -- Useful when the node is running with multiple sets of credentials.
    ShelleyLeaderCredentials c -> Text
shelleyLeaderCredentialsLabel       :: Text
  }

shelleyBlockIssuerVKey ::
  ShelleyLeaderCredentials c -> SL.VKey 'SL.BlockIssuer c
shelleyBlockIssuerVKey :: ShelleyLeaderCredentials c -> VKey 'BlockIssuer c
shelleyBlockIssuerVKey =
  PraosCanBeLeader c -> VKey 'BlockIssuer c
forall c. PraosCanBeLeader c -> VKey 'BlockIssuer c
praosCanBeLeaderColdVerKey (PraosCanBeLeader c -> VKey 'BlockIssuer c)
-> (ShelleyLeaderCredentials c -> PraosCanBeLeader c)
-> ShelleyLeaderCredentials c
-> VKey 'BlockIssuer c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyLeaderCredentials c -> PraosCanBeLeader c
forall c. ShelleyLeaderCredentials c -> PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader

{-------------------------------------------------------------------------------
  BlockForging
-------------------------------------------------------------------------------}

type instance CannotForge (ShelleyBlock proto era) = CannotForgeError proto

type instance ForgeStateInfo (ShelleyBlock proto era) = HotKey.KESInfo

type instance ForgeStateUpdateError (ShelleyBlock proto era) = HotKey.KESEvolutionError

-- | Needed in '*SharedBlockForging' because we can't partially apply
-- equality constraints.
class
  (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), EraCrypto era ~ c) =>
  ShelleyEraWithCrypto c proto era

instance
  (ShelleyCompatible proto era, TxLimits (ShelleyBlock proto era), EraCrypto era ~ c) =>
  ShelleyEraWithCrypto c proto era

{-------------------------------------------------------------------------------
  ConfigSupportsNode instance
-------------------------------------------------------------------------------}

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

{-------------------------------------------------------------------------------
  NodeInitStorage instance
-------------------------------------------------------------------------------}

instance ShelleyCompatible proto era => NodeInitStorage (ShelleyBlock proto era) where
  -- We fix the chunk size to @10k@ so that we have the same chunk size as
  -- Byron. Consequently, a Shelley net will have the same chunk size as the
  -- Byron-to-Shelley net with the same @k@.
  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
. SecurityParam -> Word64
maxRollbacks
      (SecurityParam -> Word64)
-> (StorageConfig (ShelleyBlock proto era) -> SecurityParam)
-> StorageConfig (ShelleyBlock proto era)
-> 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)

{-------------------------------------------------------------------------------
  Protocol parameters
-------------------------------------------------------------------------------}

-- | Parameters common to all Shelley-based ledgers.
--
-- When running a chain with multiple Shelley-based eras, in addition to the
-- per-era protocol parameters, one value of 'ProtocolParamsShelleyBased' will
-- be needed, which is shared among all Shelley-based eras.
--
-- The @era@ parameter determines from which era the genesis config will be
-- used.
data ProtocolParamsShelleyBased era = ProtocolParamsShelleyBased
  { ProtocolParamsShelleyBased era -> ShelleyGenesis era
shelleyBasedGenesis           :: SL.ShelleyGenesis era,
    -- | The initial nonce, typically derived from the hash of Genesis
    -- config JSON file.
    --
    -- WARNING: chains using different values of this parameter will be
    -- mutually incompatible.
    ProtocolParamsShelleyBased era -> Nonce
shelleyBasedInitialNonce      :: SL.Nonce,
    ProtocolParamsShelleyBased era
-> [ShelleyLeaderCredentials (EraCrypto era)]
shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials (EraCrypto era)]
  }