{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Ouroboros.Consensus.Shelley.Ledger.Integrity (
verifyHeaderIntegrity
, verifyBlockIntegrity
) where
import Data.Either (isRight)
import Data.Word (Word64)
import Ouroboros.Consensus.Block
import qualified Shelley.Spec.Ledger.API as SL
import qualified Shelley.Spec.Ledger.Keys as SL (verifySignedKES)
import Ouroboros.Consensus.Shelley.Ledger.Block
verifyHeaderIntegrity ::
ShelleyBasedEra era
=> Word64
-> Header (ShelleyBlock era)
-> Bool
Word64
slotsPerKESPeriod hdr :: Header (ShelleyBlock era)
hdr@ShelleyHeader { shelleyHeaderRaw } =
Either String () -> Bool
forall a b. Either a b -> Bool
isRight (Either String () -> Bool) -> Either String () -> Bool
forall a b. (a -> b) -> a -> b
$ ContextKES (KES (Crypto era))
-> VerKeyKES (KES (Crypto era))
-> Period
-> BHBody (Crypto era)
-> SignedKES (KES (Crypto era)) (BHBody (Crypto era))
-> Either String ()
forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v
-> VerKeyKES v -> Period -> a -> SignedKES v a -> Either String ()
SL.verifySignedKES () VerKeyKES (KES (Crypto era))
ocertVkHot Period
t BHBody (Crypto era)
hdrBody SignedKES (KES (Crypto era)) (BHBody (Crypto era))
hdrSignature
where
SL.BHeader BHBody (Crypto era)
hdrBody SignedKES (KES (Crypto era)) (BHBody (Crypto era))
hdrSignature = BHeader (Crypto era)
shelleyHeaderRaw
SL.OCert {
VerKeyKES (KES (Crypto era))
ocertVkHot :: forall crypto. OCert crypto -> VerKeyKES crypto
ocertVkHot :: VerKeyKES (KES (Crypto era))
ocertVkHot
, ocertKESPeriod :: forall crypto. OCert crypto -> KESPeriod
ocertKESPeriod = SL.KESPeriod Period
startOfKesPeriod
} = BHBody (Crypto era) -> OCert (Crypto era)
forall crypto. BHBody crypto -> OCert crypto
SL.bheaderOCert BHBody (Crypto era)
hdrBody
currentKesPeriod :: Period
currentKesPeriod = Word64 -> Period
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Period) -> Word64 -> Period
forall a b. (a -> b) -> a -> b
$
SlotNo -> Word64
unSlotNo (Header (ShelleyBlock era) -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot Header (ShelleyBlock era)
hdr) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
slotsPerKESPeriod
t :: Period
t | Period
currentKesPeriod Period -> Period -> Bool
forall a. Ord a => a -> a -> Bool
>= Period
startOfKesPeriod
= Period
currentKesPeriod Period -> Period -> Period
forall a. Num a => a -> a -> a
- Period
startOfKesPeriod
| Bool
otherwise
= Period
0
verifyBlockIntegrity ::
ShelleyBasedEra era
=> Word64
-> ShelleyBlock era -> Bool
verifyBlockIntegrity :: Word64 -> ShelleyBlock era -> Bool
verifyBlockIntegrity Word64
slotsPerKESPeriod ShelleyBlock era
blk =
Word64 -> Header (ShelleyBlock era) -> Bool
forall era.
ShelleyBasedEra era =>
Word64 -> Header (ShelleyBlock era) -> Bool
verifyHeaderIntegrity Word64
slotsPerKESPeriod (ShelleyBlock era -> Header (ShelleyBlock era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock era
blk) Bool -> Bool -> Bool
&&
Header (ShelleyBlock era) -> ShelleyBlock era -> Bool
forall blk. GetHeader blk => Header blk -> blk -> Bool
blockMatchesHeader (ShelleyBlock era -> Header (ShelleyBlock era)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock era
blk) ShelleyBlock era
blk