{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Empty Peras support for the mock block.
--
-- NOTE: this module exists solely because the orphan module
-- 'Ouroboros.Consensus.Mock.Node.Serialisation' needs some of the these
-- instances, but defining them there would be too confusing.
module Ouroboros.Consensus.Mock.Node.Peras () where

import Data.Typeable (Typeable)
import Ouroboros.Consensus.Block (BlockProtocol)
import Ouroboros.Consensus.Block.SupportsPeras
  ( BlockSupportsPeras (..)
  , VoidPerasCert
  , VoidPerasCrypto
  , VoidPerasError
  , VoidPerasVote
  , VoidPerasVotingCommitteeScheme
  , defaultForgePerasCert
  , defaultForgePerasVoteIfEligible
  , defaultVerifyPerasCert
  , defaultVerifyPerasVote
  )
import Ouroboros.Consensus.HardFork.History (EpochToPerasRoundInfo, forgetEraIndex)
import Ouroboros.Consensus.Mock.Ledger.Block (SimpleBlock, SimpleCrypto)
import Ouroboros.Consensus.Peras.Context (StateSupportsPerasEpochContext (..))
import Ouroboros.Consensus.Protocol.Abstract
  ( ChainDepState
  , ChainDepStateSupportsPeras
  )
import Ouroboros.Consensus.Ticked (Ticked)

instance
  ( SimpleCrypto c
  , Typeable ext
  , ChainDepStateSupportsPeras (ChainDepState (BlockProtocol (SimpleBlock c ext)))
  , ChainDepStateSupportsPeras (Ticked (ChainDepState (BlockProtocol (SimpleBlock c ext))))
  ) =>
  StateSupportsPerasEpochContext (SimpleBlock c ext)
  where
  type MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext) = EpochToPerasRoundInfo
  toMaybeEraIndexedEpochToPerasRoundInfo :: forall (proxy :: * -> *).
All Top (HardForkIndices (SimpleBlock c ext)) =>
proxy (SimpleBlock c ext)
-> EraIndexed
     (HardForkIndices (SimpleBlock c ext)) EpochToPerasRoundInfo
-> MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext)
toMaybeEraIndexedEpochToPerasRoundInfo proxy (SimpleBlock c ext)
_ = EraIndexed '[SimpleBlock c ext] EpochToPerasRoundInfo
-> EpochToPerasRoundInfo
EraIndexed
  (HardForkIndices (SimpleBlock c ext)) EpochToPerasRoundInfo
-> MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext)
forall (xs :: [*]) a. EraIndexed xs a -> a
forgetEraIndex
  fromMaybeEraIndexedEpochToPerasRoundInfo :: forall (proxy :: * -> *).
proxy (SimpleBlock c ext)
-> MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext)
-> EpochToPerasRoundInfo
fromMaybeEraIndexedEpochToPerasRoundInfo proxy (SimpleBlock c ext)
_ = EpochToPerasRoundInfo -> EpochToPerasRoundInfo
MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext)
-> EpochToPerasRoundInfo
forall a. a -> a
id
  mkBoundedPerasEpochContext :: forall (ledgerState :: MapKind -> *) chainDepState.
(LedgerStateSupportsPeras ledgerState,
 ChainDepStateSupportsPeras chainDepState) =>
MaybeEraIndexedEpochToPerasRoundInfo (SimpleBlock c ext)
-> ledgerState EmptyMK
-> chainDepState
-> Either
     (PerasError (SimpleBlock c ext))
     (BoundedPerasEpochContext (SimpleBlock c ext))
mkBoundedPerasEpochContext = [Char]
-> EpochToPerasRoundInfo
-> ledgerState EmptyMK
-> chainDepState
-> Either
     (VoidPerasError (SimpleBlock c ext))
     (BoundedPerasEpochContext (SimpleBlock c ext))
forall a. HasCallStack => [Char] -> a
error [Char]
"mkBoundedPerasEpochContext: SimpleBlock does not support Peras"

