{-# LANGUAGE NamedFieldPuns #-}
module Ouroboros.Consensus.Byron.Ledger.Integrity (
    verifyBlockIntegrity
  , verifyHeaderIntegrity
  , verifyHeaderSignature
  ) where

import           Data.Either (isRight)

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Crypto.DSIGN.Class as CC.Crypto

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Protocol.PBFT

import           Ouroboros.Consensus.Byron.Ledger.Block
import           Ouroboros.Consensus.Byron.Ledger.Config
import           Ouroboros.Consensus.Byron.Ledger.PBFT ()

-- | Verify whether a header matches its signature.
--
-- Note that we cannot check this for an EBB, as an EBB contains no signature.
-- This function will always return 'True' for an EBB.
verifyHeaderSignature :: BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderSignature :: BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderSignature BlockConfig ByronBlock
cfg Header ByronBlock
hdr =
    case BlockConfig ByronBlock
-> Header ByronBlock -> ValidateView (BlockProtocol ByronBlock)
forall blk.
BlockSupportsProtocol blk =>
BlockConfig blk -> Header blk -> ValidateView (BlockProtocol blk)
validateView BlockConfig ByronBlock
cfg Header ByronBlock
hdr of
      PBftValidateBoundary{} ->
        -- EBB, no signature to check
        Bool
True
      PBftValidateRegular fields signed contextDSIGN ->
        let PBftFields { VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer :: forall c toSign. PBftFields c toSign -> VerKeyDSIGN (PBftDSIGN c)
pbftIssuer :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer, SignedDSIGN (PBftDSIGN PBftByronCrypto) signed
pbftSignature :: forall c toSign.
PBftFields c toSign -> SignedDSIGN (PBftDSIGN c) toSign
pbftSignature :: SignedDSIGN (PBftDSIGN PBftByronCrypto) signed
pbftSignature } = PBftFields PBftByronCrypto signed
fields
        in Either String () -> Bool
forall a b. Either a b -> Bool
isRight (Either String () -> Bool) -> Either String () -> Bool
forall a b. (a -> b) -> a -> b
$ ContextDSIGN ByronDSIGN
-> VerKeyDSIGN ByronDSIGN
-> signed
-> SignedDSIGN ByronDSIGN signed
-> Either String ()
forall v a.
(DSIGNAlgorithm v, Signable v a, HasCallStack) =>
ContextDSIGN v
-> VerKeyDSIGN v -> a -> SignedDSIGN v a -> Either String ()
CC.Crypto.verifySignedDSIGN
             ContextDSIGN (PBftDSIGN PBftByronCrypto)
ContextDSIGN ByronDSIGN
contextDSIGN
             VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
VerKeyDSIGN ByronDSIGN
pbftIssuer
             signed
signed
             SignedDSIGN (PBftDSIGN PBftByronCrypto) signed
SignedDSIGN ByronDSIGN signed
pbftSignature

-- | Verify whether a header is not corrupted.
--
-- The difference with 'verifyHeaderSignature' is that this function also
-- checks the integrity of the 'CC.headerProtocolMagicId' field, which is the
-- only field of a regular header that is not signed.
--
-- Note that we cannot check this for an EBB, as an EBB contains no signature.
-- This function will always return 'True' for an EBB.
verifyHeaderIntegrity :: BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderIntegrity :: BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderIntegrity BlockConfig ByronBlock
cfg Header ByronBlock
hdr =
    BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderSignature BlockConfig ByronBlock
cfg Header ByronBlock
hdr Bool -> Bool -> Bool
&&
    -- @CC.headerProtocolMagicId@ is the only field of a regular header that
    -- is not signed, so check it manually.
    case Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
hdr of
        CC.ABOBBlockHdr AHeader ByteString
h    -> AHeader ByteString -> ProtocolMagicId
forall a. AHeader a -> ProtocolMagicId
CC.headerProtocolMagicId AHeader ByteString
h ProtocolMagicId -> ProtocolMagicId -> Bool
forall a. Eq a => a -> a -> Bool
== ProtocolMagicId
protocolMagicId
        -- EBB, we can't check it
        CC.ABOBBoundaryHdr ABoundaryHeader ByteString
_ -> Bool
True
  where
    protocolMagicId :: ProtocolMagicId
protocolMagicId = BlockConfig ByronBlock -> ProtocolMagicId
byronProtocolMagicId BlockConfig ByronBlock
cfg

-- | Verifies whether the block is not corrupted by checking its signature and
-- witnesses.
--
-- This function will always return 'True' for an EBB, as we cannot check
-- anything for an EBB.
verifyBlockIntegrity :: BlockConfig ByronBlock -> ByronBlock -> Bool
verifyBlockIntegrity :: BlockConfig ByronBlock -> ByronBlock -> Bool
verifyBlockIntegrity BlockConfig ByronBlock
cfg ByronBlock
blk =
    BlockConfig ByronBlock -> Header ByronBlock -> Bool
verifyHeaderIntegrity BlockConfig ByronBlock
cfg Header ByronBlock
hdr Bool -> Bool -> Bool
&&
    Header ByronBlock -> ByronBlock -> Bool
forall blk. GetHeader blk => Header blk -> blk -> Bool
blockMatchesHeader        Header ByronBlock
hdr ByronBlock
blk
  where
    hdr :: Header ByronBlock
hdr = ByronBlock -> Header ByronBlock
forall blk. GetHeader blk => blk -> Header blk
getHeader ByronBlock
blk