{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This module contains copies of older versions of types from Ledger in order
-- to retain backwards-compatibility. Eventually, types likes this should be
-- defined in Ledger instead of here, see
-- <https://github.com/IntersectMBO/cardano-ledger/issues/4415>.
module Ouroboros.Consensus.Shelley.Ledger.Query.Types
  ( IndividualPoolStake (..)
  , PoolDistr (..)
  , fromLedgerIndividualPoolStake
  , fromLedgerPoolDistr
  ) where

import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.Binary
  ( DecCBOR (..)
  , EncCBOR (..)
  , decodeRecordNamed
  , encodeListLen
  )
import Cardano.Ledger.Hashes (HASH)
import qualified Cardano.Ledger.Keys as SL
import qualified Cardano.Ledger.State as SL
import Cardano.Protocol.Crypto (Crypto, VRF)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic)
import NoThunks.Class

-- | Copy of 'SL.IndividualPoolStake' before
-- <https://github.com/IntersectMBO/cardano-ledger/pull/4324>.
data IndividualPoolStake c = IndividualPoolStake
  { forall c. IndividualPoolStake c -> Rational
individualPoolStake :: !Rational
  , forall c. IndividualPoolStake c -> Hash HASH (VerKeyVRF (VRF c))
individualPoolStakeVrf :: !(Hash.Hash HASH (VRF.VerKeyVRF (VRF c)))
  }
  deriving stock (Int -> IndividualPoolStake c -> ShowS
[IndividualPoolStake c] -> ShowS
IndividualPoolStake c -> String
(Int -> IndividualPoolStake c -> ShowS)
-> (IndividualPoolStake c -> String)
-> ([IndividualPoolStake c] -> ShowS)
-> Show (IndividualPoolStake c)
forall c. Int -> IndividualPoolStake c -> ShowS
forall c. [IndividualPoolStake c] -> ShowS
forall c. IndividualPoolStake c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Int -> IndividualPoolStake c -> ShowS
showsPrec :: Int -> IndividualPoolStake c -> ShowS
$cshow :: forall c. IndividualPoolStake c -> String
show :: IndividualPoolStake c -> String
$cshowList :: forall c. [IndividualPoolStake c] -> ShowS
showList :: [IndividualPoolStake c] -> ShowS
Show, IndividualPoolStake c -> IndividualPoolStake c -> Bool
(IndividualPoolStake c -> IndividualPoolStake c -> Bool)
-> (IndividualPoolStake c -> IndividualPoolStake c -> Bool)
-> Eq (IndividualPoolStake c)
forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
== :: IndividualPoolStake c -> IndividualPoolStake c -> Bool
$c/= :: forall c. IndividualPoolStake c -> IndividualPoolStake c -> Bool
/= :: IndividualPoolStake c -> IndividualPoolStake c -> Bool
Eq, (forall x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x)
-> (forall x.
    Rep (IndividualPoolStake c) x -> IndividualPoolStake c)
-> Generic (IndividualPoolStake c)
forall x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
forall x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
forall c x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
$cfrom :: forall c x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
from :: forall x. IndividualPoolStake c -> Rep (IndividualPoolStake c) x
$cto :: forall c x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
to :: forall x. Rep (IndividualPoolStake c) x -> IndividualPoolStake c
Generic)
  deriving anyclass Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
