{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Tracing.HasIssuer
  ( BlockIssuerVerificationKeyHash (..)
  , HasIssuer (..)
  ) where

import qualified Cardano.Chain.Block as Byron
import qualified Cardano.Chain.Common as Byron.Common
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.Hashing as Byron.Crypto
import qualified Cardano.Ledger.Hashes as SL
import Cardano.Protocol.Crypto (StandardCrypto)
import Data.ByteString (ByteString)
import Data.SOP
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock, Header (..))
import Ouroboros.Consensus.HardFork.Combinator
  ( HardForkBlock
  , Header (..)
  , OneEraHeader (..)
  )
import Ouroboros.Consensus.Shelley.Ledger.Block (Header (..), ShelleyBlock)
import Ouroboros.Consensus.Shelley.Protocol.Abstract

-- | Block issuer verification key hash.
data BlockIssuerVerificationKeyHash
  = -- | Serialized block issuer verification key hash.
    BlockIssuerVerificationKeyHash !ByteString
  | -- | There is no block issuer.
    --
    -- For example, this could be relevant for epoch boundary blocks (EBBs),
    -- genesis blocks, etc.
    NoBlockIssuer
  deriving (BlockIssuerVerificationKeyHash
-> BlockIssuerVerificationKeyHash -> Bool
(BlockIssuerVerificationKeyHash
 -> BlockIssuerVerificationKeyHash -> Bool)
-> (BlockIssuerVerificationKeyHash
    -> BlockIssuerVerificationKeyHash -> Bool)
-> Eq BlockIssuerVerificationKeyHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BlockIssuerVerificationKeyHash
-> BlockIssuerVerificationKeyHash -> Bool
== :: BlockIssuerVerificationKeyHash
-> BlockIssuerVerificationKeyHash -> Bool
$c/= :: BlockIssuerVerificationKeyHash
-> BlockIssuerVerificationKeyHash -> Bool
/= :: BlockIssuerVerificationKeyHash
-> BlockIssuerVerificationKeyHash -> Bool
Eq, Int -> BlockIssuerVerificationKeyHash -> ShowS
[BlockIssuerVerificationKeyHash] -> ShowS
BlockIssuerVerificationKeyHash -> String
(Int -> BlockIssuerVerificationKeyHash -> ShowS)
-> (BlockIssuerVerificationKeyHash -> String)
-> ([BlockIssuerVerificationKeyHash] -> ShowS)
-> Show BlockIssuerVerificationKeyHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BlockIssuerVerificationKeyHash -> ShowS
showsPrec :: Int -> BlockIssuerVerificationKeyHash -> ShowS
$cshow :: BlockIssuerVerificationKeyHash -> String
show :: BlockIssuerVerificationKeyHash -> String
$cshowList :: [BlockIssuerVerificationKeyHash] -> ShowS
showList :: [BlockIssuerVerificationKeyHash] -> ShowS
Show)

-- | Get the block issuer verification key hash from a block header.
class HasIssuer blk where
  -- | Given a block header, return the serialized block issuer verification
  -- key hash.
  getIssuerVerificationKeyHash :: Header blk -> BlockIssuerVerificationKeyHash

instance HasIssuer ByronBlock where
  getIssuerVerificationKeyHash :: Header ByronBlock -> BlockIssuerVerificationKeyHash
getIssuerVerificationKeyHash Header ByronBlock
byronBlkHdr =
    case Header ByronBlock -> ABlockOrBoundaryHdr ByteString
byronHeaderRaw Header ByronBlock
byronBlkHdr of
      Byron.ABOBBlockHdr AHeader ByteString
hdr ->
        ByteString -> BlockIssuerVerificationKeyHash
BlockIssuerVerificationKeyHash
          -- The raw bytes of the Blake2b_224 hash of the issuer verification
          -- key. This matches @cardano-api@'s
          -- @serialiseToRawBytes . verificationKeyHash . ByronVerificationKey@.
          (ByteString -> BlockIssuerVerificationKeyHash)
-> (VerificationKey -> ByteString)
-> VerificationKey
-> BlockIssuerVerificationKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractHash Blake2b_224 VerificationKey -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes
          (AbstractHash Blake2b_224 VerificationKey -> ByteString)
-> (VerificationKey -> AbstractHash Blake2b_224 VerificationKey)
-> VerificationKey
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash -> AbstractHash Blake2b_224 VerificationKey
Byron.Common.unKeyHash
          (KeyHash -> AbstractHash Blake2b_224 VerificationKey)
-> (VerificationKey -> KeyHash)
-> VerificationKey
-> AbstractHash Blake2b_224 VerificationKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey -> KeyHash
Byron.Common.hashKey
          (VerificationKey -> BlockIssuerVerificationKeyHash)
