content: {-# LANGUAGE DeriveAnyClass  #-}
  {-# LANGUAGE RecordWildCards #-}
  
  {-# OPTIONS_GHC -Wno-redundant-constraints #-} -- for the Getter instances
  
  module Pos.Chain.Block.Header
         ( BlockHeader (..)
         , blockHeaderProtocolMagicId
         , blockHeaderHash
         , choosingBlockHeader
         , _BlockHeaderGenesis
         , _BlockHeaderMain
         , verifyBlockHeader
         , headerLeaderKey
         , headerLastSlotInfo
  
         , HeaderHash
         , headerHashF
         , headerHashG
  
         , HasHeaderHash (..)
  
         , BlockSignature (..)
  
         , GenericBlockHeader
         , mkGenericBlockHeaderUnsafe
         , gbhProtocolMagicId
         , gbhPrevBlock
         , gbhBodyProof
         , gbhConsensus
         , gbhExtra
  
         , GenesisBlockHeader
         , mkGenesisHeader
         , genHeaderPrevBlock
         , genHeaderProof
         , genHeaderEpoch
         , genHeaderDifficulty
         , genHeaderAttributes
  
         , MainBlockHeader
         , mkMainHeader
         , mkMainHeaderExplicit
         , mainHeaderPrevBlock
         , mainHeaderProof
         , mainHeaderSlot
         , mainHeaderLeaderKey
         , mainHeaderDifficulty
         , mainHeaderSignature
         , mainHeaderBlockVersion
         , mainHeaderSoftwareVersion
         , mainHeaderAttributes
         , mainHeaderEBDataProof
         , verifyMainBlockHeader
  
         , MainToSign (..)
         , msHeaderHash
         , msBodyProof
         , msSlot
         , msChainDiff
         , msExtraHeader
  
         , MainConsensusData (..)
         , mcdSlot
         , mcdLeaderKey
         , mcdDifficulty
         , mcdSignature
         , verifyMainConsensusData
         ) where
  
  import           Universum
  
  import           Codec.CBOR.Decoding (decodeWordCanonical)
  import           Codec.CBOR.Encoding (encodeWord)
  import           Control.Lens (Getter, LensLike', makeLenses, makePrisms, to)
  import           Control.Monad.Except (MonadError (throwError))
  import           Data.SafeCopy (SafeCopy (..), contain, safeGet, safePut)
  import qualified Data.Serialize as Cereal
  import           Formatting (Format, bprint, build, int, (%))
  import qualified Formatting.Buildable as Buildable
  
  import           Pos.Binary.Class (Bi (..), decodeListLenCanonicalOf,
                       encodeListLen, enforceSize)
  import           Pos.Chain.Block.Genesis (GenesisBody,
                       GenesisConsensusData (..), GenesisExtraHeaderData (..),
                       GenesisHeaderAttributes, GenesisProof (..), gcdDifficulty,
                       gcdEpoch, gehAttributes, mkGenesisProof)
  import           Pos.Chain.Block.Main (BlockHeaderAttributes, MainBody,
                       MainExtraBodyData, MainExtraHeaderData, MainProof (..),
                       mehAttributes, mehBlockVersion, mehEBDataProof,
                       mehSoftwareVersion, mkMainProof,
                       verifyMainExtraHeaderData)
  import           Pos.Chain.Delegation.HeavyDlgIndex (ProxySKBlockInfo,
                       ProxySigHeavy)
  import           Pos.Chain.Delegation.LightDlgIndices (LightDlgIndices (..),
                       ProxySigLight)
  import           Pos.Chain.Genesis.Hash (GenesisHash (..))
  import           Pos.Chain.Update.BlockVersion (BlockVersion,
                       HasBlockVersion (..))
  import           Pos.Chain.Update.SoftwareVersion (HasSoftwareVersion (..),
                       SoftwareVersion)
  import           Pos.Core.Attributes (mkAttributes)
  import           Pos.Core.Common (ChainDifficulty, HasDifficulty (..),
                       addressHash)
  import           Pos.Core.Slotting (EpochIndex (..), EpochOrSlot (..),
                       HasEpochIndex (..), HasEpochOrSlot (..), SlotCount (..),
                       SlotId (..), flattenSlotId, slotIdF)
  import           Pos.Crypto (Hash, ProtocolMagic (..), ProtocolMagicId (..),
                       PublicKey, SecretKey, SignTag (..), Signature, checkSig,
                       hashHexF, isSelfSignedPsk, proxySign, proxyVerify,
                       psigPsk, sign, toPublic, unsafeHash)
  import           Pos.Util.Some (Some, applySome)
  import           Pos.Util.Util (cborError, cerealError)
  
  import           Pos.Chain.Block.Slog.Types (LastSlotInfo (..))
  
  --------------------------------------------------------------------------------
  -- GenesisBlock ∪ MainBlock
  --------------------------------------------------------------------------------
  
  -- | Either header of ordinary main block or genesis block.
  data BlockHeader
      = BlockHeaderGenesis GenesisBlockHeader
      | BlockHeaderMain MainBlockHeader
      deriving (Eq, Show, Generic, NFData)
  
  instance Buildable BlockHeader where
      build = \case
          BlockHeaderGenesis bhg -> Buildable.build bhg
          BlockHeaderMain    bhm -> Buildable.build bhm
  
  instance HasDifficulty BlockHeader where
      difficultyL = choosingBlockHeader difficultyL difficultyL
  
  instance HasEpochIndex BlockHeader where
      epochIndexL = choosingBlockHeader epochIndexL epochIndexL
  
  instance HasEpochOrSlot BlockHeader where
      getEpochOrSlot = view (choosingBlockHeader (to getEpochOrSlot) (to getEpochOrSlot))
  
  choosingBlockHeader
      :: Functor f
      => LensLike' f GenesisBlockHeader r
      -> LensLike' f MainBlockHeader r
      -> LensLike' f BlockHeader r
  choosingBlockHeader onGenesis onMain f = \case
      BlockHeaderGenesis bh -> BlockHeaderGenesis <$> onGenesis f bh
      BlockHeaderMain bh -> BlockHeaderMain <$> onMain f bh
  
  instance Bi BlockHeader where
     encode x = encodeListLen 2 <> encodeWord tag <> body
       where
         (tag, body) = case x of
           BlockHeaderGenesis bh -> (0, encode bh)
           BlockHeaderMain bh    -> (1, encode bh)
  
     decode = do
         decodeListLenCanonicalOf 2
         t <- decodeWordCanonical
         case t of
             0 -> BlockHeaderGenesis <$!> decode
             1 -> BlockHeaderMain <$!> decode
             _ -> cborError $ "decode@BlockHeader: unknown tag " <> pretty t
  
  -- | The 'ProtocolMagic' in a 'BlockHeader'.
  blockHeaderProtocolMagicId :: BlockHeader -> ProtocolMagicId
  blockHeaderProtocolMagicId (BlockHeaderGenesis gbh) = _gbhProtocolMagicId gbh
  blockHeaderProtocolMagicId (BlockHeaderMain mbh)    = _gbhProtocolMagicId mbh
  
  -- | Verify a BlockHeader in isolation. There is nothing to be done for
  -- genesis headers.
  verifyBlockHeader
      :: MonadError Text m
      => ProtocolMagic
      -> BlockHeader
      -> m ()
  verifyBlockHeader _ (BlockHeaderGenesis _) = pure ()
  verifyBlockHeader pm (BlockHeaderMain bhm) = verifyMainBlockHeader pm bhm
  
  headerLastSlotInfo :: SlotCount -> BlockHeader -> Maybe LastSlotInfo
  headerLastSlotInfo slotCount = \case
      BlockHeaderGenesis _ -> Nothing
      BlockHeaderMain mbh -> Just $ convert mbh
    where
      convert :: MainBlockHeader -> LastSlotInfo
      convert bh =
          LastSlotInfo
              (flattenSlotId slotCount . _mcdSlot $ _gbhConsensus bh)
              -- Since _mcdLeaderKey is confirmed (see comment in function
              -- `mkMainHeaderExplicit`) to be the delegator's key, we will be
              -- enforcing block-minting-count thresholds by the delegator's key,
              -- which is the desired behavior.
              (addressHash . _mcdLeaderKey $ _gbhConsensus bh)
  
  --------------------------------------------------------------------------------
  -- HeaderHash
  --------------------------------------------------------------------------------
  
  -- | 'Hash' of block header.
  type HeaderHash = Hash BlockHeader
  
  -- | Specialized formatter for 'HeaderHash'.
  headerHashF :: Format r (HeaderHash -> r)
  headerHashF = build
  
  -- HasHeaderHash
  class HasHeaderHash a where
      headerHash :: a -> HeaderHash
  
  instance HasHeaderHash HeaderHash where
      headerHash = identity
  
  instance HasHeaderHash (Some HasHeaderHash) where
      headerHash = applySome headerHash
  
  instance HasHeaderHash BlockHeader where
      headerHash = blockHeaderHash
  
  instance HasHeaderHash GenesisBlockHeader where
      headerHash = blockHeaderHash . BlockHeaderGenesis
  
  instance HasHeaderHash MainBlockHeader where
      headerHash = blockHeaderHash . BlockHeaderMain
  
  headerHashG :: HasHeaderHash a => Getter a HeaderHash
  headerHashG = to headerHash
  
  -- | This function is required because type inference fails in attempts to
  -- hash only @Right@ or @Left@.
  --
  -- Perhaps, it shouldn't be here, but I decided not to create a module
  -- for only this function.
  blockHeaderHash :: BlockHeader -> HeaderHash
  blockHeaderHash = unsafeHash
  
  
  --------------------------------------------------------------------------------
  -- GenericBlockHeader
  --------------------------------------------------------------------------------
  
  -- | Header of block contains some kind of summary. There are various
  -- benefits which people get by separating header from other data.
  --
  -- The constructor has `Unsafe' prefix in its name, because there in
  -- general there may be some invariants which must hold for the
  -- contents of header.
  data GenericBlockHeader bodyProof consensus extra = GenericBlockHeader
      { _gbhProtocolMagicId :: !ProtocolMagicId
        -- | Pointer to the header of the previous block.
      , _gbhPrevBlock       :: !HeaderHash
      , -- | Proof of body.
        _gbhBodyProof       :: !bodyProof
      , -- | Consensus data to verify consensus algorithm.
        _gbhConsensus       :: !consensus
      , -- | Any extra data.
        _gbhExtra           :: !extra
      } deriving (Eq, Show, Generic, NFData)
  
  instance
      (Bi bodyProof, Bi consensus, Bi extra)
      => Bi (GenericBlockHeader bodyProof consensus extra)
    where
      encode bh =  encodeListLen 5
                <> encode (unProtocolMagicId (_gbhProtocolMagicId bh))
                <> encode (_gbhPrevBlock bh)
                <> encode (_gbhBodyProof bh)
                <> encode (_gbhConsensus bh)
                <> encode (_gbhExtra bh)
      decode = do
          enforceSize "GenericBlockHeader b" 5
          _gbhProtocolMagicId <- ProtocolMagicId <$> decode
          _gbhPrevBlock <- decode
          _gbhBodyProof <- decode
          _gbhConsensus <- decode
          _gbhExtra     <- decode
          pure GenericBlockHeader {..}
  
  instance
      (SafeCopy bodyProof, SafeCopy consensus, SafeCopy extra)
      => SafeCopy (GenericBlockHeader bodyProof consensus extra)
    where
      getCopy =
          contain $
          do _gbhProtocolMagicId <- safeGet
             _gbhPrevBlock <- safeGet
             _gbhBodyProof <- safeGet
             _gbhConsensus <- safeGet
             _gbhExtra <- safeGet
             return $! GenericBlockHeader {..}
      putCopy GenericBlockHeader {..} =
          contain $
          do safePut _gbhProtocolMagicId
             safePut _gbhPrevBlock
             safePut _gbhBodyProof
             safePut _gbhConsensus
             safePut _gbhExtra
  
  -- | Export the @GenericBlockHeader@ constructor as an unsafe function for tests
  mkGenericBlockHeaderUnsafe
      :: ProtocolMagic
      -> HeaderHash
      -> bodyProof
      -> consensus
      -> extra
      -> GenericBlockHeader bodyProof consensus extra
  mkGenericBlockHeaderUnsafe pm = GenericBlockHeader pmi
    where
      pmi = getProtocolMagicId pm
  
  
  --------------------------------------------------------------------------------
  -- GenesisBlockHeader
  --------------------------------------------------------------------------------
  
  -- | Header of Genesis block.
  type GenesisBlockHeader = GenericBlockHeader
      GenesisProof
      GenesisConsensusData
      GenesisExtraHeaderData
  
  instance Buildable GenesisBlockHeader where
      build gbh@GenericBlockHeader {..} =
          bprint
              ("GenesisBlockHeader:\n"%
               "    hash: "%hashHexF%"\n"%
               "    previous block: "%hashHexF%"\n"%
               "    epoch: "%build%"\n"%
               "    difficulty: "%int%"\n"
              )
              gbhHeaderHash
              _gbhPrevBlock
              _gcdEpoch
              _gcdDifficulty
        where
          gbhHeaderHash :: HeaderHash
          gbhHeaderHash = blockHeaderHash $ BlockHeaderGenesis gbh
          GenesisConsensusData {..} = _gbhConsensus
  
  instance HasEpochOrSlot GenesisBlockHeader where
      getEpochOrSlot = EpochOrSlot . Left . _gcdEpoch . _gbhConsensus
  
  -- | Smart constructor for 'GenesisBlockHeader'
  mkGenesisHeader
      :: ProtocolMagic
      -> Either GenesisHash BlockHeader
      -> EpochIndex
      -> GenesisBody
      -> GenesisBlockHeader
  mkGenesisHeader pm prevHeader epoch body =
      GenericBlockHeader
          pmi
          (either getGenesisHash headerHash prevHeader)
          (mkGenesisProof body)
          consensus
          (GenesisExtraHeaderData $ mkAttributes ())
    where
      pmi = getProtocolMagicId pm
      difficulty = either (const 0) (view difficultyL) prevHeader
      consensus = GenesisConsensusData {_gcdEpoch = epoch, _gcdDifficulty = difficulty}
  
  
  --------------------------------------------------------------------------------
  -- MainBlockHeader
  --------------------------------------------------------------------------------
  
  -- | Header of generic main block.
  type MainBlockHeader =
      GenericBlockHeader MainProof MainConsensusData MainExtraHeaderData
  
  instance Buildable MainBlockHeader where
      build gbh@GenericBlockHeader {..} =
          bprint
              ("MainBlockHeader:\n"%
               "    hash: "%hashHexF%"\n"%
               "    previous block: "%hashHexF%"\n"%
               "    slot: "%slotIdF%"\n"%
               "    difficulty: "%int%"\n"%
               "    leader: "%build%"\n"%
               "    signature: "%build%"\n"%
               build
              )
              gbhHeaderHash
              _gbhPrevBlock
              _mcdSlot
              _mcdDifficulty
              _mcdLeaderKey
              _mcdSignature
              _gbhExtra
        where
          gbhHeaderHash :: HeaderHash
          gbhHeaderHash = blockHeaderHash $ BlockHeaderMain gbh
          MainConsensusData {..} = _gbhConsensus
  
  -- | Smart constructor for 'MainBlockHeader'.
  mkMainHeader
      :: ProtocolMagic
      -> Either GenesisHash BlockHeader
      -> SlotId
      -> SecretKey
      -> ProxySKBlockInfo
      -> MainBody
      -> MainExtraHeaderData
      -> MainBlockHeader
  mkMainHeader pm prevHeader =
      mkMainHeaderExplicit pm prevHash difficulty
    where
      prevHash = either getGenesisHash headerHash prevHeader
      difficulty = either (const 0) (succ . view difficultyL) prevHeader
  
  -- | Make a 'MainBlockHeader' for a given slot, with a given body, parent hash,
  -- and difficulty. This takes care of some signing and consensus data.
  mkMainHeaderExplicit
      :: ProtocolMagic
      -> HeaderHash -- ^ Parent
      -> ChainDifficulty
      -> SlotId
      -> SecretKey
      -> ProxySKBlockInfo
      -> MainBody
      -> MainExtraHeaderData
      -> MainBlockHeader
  mkMainHeaderExplicit pm prevHash difficulty slotId sk pske body extra =
      GenericBlockHeader pmi prevHash proof consensus extra
    where
      pmi = getProtocolMagicId pm
      proof = mkMainProof body
      makeSignature toSign (psk,_) =
          BlockPSignatureHeavy $ proxySign pm SignMainBlockHeavy sk psk toSign
      signature =
          let toSign = MainToSign prevHash proof slotId difficulty extra
          in maybe
                 (BlockSignature $ sign pm SignMainBlock sk toSign)
                 (makeSignature toSign)
                 pske
      -- If `pske :: ProxySKBlockInfo` is Just, indicating delegation, we use
      -- the PublicKey of the delegator (in Original era, this is the Stakeholder
      -- whose stake was selected by FTS. In OBFT era, this is the Genesis
      -- Stakeholder, selected via round-robin. In both cases, the delegator is
      -- delegating the right to mint a block to the delegatee).
      --
      -- If `pske :: ProxySKBlockInfo` is Nothing, we use `toPublic` of the `sk`
      -- provided, which should be provided by the node issuing the block who was
      -- thus selected themselves. See `db/src/Pos/DB/Block/Logic/Creation.hs`
      -- for the top of the function call chain which provides the `sk` which
      -- makes its way down to here.
      leaderPk = maybe (toPublic sk) snd pske
      consensus =
          MainConsensusData
          { _mcdSlot = slotId
          , _mcdLeaderKey = leaderPk
          , _mcdDifficulty = difficulty
          , _mcdSignature = signature
          }
  
  -- | Verify a main block header in isolation.
  verifyMainBlockHeader
      :: MonadError Text m
      => ProtocolMagic
      -> MainBlockHeader
      -> m ()
  verifyMainBlockHeader pm GenericBlockHeader {..} = do
      -- Previous header hash is always valid.
      -- Body proof is just a bunch of hashes, which is always valid (although
      -- must be checked against the actual body, in verifyMainBlock.
      -- Consensus data and extra header data require validation.
      verifyMainConsensusData _gbhConsensus
      verifyMainExtraHeaderData _gbhExtra
      -- Internal consistency: is the signature in the consensus data really for
      -- this block?
      unless (verifyBlockSignature _mcdSignature) $
          throwError "can't verify signature"
  
    where
  
      verifyBlockSignature (BlockSignature sig) =
          checkSig pm SignMainBlock leaderPk signature sig
      verifyBlockSignature (BlockPSignatureLight proxySig) =
          proxyVerify
              pm
              SignMainBlockLight
              proxySig
              (\(LightDlgIndices (epochLow, epochHigh)) ->
                   epochLow <= epochId && epochId <= epochHigh)
              signature
      verifyBlockSignature (BlockPSignatureHeavy proxySig) =
          proxyVerify pm SignMainBlockHeavy proxySig (const True) signature
      signature = MainToSign _gbhPrevBlock _gbhBodyProof slotId difficulty _gbhExtra
      epochId = siEpoch slotId
      MainConsensusData
          { _mcdLeaderKey = leaderPk
          , _mcdSlot = slotId
          , _mcdDifficulty = difficulty
          , ..
          } = _gbhConsensus
  
  
  --------------------------------------------------------------------------------
  -- BlockSignature
  --------------------------------------------------------------------------------
  
  -- | Signature of the block. Can be either regular signature from the
  -- issuer or delegated signature having a constraint on epoch indices
  -- (it means the signature is valid only if block's slot id has epoch
  -- inside the constrained interval).
  data BlockSignature
      = BlockSignature (Signature MainToSign)
      | BlockPSignatureLight (ProxySigLight MainToSign)
      | BlockPSignatureHeavy (ProxySigHeavy MainToSign)
      deriving (Show, Eq, Generic)
  
  instance NFData BlockSignature
  
  instance Buildable BlockSignature where
      build (BlockSignature s)       = bprint ("BlockSignature: "%build) s
      build (BlockPSignatureLight s) = bprint ("BlockPSignatureLight: "%build) s
      build (BlockPSignatureHeavy s) = bprint ("BlockPSignatureHeavy: "%build) s
  
  instance Bi BlockSignature where
      encode input = case input of
          BlockSignature sig       -> encodeListLen 2 <> encode (0 :: Word8) <> encode sig
          BlockPSignatureLight pxy -> encodeListLen 2 <> encode (1 :: Word8) <> encode pxy
          BlockPSignatureHeavy pxy -> encodeListLen 2 <> encode (2 :: Word8) <> encode pxy
      decode = do
          enforceSize "BlockSignature" 2
          tag <- decode @Word8
          case tag of
            0 -> BlockSignature <$> decode
            1 -> BlockPSignatureLight <$> decode
            2 -> BlockPSignatureHeavy <$> decode
            _ -> cborError $ "decode@BlockSignature: unknown tag: " <> show tag
  
  instance SafeCopy BlockSignature where
      getCopy = contain $ Cereal.getWord8 >>= \case
          0 -> BlockSignature <$> safeGet
          1 -> BlockPSignatureLight <$> safeGet
          2 -> BlockPSignatureHeavy <$> safeGet
          t -> cerealError $ "getCopy@BlockSignature: couldn't read tag: " <> show t
      putCopy (BlockSignature sig)            = contain $ Cereal.putWord8 0 >> safePut sig
      putCopy (BlockPSignatureLight proxySig) = contain $ Cereal.putWord8 1 >> safePut proxySig
      putCopy (BlockPSignatureHeavy proxySig) = contain $ Cereal.putWord8 2 >> safePut proxySig
  
  -- | Data to be signed in main block.
  data MainToSign
      = MainToSign
      { _msHeaderHash  :: !HeaderHash  -- ^ Hash of previous header
                                       --    in the chain
      , _msBodyProof   :: !MainProof
      , _msSlot        :: !SlotId
      , _msChainDiff   :: !ChainDifficulty
      , _msExtraHeader :: !MainExtraHeaderData
      } deriving Generic
  
  deriving instance Show MainToSign
  deriving instance Eq MainToSign
  
  instance Bi MainToSign where
      encode mts = encodeListLen 5
                 <> encode (_msHeaderHash mts)
                 <> encode (_msBodyProof mts)
                 <> encode (_msSlot mts)
                 <> encode (_msChainDiff mts)
                 <> encode (_msExtraHeader mts)
      decode = do
          enforceSize "MainToSign" 5
          MainToSign <$> decode <*>
                            decode <*>
                            decode <*>
                            decode <*>
                            decode
  
  
  --------------------------------------------------------------------------------
  -- MainConsensusData
  --------------------------------------------------------------------------------
  
  data MainConsensusData = MainConsensusData
      { -- | Id of the slot for which this block was generated.
        _mcdSlot       :: !SlotId
      , -- | Public key of the slot leader. It's essential to have it here,
        -- because FTS gives us only hash of public key (aka 'StakeholderId').
        _mcdLeaderKey  :: !PublicKey
      , -- | Difficulty of chain ending in this block.
        _mcdDifficulty :: !ChainDifficulty
      , -- | Signature given by slot leader.
        _mcdSignature  :: !BlockSignature
      } deriving (Generic, Show, Eq)
  
  instance NFData MainConsensusData
  
  instance Bi MainConsensusData where
      encode cd =  encodeListLen 4
                <> encode (_mcdSlot cd)
                <> encode (_mcdLeaderKey cd)
                <> encode (_mcdDifficulty cd)
                <> encode (_mcdSignature cd)
      decode = do
          enforceSize "ConsensusData MainBlockchain)" 4
          MainConsensusData <$> decode <*>
                                   decode <*>
                                   decode <*>
                                   decode
  
  instance SafeCopy MainConsensusData where
      getCopy =
          contain $
          do _mcdSlot <- safeGet
             _mcdLeaderKey <- safeGet
             _mcdDifficulty <- safeGet
             _mcdSignature <- safeGet
             return $! MainConsensusData {..}
      putCopy MainConsensusData {..} =
          contain $
          do safePut _mcdSlot
             safePut _mcdLeaderKey
             safePut _mcdDifficulty
             safePut _mcdSignature
  
  -- | Verify the consensus data in isolation.
  verifyMainConsensusData
      :: ( MonadError Text m )
      => MainConsensusData
      -> m ()
  verifyMainConsensusData MainConsensusData {..} = do
      when (selfSignedProxy _mcdSignature) $
          throwError "can't use self-signed psk to issue the block"
    where
      selfSignedProxy (BlockSignature _)                      = False
      selfSignedProxy (BlockPSignatureLight (psigPsk -> psk)) = isSelfSignedPsk psk
      selfSignedProxy (BlockPSignatureHeavy (psigPsk -> psk)) = isSelfSignedPsk psk
  
  
  --------------------------------------------------------------------------------
  -- BlockHeaderGenesis prisms
  --------------------------------------------------------------------------------
  
  makePrisms 'BlockHeaderGenesis
  
  
  --------------------------------------------------------------------------------
  -- GenericBlockHeader Lenses
  --------------------------------------------------------------------------------
  
  makeLenses ''GenericBlockHeader
  
  instance HasDifficulty GenesisBlockHeader where
      difficultyL = gbhConsensus . difficultyL
  
  instance HasEpochIndex GenesisBlockHeader where
      epochIndexL = gbhConsensus . gcdEpoch
  
  
  --------------------------------------------------------------------------------
  -- MainConsensusData lenses
  --------------------------------------------------------------------------------
  
  makeLenses 'MainConsensusData
  
  instance HasDifficulty MainConsensusData where
      difficultyL = mcdDifficulty
  
  
  ----------------------------------------------------------------------------
  -- GenesisBlockHeader lenses
  ----------------------------------------------------------------------------
  
  -- | Lens from 'GenesisBlockHeader' to 'HeaderHash' of its parent.
  genHeaderPrevBlock :: Lens' GenesisBlockHeader HeaderHash
  genHeaderPrevBlock = gbhPrevBlock
  
  -- | Lens from 'GenesisBlockHeader' to 'GenesisProof'.
  genHeaderProof :: Lens' GenesisBlockHeader GenesisProof
  genHeaderProof = gbhBodyProof
  
  -- | Lens from 'GenesisBlockHeader' to 'EpochIndex'.
  genHeaderEpoch :: Lens' GenesisBlockHeader EpochIndex
  genHeaderEpoch = gbhConsensus . gcdEpoch
  
  -- | Lens from 'GenesisBlockHeader' to 'ChainDifficulty'.
  genHeaderDifficulty :: Lens' GenesisBlockHeader ChainDifficulty
  genHeaderDifficulty = gbhConsensus . gcdDifficulty
  
  -- | Lens from 'GenesisBlockHeader' to 'GenesisHeaderAttributes'.
  genHeaderAttributes :: Lens' GenesisBlockHeader GenesisHeaderAttributes
  genHeaderAttributes = gbhExtra . gehAttributes
  
  
  --------------------------------------------------------------------------------
  -- MainBlockHeader lenses
  --------------------------------------------------------------------------------
  
  -- | Lens from 'MainBlockHeader' to 'HeaderHash' of its parent.
  mainHeaderPrevBlock :: Lens' MainBlockHeader HeaderHash
  mainHeaderPrevBlock = gbhPrevBlock
  
  -- | Lens from 'MainBlockHeader' to 'MainProof'.
  mainHeaderProof :: Lens' MainBlockHeader MainProof
  mainHeaderProof = gbhBodyProof
  
  -- | Lens from 'MainBlockHeader' to 'SlotId'.
  mainHeaderSlot :: Lens' MainBlockHeader SlotId
  mainHeaderSlot = gbhConsensus . mcdSlot
  
  -- | Lens from 'MainBlockHeader' to 'PublicKey'.
  mainHeaderLeaderKey :: Lens' MainBlockHeader PublicKey
  mainHeaderLeaderKey = gbhConsensus . mcdLeaderKey
  
  headerLeaderKey :: BlockHeader -> Maybe PublicKey
  headerLeaderKey = \case
      BlockHeaderGenesis _ -> Nothing
      BlockHeaderMain mbh -> Just $ view mainHeaderLeaderKey mbh
  
  -- | Lens from 'MainBlockHeader' to 'ChainDifficulty'.
  mainHeaderDifficulty :: Lens' MainBlockHeader ChainDifficulty
  mainHeaderDifficulty = gbhConsensus . mcdDifficulty
  
  -- | Lens from 'MainBlockHeader' to 'Signature'.
  mainHeaderSignature :: Lens' MainBlockHeader BlockSignature
  mainHeaderSignature = gbhConsensus . mcdSignature
  
  -- | Lens from 'MainBlockHeader' to 'BlockVersion'.
  mainHeaderBlockVersion :: Lens' MainBlockHeader BlockVersion
  mainHeaderBlockVersion = gbhExtra . mehBlockVersion
  
  -- | Lens from 'MainBlockHeader' to 'SoftwareVersion'.
  mainHeaderSoftwareVersion :: Lens' MainBlockHeader SoftwareVersion
  mainHeaderSoftwareVersion = gbhExtra . mehSoftwareVersion
  
  -- | Lens from 'MainBlockHeader' to 'BlockHeaderAttributes'.
  mainHeaderAttributes :: Lens' MainBlockHeader BlockHeaderAttributes
  mainHeaderAttributes = gbhExtra . mehAttributes
  
  -- | Lens from 'MainBlockHeader' to 'MainExtraBodyData'
  mainHeaderEBDataProof :: Lens' MainBlockHeader (Hash MainExtraBodyData)
  mainHeaderEBDataProof = gbhExtra . mehEBDataProof
  
  instance HasDifficulty MainBlockHeader where
      difficultyL = mainHeaderDifficulty
  
  instance HasEpochOrSlot MainBlockHeader where
      getEpochOrSlot = EpochOrSlot . Right . view mainHeaderSlot
  
  instance HasEpochIndex MainBlockHeader where
      epochIndexL = mainHeaderSlot . epochIndexL
  
  instance HasBlockVersion MainBlockHeader where
      blockVersionL = mainHeaderBlockVersion
  
  instance HasSoftwareVersion MainBlockHeader where
      softwareVersionL = mainHeaderSoftwareVersion
  
  
  ----------------------------------------------------------------------------
  -- MainToSign lenses
  ----------------------------------------------------------------------------
  
  makeLenses ''MainToSign
  