Proxy (IndividualPoolStake c) -> String
(Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo))
-> (Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo))
-> (Proxy (IndividualPoolStake c) -> String)
-> NoThunks (IndividualPoolStake c)
forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
forall c. Proxy (IndividualPoolStake c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
noThunks :: Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> IndividualPoolStake c -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall c. Proxy (IndividualPoolStake c) -> String
showTypeOf :: Proxy (IndividualPoolStake c) -> String
NoThunks

fromLedgerIndividualPoolStake :: SL.IndividualPoolStake -> IndividualPoolStake c
fromLedgerIndividualPoolStake :: forall c. IndividualPoolStake -> IndividualPoolStake c
fromLedgerIndividualPoolStake IndividualPoolStake
ips =
  IndividualPoolStake
    { individualPoolStake :: Rational
individualPoolStake = IndividualPoolStake -> Rational
SL.individualPoolStake IndividualPoolStake
ips
    , individualPoolStakeVrf :: Hash HASH (VerKeyVRF (VRF c))
individualPoolStakeVrf = VRFVerKeyHash 'StakePoolVRF -> Hash HASH (VerKeyVRF (VRF c))
forall (r :: KeyRoleVRF) v.
VRFVerKeyHash r -> Hash HASH (VerKeyVRF v)
SL.fromVRFVerKeyHash (VRFVerKeyHash 'StakePoolVRF -> Hash HASH (VerKeyVRF (VRF c)))
-> VRFVerKeyHash 'StakePoolVRF -> Hash HASH (VerKeyVRF (VRF c))
forall a b. (a -> b) -> a -> b
$ IndividualPoolStake -> VRFVerKeyHash 'StakePoolVRF
SL.individualPoolStakeVrf IndividualPoolStake
ips
    }

instance Crypto c => EncCBOR (IndividualPoolStake c) where
  encCBOR :: IndividualPoolStake c -> Encoding
encCBOR (IndividualPoolStake Rational
stake Hash HASH (VerKeyVRF (VRF c))
vrf) =
    [Encoding] -> Encoding
forall a. Monoid a => [a] -> a
mconcat
      [ Word -> Encoding
encodeListLen Word
2
      , Rational -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Rational
stake
      , Hash HASH (VerKeyVRF (VRF c)) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Hash HASH (VerKeyVRF (VRF c))
vrf
      ]

instance Crypto c => DecCBOR (IndividualPoolStake c) where
  decCBOR :: forall s. Decoder s (IndividualPoolStake c)
decCBOR =
    Text
-> (IndividualPoolStake c -> Int)
-> Decoder s (IndividualPoolStake c)
-> Decoder s (IndividualPoolStake c)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"IndividualPoolStake" (Int -> IndividualPoolStake c -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (IndividualPoolStake c)
 -> Decoder s (IndividualPoolStake c))
-> Decoder s (IndividualPoolStake c)
-> Decoder s (IndividualPoolStake c)
forall a b. (a -> b) -> a -> b
$
      Rational -> Hash HASH (VerKeyVRF (VRF c)) -> IndividualPoolStake c
forall c.
Rational -> Hash HASH (VerKeyVRF (VRF c)) -> IndividualPoolStake c
IndividualPoolStake
        (Rational
 -> Hash HASH (VerKeyVRF (VRF c)) -> IndividualPoolStake c)
-> Decoder s Rational
-> Decoder
     s (Hash HASH (VerKeyVRF (VRF c)) -> IndividualPoolStake c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Rational
forall s. Decoder s Rational
forall a s. DecCBOR a => Decoder s a
decCBOR
        Decoder s (Hash HASH (VerKeyVRF (VRF c)) -> IndividualPoolStake c)
-> Decoder s (Hash HASH (VerKeyVRF (VRF c)))
-> Decoder s (IndividualPoolStake c)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Hash HASH (VerKeyVRF (VRF c)))
forall s. Decoder s (Hash HASH (VerKeyVRF (VRF c)))
forall a s. DecCBOR a => Decoder s a
decCBOR

-- | Copy of 'SL.PoolDistr' before
-- <https://github.com/IntersectMBO/cardano-ledger/pull/4324>.
newtype PoolDistr c = PoolDistr
  { forall c.
PoolDistr c -> Map (KeyHash 'StakePool) (IndividualPoolStake c)
unPoolDistr :: Map (SL.KeyHash SL.StakePool) (IndividualPoolStake c)
  }
  deriving stock (Int -> PoolDistr c -> ShowS
[PoolDistr c] -> ShowS
PoolDistr c -> String
(Int -> PoolDistr c -> ShowS)
-> (PoolDistr c -> String)
-> ([PoolDistr c] -> ShowS)
-> Show (PoolDistr c)
forall c. Int -> PoolDistr c -> ShowS
forall c. [PoolDistr c] -> ShowS
forall c. PoolDistr c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Int -> PoolDistr c -> ShowS
showsPrec :: Int -> PoolDistr c -> ShowS
$cshow :: forall c. PoolDistr c -> String
show :: PoolDistr c -> String
$cshowList :: forall c. [PoolDistr c] -> ShowS
showList :: [PoolDistr c] -> ShowS
Show, PoolDistr c -> PoolDistr c -> Bool
(PoolDistr c -> PoolDistr c -> Bool)
-> (PoolDistr c -> PoolDistr c -> Bool) -> Eq (PoolDistr c)
forall c. PoolDistr c -> PoolDistr c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. PoolDistr c -> PoolDistr c -> Bool
== :: PoolDistr c -> PoolDistr c -> Bool
$c/= :: forall c. PoolDistr c -> PoolDistr c -> Bool
/= :: PoolDistr c -> PoolDistr c -> Bool
Eq, (forall x. PoolDistr c -> Rep (PoolDistr c) x)
-> (forall x. Rep (PoolDistr c) x -> PoolDistr c)
-> Generic (PoolDistr c)
forall x. Rep (PoolDistr c) x -> PoolDistr c
forall x. PoolDistr c -> Rep (PoolDistr c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (PoolDistr c) x -> PoolDistr c
forall c x. PoolDistr c -> Rep (PoolDistr c) x
$cfrom :: forall c x. PoolDistr c -> Rep (PoolDistr c) x
from :: forall x. PoolDistr c -> Rep (PoolDistr c) x
$cto :: forall c x. Rep (PoolDistr c) x -> PoolDistr c
to :: forall x. Rep (PoolDistr c) x -> PoolDistr c
Generic)
  deriving newtype (Typeable (PoolDistr c)
Typeable (PoolDistr c) =>
(PoolDistr c -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (PoolDistr c) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [PoolDistr c] -> Size)
-> EncCBOR (PoolDistr c)
PoolDistr c -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr c] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr c) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall c. Crypto c => Typeable (PoolDistr c)
forall c. Crypto c => PoolDistr c -> Encoding
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr c] -> Size
forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr c) -> Size
$cencCBOR :: forall c. Crypto c => PoolDistr c -> Encoding
encCBOR :: PoolDistr c -> Encoding
$cencodedSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr c) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (PoolDistr c) -> Size
$cencodedListSizeExpr :: forall c.
Crypto c =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr c] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [PoolDistr c] -> Size
EncCBOR, Typeable (PoolDistr c)
Typeable (PoolDistr c) =>
(forall s. Decoder s (PoolDistr c))
-> (forall s. Proxy (PoolDistr c) -> Decoder s ())
-> (Proxy (PoolDistr c) -> Text)
-> DecCBOR (PoolDistr c)
Proxy (PoolDistr c) -> Text
forall s. Decoder s (PoolDistr c)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (PoolDistr c) -> Decoder s ()
forall c. Crypto c => Typeable (PoolDistr c)
forall c. Crypto c => Proxy (PoolDistr c) -> Text
forall c s. Crypto c => Decoder s (PoolDistr c)
forall c s. Crypto c => Proxy (PoolDistr c) -> Decoder s ()
$cdecCBOR :: forall c s. Crypto c => Decoder s (PoolDistr c)
decCBOR :: forall s. Decoder s (PoolDistr c)
$cdropCBOR :: forall c s. Crypto c => Proxy (PoolDistr c) -> Decoder s ()
dropCBOR :: forall s. Proxy (PoolDistr c) -> Decoder s ()
$clabel :: forall c. Crypto c => Proxy (PoolDistr c) -> Text
label :: Proxy (PoolDistr c) -> Text
DecCBOR)

fromLedgerPoolDistr :: SL.PoolDistr -> PoolDistr c
fromLedgerPoolDistr :: forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr PoolDistr
pd =
  PoolDistr
    { unPoolDistr :: Map (KeyHash 'StakePool) (IndividualPoolStake c)
unPoolDistr = (IndividualPoolStake -> IndividualPoolStake c)
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) (IndividualPoolStake c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake -> IndividualPoolStake c
forall c. IndividualPoolStake -> IndividualPoolStake c
fromLedgerIndividualPoolStake (Map (KeyHash 'StakePool) IndividualPoolStake
 -> Map (KeyHash 'StakePool) (IndividualPoolStake c))
-> Map (KeyHash 'StakePool) IndividualPoolStake
-> Map (KeyHash 'StakePool) (IndividualPoolStake c)
forall a b. (a -> b) -> a -> b
$ PoolDistr -> Map (KeyHash 'StakePool) IndividualPoolStake
SL.unPoolDistr PoolDistr
pd
    }