{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Ouroboros.Consensus.Ledger.SupportsPeras
  ( LedgerStateSupportsPeras (..)
  )
where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Coin (Coin (..), compactCoinOrError, knownNonZeroCoin)
import Cardano.Ledger.Keys (KeyHash (..), toVRFVerKeyHash)
import Cardano.Ledger.State (IndividualPoolStake (..), PoolDistr (..))
import qualified Data.Map as Map
import Ouroboros.Consensus.Block.SupportsPeras (PerasParams, defaultPerasParams)
import Ouroboros.Consensus.Ledger.Abstract (EmptyMK)

-- | Extract Peras information stored in the ledger state.
class LedgerStateSupportsPeras ledgerState where
  -- | Extract the stake distribution from the given ledger state.
  --
  -- PRECONDITION: this function will only return a meaningful result if the
  -- ledger state is from a block that supports Peras.
  getPoolDistr :: ledgerState EmptyMK -> PoolDistr
  default getPoolDistr :: ledgerState EmptyMK -> PoolDistr
  getPoolDistr ledgerState EmptyMK
_ = PoolDistr
dummyPoolDistr

  -- | Extract the Peras parameters from the given ledger state.
  --
  -- TODO: when Peras params go on chain, update this.
  getPerasParams :: proxy blk -> ledgerState EmptyMK -> PerasParams blk
  default getPerasParams :: proxy blk -> ledgerState EmptyMK -> PerasParams blk
  getPerasParams proxy blk
_ ledgerState EmptyMK
_ = PerasParams blk
forall blk. PerasParams blk
defaultPerasParams

-- NOTE: this is a bit of a hack for blocks that do not really support Peras.
-- We return a single dummy stake pool holding all of the active stake, so that
-- consumers relying on a non-empty stake distribution (e.g. the mock voting
-- committee) do not fail.
dummyPoolDistr :: PoolDistr
dummyPoolDistr :: PoolDistr
dummyPoolDistr =
  PoolDistr
    { unPoolDistr :: Map (KeyHash StakePool) IndividualPoolStake
unPoolDistr = KeyHash StakePool
-> IndividualPoolStake
-> Map (KeyHash StakePool) IndividualPoolStake
forall k a. k -> a -> Map k a
Map.singleton KeyHash StakePool
forall {r :: KeyRole}. KeyHash r
dummyPoolId IndividualPoolStake
dummyPoolStake
    , pdTotalActiveStake :: NonZero Coin
pdTotalActiveStake = forall (n :: Natural). (KnownNat n, 1 <= n) => NonZero Coin
knownNonZeroCoin @1
    }
 where
  dummyPoolId :: KeyHash r
dummyPoolId =
    Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash
      (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r)
-> (ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> ByteString
-> KeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash ADDRHASH ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall h a b. Hash h a -> Hash h b
Hash.castHash
      (Hash ADDRHASH ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN))
-> (ByteString -> Hash ADDRHASH ByteString)
-> ByteString
-> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash ADDRHASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
      (ByteString -> KeyHash r) -> ByteString -> KeyHash r
forall a b. (a -> b) -> a -> b
$ ByteString
"peras-mock-pool"
  dummyPoolVrf :: VRFVerKeyHash r
dummyPoolVrf =
    Hash HASH (VerKeyVRF (ZonkAny 0)) -> VRFVerKeyHash r
forall v (r :: KeyRoleVRF).
Hash HASH (VerKeyVRF v) -> VRFVerKeyHash r
toVRFVerKeyHash
      (Hash HASH (VerKeyVRF (ZonkAny 0)) -> VRFVerKeyHash r)
-> (ByteString -> Hash HASH (VerKeyVRF (ZonkAny 0)))
-> ByteString
-> VRFVerKeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash HASH ByteString -> Hash HASH (VerKeyVRF (ZonkAny 0))
forall h a b. Hash h a -> Hash h b
Hash.castHash
      (Hash HASH ByteString -> Hash HASH (VerKeyVRF (ZonkAny 0)))
-> (ByteString -> Hash HASH ByteString)
-> ByteString
-> Hash HASH (VerKeyVRF (ZonkAny 0))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> ByteString -> Hash HASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
      (ByteString -> VRFVerKeyHash r) -> ByteString -> VRFVerKeyHash r
forall a b. (a -> b) -> a -> b
$ ByteString
"peras-mock-pool-vrf"
  dummyPoolStake :: IndividualPoolStake
dummyPoolStake =
    IndividualPoolStake
      { individualPoolStake :: Ratio Integer
individualPoolStake = Ratio Integer
1
      , individualTotalPoolStake :: CompactForm Coin
individualTotalPoolStake = HasCallStack => Coin -> CompactForm Coin
Coin -> CompactForm Coin
compactCoinOrError (Integer -> Coin
Coin Integer
1)
      , individualPoolStakeVrf :: VRFVerKeyHash StakePoolVRF
individualPoolStakeVrf = VRFVerKeyHash StakePoolVRF
forall {r :: KeyRoleVRF}. VRFVerKeyHash r
dummyPoolVrf
      }