{-# 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
    }