{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.State.Stake (
  ConwayInstantStake (..),
  conwayInstantStakeCredentialsL,
  addConwayInstantStake,
  deleteConwayInstantStake,
  resolveConwayInstantStake,
) where

import Cardano.Ledger.Address
import Cardano.Ledger.Binary (
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  TokenType (..),
  peekTokenType,
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.TxOut ()
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Shelley.State
import qualified Cardano.Ledger.UMap as UM
import Control.DeepSeq (NFData)
import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
import Data.Coerce
import Data.Default (Default (..))
import qualified Data.Map.Strict as Map
import qualified Data.VMap as VMap
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

newtype ConwayInstantStake era = ConwayInstantStake
  { forall era.
ConwayInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake :: Map.Map (Credential 'Staking) (CompactForm Coin)
  }
  deriving ((forall x.
 ConwayInstantStake era -> Rep (ConwayInstantStake era) x)
-> (forall x.
    Rep (ConwayInstantStake era) x -> ConwayInstantStake era)
-> Generic (ConwayInstantStake era)
forall x. Rep (ConwayInstantStake era) x -> ConwayInstantStake era
forall x. ConwayInstantStake era -> Rep (ConwayInstantStake era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayInstantStake era) x -> ConwayInstantStake era
forall era x.
ConwayInstantStake era -> Rep (ConwayInstantStake era) x
$cfrom :: forall era x.
ConwayInstantStake era -> Rep (ConwayInstantStake era) x
from :: forall x. ConwayInstantStake era -> Rep (ConwayInstantStake era) x
$cto :: forall era x.
Rep (ConwayInstantStake era) x -> ConwayInstantStake era
to :: forall x. Rep (ConwayInstantStake era) x -> ConwayInstantStake era
Generic, Int -> ConwayInstantStake era -> ShowS
[ConwayInstantStake era] -> ShowS
ConwayInstantStake era -> String
(Int -> ConwayInstantStake era -> ShowS)
-> (ConwayInstantStake era -> String)
-> ([ConwayInstantStake era] -> ShowS)
-> Show (ConwayInstantStake era)
forall era. Int -> ConwayInstantStake era -> ShowS
forall era. [ConwayInstantStake era] -> ShowS
forall era. ConwayInstantStake era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayInstantStake era -> ShowS
showsPrec :: Int -> ConwayInstantStake era -> ShowS
$cshow :: forall era. ConwayInstantStake era -> String
show :: ConwayInstantStake era -> String
$cshowList :: forall era. [ConwayInstantStake era] -> ShowS
showList :: [ConwayInstantStake era] -> ShowS
Show, ConwayInstantStake era -> ConwayInstantStake era -> Bool
(ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> (ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> Eq (ConwayInstantStake era)
forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
== :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
$c/= :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
/= :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
Eq, Eq (ConwayInstantStake era)
Eq (ConwayInstantStake era) =>
(ConwayInstantStake era -> ConwayInstantStake era -> Ordering)
-> (ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> (ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> (ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> (ConwayInstantStake era -> ConwayInstantStake era -> Bool)
-> (ConwayInstantStake era
    -> ConwayInstantStake era -> ConwayInstantStake era)
-> (ConwayInstantStake era
    -> ConwayInstantStake era -> ConwayInstantStake era)
-> Ord (ConwayInstantStake era)
ConwayInstantStake era -> ConwayInstantStake era -> Bool
ConwayInstantStake era -> ConwayInstantStake era -> Ordering
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
forall era. Eq (ConwayInstantStake era)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Ordering
forall era.
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
$ccompare :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Ordering
compare :: ConwayInstantStake era -> ConwayInstantStake era -> Ordering
$c< :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
< :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
$c<= :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
<= :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
$c> :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
> :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
$c>= :: forall era.
ConwayInstantStake era -> ConwayInstantStake era -> Bool
>= :: ConwayInstantStake era -> ConwayInstantStake era -> Bool
$cmax :: forall era.
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
max :: ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
$cmin :: forall era.
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
min :: ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
Ord, Typeable (ConwayInstantStake era)
Typeable (ConwayInstantStake era) =>
(ConwayInstantStake era -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (ConwayInstantStake era) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [ConwayInstantStake era] -> Size)
-> EncCBOR (ConwayInstantStake era)
ConwayInstantStake era -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayInstantStake era] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayInstantStake era) -> Size
forall era. Typeable era => Typeable (ConwayInstantStake era)
forall era. Typeable era => ConwayInstantStake era -> Encoding
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 era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayInstantStake era] -> Size
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayInstantStake era) -> Size
$cencCBOR :: forall era. Typeable era => ConwayInstantStake era -> Encoding
encCBOR :: ConwayInstantStake era -> Encoding
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayInstantStake era) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayInstantStake era) -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayInstantStake era] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayInstantStake era] -> Size
EncCBOR, ConwayInstantStake era -> ()
(ConwayInstantStake era -> ()) -> NFData (ConwayInstantStake era)
forall era. ConwayInstantStake era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. ConwayInstantStake era -> ()
rnf :: ConwayInstantStake era -> ()
NFData, Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
Proxy (ConwayInstantStake era) -> String
(Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo))
-> (Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo))
-> (Proxy (ConwayInstantStake era) -> String)
-> NoThunks (ConwayInstantStake era)
forall era.
Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
forall era. Proxy (ConwayInstantStake era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall era.
Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era.
Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ConwayInstantStake era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (ConwayInstantStake era) -> String
showTypeOf :: Proxy (ConwayInstantStake era) -> String
NoThunks, ConwayInstantStake era
ConwayInstantStake era -> Default (ConwayInstantStake era)
forall era. ConwayInstantStake era
forall a. a -> Default a
$cdef :: forall era. ConwayInstantStake era
def :: ConwayInstantStake era
Default, Semigroup (ConwayInstantStake era)
ConwayInstantStake era
Semigroup (ConwayInstantStake era) =>
ConwayInstantStake era
-> (ConwayInstantStake era
    -> ConwayInstantStake era -> ConwayInstantStake era)
-> ([ConwayInstantStake era] -> ConwayInstantStake era)
-> Monoid (ConwayInstantStake era)
[ConwayInstantStake era] -> ConwayInstantStake era
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
forall era. Semigroup (ConwayInstantStake era)
forall era. ConwayInstantStake era
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall era. [ConwayInstantStake era] -> ConwayInstantStake era
forall era.
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
$cmempty :: forall era. ConwayInstantStake era
mempty :: ConwayInstantStake era
$cmappend :: forall era.
ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
mappend :: ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
$cmconcat :: forall era. [ConwayInstantStake era] -> ConwayInstantStake era
mconcat :: [ConwayInstantStake era] -> ConwayInstantStake era
Monoid)

