{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Consensus.Shelley.Protocol (
TPraos
, TPraosState (..)
, TPraosChainSelectView (..)
, SelfIssued (..)
, TPraosFields (..)
, forgeTPraosFields
, TPraosToSign (..)
, TPraosValidateView
, TPraosParams (..)
, mkTPraosParams
, TPraosCanBeLeader (..)
, TPraosIsLeader (..)
, mkShelleyGlobals
, MaxMajorProtVer (..)
, PraosCrypto
, StandardCrypto
, TPraosCannotForge (..)
, tpraosCheckCanForge
, ConsensusConfig (..)
, Ticked (..)
) where
import qualified Codec.CBOR.Encoding as CBOR
import Codec.Serialise (Serialise (..))
import Control.Monad.Except (throwError)
import Data.Coerce (coerce)
import Data.Function (on)
import Data.Functor.Identity (Identity)
import qualified Data.Map.Strict as Map
import Data.Ord (Down (..))
import Data.Word (Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)
import Cardano.Binary (enforceSize, fromCBOR, toCBOR)
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Slotting.EpochInfo
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Protocol.Abstract
import Ouroboros.Consensus.Ticked
import Ouroboros.Consensus.Util.Condense
import Ouroboros.Consensus.Util.Versioned
import Cardano.Ledger.Crypto (VRF)
import qualified Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.BaseTypes as SL (ActiveSlotCoeff, Seed)
import qualified Shelley.Spec.Ledger.BlockChain as SL (checkLeaderValue, mkSeed,
seedEta, seedL)
import qualified Shelley.Spec.Ledger.OCert as Absolute (KESPeriod (..))
import Ouroboros.Consensus.Shelley.Protocol.Crypto
import Ouroboros.Consensus.Shelley.Protocol.HotKey (HotKey)
import qualified Ouroboros.Consensus.Shelley.Protocol.HotKey as HotKey
import Ouroboros.Consensus.Shelley.Protocol.Util
data TPraosFields c toSign = TPraosFields {
TPraosFields c toSign -> SignedKES c toSign
tpraosSignature :: SL.SignedKES c toSign
, TPraosFields c toSign -> toSign
tpraosToSign :: toSign
}
deriving ((forall x. TPraosFields c toSign -> Rep (TPraosFields c toSign) x)
-> (forall x.
Rep (TPraosFields c toSign) x -> TPraosFields c toSign)
-> Generic (TPraosFields c toSign)
forall x. Rep (TPraosFields c toSign) x -> TPraosFields c toSign
forall x. TPraosFields c toSign -> Rep (TPraosFields c toSign) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c toSign x.
Rep (TPraosFields c toSign) x -> TPraosFields c toSign
forall c toSign x.
TPraosFields c toSign -> Rep (TPraosFields c toSign) x
$cto :: forall c toSign x.
Rep (TPraosFields c toSign) x -> TPraosFields c toSign
$cfrom :: forall c toSign x.
TPraosFields c toSign -> Rep (TPraosFields c toSign) x
Generic)
deriving instance (NoThunks toSign, PraosCrypto c)
=> NoThunks (TPraosFields c toSign)
deriving instance (Show toSign, PraosCrypto c)
=> Show (TPraosFields c toSign)
data TPraosToSign c = TPraosToSign {
TPraosToSign c -> VKey 'BlockIssuer c
tpraosToSignIssuerVK :: SL.VKey 'SL.BlockIssuer c
, TPraosToSign c -> VerKeyVRF c
tpraosToSignVrfVK :: SL.VerKeyVRF c
, TPraosToSign c -> CertifiedVRF c Nonce
tpraosToSignEta :: SL.CertifiedVRF c SL.Nonce
, TPraosToSign c -> CertifiedVRF c Natural
tpraosToSignLeader :: SL.CertifiedVRF c Natural
, TPraosToSign c -> OCert c
tpraosToSignOCert :: SL.OCert c
}
deriving ((forall x. TPraosToSign c -> Rep (TPraosToSign c) x)
-> (forall x. Rep (TPraosToSign c) x -> TPraosToSign c)
-> Generic (TPraosToSign c)
forall x. Rep (TPraosToSign c) x -> TPraosToSign c
forall x. TPraosToSign c -> Rep (TPraosToSign c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TPraosToSign c) x -> TPraosToSign c
forall c x. TPraosToSign c -> Rep (TPraosToSign c) x
$cto :: forall c x. Rep (TPraosToSign c) x -> TPraosToSign c
$cfrom :: forall c x. TPraosToSign c -> Rep (TPraosToSign c) x
Generic)
instance PraosCrypto c => NoThunks (TPraosToSign c)
deriving instance PraosCrypto c => Show (TPraosToSign c)
forgeTPraosFields ::
( PraosCrypto c
, SL.KESignable c toSign
, Monad m
)
=> HotKey c m
-> CanBeLeader (TPraos c)
-> IsLeader (TPraos c)
-> (TPraosToSign c -> toSign)
-> m (TPraosFields c toSign)
forgeTPraosFields :: HotKey c m
-> CanBeLeader (TPraos c)
-> IsLeader (TPraos c)
-> (TPraosToSign c -> toSign)
-> m (TPraosFields c toSign)
forgeTPraosFields HotKey c m
hotKey TPraosCanBeLeader{..} TPraosIsLeader{..} TPraosToSign c -> toSign
mkToSign = do
SignedKES (KES c) toSign
signature <- HotKey c m -> toSign -> m (SignedKES (KES c) toSign)
forall c toSign (m :: * -> *).
(KESignable c toSign, HasCallStack) =>
HotKey c m -> toSign -> m (SignedKES c toSign)
HotKey.sign HotKey c m
hotKey toSign
toSign
TPraosFields c toSign -> m (TPraosFields c toSign)
forall (m :: * -> *) a. Monad m => a -> m a
return TPraosFields :: forall c toSign.
SignedKES c toSign -> toSign -> TPraosFields c toSign
TPraosFields {
tpraosSignature :: SignedKES (KES c) toSign
tpraosSignature = SignedKES (KES c) toSign
signature
, tpraosToSign :: toSign
tpraosToSign = toSign
toSign
}
where
toSign :: toSign
toSign = TPraosToSign c -> toSign
mkToSign TPraosToSign c
signedFields
signedFields :: TPraosToSign c
signedFields = TPraosToSign :: forall c.
VKey 'BlockIssuer c
-> VerKeyVRF c
-> CertifiedVRF c Nonce
-> CertifiedVRF c Natural
-> OCert c
-> TPraosToSign c
TPraosToSign {
tpraosToSignIssuerVK :: VKey 'BlockIssuer c
tpraosToSignIssuerVK = VKey 'BlockIssuer c
tpraosCanBeLeaderColdVerKey
, tpraosToSignVrfVK :: VerKeyVRF c
tpraosToSignVrfVK = SignKeyVRF (VRF c) -> VerKeyVRF c
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF SignKeyVRF (VRF c)
tpraosCanBeLeaderSignKeyVRF
, tpraosToSignEta :: CertifiedVRF c Nonce
tpraosToSignEta = CertifiedVRF c Nonce
tpraosIsLeaderEta
, tpraosToSignLeader :: CertifiedVRF c Natural
tpraosToSignLeader = CertifiedVRF c Natural
tpraosIsLeaderProof
, tpraosToSignOCert :: OCert c
tpraosToSignOCert = OCert c
tpraosCanBeLeaderOpCert
}
type TPraosValidateView c = SL.BHeader c
newtype MaxMajorProtVer = MaxMajorProtVer {
MaxMajorProtVer -> Natural
getMaxMajorProtVer :: Natural
}
deriving (MaxMajorProtVer -> MaxMajorProtVer -> Bool
(MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> (MaxMajorProtVer -> MaxMajorProtVer -> Bool)
-> Eq MaxMajorProtVer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
$c/= :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
$c== :: MaxMajorProtVer -> MaxMajorProtVer -> Bool
Eq, Int -> MaxMajorProtVer -> ShowS
[MaxMajorProtVer] -> ShowS
MaxMajorProtVer -> String
(Int -> MaxMajorProtVer -> ShowS)
-> (MaxMajorProtVer -> String)
-> ([MaxMajorProtVer] -> ShowS)
-> Show MaxMajorProtVer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxMajorProtVer] -> ShowS
$cshowList :: [MaxMajorProtVer] -> ShowS
show :: MaxMajorProtVer -> String
$cshow :: MaxMajorProtVer -> String
showsPrec :: Int -> MaxMajorProtVer -> ShowS
$cshowsPrec :: Int -> MaxMajorProtVer -> ShowS
Show, (forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x)
-> (forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer)
-> Generic MaxMajorProtVer
forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxMajorProtVer x -> MaxMajorProtVer
$cfrom :: forall x. MaxMajorProtVer -> Rep MaxMajorProtVer x
Generic, Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
Proxy MaxMajorProtVer -> String
(Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo))
-> (Proxy MaxMajorProtVer -> String)
-> NoThunks MaxMajorProtVer
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy MaxMajorProtVer -> String
$cshowTypeOf :: Proxy MaxMajorProtVer -> String
wNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
noThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> MaxMajorProtVer -> IO (Maybe ThunkInfo)
NoThunks)
data TPraos c
data TPraosParams = TPraosParams {
TPraosParams -> Word64
tpraosSlotsPerKESPeriod :: !Word64
, TPraosParams -> ActiveSlotCoeff
tpraosLeaderF :: !SL.ActiveSlotCoeff
, TPraosParams -> SecurityParam
tpraosSecurityParam :: !SecurityParam
, TPraosParams -> Word64
tpraosMaxKESEvo :: !Word64
, TPraosParams -> Word64
tpraosQuorum :: !Word64
, TPraosParams -> MaxMajorProtVer
tpraosMaxMajorPV :: !MaxMajorProtVer
, TPraosParams -> Word64
tpraosMaxLovelaceSupply :: !Word64
, TPraosParams -> Network
tpraosNetworkId :: !SL.Network
, TPraosParams -> Nonce
tpraosInitialNonce :: !SL.Nonce
}
deriving ((forall x. TPraosParams -> Rep TPraosParams x)
-> (forall x. Rep TPraosParams x -> TPraosParams)
-> Generic TPraosParams
forall x. Rep TPraosParams x -> TPraosParams
forall x. TPraosParams -> Rep TPraosParams x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TPraosParams x -> TPraosParams
$cfrom :: forall x. TPraosParams -> Rep TPraosParams x
Generic, Context -> TPraosParams -> IO (Maybe ThunkInfo)
Proxy TPraosParams -> String
(Context -> TPraosParams -> IO (Maybe ThunkInfo))
-> (Context -> TPraosParams -> IO (Maybe ThunkInfo))
-> (Proxy TPraosParams -> String)
-> NoThunks TPraosParams
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TPraosParams -> String
$cshowTypeOf :: Proxy TPraosParams -> String
wNoThunks :: Context -> TPraosParams -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TPraosParams -> IO (Maybe ThunkInfo)
noThunks :: Context -> TPraosParams -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TPraosParams -> IO (Maybe ThunkInfo)
NoThunks)
mkTPraosParams
:: MaxMajorProtVer
-> SL.Nonce
-> SL.ShelleyGenesis era
-> TPraosParams
mkTPraosParams :: MaxMajorProtVer -> Nonce -> ShelleyGenesis era -> TPraosParams
mkTPraosParams MaxMajorProtVer
maxMajorPV Nonce
initialNonce ShelleyGenesis era
genesis = TPraosParams :: Word64
-> ActiveSlotCoeff
-> SecurityParam
-> Word64
-> Word64
-> MaxMajorProtVer
-> Word64
-> Network
-> Nonce
-> TPraosParams
TPraosParams {
tpraosSlotsPerKESPeriod :: Word64
tpraosSlotsPerKESPeriod = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSlotsPerKESPeriod ShelleyGenesis era
genesis
, tpraosLeaderF :: ActiveSlotCoeff
tpraosLeaderF = ShelleyGenesis era -> ActiveSlotCoeff
forall era. ShelleyGenesis era -> ActiveSlotCoeff
SL.sgActiveSlotCoeff ShelleyGenesis era
genesis
, tpraosMaxKESEvo :: Word64
tpraosMaxKESEvo = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgMaxKESEvolutions ShelleyGenesis era
genesis
, tpraosQuorum :: Word64
tpraosQuorum = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgUpdateQuorum ShelleyGenesis era
genesis
, tpraosMaxLovelaceSupply :: Word64
tpraosMaxLovelaceSupply = ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgMaxLovelaceSupply ShelleyGenesis era
genesis
, tpraosNetworkId :: Network
tpraosNetworkId = ShelleyGenesis era -> Network
forall era. ShelleyGenesis era -> Network
SL.sgNetworkId ShelleyGenesis era
genesis
, tpraosSecurityParam :: SecurityParam
tpraosSecurityParam = SecurityParam
securityParam
, tpraosMaxMajorPV :: MaxMajorProtVer
tpraosMaxMajorPV = MaxMajorProtVer
maxMajorPV
, tpraosInitialNonce :: Nonce
tpraosInitialNonce = Nonce
initialNonce
}
where
securityParam :: SecurityParam
securityParam = Word64 -> SecurityParam
SecurityParam (Word64 -> SecurityParam) -> Word64 -> SecurityParam
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis era -> Word64
forall era. ShelleyGenesis era -> Word64
SL.sgSecurityParam ShelleyGenesis era
genesis
data TPraosCanBeLeader c = TPraosCanBeLeader {
TPraosCanBeLeader c -> OCert c
tpraosCanBeLeaderOpCert :: !(SL.OCert c)
, TPraosCanBeLeader c -> VKey 'BlockIssuer c
tpraosCanBeLeaderColdVerKey :: !(SL.VKey 'SL.BlockIssuer c)
, TPraosCanBeLeader c -> SignKeyVRF c
tpraosCanBeLeaderSignKeyVRF :: !(SL.SignKeyVRF c)
}
deriving ((forall x. TPraosCanBeLeader c -> Rep (TPraosCanBeLeader c) x)
-> (forall x. Rep (TPraosCanBeLeader c) x -> TPraosCanBeLeader c)
-> Generic (TPraosCanBeLeader c)
forall x. Rep (TPraosCanBeLeader c) x -> TPraosCanBeLeader c
forall x. TPraosCanBeLeader c -> Rep (TPraosCanBeLeader c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TPraosCanBeLeader c) x -> TPraosCanBeLeader c
forall c x. TPraosCanBeLeader c -> Rep (TPraosCanBeLeader c) x
$cto :: forall c x. Rep (TPraosCanBeLeader c) x -> TPraosCanBeLeader c
$cfrom :: forall c x. TPraosCanBeLeader c -> Rep (TPraosCanBeLeader c) x
Generic)
instance PraosCrypto c => NoThunks (TPraosCanBeLeader c)
data TPraosIsLeader c = TPraosIsLeader {
TPraosIsLeader c -> CertifiedVRF c Nonce
tpraosIsLeaderEta :: SL.CertifiedVRF c SL.Nonce
, TPraosIsLeader c -> CertifiedVRF c Natural
tpraosIsLeaderProof :: SL.CertifiedVRF c Natural
, TPraosIsLeader c -> Maybe (Hash c (VerKeyVRF c))
tpraosIsLeaderGenVRFHash :: Maybe (SL.Hash c (SL.VerKeyVRF c))
}
deriving ((forall x. TPraosIsLeader c -> Rep (TPraosIsLeader c) x)
-> (forall x. Rep (TPraosIsLeader c) x -> TPraosIsLeader c)
-> Generic (TPraosIsLeader c)
forall x. Rep (TPraosIsLeader c) x -> TPraosIsLeader c
forall x. TPraosIsLeader c -> Rep (TPraosIsLeader c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TPraosIsLeader c) x -> TPraosIsLeader c
forall c x. TPraosIsLeader c -> Rep (TPraosIsLeader c) x
$cto :: forall c x. Rep (TPraosIsLeader c) x -> TPraosIsLeader c
$cfrom :: forall c x. TPraosIsLeader c -> Rep (TPraosIsLeader c) x
Generic)
instance PraosCrypto c => NoThunks (TPraosIsLeader c)
data instance ConsensusConfig (TPraos c) = TPraosConfig {
ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams :: !TPraosParams
, ConsensusConfig (TPraos c) -> EpochInfo Identity
tpraosEpochInfo :: !(EpochInfo Identity)
}
deriving ((forall x.
ConsensusConfig (TPraos c) -> Rep (ConsensusConfig (TPraos c)) x)
-> (forall x.
Rep (ConsensusConfig (TPraos c)) x -> ConsensusConfig (TPraos c))
-> Generic (ConsensusConfig (TPraos c))
forall x.
Rep (ConsensusConfig (TPraos c)) x -> ConsensusConfig (TPraos c)
forall x.
ConsensusConfig (TPraos c) -> Rep (ConsensusConfig (TPraos c)) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x.
Rep (ConsensusConfig (TPraos c)) x -> ConsensusConfig (TPraos c)
forall c x.
ConsensusConfig (TPraos c) -> Rep (ConsensusConfig (TPraos c)) x
$cto :: forall c x.
Rep (ConsensusConfig (TPraos c)) x -> ConsensusConfig (TPraos c)
$cfrom :: forall c x.
ConsensusConfig (TPraos c) -> Rep (ConsensusConfig (TPraos c)) x
Generic)
instance PraosCrypto c => NoThunks (ConsensusConfig (TPraos c))
data SelfIssued =
SelfIssued
| NotSelfIssued
deriving (Int -> SelfIssued -> ShowS
[SelfIssued] -> ShowS
SelfIssued -> String
(Int -> SelfIssued -> ShowS)
-> (SelfIssued -> String)
-> ([SelfIssued] -> ShowS)
-> Show SelfIssued
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfIssued] -> ShowS
$cshowList :: [SelfIssued] -> ShowS
show :: SelfIssued -> String
$cshow :: SelfIssued -> String
showsPrec :: Int -> SelfIssued -> ShowS
$cshowsPrec :: Int -> SelfIssued -> ShowS
Show, SelfIssued -> SelfIssued -> Bool
(SelfIssued -> SelfIssued -> Bool)
-> (SelfIssued -> SelfIssued -> Bool) -> Eq SelfIssued
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfIssued -> SelfIssued -> Bool
$c/= :: SelfIssued -> SelfIssued -> Bool
== :: SelfIssued -> SelfIssued -> Bool
$c== :: SelfIssued -> SelfIssued -> Bool
Eq)
instance Ord SelfIssued where
compare :: SelfIssued -> SelfIssued -> Ordering
compare SelfIssued
SelfIssued SelfIssued
SelfIssued = Ordering
EQ
compare SelfIssued
NotSelfIssued SelfIssued
NotSelfIssued = Ordering
EQ
compare SelfIssued
SelfIssued SelfIssued
NotSelfIssued = Ordering
GT
compare SelfIssued
NotSelfIssued SelfIssued
SelfIssued = Ordering
LT
data TPraosChainSelectView c = TPraosChainSelectView {
TPraosChainSelectView c -> BlockNo
csvChainLength :: BlockNo
, TPraosChainSelectView c -> SlotNo
csvSlotNo :: SlotNo
, TPraosChainSelectView c -> SelfIssued
csvSelfIssued :: SelfIssued
, TPraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer :: SL.VKey 'SL.BlockIssuer c
, TPraosChainSelectView c -> Word64
csvIssueNo :: Word64
, TPraosChainSelectView c -> OutputVRF (VRF c)
csvLeaderVRF :: VRF.OutputVRF (VRF c)
} deriving (Int -> TPraosChainSelectView c -> ShowS
[TPraosChainSelectView c] -> ShowS
TPraosChainSelectView c -> String
(Int -> TPraosChainSelectView c -> ShowS)
-> (TPraosChainSelectView c -> String)
-> ([TPraosChainSelectView c] -> ShowS)
-> Show (TPraosChainSelectView c)
forall c. Crypto c => Int -> TPraosChainSelectView c -> ShowS
forall c. Crypto c => [TPraosChainSelectView c] -> ShowS
forall c. Crypto c => TPraosChainSelectView c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TPraosChainSelectView c] -> ShowS
$cshowList :: forall c. Crypto c => [TPraosChainSelectView c] -> ShowS
show :: TPraosChainSelectView c -> String
$cshow :: forall c. Crypto c => TPraosChainSelectView c -> String
showsPrec :: Int -> TPraosChainSelectView c -> ShowS
$cshowsPrec :: forall c. Crypto c => Int -> TPraosChainSelectView c -> ShowS
Show, TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
(TPraosChainSelectView c -> TPraosChainSelectView c -> Bool)
-> (TPraosChainSelectView c -> TPraosChainSelectView c -> Bool)
-> Eq (TPraosChainSelectView c)
forall c.
Crypto c =>
TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
$c/= :: forall c.
Crypto c =>
TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
== :: TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
$c== :: forall c.
Crypto c =>
TPraosChainSelectView c -> TPraosChainSelectView c -> Bool
Eq)
instance PraosCrypto c => Ord (TPraosChainSelectView c) where
compare :: TPraosChainSelectView c -> TPraosChainSelectView c -> Ordering
compare =
[TPraosChainSelectView c -> TPraosChainSelectView c -> Ordering]
-> TPraosChainSelectView c -> TPraosChainSelectView c -> Ordering
forall a. Monoid a => [a] -> a
mconcat [
BlockNo -> BlockNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (BlockNo -> BlockNo -> Ordering)
-> (TPraosChainSelectView c -> BlockNo)
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TPraosChainSelectView c -> BlockNo
forall c. TPraosChainSelectView c -> BlockNo
csvChainLength
, (TPraosChainSelectView c -> SlotNo)
-> (TPraosChainSelectView c -> TPraosChainSelectView c -> Ordering)
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall a view.
Eq a =>
(view -> a)
-> (view -> view -> Ordering) -> view -> view -> Ordering
whenSame TPraosChainSelectView c -> SlotNo
forall c. TPraosChainSelectView c -> SlotNo
csvSlotNo (SelfIssued -> SelfIssued -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SelfIssued -> SelfIssued -> Ordering)
-> (TPraosChainSelectView c -> SelfIssued)
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TPraosChainSelectView c -> SelfIssued
forall c. TPraosChainSelectView c -> SelfIssued
csvSelfIssued)
, (TPraosChainSelectView c -> VKey 'BlockIssuer c)
-> (TPraosChainSelectView c -> TPraosChainSelectView c -> Ordering)
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall a view.
Eq a =>
(view -> a)
-> (view -> view -> Ordering) -> view -> view -> Ordering
whenSame TPraosChainSelectView c -> VKey 'BlockIssuer c
forall c. TPraosChainSelectView c -> VKey 'BlockIssuer c
csvIssuer (Word64 -> Word64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Word64 -> Word64 -> Ordering)
-> (TPraosChainSelectView c -> Word64)
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TPraosChainSelectView c -> Word64
forall c. TPraosChainSelectView c -> Word64
csvIssueNo)
, Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Down (OutputVRF (VRF c)) -> Down (OutputVRF (VRF c)) -> Ordering)
-> (TPraosChainSelectView c -> Down (OutputVRF (VRF c)))
-> TPraosChainSelectView c
-> TPraosChainSelectView c
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` OutputVRF (VRF c) -> Down (OutputVRF (VRF c))
forall a. a -> Down a
Down (OutputVRF (VRF c) -> Down (OutputVRF (VRF c)))
-> (TPraosChainSelectView c -> OutputVRF (VRF c))
-> TPraosChainSelectView c
-> Down (OutputVRF (VRF c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPraosChainSelectView c -> OutputVRF (VRF c)
forall c. TPraosChainSelectView c -> OutputVRF (VRF c)
csvLeaderVRF
]
where
whenSame ::
Eq a
=> (view -> a)
-> (view -> view -> Ordering)
-> (view -> view -> Ordering)
whenSame :: (view -> a)
-> (view -> view -> Ordering) -> view -> view -> Ordering
whenSame view -> a
f view -> view -> Ordering
comp view
v1 view
v2
| view -> a
f view
v1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== view -> a
f view
v2
= view -> view -> Ordering
comp view
v1 view
v2
| Bool
otherwise
= Ordering
EQ
instance PraosCrypto c => ChainSelection (TPraos c) where
type SelectView (TPraos c) = TPraosChainSelectView c
newtype instance Ticked (SL.LedgerView c) = TickedPraosLedgerView {
Ticked (LedgerView c) -> LedgerView c
getTickedPraosLedgerView :: SL.LedgerView c
}
data TPraosState c = TPraosState {
TPraosState c -> WithOrigin SlotNo
tpraosStateLastSlot :: !(WithOrigin SlotNo)
, TPraosState c -> ChainDepState c
tpraosStateChainDepState :: !(SL.ChainDepState c)
}
deriving ((forall x. TPraosState c -> Rep (TPraosState c) x)
-> (forall x. Rep (TPraosState c) x -> TPraosState c)
-> Generic (TPraosState c)
forall x. Rep (TPraosState c) x -> TPraosState c
forall x. TPraosState c -> Rep (TPraosState c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TPraosState c) x -> TPraosState c
forall c x. TPraosState c -> Rep (TPraosState c) x
$cto :: forall c x. Rep (TPraosState c) x -> TPraosState c
$cfrom :: forall c x. TPraosState c -> Rep (TPraosState c) x
Generic, Int -> TPraosState c -> ShowS
[TPraosState c] -> ShowS
TPraosState c -> String
(Int -> TPraosState c -> ShowS)
-> (TPraosState c -> String)
-> ([TPraosState c] -> ShowS)
-> Show (TPraosState c)
forall c. Int -> TPraosState c -> ShowS
forall c. [TPraosState c] -> ShowS
forall c. TPraosState c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TPraosState c] -> ShowS
$cshowList :: forall c. [TPraosState c] -> ShowS
show :: TPraosState c -> String
$cshow :: forall c. TPraosState c -> String
showsPrec :: Int -> TPraosState c -> ShowS
$cshowsPrec :: forall c. Int -> TPraosState c -> ShowS
Show, TPraosState c -> TPraosState c -> Bool
(TPraosState c -> TPraosState c -> Bool)
-> (TPraosState c -> TPraosState c -> Bool) -> Eq (TPraosState c)
forall c. TPraosState c -> TPraosState c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TPraosState c -> TPraosState c -> Bool
$c/= :: forall c. TPraosState c -> TPraosState c -> Bool
== :: TPraosState c -> TPraosState c -> Bool
$c== :: forall c. TPraosState c -> TPraosState c -> Bool
Eq)
instance PraosCrypto c => NoThunks (TPraosState c)
serialisationFormatVersion1 :: VersionNumber
serialisationFormatVersion1 :: VersionNumber
serialisationFormatVersion1 = VersionNumber
1
instance PraosCrypto c => Serialise (TPraosState c) where
encode :: TPraosState c -> Encoding
encode (TPraosState WithOrigin SlotNo
slot ChainDepState c
chainDepState) =
VersionNumber -> Encoding -> Encoding
encodeVersion VersionNumber
serialisationFormatVersion1 (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$ [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat [
Word -> Encoding
CBOR.encodeListLen Word
2
, WithOrigin SlotNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR WithOrigin SlotNo
slot
, ChainDepState c -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ChainDepState c
chainDepState
]
decode :: Decoder s (TPraosState c)
decode = [(VersionNumber, VersionDecoder (TPraosState c))]
-> forall s. Decoder s (TPraosState c)
forall a.
[(VersionNumber, VersionDecoder a)] -> forall s. Decoder s a
decodeVersion
[(VersionNumber
serialisationFormatVersion1, (forall s. Decoder s (TPraosState c))
-> VersionDecoder (TPraosState c)
forall a. (forall s. Decoder s a) -> VersionDecoder a
Decode forall s. Decoder s (TPraosState c)
decodeTPraosState1)]
where
decodeTPraosState1 :: Decoder s (TPraosState c)
decodeTPraosState1 = do
Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TPraosState" Int
2
WithOrigin SlotNo -> ChainDepState c -> TPraosState c
forall c. WithOrigin SlotNo -> ChainDepState c -> TPraosState c
TPraosState (WithOrigin SlotNo -> ChainDepState c -> TPraosState c)
-> Decoder s (WithOrigin SlotNo)
-> Decoder s (ChainDepState c -> TPraosState c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (WithOrigin SlotNo)
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (ChainDepState c -> TPraosState c)
-> Decoder s (ChainDepState c) -> Decoder s (TPraosState c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (ChainDepState c)
forall a s. FromCBOR a => Decoder s a
fromCBOR
data instance Ticked (TPraosState c) = TickedChainDepState {
Ticked (TPraosState c) -> ChainDepState c
tickedTPraosStateChainDepState :: SL.ChainDepState c
, Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
tickedTPraosStateLedgerView :: Ticked (LedgerView (TPraos c))
}
instance PraosCrypto c => ConsensusProtocol (TPraos c) where
type ChainDepState (TPraos c) = TPraosState c
type IsLeader (TPraos c) = TPraosIsLeader c
type CanBeLeader (TPraos c) = TPraosCanBeLeader c
type LedgerView (TPraos c) = SL.LedgerView c
type ValidationErr (TPraos c) = SL.ChainTransitionError c
type ValidateView (TPraos c) = TPraosValidateView c
protocolSecurityParam :: ConsensusConfig (TPraos c) -> SecurityParam
protocolSecurityParam = TPraosParams -> SecurityParam
tpraosSecurityParam (TPraosParams -> SecurityParam)
-> (ConsensusConfig (TPraos c) -> TPraosParams)
-> ConsensusConfig (TPraos c)
-> SecurityParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConsensusConfig (TPraos c) -> TPraosParams
forall c. ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams
checkIsLeader :: ConsensusConfig (TPraos c)
-> CanBeLeader (TPraos c)
-> SlotNo
-> Ticked (ChainDepState (TPraos c))
-> Maybe (IsLeader (TPraos c))
checkIsLeader ConsensusConfig (TPraos c)
cfg TPraosCanBeLeader{..} SlotNo
slot Ticked (ChainDepState (TPraos c))
cs = do
case SlotNo
-> Set (KeyHash 'Genesis c)
-> UnitInterval
-> ActiveSlotCoeff
-> SlotNo
-> Maybe (OBftSlot c)
forall crypto.
SlotNo
-> Set (KeyHash 'Genesis crypto)
-> UnitInterval
-> ActiveSlotCoeff
-> SlotNo
-> Maybe (OBftSlot crypto)
SL.lookupInOverlaySchedule SlotNo
firstSlot Set (KeyHash 'Genesis c)
gkeys UnitInterval
d ActiveSlotCoeff
asc SlotNo
slot of
Maybe (OBftSlot c)
Nothing
| ConsensusConfig (TPraos c)
-> LedgerView (TPraos c)
-> KeyHash 'StakePool c
-> CertifiedVRF c Seed
-> Bool
forall c.
PraosCrypto c =>
ConsensusConfig (TPraos c)
-> LedgerView (TPraos c)
-> KeyHash 'StakePool c
-> CertifiedVRF c Seed
-> Bool
meetsLeaderThreshold ConsensusConfig (TPraos c)
cfg LedgerView (TPraos c)
LedgerView c
lv (KeyHash 'BlockIssuer c -> KeyHash 'StakePool c
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
(r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
SL.coerceKeyRole KeyHash 'BlockIssuer c
vkhCold) CertifiedVRF c Seed
y
-> TPraosIsLeader c -> Maybe (TPraosIsLeader c)
forall a. a -> Maybe a
Just TPraosIsLeader :: forall c.
CertifiedVRF c Nonce
-> CertifiedVRF c Natural
-> Maybe (Hash c (VerKeyVRF c))
-> TPraosIsLeader c
TPraosIsLeader {
tpraosIsLeaderEta :: CertifiedVRF c Nonce
tpraosIsLeaderEta = CertifiedVRF c Seed -> CertifiedVRF c Nonce
coerce CertifiedVRF c Seed
rho
, tpraosIsLeaderProof :: CertifiedVRF c Natural
tpraosIsLeaderProof = CertifiedVRF c Seed -> CertifiedVRF c Natural
coerce CertifiedVRF c Seed
y
, tpraosIsLeaderGenVRFHash :: Maybe (Hash c (VerKeyVRF c))
tpraosIsLeaderGenVRFHash = Maybe (Hash c (VerKeyVRF c))
forall a. Maybe a
Nothing
}
| Bool
otherwise
-> Maybe (IsLeader (TPraos c))
forall a. Maybe a
Nothing
Just OBftSlot c
SL.NonActiveSlot -> Maybe (IsLeader (TPraos c))
forall a. Maybe a
Nothing
Just (SL.ActiveSlot KeyHash 'Genesis c
gkhash) -> case KeyHash 'Genesis c
-> Map (KeyHash 'Genesis c) (GenDelegPair c)
-> Maybe (GenDelegPair c)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'Genesis c
gkhash Map (KeyHash 'Genesis c) (GenDelegPair c)
dlgMap of
Maybe (GenDelegPair c)
Nothing
-> String -> Maybe (TPraosIsLeader c)
forall a. HasCallStack => String -> a
error String
"unknown genesis key in overlay schedule"
Just (SL.GenDelegPair KeyHash 'GenesisDelegate c
dlgHash Hash c (VerKeyVRF c)
genDlgVRFHash)
| KeyHash 'GenesisDelegate c -> KeyHash 'BlockIssuer c
forall (a :: KeyRole -> * -> *) (r :: KeyRole) crypto
(r' :: KeyRole).
HasKeyRole a =>
a r crypto -> a r' crypto
SL.coerceKeyRole KeyHash 'GenesisDelegate c
dlgHash KeyHash 'BlockIssuer c -> KeyHash 'BlockIssuer c -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash 'BlockIssuer c
vkhCold
-> TPraosIsLeader c -> Maybe (TPraosIsLeader c)
forall a. a -> Maybe a
Just TPraosIsLeader :: forall c.
CertifiedVRF c Nonce
-> CertifiedVRF c Natural
-> Maybe (Hash c (VerKeyVRF c))
-> TPraosIsLeader c
TPraosIsLeader {
tpraosIsLeaderEta :: CertifiedVRF c Nonce
tpraosIsLeaderEta = CertifiedVRF c Seed -> CertifiedVRF c Nonce
coerce CertifiedVRF c Seed
rho
, tpraosIsLeaderProof :: CertifiedVRF c Natural
tpraosIsLeaderProof = CertifiedVRF c Seed -> CertifiedVRF c Natural
coerce CertifiedVRF c Seed
y
, tpraosIsLeaderGenVRFHash :: Maybe (Hash c (VerKeyVRF c))
tpraosIsLeaderGenVRFHash = Hash c (VerKeyVRF c) -> Maybe (Hash c (VerKeyVRF c))
forall a. a -> Maybe a
Just Hash c (VerKeyVRF c)
genDlgVRFHash
}
| Bool
otherwise
-> Maybe (IsLeader (TPraos c))
forall a. Maybe a
Nothing
where
chainState :: ChainDepState c
chainState = Ticked (TPraosState c) -> ChainDepState c
forall c. Ticked (TPraosState c) -> ChainDepState c
tickedTPraosStateChainDepState Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs
lv :: LedgerView c
lv = Ticked (LedgerView c) -> LedgerView c
forall c. Ticked (LedgerView c) -> LedgerView c
getTickedPraosLedgerView (Ticked (LedgerView c) -> LedgerView c)
-> Ticked (LedgerView c) -> LedgerView c
forall a b. (a -> b) -> a -> b
$ Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
forall c. Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
tickedTPraosStateLedgerView Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs
d :: UnitInterval
d = LedgerView c -> UnitInterval
forall crypto. LedgerView crypto -> UnitInterval
SL.lvD LedgerView c
lv
asc :: ActiveSlotCoeff
asc = TPraosParams -> ActiveSlotCoeff
tpraosLeaderF (TPraosParams -> ActiveSlotCoeff)
-> TPraosParams -> ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ ConsensusConfig (TPraos c) -> TPraosParams
forall c. ConsensusConfig (TPraos c) -> TPraosParams
tpraosParams ConsensusConfig (TPraos c)
cfg
firstSlot :: SlotNo
firstSlot = EpochInfo Identity -> SlotNo -> SlotNo
firstSlotOfEpochOfSlot (ConsensusConfig (TPraos c) -> EpochInfo Identity
forall c. ConsensusConfig (TPraos c) -> EpochInfo Identity
tpraosEpochInfo ConsensusConfig (TPraos c)
cfg) SlotNo
slot
gkeys :: Set (KeyHash 'Genesis c)
gkeys = Map (KeyHash 'Genesis c) (GenDelegPair c)
-> Set (KeyHash 'Genesis c)
forall k a. Map k a -> Set k
Map.keysSet Map (KeyHash 'Genesis c) (GenDelegPair c)
dlgMap
eta0 :: Nonce
eta0 = TicknState -> Nonce
SL.ticknStateEpochNonce (TicknState -> Nonce) -> TicknState -> Nonce
forall a b. (a -> b) -> a -> b
$ ChainDepState c -> TicknState
forall crypto. ChainDepState crypto -> TicknState
SL.csTickn ChainDepState c
chainState
vkhCold :: KeyHash 'BlockIssuer c
vkhCold = VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
SL.hashKey VKey 'BlockIssuer c
tpraosCanBeLeaderColdVerKey
rho' :: Seed
rho' = Nonce -> SlotNo -> Nonce -> Seed
SL.mkSeed Nonce
SL.seedEta SlotNo
slot Nonce
eta0
y' :: Seed
y' = Nonce -> SlotNo -> Nonce -> Seed
SL.mkSeed Nonce
SL.seedL SlotNo
slot Nonce
eta0
rho :: CertifiedVRF c Seed
rho = ContextVRF (VRF c)
-> Seed -> SignKeyVRF (VRF c) -> CertifiedVRF c Seed
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () Seed
rho' SignKeyVRF (VRF c)
tpraosCanBeLeaderSignKeyVRF
y :: CertifiedVRF c Seed
y = ContextVRF (VRF c)
-> Seed -> SignKeyVRF (VRF c) -> CertifiedVRF c Seed
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () Seed
y' SignKeyVRF (VRF c)
tpraosCanBeLeaderSignKeyVRF
SL.GenDelegs Map (KeyHash 'Genesis c) (GenDelegPair c)
dlgMap = LedgerView c -> GenDelegs c
forall crypto. LedgerView crypto -> GenDelegs crypto
SL.lvGenDelegs LedgerView c
lv
tickChainDepState :: ConsensusConfig (TPraos c)
-> Ticked (LedgerView (TPraos c))
-> SlotNo
-> ChainDepState (TPraos c)
-> Ticked (ChainDepState (TPraos c))
tickChainDepState TPraosConfig{..}
(TickedPraosLedgerView lv)
SlotNo
slot
(TPraosState lastSlot st) =
TickedChainDepState :: forall c.
ChainDepState c
-> Ticked (LedgerView (TPraos c)) -> Ticked (TPraosState c)
TickedChainDepState {
tickedTPraosStateChainDepState :: ChainDepState c
tickedTPraosStateChainDepState = ChainDepState c
st'
, tickedTPraosStateLedgerView :: Ticked (LedgerView (TPraos c))
tickedTPraosStateLedgerView = LedgerView c -> Ticked (LedgerView c)
forall c. LedgerView c -> Ticked (LedgerView c)
TickedPraosLedgerView LedgerView c
lv
}
where
st' :: ChainDepState c
st' = Globals
-> LedgerView c -> Bool -> ChainDepState c -> ChainDepState c
forall crypto.
Globals
-> LedgerView crypto
-> Bool
-> ChainDepState crypto
-> ChainDepState crypto
SL.tickChainDepState
Globals
shelleyGlobals
LedgerView c
lv
(EpochInfo Identity -> WithOrigin SlotNo -> SlotNo -> Bool
isNewEpoch EpochInfo Identity
tpraosEpochInfo WithOrigin SlotNo
lastSlot SlotNo
slot)
ChainDepState c
st
shelleyGlobals :: Globals
shelleyGlobals = EpochInfo Identity -> TPraosParams -> Globals
mkShelleyGlobals EpochInfo Identity
tpraosEpochInfo TPraosParams
tpraosParams
updateChainDepState :: ConsensusConfig (TPraos c)
-> ValidateView (TPraos c)
-> SlotNo
-> Ticked (ChainDepState (TPraos c))
-> Except (ValidationErr (TPraos c)) (ChainDepState (TPraos c))
updateChainDepState TPraosConfig{..} ValidateView (TPraos c)
b SlotNo
slot Ticked (ChainDepState (TPraos c))
cs =
WithOrigin SlotNo -> ChainDepState c -> TPraosState c
forall c. WithOrigin SlotNo -> ChainDepState c -> TPraosState c
TPraosState (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slot) (ChainDepState c -> TPraosState c)
-> ExceptT (ChainTransitionError c) Identity (ChainDepState c)
-> ExceptT (ChainTransitionError c) Identity (TPraosState c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Globals
-> LedgerView c
-> BHeader c
-> ChainDepState c
-> ExceptT (ChainTransitionError c) Identity (ChainDepState c)
forall crypto (m :: * -> *).
(PraosCrypto crypto, MonadError (ChainTransitionError crypto) m) =>
Globals
-> LedgerView crypto
-> BHeader crypto
-> ChainDepState crypto
-> m (ChainDepState crypto)
SL.updateChainDepState
Globals
shelleyGlobals
LedgerView c
lv
ValidateView (TPraos c)
BHeader c
b
(Ticked (TPraosState c) -> ChainDepState c
forall c. Ticked (TPraosState c) -> ChainDepState c
tickedTPraosStateChainDepState Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs)
where
shelleyGlobals :: Globals
shelleyGlobals = EpochInfo Identity -> TPraosParams -> Globals
mkShelleyGlobals EpochInfo Identity
tpraosEpochInfo TPraosParams
tpraosParams
lv :: LedgerView c
lv = Ticked (LedgerView c) -> LedgerView c
forall c. Ticked (LedgerView c) -> LedgerView c
getTickedPraosLedgerView (Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
forall c. Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
tickedTPraosStateLedgerView Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs)
reupdateChainDepState :: ConsensusConfig (TPraos c)
-> ValidateView (TPraos c)
-> SlotNo
-> Ticked (ChainDepState (TPraos c))
-> ChainDepState (TPraos c)
reupdateChainDepState TPraosConfig{..} ValidateView (TPraos c)
b SlotNo
slot Ticked (ChainDepState (TPraos c))
cs =
WithOrigin SlotNo -> ChainDepState c -> TPraosState c
forall c. WithOrigin SlotNo -> ChainDepState c -> TPraosState c
TPraosState (SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin SlotNo
slot) (ChainDepState c -> TPraosState c)
-> ChainDepState c -> TPraosState c
forall a b. (a -> b) -> a -> b
$
Globals
-> LedgerView c -> BHeader c -> ChainDepState c -> ChainDepState c
forall crypto.
PraosCrypto crypto =>
Globals
-> LedgerView crypto
-> BHeader crypto
-> ChainDepState crypto
-> ChainDepState crypto
SL.reupdateChainDepState
Globals
shelleyGlobals
LedgerView c
lv
ValidateView (TPraos c)
BHeader c
b
(Ticked (TPraosState c) -> ChainDepState c
forall c. Ticked (TPraosState c) -> ChainDepState c
tickedTPraosStateChainDepState Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs)
where
shelleyGlobals :: Globals
shelleyGlobals = EpochInfo Identity -> TPraosParams -> Globals
mkShelleyGlobals EpochInfo Identity
tpraosEpochInfo TPraosParams
tpraosParams
lv :: LedgerView c
lv = Ticked (LedgerView c) -> LedgerView c
forall c. Ticked (LedgerView c) -> LedgerView c
getTickedPraosLedgerView (Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
forall c. Ticked (TPraosState c) -> Ticked (LedgerView (TPraos c))
tickedTPraosStateLedgerView Ticked (ChainDepState (TPraos c))
Ticked (TPraosState c)
cs)
mkShelleyGlobals :: EpochInfo Identity -> TPraosParams -> SL.Globals
mkShelleyGlobals :: EpochInfo Identity -> TPraosParams -> Globals
mkShelleyGlobals EpochInfo Identity
epochInfo TPraosParams {Word64
SecurityParam
Nonce
ActiveSlotCoeff
Network
MaxMajorProtVer
tpraosInitialNonce :: Nonce
tpraosNetworkId :: Network
tpraosMaxLovelaceSupply :: Word64
tpraosMaxMajorPV :: MaxMajorProtVer
tpraosQuorum :: Word64
tpraosMaxKESEvo :: Word64
tpraosSecurityParam :: SecurityParam
tpraosLeaderF :: ActiveSlotCoeff
tpraosSlotsPerKESPeriod :: Word64
tpraosInitialNonce :: TPraosParams -> Nonce
tpraosNetworkId :: TPraosParams -> Network
tpraosMaxLovelaceSupply :: TPraosParams -> Word64
tpraosMaxMajorPV :: TPraosParams -> MaxMajorProtVer
tpraosQuorum :: TPraosParams -> Word64
tpraosMaxKESEvo :: TPraosParams -> Word64
tpraosSecurityParam :: TPraosParams -> SecurityParam
tpraosLeaderF :: TPraosParams -> ActiveSlotCoeff
tpraosSlotsPerKESPeriod :: TPraosParams -> Word64
..} = Globals :: EpochInfo Identity
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Word64
-> Natural
-> Word64
-> ActiveSlotCoeff
-> Network
-> Globals
SL.Globals {
epochInfo :: EpochInfo Identity
epochInfo = EpochInfo Identity
epochInfo
, slotsPerKESPeriod :: Word64
slotsPerKESPeriod = Word64
tpraosSlotsPerKESPeriod
, stabilityWindow :: Word64
stabilityWindow = Word64 -> ActiveSlotCoeff -> Word64
SL.computeStabilityWindow Word64
k ActiveSlotCoeff
tpraosLeaderF
, randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow = Word64 -> ActiveSlotCoeff -> Word64
SL.computeRandomnessStabilisationWindow Word64
k ActiveSlotCoeff
tpraosLeaderF
, securityParameter :: Word64
securityParameter = Word64
k
, maxKESEvo :: Word64
maxKESEvo = Word64
tpraosMaxKESEvo
, quorum :: Word64
quorum = Word64
tpraosQuorum
, maxMajorPV :: Natural
maxMajorPV = MaxMajorProtVer -> Natural
getMaxMajorProtVer MaxMajorProtVer
tpraosMaxMajorPV
, maxLovelaceSupply :: Word64
maxLovelaceSupply = Word64
tpraosMaxLovelaceSupply
, activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = ActiveSlotCoeff
tpraosLeaderF
, networkId :: Network
networkId = Network
tpraosNetworkId
}
where
SecurityParam Word64
k = SecurityParam
tpraosSecurityParam
meetsLeaderThreshold ::
forall c. PraosCrypto c
=> ConsensusConfig (TPraos c)
-> LedgerView (TPraos c)
-> SL.KeyHash 'SL.StakePool c
-> SL.CertifiedVRF c SL.Seed
-> Bool
meetsLeaderThreshold :: ConsensusConfig (TPraos c)
-> LedgerView (TPraos c)
-> KeyHash 'StakePool c
-> CertifiedVRF c Seed
-> Bool
meetsLeaderThreshold TPraosConfig { tpraosParams }
SL.LedgerView { lvPoolDistr }
KeyHash 'StakePool c
keyHash
CertifiedVRF c Seed
certNat =
OutputVRF (VRF c) -> Rational -> ActiveSlotCoeff -> Bool
forall v.
VRFAlgorithm v =>
OutputVRF v -> Rational -> ActiveSlotCoeff -> Bool
SL.checkLeaderValue
(CertifiedVRF c Seed -> OutputVRF (VRF c)
forall v a. CertifiedVRF v a -> OutputVRF v
VRF.certifiedOutput CertifiedVRF c Seed
certNat)
Rational
r
(TPraosParams -> ActiveSlotCoeff
tpraosLeaderF TPraosParams
tpraosParams)
where
SL.PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
poolDistr = PoolDistr c
lvPoolDistr
r :: Rational
r = Rational
-> (IndividualPoolStake c -> Rational)
-> Maybe (IndividualPoolStake c)
-> Rational
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Rational
0 IndividualPoolStake c -> Rational
forall crypto. IndividualPoolStake crypto -> Rational
SL.individualPoolStake
(Maybe (IndividualPoolStake c) -> Rational)
-> Maybe (IndividualPoolStake c) -> Rational
forall a b. (a -> b) -> a -> b
$ KeyHash 'StakePool c
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> Maybe (IndividualPoolStake c)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'StakePool c
keyHash Map (KeyHash 'StakePool c) (IndividualPoolStake c)
poolDistr
data TPraosCannotForge c =
TPraosCannotForgeKeyNotUsableYet
!Absolute.KESPeriod
!Absolute.KESPeriod
| TPraosCannotForgeWrongVRF
!(SL.Hash c (SL.VerKeyVRF c))
!(SL.Hash c (SL.VerKeyVRF c))
deriving ((forall x. TPraosCannotForge c -> Rep (TPraosCannotForge c) x)
-> (forall x. Rep (TPraosCannotForge c) x -> TPraosCannotForge c)
-> Generic (TPraosCannotForge c)
forall x. Rep (TPraosCannotForge c) x -> TPraosCannotForge c
forall x. TPraosCannotForge c -> Rep (TPraosCannotForge c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (TPraosCannotForge c) x -> TPraosCannotForge c
forall c x. TPraosCannotForge c -> Rep (TPraosCannotForge c) x
$cto :: forall c x. Rep (TPraosCannotForge c) x -> TPraosCannotForge c
$cfrom :: forall c x. TPraosCannotForge c -> Rep (TPraosCannotForge c) x
Generic)
deriving instance PraosCrypto c => Show (TPraosCannotForge c)
tpraosCheckCanForge ::
ConsensusConfig (TPraos c)
-> SL.Hash c (SL.VerKeyVRF c)
-> SlotNo
-> IsLeader (TPraos c)
-> HotKey.KESInfo
-> Either (TPraosCannotForge c) ()
tpraosCheckCanForge :: ConsensusConfig (TPraos c)
-> Hash c (VerKeyVRF c)
-> SlotNo
-> IsLeader (TPraos c)
-> KESInfo
-> Either (TPraosCannotForge c) ()
tpraosCheckCanForge TPraosConfig { tpraosParams }
Hash c (VerKeyVRF c)
forgingVRFHash
SlotNo
curSlot
TPraosIsLeader { tpraosIsLeaderGenVRFHash }
KESInfo
kesInfo
| let startPeriod :: KESPeriod
startPeriod = KESInfo -> KESPeriod
HotKey.kesStartPeriod KESInfo
kesInfo
, KESPeriod
startPeriod KESPeriod -> KESPeriod -> Bool
forall a. Ord a => a -> a -> Bool
> KESPeriod
wallclockPeriod
= TPraosCannotForge c -> Either (TPraosCannotForge c) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TPraosCannotForge c -> Either (TPraosCannotForge c) ())
-> TPraosCannotForge c -> Either (TPraosCannotForge c) ()
forall a b. (a -> b) -> a -> b
$ KESPeriod -> KESPeriod -> TPraosCannotForge c
forall c. KESPeriod -> KESPeriod -> TPraosCannotForge c
TPraosCannotForgeKeyNotUsableYet KESPeriod
wallclockPeriod KESPeriod
startPeriod
| Just Hash c (VerKeyVRF c)
genVRFHash <- Maybe (Hash c (VerKeyVRF c))
tpraosIsLeaderGenVRFHash
, Hash c (VerKeyVRF c)
genVRFHash Hash c (VerKeyVRF c) -> Hash c (VerKeyVRF c) -> Bool
forall a. Eq a => a -> a -> Bool
/= Hash c (VerKeyVRF c)
forgingVRFHash
= TPraosCannotForge c -> Either (TPraosCannotForge c) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (TPraosCannotForge c -> Either (TPraosCannotForge c) ())
-> TPraosCannotForge c -> Either (TPraosCannotForge c) ()
forall a b. (a -> b) -> a -> b
$ Hash c (VerKeyVRF c) -> Hash c (VerKeyVRF c) -> TPraosCannotForge c
forall c.
Hash c (VerKeyVRF c) -> Hash c (VerKeyVRF c) -> TPraosCannotForge c
TPraosCannotForgeWrongVRF Hash c (VerKeyVRF c)
genVRFHash Hash c (VerKeyVRF c)
forgingVRFHash
| Bool
otherwise
= () -> Either (TPraosCannotForge c) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
wallclockPeriod :: Absolute.KESPeriod
wallclockPeriod :: KESPeriod
wallclockPeriod = Word -> KESPeriod
Absolute.KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$
SlotNo -> Word64
unSlotNo SlotNo
curSlot Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` TPraosParams -> Word64
tpraosSlotsPerKESPeriod TPraosParams
tpraosParams
instance (Condense toSign, PraosCrypto c) => Condense (TPraosFields c toSign) where
condense :: TPraosFields c toSign -> String
condense = toSign -> String
forall a. Condense a => a -> String
condense (toSign -> String)
-> (TPraosFields c toSign -> toSign)
-> TPraosFields c toSign
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TPraosFields c toSign -> toSign
forall c toSign. TPraosFields c toSign -> toSign
tpraosToSign