{-# LANGUAGE NamedFieldPuns #-}

module Ouroboros.Consensus.Byron.Ledger.Integrity
  ( verifyBlockIntegrity
  , verifyHeaderIntegrity
  , verifyHeaderSignature
  ) where

import qualified Cardano.Chain.Block as CC
import qualified Cardano.Crypto.DSIGN.Class as CC.Crypto
import Data.Either (isRight)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Byron.Ledger.Block
import Ouroboros.Consensus.Byron.Ledger.Config
import Ouroboros.Consensus.Byron.Ledger.PBFT ()
import Ouroboros.Consensus.Protocol.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 PBftFields PBftByronCrypto signed
fields signed
signed ContextDSIGN (PBftDSIGN PBftByronCrypto)
contextDSIGN ->
      let PBftFields{VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer :: VerKeyDSIGN (PBftDSIGN PBftByronCrypto)
pbftIssuer :: forall c toSign. PBftFields c toSign -> VerKeyDSIGN (PBftDSIGN c)
pbftIssuer, SignedDSIGN (PBftDSIGN PBftByronCrypto) signed
pbftSignature :: SignedDSIGN (PBftDSIGN PBftByronCrypto) signed
pbftSignature :: forall c toSign.
PBftFields c toSign -> SignedDSIGN (PBftDSIGN c) toSign
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