instance
  ( SimpleCrypto c
  , Typeable ext
  ) =>
  BlockSupportsPeras (SimpleBlock c ext)
  where
  type PerasVote (SimpleBlock c ext) = VoidPerasVote (SimpleBlock c ext)
  type PerasCert (SimpleBlock c ext) = VoidPerasCert (SimpleBlock c ext)
  type PerasError (SimpleBlock c ext) = VoidPerasError (SimpleBlock c ext)
  type PerasCrypto (SimpleBlock c ext) = VoidPerasCrypto (SimpleBlock c ext)
  type PerasVotingCommitteeScheme (SimpleBlock c ext) = VoidPerasVotingCommitteeScheme
  forgePerasVoteIfEligible :: PerasEpochContext (SimpleBlock c ext)
-> PoolId
-> PrivateKey (PerasCrypto (SimpleBlock c ext))
-> PerasRoundNo
-> Point (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (Maybe (ValidatedPerasVote (SimpleBlock c ext)))
forgePerasVoteIfEligible = PerasEpochContext (SimpleBlock c ext)
-> PoolId
-> PrivateKey (PerasCrypto (SimpleBlock c ext))
-> PerasRoundNo
-> Point (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (Maybe (ValidatedPerasVote (SimpleBlock c ext)))
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PoolId
-> PrivateKey (PerasCrypto blk)
-> PerasRoundNo
-> Point blk
-> Either (PerasError blk) (Maybe (ValidatedPerasVote blk))
defaultForgePerasVoteIfEligible
  verifyPerasVote :: PerasEpochContext (SimpleBlock c ext)
-> PerasVote (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasVote (SimpleBlock c ext))
verifyPerasVote = PerasEpochContext (SimpleBlock c ext)
-> PerasVote (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasVote (SimpleBlock c ext))
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasVote blk
-> Either (PerasError blk) (ValidatedPerasVote blk)
defaultVerifyPerasVote
  forgePerasCert :: PerasEpochContext (SimpleBlock c ext)
-> PerasVoteCollectionWithQuorum (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasCert (SimpleBlock c ext))
forgePerasCert = PerasEpochContext (SimpleBlock c ext)
-> PerasVoteCollectionWithQuorum (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasCert (SimpleBlock c ext))
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasVoteCompatibleWithVotingCommittee
   (PerasVote blk) (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasCertCompatibleWithVotingCommittee
   (PerasCert blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasVoteCollectionWithQuorum blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
defaultForgePerasCert
  verifyPerasCert :: PerasEpochContext (SimpleBlock c ext)
-> PerasCert (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasCert (SimpleBlock c ext))
verifyPerasCert = PerasEpochContext (SimpleBlock c ext)
-> PerasCert (SimpleBlock c ext)
-> Either
     (PerasError (SimpleBlock c ext))
     (ValidatedPerasCert (SimpleBlock c ext))
forall blk.
(BlockSupportsPeras blk,
 CryptoSupportsVotingCommittee
   (PerasCrypto blk) (PerasVotingCommitteeScheme blk),
 PerasCertCompatibleWithVotingCommittee
   (PerasCert blk)
   (PerasCrypto blk)
   (PerasVotingCommitteeScheme blk)) =>
PerasEpochContext blk
-> PerasCert blk
-> Either (PerasError blk) (ValidatedPerasCert blk)
defaultVerifyPerasCert
  getPerasCertInBlock :: SimpleBlock c ext
-> Either
     (PerasError (SimpleBlock c ext))
     (Maybe (PerasCert (SimpleBlock c ext)))
getPerasCertInBlock SimpleBlock c ext
_ = Maybe (VoidPerasCert (SimpleBlock c ext))
-> Either
     (VoidPerasError (SimpleBlock c ext))
     (Maybe (VoidPerasCert (SimpleBlock c ext)))
forall a b. b -> Either a b
Right Maybe (VoidPerasCert (SimpleBlock c ext))
forall a. Maybe a
Nothing