instance DecShareCBOR (ConwayInstantStake era) where
  type Share (ConwayInstantStake era) = Interns (Credential 'Staking)
  decShareCBOR :: forall s.
Share (ConwayInstantStake era)
-> Decoder s (ConwayInstantStake era)
decShareCBOR Share (ConwayInstantStake era)
credInterns = do
    Decoder s TokenType
forall s. Decoder s TokenType
peekTokenType Decoder s TokenType
-> (TokenType -> Decoder s (ConwayInstantStake era))
-> Decoder s (ConwayInstantStake era)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      TokenType
TypeListLen -> ShelleyInstantStake era -> ConwayInstantStake era
forall era. ShelleyInstantStake era -> ConwayInstantStake era
toConwayInstantStake (ShelleyInstantStake era -> ConwayInstantStake era)
-> Decoder s (ShelleyInstantStake era)
-> Decoder s (ConwayInstantStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
decShareCBOR Share (ShelleyInstantStake era)
Share (ConwayInstantStake era)
credInterns
      TokenType
TypeListLen64 -> ShelleyInstantStake era -> ConwayInstantStake era
forall era. ShelleyInstantStake era -> ConwayInstantStake era
toConwayInstantStake (ShelleyInstantStake era -> ConwayInstantStake era)
-> Decoder s (ShelleyInstantStake era)
-> Decoder s (ConwayInstantStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
decShareCBOR Share (ShelleyInstantStake era)
Share (ConwayInstantStake era)
credInterns
      TokenType
TypeListLenIndef -> ShelleyInstantStake era -> ConwayInstantStake era
forall era. ShelleyInstantStake era -> ConwayInstantStake era
toConwayInstantStake (ShelleyInstantStake era -> ConwayInstantStake era)
-> Decoder s (ShelleyInstantStake era)
-> Decoder s (ConwayInstantStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
decShareCBOR Share (ShelleyInstantStake era)
Share (ConwayInstantStake era)
credInterns
      TokenType
_ -> Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
ConwayInstantStake (Map (Credential 'Staking) (CompactForm Coin)
 -> ConwayInstantStake era)
-> Decoder s (Map (Credential 'Staking) (CompactForm Coin))
-> Decoder s (ConwayInstantStake era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Share (Map (Credential 'Staking) (CompactForm Coin))
-> Decoder s (Map (Credential 'Staking) (CompactForm Coin))
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (Map (Credential 'Staking) (CompactForm Coin))
-> Decoder s (Map (Credential 'Staking) (CompactForm Coin))
decShareCBOR (Share (ConwayInstantStake era)
Interns (Credential 'Staking)
credInterns, Interns (CompactForm Coin)
forall a. Monoid a => a
mempty)
    where
      toConwayInstantStake :: ShelleyInstantStake era -> ConwayInstantStake era
      toConwayInstantStake :: forall era. ShelleyInstantStake era -> ConwayInstantStake era
toConwayInstantStake = Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
ConwayInstantStake (Map (Credential 'Staking) (CompactForm Coin)
 -> ConwayInstantStake era)
-> (ShelleyInstantStake era
    -> Map (Credential 'Staking) (CompactForm Coin))
-> ShelleyInstantStake era
-> ConwayInstantStake era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
forall era.
ShelleyInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake

instance Semigroup (ConwayInstantStake era) where
  ConwayInstantStake Map (Credential 'Staking) (CompactForm Coin)
cs1 <> :: ConwayInstantStake era
-> ConwayInstantStake era -> ConwayInstantStake era
<> ConwayInstantStake Map (Credential 'Staking) (CompactForm Coin)
cs2 =
    Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> ConwayInstantStake era
ConwayInstantStake ((CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
(<>) Map (Credential 'Staking) (CompactForm Coin)
cs1 Map (Credential 'Staking) (CompactForm Coin)
cs2)

instance ToJSON (ConwayInstantStake era) where
  toJSON :: ConwayInstantStake era -> Value
toJSON = [Pair] -> Value
object ([Pair] -> Value)
-> (ConwayInstantStake era -> [Pair])
-> ConwayInstantStake era
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayInstantStake era -> [Pair]
forall e a era. KeyValue e a => ConwayInstantStake era -> [a]
toIncrementalStakePairs
  toEncoding :: ConwayInstantStake era -> Encoding
toEncoding = Series -> Encoding
pairs (Series -> Encoding)
-> (ConwayInstantStake era -> Series)
-> ConwayInstantStake era
-> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series)
-> (ConwayInstantStake era -> [Series])
-> ConwayInstantStake era
-> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayInstantStake era -> [Series]
forall e a era. KeyValue e a => ConwayInstantStake era -> [a]
toIncrementalStakePairs

toIncrementalStakePairs :: KeyValue e a => ConwayInstantStake era -> [a]
toIncrementalStakePairs :: forall e a era. KeyValue e a => ConwayInstantStake era -> [a]
toIncrementalStakePairs iStake :: ConwayInstantStake era
iStake@(ConwayInstantStake Map (Credential 'Staking) (CompactForm Coin)
_) =
  let ConwayInstantStake {Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake :: forall era.
ConwayInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
..} = ConwayInstantStake era
iStake -- guard against addition or removal of fields
   in [ Key
"credentials" Key -> Map (Credential 'Staking) (CompactForm Coin) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake
      ]

instance EraStake ConwayEra where
  type InstantStake ConwayEra = ConwayInstantStake ConwayEra
  instantStakeCredentialsL :: Lens'
  (InstantStake ConwayEra)
  (Map (Credential 'Staking) (CompactForm Coin))
instantStakeCredentialsL = (Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> InstantStake ConwayEra -> f (InstantStake ConwayEra)
(Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> ConwayInstantStake ConwayEra -> f (ConwayInstantStake ConwayEra)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> ConwayInstantStake era -> f (ConwayInstantStake era)
conwayInstantStakeCredentialsL
  addInstantStake :: UTxO ConwayEra -> InstantStake ConwayEra -> InstantStake ConwayEra
addInstantStake = UTxO ConwayEra -> InstantStake ConwayEra -> InstantStake ConwayEra
UTxO ConwayEra
-> ConwayInstantStake ConwayEra -> ConwayInstantStake ConwayEra
forall era.
EraTxOut era =>
UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
addConwayInstantStake
  deleteInstantStake :: UTxO ConwayEra -> InstantStake ConwayEra -> InstantStake ConwayEra
deleteInstantStake = UTxO ConwayEra -> InstantStake ConwayEra -> InstantStake ConwayEra
UTxO ConwayEra
-> ConwayInstantStake ConwayEra -> ConwayInstantStake ConwayEra
forall era.
EraTxOut era =>
UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
deleteConwayInstantStake
  resolveInstantStake :: InstantStake ConwayEra -> UMap -> Stake
resolveInstantStake = InstantStake ConwayEra -> UMap -> Stake
ConwayInstantStake ConwayEra -> UMap -> Stake
forall era.
(EraStake era, InstantStake era ~ ConwayInstantStake era) =>
ConwayInstantStake era -> UMap -> Stake
resolveConwayInstantStake

conwayInstantStakeCredentialsL ::
  Lens' (ConwayInstantStake era) (Map.Map (Credential 'Staking) (CompactForm Coin))
conwayInstantStakeCredentialsL :: forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> ConwayInstantStake era -> f (ConwayInstantStake era)
conwayInstantStakeCredentialsL = (ConwayInstantStake era
 -> Map (Credential 'Staking) (CompactForm Coin))
-> (ConwayInstantStake era
    -> Map (Credential 'Staking) (CompactForm Coin)
    -> ConwayInstantStake era)
-> forall {f :: * -> *}.
   Functor f =>
   (Map (Credential 'Staking) (CompactForm Coin)
    -> f (Map (Credential 'Staking) (CompactForm Coin)))
   -> ConwayInstantStake era -> f (ConwayInstantStake era)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ConwayInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
forall era.
ConwayInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake ((ConwayInstantStake era
  -> Map (Credential 'Staking) (CompactForm Coin)
  -> ConwayInstantStake era)
 -> forall {f :: * -> *}.
    Functor f =>
    (Map (Credential 'Staking) (CompactForm Coin)
     -> f (Map (Credential 'Staking) (CompactForm Coin)))
    -> ConwayInstantStake era -> f (ConwayInstantStake era))
-> (ConwayInstantStake era
    -> Map (Credential 'Staking) (CompactForm Coin)
    -> ConwayInstantStake era)
-> forall {f :: * -> *}.
   Functor f =>
   (Map (Credential 'Staking) (CompactForm Coin)
    -> f (Map (Credential 'Staking) (CompactForm Coin)))
   -> ConwayInstantStake era -> f (ConwayInstantStake era)
forall a b. (a -> b) -> a -> b
$ \ConwayInstantStake era
is Map (Credential 'Staking) (CompactForm Coin)
m -> ConwayInstantStake era
is {cisCredentialStake = m}

addConwayInstantStake ::
  EraTxOut era => UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
addConwayInstantStake :: forall era.
EraTxOut era =>
UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
addConwayInstantStake = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
applyUTxOConwayInstantStake ((Word64 -> Word64 -> Word64)
-> CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a b. Coercible a b => a -> b
coerce (forall a. Num a => a -> a -> a
(+) @Word64))

deleteConwayInstantStake ::
  EraTxOut era => UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
deleteConwayInstantStake :: forall era.
EraTxOut era =>
UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
deleteConwayInstantStake = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
applyUTxOConwayInstantStake ((Word64 -> Word64 -> Word64)
-> CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a b. Coercible a b => a -> b
coerce ((-) @Word64))

applyUTxOConwayInstantStake ::
  EraTxOut era =>
  (CompactForm Coin -> CompactForm Coin -> CompactForm Coin) ->
  UTxO era ->
  ConwayInstantStake era ->
  ConwayInstantStake era
applyUTxOConwayInstantStake :: forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ConwayInstantStake era -> ConwayInstantStake era
applyUTxOConwayInstantStake CompactForm Coin -> CompactForm Coin -> CompactForm Coin
f (UTxO Map TxIn (TxOut era)
u) ConwayInstantStake era
instantInstantStake =
  (ConwayInstantStake era -> TxOut era -> ConwayInstantStake era)
-> ConwayInstantStake era
-> Map TxIn (TxOut era)
-> ConwayInstantStake era
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' ConwayInstantStake era -> TxOut era -> ConwayInstantStake era
accum ConwayInstantStake era
instantInstantStake Map TxIn (TxOut era)
u
  where
    keepOrDeleteCompact :: CompactForm Coin
-> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
keepOrDeleteCompact CompactForm Coin
new = \case
      Maybe (CompactForm Coin)
Nothing ->
        case CompactForm Coin
new of
          CompactCoin Word64
0 -> Maybe (CompactForm Coin)
forall a. Maybe a
Nothing
          CompactForm Coin
final -> CompactForm Coin -> Maybe (CompactForm Coin)
forall a. a -> Maybe a
Just CompactForm Coin
final
      Just CompactForm Coin
old ->
        case CompactForm Coin
old CompactForm Coin -> CompactForm Coin -> CompactForm Coin
`f` CompactForm Coin
new of
          CompactCoin Word64
0 -> Maybe (CompactForm Coin)
forall a. Maybe a
Nothing
          CompactForm Coin
final -> CompactForm Coin -> Maybe (CompactForm Coin)
forall a. a -> Maybe a
Just CompactForm Coin
final
    accum :: ConwayInstantStake era -> TxOut era -> ConwayInstantStake era
accum ans :: ConwayInstantStake era
ans@(ConwayInstantStake {Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake :: forall era.
ConwayInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake}) TxOut era
out =
      let cc :: CompactForm Coin
cc = TxOut era
out TxOut era
-> Getting (CompactForm Coin) (TxOut era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (TxOut era) (CompactForm Coin)
forall era.
(HasCallStack, EraTxOut era) =>
Lens' (TxOut era) (CompactForm Coin)
Lens' (TxOut era) (CompactForm Coin)
compactCoinTxOutL
       in case TxOut era
out TxOut era -> Getting Addr (TxOut era) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL of
            Addr Network
_ PaymentCredential
_ (StakeRefBase Credential 'Staking
stakingKeyHash) ->
              ConwayInstantStake
                { cisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake = (Maybe (CompactForm Coin) -> Maybe (CompactForm Coin))
-> Credential 'Staking
-> Map (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (CompactForm Coin
-> Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
keepOrDeleteCompact CompactForm Coin
cc) Credential 'Staking
stakingKeyHash Map (Credential 'Staking) (CompactForm Coin)
cisCredentialStake
                }
            Addr
_other -> ConwayInstantStake era
ans

-- The invariant in `InstantStake` is that stake is never zero.
resolveConwayInstantStake ::
  (EraStake era, InstantStake era ~ ConwayInstantStake era) =>
  ConwayInstantStake era -> UM.UMap -> Stake
resolveConwayInstantStake :: forall era.
(EraStake era, InstantStake era ~ ConwayInstantStake era) =>
ConwayInstantStake era -> UMap -> Stake
resolveConwayInstantStake ConwayInstantStake era
instantStake UMap
umap =
  VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
Stake (VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake)
-> VMap VB VP (Credential 'Staking) (CompactForm Coin) -> Stake
forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking) (CompactForm Coin)
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (Map (Credential 'Staking) (CompactForm Coin)
 -> VMap VB VP (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
-> VMap VB VP (Credential 'Staking) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ InstantStake era
-> UMap -> Map (Credential 'Staking) (CompactForm Coin)
forall era.
EraStake era =>
InstantStake era
-> UMap -> Map (Credential 'Staking) (CompactForm Coin)
resolveActiveInstantStakeCredentials InstantStake era
ConwayInstantStake era
instantStake UMap
umap
{-# INLINE resolveConwayInstantStake #-}