-> VerificationKey -> BlockIssuerVerificationKeyHash
forall a b. (a -> b) -> a -> b
$ AHeader ByteString -> VerificationKey
forall a. AHeader a -> VerificationKey
Byron.headerIssuer AHeader ByteString
hdr
      Byron.ABOBBoundaryHdr ABoundaryHeader ByteString
_ -> BlockIssuerVerificationKeyHash
NoBlockIssuer

instance
  ( ProtoCrypto protocol ~ StandardCrypto
  , ProtocolHeaderSupportsProtocol protocol
  ) =>
  HasIssuer (ShelleyBlock protocol era)
  where
  getIssuerVerificationKeyHash :: Header (ShelleyBlock protocol era)
-> BlockIssuerVerificationKeyHash
getIssuerVerificationKeyHash Header (ShelleyBlock protocol era)
shelleyBlkHdr =
    ByteString -> BlockIssuerVerificationKeyHash
BlockIssuerVerificationKeyHash
      -- The raw bytes of the key hash. This matches @cardano-api@'s
      -- @serialiseToRawBytes . verificationKeyHash . StakePoolVerificationKey@;
      -- the key role is a phantom type, so hashing the block-issuer key
      -- directly yields the same bytes as first converting it to a stake
      -- pool key.
      (ByteString -> BlockIssuerVerificationKeyHash)
-> (VKey BlockIssuer -> ByteString)
-> VKey BlockIssuer
-> BlockIssuerVerificationKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes
      (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> ByteString)
-> (VKey BlockIssuer -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> VKey BlockIssuer
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyHash BlockIssuer -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall (r :: KeyRole).
KeyHash r -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
SL.unKeyHash
      (KeyHash BlockIssuer -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> (VKey BlockIssuer -> KeyHash BlockIssuer)
-> VKey BlockIssuer
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey BlockIssuer -> KeyHash BlockIssuer
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey
      (VKey BlockIssuer -> BlockIssuerVerificationKeyHash)
-> VKey BlockIssuer -> BlockIssuerVerificationKeyHash
forall a b. (a -> b) -> a -> b
$ ShelleyProtocolHeader protocol -> VKey BlockIssuer
forall proto.
ProtocolHeaderSupportsProtocol proto =>
ShelleyProtocolHeader proto -> VKey BlockIssuer
pHeaderIssuer (Header (ShelleyBlock protocol era)
-> ShelleyProtocolHeader protocol
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw Header (ShelleyBlock protocol era)
shelleyBlkHdr)

instance All HasIssuer xs => HasIssuer (HardForkBlock xs) where
  getIssuerVerificationKeyHash :: Header (HardForkBlock xs) -> BlockIssuerVerificationKeyHash
getIssuerVerificationKeyHash =
    NS (K BlockIssuerVerificationKeyHash) xs
-> CollapseTo NS BlockIssuerVerificationKeyHash
NS (K BlockIssuerVerificationKeyHash) xs
-> BlockIssuerVerificationKeyHash
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K BlockIssuerVerificationKeyHash) xs
 -> BlockIssuerVerificationKeyHash)
-> (Header (HardForkBlock xs)
    -> NS (K BlockIssuerVerificationKeyHash) xs)
-> Header (HardForkBlock xs)
-> BlockIssuerVerificationKeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy HasIssuer
-> (forall a.
    HasIssuer a =>
    Header a -> K BlockIssuerVerificationKeyHash a)
-> NS Header xs
-> NS (K BlockIssuerVerificationKeyHash) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @HasIssuer) (BlockIssuerVerificationKeyHash
-> K BlockIssuerVerificationKeyHash a
forall k a (b :: k). a -> K a b
K (BlockIssuerVerificationKeyHash
 -> K BlockIssuerVerificationKeyHash a)
-> (Header a -> BlockIssuerVerificationKeyHash)
-> Header a
-> K BlockIssuerVerificationKeyHash a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header a -> BlockIssuerVerificationKeyHash
forall blk.
HasIssuer blk =>
Header blk -> BlockIssuerVerificationKeyHash
getIssuerVerificationKeyHash)
      (NS Header xs -> NS (K BlockIssuerVerificationKeyHash) xs)
-> (Header (HardForkBlock xs) -> NS Header xs)
-> Header (HardForkBlock xs)
-> NS (K BlockIssuerVerificationKeyHash) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraHeader xs -> NS Header xs
forall (xs :: [*]). OneEraHeader xs -> NS Header xs
getOneEraHeader
      (OneEraHeader xs -> NS Header xs)
-> (Header (HardForkBlock xs) -> OneEraHeader xs)
-> Header (HardForkBlock xs)
-> NS Header xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (HardForkBlock xs) -> OneEraHeader xs
forall (xs :: [*]). Header (HardForkBlock xs) -> OneEraHeader xs
getHardForkHeader