{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Consensus.Shelley.Ledger.Config (
BlockConfig (..)
, mkShelleyBlockConfig
, CodecConfig (..)
, StorageConfig (..)
, CompactGenesis
, getCompactGenesis
, compactGenesis
) where
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Cardano.Binary (FromCBOR, ToCBOR)
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Config
import qualified Shelley.Spec.Ledger.API as SL
import Ouroboros.Consensus.Shelley.Eras (EraCrypto)
import Ouroboros.Consensus.Shelley.Ledger.Block
data instance BlockConfig (ShelleyBlock era) = ShelleyConfig {
BlockConfig (ShelleyBlock era) -> ProtVer
shelleyProtocolVersion :: !SL.ProtVer
, BlockConfig (ShelleyBlock era) -> SystemStart
shelleySystemStart :: !SystemStart
, BlockConfig (ShelleyBlock era) -> NetworkMagic
shelleyNetworkMagic :: !NetworkMagic
, BlockConfig (ShelleyBlock era)
-> Map
(KeyHash 'BlockIssuer (EraCrypto era))
(VKey 'BlockIssuer (EraCrypto era))
shelleyBlockIssuerVKeys :: !(Map (SL.KeyHash 'SL.BlockIssuer (EraCrypto era))
(SL.VKey 'SL.BlockIssuer (EraCrypto era)))
}
deriving stock ((forall x.
BlockConfig (ShelleyBlock era)
-> Rep (BlockConfig (ShelleyBlock era)) x)
-> (forall x.
Rep (BlockConfig (ShelleyBlock era)) x
-> BlockConfig (ShelleyBlock era))
-> Generic (BlockConfig (ShelleyBlock era))
forall x.
Rep (BlockConfig (ShelleyBlock era)) x
-> BlockConfig (ShelleyBlock era)
forall x.
BlockConfig (ShelleyBlock era)
-> Rep (BlockConfig (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (BlockConfig (ShelleyBlock era)) x
-> BlockConfig (ShelleyBlock era)
forall era x.
BlockConfig (ShelleyBlock era)
-> Rep (BlockConfig (ShelleyBlock era)) x
$cto :: forall era x.
Rep (BlockConfig (ShelleyBlock era)) x
-> BlockConfig (ShelleyBlock era)
$cfrom :: forall era x.
BlockConfig (ShelleyBlock era)
-> Rep (BlockConfig (ShelleyBlock era)) x
Generic)
deriving instance ShelleyBasedEra era => Show (BlockConfig (ShelleyBlock era))
deriving instance ShelleyBasedEra era => NoThunks (BlockConfig (ShelleyBlock era))
mkShelleyBlockConfig ::
ShelleyBasedEra era
=> SL.ProtVer
-> SL.ShelleyGenesis era
-> [SL.VKey 'SL.BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
mkShelleyBlockConfig :: ProtVer
-> ShelleyGenesis era
-> [VKey 'BlockIssuer (EraCrypto era)]
-> BlockConfig (ShelleyBlock era)
mkShelleyBlockConfig ProtVer
protVer ShelleyGenesis era
genesis [VKey 'BlockIssuer (EraCrypto era)]
blockIssuerVKeys = ShelleyConfig :: forall era.
ProtVer
-> SystemStart
-> NetworkMagic
-> Map
(KeyHash 'BlockIssuer (EraCrypto era))
(VKey 'BlockIssuer (EraCrypto era))
-> BlockConfig (ShelleyBlock era)
ShelleyConfig {
shelleyProtocolVersion :: ProtVer
shelleyProtocolVersion = ProtVer
protVer
, shelleySystemStart :: SystemStart
shelleySystemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> UTCTime
forall era. ShelleyGenesis era -> UTCTime
SL.sgSystemStart ShelleyGenesis era
genesis
, shelleyNetworkMagic :: NetworkMagic
shelleyNetworkMagic = Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> Word32
forall era. ShelleyGenesis era -> Word32
SL.sgNetworkMagic ShelleyGenesis era
genesis
, shelleyBlockIssuerVKeys :: Map
(KeyHash 'BlockIssuer (EraCrypto era))
(VKey 'BlockIssuer (EraCrypto era))
shelleyBlockIssuerVKeys = [(KeyHash 'BlockIssuer (EraCrypto era),
VKey 'BlockIssuer (EraCrypto era))]
-> Map
(KeyHash 'BlockIssuer (EraCrypto era))
(VKey 'BlockIssuer (EraCrypto era))
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[ (VKey 'BlockIssuer (EraCrypto era)
-> KeyHash 'BlockIssuer (EraCrypto era)
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
SL.hashKey VKey 'BlockIssuer (EraCrypto era)
k, VKey 'BlockIssuer (EraCrypto era)
k)
| VKey 'BlockIssuer (EraCrypto era)
k <- [VKey 'BlockIssuer (EraCrypto era)]
blockIssuerVKeys
]
}
data instance CodecConfig (ShelleyBlock era) = ShelleyCodecConfig
deriving ((forall x.
CodecConfig (ShelleyBlock era)
-> Rep (CodecConfig (ShelleyBlock era)) x)
-> (forall x.
Rep (CodecConfig (ShelleyBlock era)) x
-> CodecConfig (ShelleyBlock era))
-> Generic (CodecConfig (ShelleyBlock era))
forall x.
Rep (CodecConfig (ShelleyBlock era)) x
-> CodecConfig (ShelleyBlock era)
forall x.
CodecConfig (ShelleyBlock era)
-> Rep (CodecConfig (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (CodecConfig (ShelleyBlock era)) x
-> CodecConfig (ShelleyBlock era)
forall era x.
CodecConfig (ShelleyBlock era)
-> Rep (CodecConfig (ShelleyBlock era)) x
$cto :: forall era x.
Rep (CodecConfig (ShelleyBlock era)) x
-> CodecConfig (ShelleyBlock era)
$cfrom :: forall era x.
CodecConfig (ShelleyBlock era)
-> Rep (CodecConfig (ShelleyBlock era)) x
Generic, Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
Proxy (CodecConfig (ShelleyBlock era)) -> String
(Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Context
-> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Proxy (CodecConfig (ShelleyBlock era)) -> String)
-> NoThunks (CodecConfig (ShelleyBlock era))
forall era.
Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
forall era. Proxy (CodecConfig (ShelleyBlock era)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CodecConfig (ShelleyBlock era)) -> String
$cshowTypeOf :: forall era. Proxy (CodecConfig (ShelleyBlock era)) -> String
wNoThunks :: Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
noThunks :: Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> CodecConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
NoThunks)
data instance StorageConfig (ShelleyBlock era) = ShelleyStorageConfig {
StorageConfig (ShelleyBlock era) -> Word64
shelleyStorageConfigSlotsPerKESPeriod :: !Word64
, StorageConfig (ShelleyBlock era) -> SecurityParam
shelleyStorageConfigSecurityParam :: !SecurityParam
}
deriving ((forall x.
StorageConfig (ShelleyBlock era)
-> Rep (StorageConfig (ShelleyBlock era)) x)
-> (forall x.
Rep (StorageConfig (ShelleyBlock era)) x
-> StorageConfig (ShelleyBlock era))
-> Generic (StorageConfig (ShelleyBlock era))
forall x.
Rep (StorageConfig (ShelleyBlock era)) x
-> StorageConfig (ShelleyBlock era)
forall x.
StorageConfig (ShelleyBlock era)
-> Rep (StorageConfig (ShelleyBlock era)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (StorageConfig (ShelleyBlock era)) x
-> StorageConfig (ShelleyBlock era)
forall era x.
StorageConfig (ShelleyBlock era)
-> Rep (StorageConfig (ShelleyBlock era)) x
$cto :: forall era x.
Rep (StorageConfig (ShelleyBlock era)) x
-> StorageConfig (ShelleyBlock era)
$cfrom :: forall era x.
StorageConfig (ShelleyBlock era)
-> Rep (StorageConfig (ShelleyBlock era)) x
Generic, Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
Proxy (StorageConfig (ShelleyBlock era)) -> String
(Context
-> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Context
-> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo))
-> (Proxy (StorageConfig (ShelleyBlock era)) -> String)
-> NoThunks (StorageConfig (ShelleyBlock era))
forall era.
Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
forall era. Proxy (StorageConfig (ShelleyBlock era)) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (StorageConfig (ShelleyBlock era)) -> String
$cshowTypeOf :: forall era. Proxy (StorageConfig (ShelleyBlock era)) -> String
wNoThunks :: Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
noThunks :: Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
$cnoThunks :: forall era.
Context -> StorageConfig (ShelleyBlock era) -> IO (Maybe ThunkInfo)
NoThunks)
newtype CompactGenesis era = CompactGenesis {
CompactGenesis era -> ShelleyGenesis era
getCompactGenesis :: SL.ShelleyGenesis era
}
deriving stock (CompactGenesis era -> CompactGenesis era -> Bool
(CompactGenesis era -> CompactGenesis era -> Bool)
-> (CompactGenesis era -> CompactGenesis era -> Bool)
-> Eq (CompactGenesis era)
forall era. CompactGenesis era -> CompactGenesis era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompactGenesis era -> CompactGenesis era -> Bool
$c/= :: forall era. CompactGenesis era -> CompactGenesis era -> Bool
== :: CompactGenesis era -> CompactGenesis era -> Bool
$c== :: forall era. CompactGenesis era -> CompactGenesis era -> Bool
Eq, Int -> CompactGenesis era -> ShowS
[CompactGenesis era] -> ShowS
CompactGenesis era -> String
(Int -> CompactGenesis era -> ShowS)
-> (CompactGenesis era -> String)
-> ([CompactGenesis era] -> ShowS)
-> Show (CompactGenesis era)
forall era. Int -> CompactGenesis era -> ShowS
forall era. [CompactGenesis era] -> ShowS
forall era. CompactGenesis era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompactGenesis era] -> ShowS
$cshowList :: forall era. [CompactGenesis era] -> ShowS
show :: CompactGenesis era -> String
$cshow :: forall era. CompactGenesis era -> String
showsPrec :: Int -> CompactGenesis era -> ShowS
$cshowsPrec :: forall era. Int -> CompactGenesis era -> ShowS
Show, (forall x. CompactGenesis era -> Rep (CompactGenesis era) x)
-> (forall x. Rep (CompactGenesis era) x -> CompactGenesis era)
-> Generic (CompactGenesis era)
forall x. Rep (CompactGenesis era) x -> CompactGenesis era
forall x. CompactGenesis era -> Rep (CompactGenesis era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (CompactGenesis era) x -> CompactGenesis era
forall era x. CompactGenesis era -> Rep (CompactGenesis era) x
$cto :: forall era x. Rep (CompactGenesis era) x -> CompactGenesis era
$cfrom :: forall era x. CompactGenesis era -> Rep (CompactGenesis era) x
Generic)
deriving newtype (Typeable (CompactGenesis era)
Decoder s (CompactGenesis era)
Typeable (CompactGenesis era)
-> (forall s. Decoder s (CompactGenesis era))
-> (Proxy (CompactGenesis era) -> Text)
-> FromCBOR (CompactGenesis era)
Proxy (CompactGenesis era) -> Text
forall s. Decoder s (CompactGenesis era)
forall a.
Typeable a
-> (forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
forall era. Era era => Typeable (CompactGenesis era)
forall era. Era era => Proxy (CompactGenesis era) -> Text
forall era s. Era era => Decoder s (CompactGenesis era)
label :: Proxy (CompactGenesis era) -> Text
$clabel :: forall era. Era era => Proxy (CompactGenesis era) -> Text
fromCBOR :: Decoder s (CompactGenesis era)
$cfromCBOR :: forall era s. Era era => Decoder s (CompactGenesis era)
$cp1FromCBOR :: forall era. Era era => Typeable (CompactGenesis era)
FromCBOR, Typeable (CompactGenesis era)
Typeable (CompactGenesis era)
-> (CompactGenesis era -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactGenesis era) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactGenesis era] -> Size)
-> ToCBOR (CompactGenesis era)
CompactGenesis era -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactGenesis era] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactGenesis era) -> Size
forall a.
Typeable a
-> (a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
forall era. Era era => Typeable (CompactGenesis era)
forall era. Era era => CompactGenesis era -> Encoding
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactGenesis era] -> Size
forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactGenesis era) -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactGenesis era] -> Size
$cencodedListSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [CompactGenesis era] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactGenesis era) -> Size
$cencodedSizeExpr :: forall era.
Era era =>
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CompactGenesis era) -> Size
toCBOR :: CompactGenesis era -> Encoding
$ctoCBOR :: forall era. Era era => CompactGenesis era -> Encoding
$cp1ToCBOR :: forall era. Era era => Typeable (CompactGenesis era)
ToCBOR)
deriving anyclass instance ShelleyBasedEra era => NoThunks (CompactGenesis era)
compactGenesis :: SL.ShelleyGenesis era -> CompactGenesis era
compactGenesis :: ShelleyGenesis era -> CompactGenesis era
compactGenesis ShelleyGenesis era
genesis = ShelleyGenesis era -> CompactGenesis era
forall era. ShelleyGenesis era -> CompactGenesis era
CompactGenesis (ShelleyGenesis era -> CompactGenesis era)
-> ShelleyGenesis era -> CompactGenesis era
forall a b. (a -> b) -> a -> b
$
ShelleyGenesis era
genesis {
sgInitialFunds :: Map (Addr era) Coin
SL.sgInitialFunds = Map (Addr era) Coin
forall a. Monoid a => a
mempty
, sgStaking :: ShelleyGenesisStaking era
SL.sgStaking = ShelleyGenesisStaking era
forall era. ShelleyGenesisStaking era
SL.emptyGenesisStaking
}