{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# 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.BaseTypes (KeyValuePairs (..), ToKeyValuePairs (..))
import Cardano.Ledger.Binary (
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  TokenType (..),
  peekTokenType,
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.State.Account ()
import Cardano.Ledger.Conway.TxOut ()
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Shelley.State
import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON (..), (.=))
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, ConwayInstantStake era -> Encoding
(ConwayInstantStake era -> Encoding)
-> EncCBOR (ConwayInstantStake era)
forall era. ConwayInstantStake era -> Encoding
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: forall era. ConwayInstantStake era -> Encoding
encCBOR :: ConwayInstantStake era -> Encoding
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)
  deriving ([ConwayInstantStake era] -> Value
[ConwayInstantStake era] -> Encoding
ConwayInstantStake era -> Bool
ConwayInstantStake era -> Value
ConwayInstantStake era -> Encoding
(ConwayInstantStake era -> Value)
-> (ConwayInstantStake era -> Encoding)
-> ([ConwayInstantStake era] -> Value)
-> ([ConwayInstantStake era] -> Encoding)
-> (ConwayInstantStake era -> Bool)
-> ToJSON (ConwayInstantStake era)
forall era. [ConwayInstantStake era] -> Value
forall era. [ConwayInstantStake era] -> Encoding
forall era. ConwayInstantStake era -> Bool
forall era. ConwayInstantStake era -> Value
forall era. ConwayInstantStake era -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall era. ConwayInstantStake era -> Value
toJSON :: ConwayInstantStake era -> Value
$ctoEncoding :: forall era. ConwayInstantStake era -> Encoding
toEncoding :: ConwayInstantStake era -> Encoding
$ctoJSONList :: forall era. [ConwayInstantStake era] -> Value
toJSONList :: [ConwayInstantStake era] -> Value
$ctoEncodingList :: forall era. [ConwayInstantStake era] -> Encoding
toEncodingList :: [ConwayInstantStake era] -> Encoding
$comitField :: forall era. ConwayInstantStake era -> Bool
omitField :: ConwayInstantStake era -> Bool
ToJSON) via KeyValuePairs (ConwayInstantStake era)

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 ToKeyValuePairs (ConwayInstantStake era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => ConwayInstantStake era -> [kv]
toKeyValuePairs 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) -> kv
forall v. ToJSON v => Key -> v -> kv
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 -> Accounts ConwayEra -> Stake
resolveInstantStake = InstantStake ConwayEra -> Accounts ConwayEra -> Stake
ConwayInstantStake ConwayEra -> Accounts ConwayEra -> Stake
forall era.
(EraStake era, InstantStake era ~ ConwayInstantStake era) =>
ConwayInstantStake era -> Accounts era -> 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)
-> Lens
     (ConwayInstantStake era)
     (ConwayInstantStake era)
     (Map (Credential Staking) (CompactForm Coin))
     (Map (Credential Staking) (CompactForm Coin))
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)
 -> Lens
      (ConwayInstantStake era)
      (ConwayInstantStake era)
      (Map (Credential Staking) (CompactForm Coin))
      (Map (Credential Staking) (CompactForm Coin)))
-> (ConwayInstantStake era
    -> Map (Credential Staking) (CompactForm Coin)
    -> ConwayInstantStake era)
-> Lens
     (ConwayInstantStake era)
     (ConwayInstantStake era)
     (Map (Credential Staking) (CompactForm Coin))
     (Map (Credential Staking) (CompactForm Coin))
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
_ Credential Payment
_ (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 ->
  Accounts era ->
  Stake
resolveConwayInstantStake :: forall era.
(EraStake era, InstantStake era ~ ConwayInstantStake era) =>
ConwayInstantStake era -> Accounts era -> Stake
resolveConwayInstantStake ConwayInstantStake era
instantStake Accounts era
accounts =
  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
-> Accounts era -> Map (Credential Staking) (CompactForm Coin)
forall era.
EraStake era =>
InstantStake era
-> Accounts era -> Map (Credential Staking) (CompactForm Coin)
resolveActiveInstantStakeCredentials InstantStake era
ConwayInstantStake era
instantStake Accounts era
accounts
{-# INLINE resolveConwayInstantStake #-}