{-# 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           Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..),
                     decodeRecordNamed, encodeListLen)
import           Cardano.Ledger.Crypto (Crypto)
import           Cardano.Ledger.Keys (Hash)
import qualified Cardano.Ledger.PoolDistr as SL
import qualified Cardano.Ledger.Shelley.API as SL
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 c (VerKeyVRF c)
individualPoolStakeVrf :: !(Hash c (SL.VerKeyVRF 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 c -> IndividualPoolStake c
fromLedgerIndividualPoolStake :: forall c. IndividualPoolStake c -> IndividualPoolStake c
fromLedgerIndividualPoolStake IndividualPoolStake c
ips = IndividualPoolStake {
      individualPoolStake :: Rational
individualPoolStake    = IndividualPoolStake c -> Rational
forall c. IndividualPoolStake c -> Rational
SL.individualPoolStake IndividualPoolStake c
ips
    , individualPoolStakeVrf :: Hash c (VerKeyVRF c)
individualPoolStakeVrf = IndividualPoolStake c -> Hash c (VerKeyVRF c)
forall c. IndividualPoolStake c -> Hash c (VerKeyVRF c)
SL.individualPoolStakeVrf IndividualPoolStake c
ips
    }

instance Crypto c => EncCBOR (IndividualPoolStake c) where
  encCBOR :: IndividualPoolStake c -> Encoding
encCBOR (IndividualPoolStake Rational
stake Hash (HASH c) (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 c) (VerKeyVRF (VRF c)) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Hash (HASH c) (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 c) (VerKeyVRF (VRF c)) -> IndividualPoolStake c
forall c. Rational -> Hash c (VerKeyVRF c) -> IndividualPoolStake c
IndividualPoolStake
        (Rational
 -> Hash (HASH c) (VerKeyVRF (VRF c)) -> IndividualPoolStake c)
-> Decoder s Rational
-> Decoder
     s (Hash (HASH c) (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 c) (VerKeyVRF (VRF c)) -> IndividualPoolStake c)
-> Decoder s (Hash (HASH c) (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 c) (VerKeyVRF (VRF c)))
forall s. Decoder s (Hash (HASH c) (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 c) (IndividualPoolStake c)
unPoolDistr :: Map (SL.KeyHash SL.StakePool c) (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 c -> PoolDistr c
fromLedgerPoolDistr :: forall c. PoolDistr c -> PoolDistr c
fromLedgerPoolDistr PoolDistr c
pd = PoolDistr {
      unPoolDistr :: Map (KeyHash 'StakePool c) (IndividualPoolStake c)
unPoolDistr = (IndividualPoolStake c -> IndividualPoolStake c)
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map IndividualPoolStake c -> IndividualPoolStake c
forall c. IndividualPoolStake c -> IndividualPoolStake c
fromLedgerIndividualPoolStake (Map (KeyHash 'StakePool c) (IndividualPoolStake c)
 -> Map (KeyHash 'StakePool c) (IndividualPoolStake c))
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall a b. (a -> b) -> a -> b
$ PoolDistr c -> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall c.
PoolDistr c -> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
SL.unPoolDistr PoolDistr c
pd
    }