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

module Cardano.Ledger.Shelley.State.Stake (
  ShelleyInstantStake (..),
  shelleyInstantStakeCredentialsL,
  addShelleyInstantStake,
  deleteShelleyInstantStake,
  resolveShelleyInstantStake,
) where

import Cardano.Ledger.Address
import Cardano.Ledger.Binary (
  DecShareCBOR (..),
  EncCBOR (..),
  Interns,
  decCBOR,
  decodeRecordNamed,
  encodeListLen,
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Credential
import Cardano.Ledger.Shelley.Era
import Cardano.Ledger.Shelley.TxOut ()
import Cardano.Ledger.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 Data.Maybe (fromMaybe)
import Data.Typeable
import qualified Data.VMap as VMap
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data ShelleyInstantStake era = ShelleyInstantStake
  { forall era.
ShelleyInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake :: !(Map.Map (Credential 'Staking) (CompactForm Coin))
  , forall era. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
sisPtrStake :: !(Map.Map Ptr (CompactForm Coin))
  }
  deriving ((forall x.
 ShelleyInstantStake era -> Rep (ShelleyInstantStake era) x)
-> (forall x.
    Rep (ShelleyInstantStake era) x -> ShelleyInstantStake era)
-> Generic (ShelleyInstantStake era)
forall x.
Rep (ShelleyInstantStake era) x -> ShelleyInstantStake era
forall x.
ShelleyInstantStake era -> Rep (ShelleyInstantStake era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyInstantStake era) x -> ShelleyInstantStake era
forall era x.
ShelleyInstantStake era -> Rep (ShelleyInstantStake era) x
$cfrom :: forall era x.
ShelleyInstantStake era -> Rep (ShelleyInstantStake era) x
from :: forall x.
ShelleyInstantStake era -> Rep (ShelleyInstantStake era) x
$cto :: forall era x.
Rep (ShelleyInstantStake era) x -> ShelleyInstantStake era
to :: forall x.
Rep (ShelleyInstantStake era) x -> ShelleyInstantStake era
Generic, Int -> ShelleyInstantStake era -> ShowS
[ShelleyInstantStake era] -> ShowS
ShelleyInstantStake era -> String
(Int -> ShelleyInstantStake era -> ShowS)
-> (ShelleyInstantStake era -> String)
-> ([ShelleyInstantStake era] -> ShowS)
-> Show (ShelleyInstantStake era)
forall era. Int -> ShelleyInstantStake era -> ShowS
forall era. [ShelleyInstantStake era] -> ShowS
forall era. ShelleyInstantStake era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyInstantStake era -> ShowS
showsPrec :: Int -> ShelleyInstantStake era -> ShowS
$cshow :: forall era. ShelleyInstantStake era -> String
show :: ShelleyInstantStake era -> String
$cshowList :: forall era. [ShelleyInstantStake era] -> ShowS
showList :: [ShelleyInstantStake era] -> ShowS
Show, ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
(ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> (ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> Eq (ShelleyInstantStake era)
forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
== :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
$c/= :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
/= :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
Eq, Eq (ShelleyInstantStake era)
Eq (ShelleyInstantStake era) =>
(ShelleyInstantStake era -> ShelleyInstantStake era -> Ordering)
-> (ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> (ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> (ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> (ShelleyInstantStake era -> ShelleyInstantStake era -> Bool)
-> (ShelleyInstantStake era
    -> ShelleyInstantStake era -> ShelleyInstantStake era)
-> (ShelleyInstantStake era
    -> ShelleyInstantStake era -> ShelleyInstantStake era)
-> Ord (ShelleyInstantStake era)
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
ShelleyInstantStake era -> ShelleyInstantStake era -> Ordering
ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
forall era. Eq (ShelleyInstantStake 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.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Ordering
forall era.
ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
$ccompare :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Ordering
compare :: ShelleyInstantStake era -> ShelleyInstantStake era -> Ordering
$c< :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
< :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
$c<= :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
<= :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
$c> :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
> :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
$c>= :: forall era.
ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
>= :: ShelleyInstantStake era -> ShelleyInstantStake era -> Bool
$cmax :: forall era.
ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
max :: ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
$cmin :: forall era.
ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
min :: ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
Ord)

instance NFData (ShelleyInstantStake era)

instance NoThunks (ShelleyInstantStake era)

instance Typeable era => EncCBOR (ShelleyInstantStake era) where
  encCBOR :: ShelleyInstantStake era -> Encoding
encCBOR (ShelleyInstantStake Map (Credential 'Staking) (CompactForm Coin)
credentialStake Map Ptr (CompactForm Coin)
ptrStake) =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking) (CompactForm Coin) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) (CompactForm Coin)
credentialStake Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Ptr (CompactForm Coin) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (CompactForm Coin)
ptrStake

instance DecShareCBOR (ShelleyInstantStake era) where
  type Share (ShelleyInstantStake era) = Interns (Credential 'Staking)
  decShareCBOR :: forall s.
Share (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
decShareCBOR Share (ShelleyInstantStake era)
credInterns =
    Text
-> (ShelleyInstantStake era -> Int)
-> Decoder s (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyInstantStake" (Int -> ShelleyInstantStake era -> Int
forall a b. a -> b -> a
const Int
2) (Decoder s (ShelleyInstantStake era)
 -> Decoder s (ShelleyInstantStake era))
-> Decoder s (ShelleyInstantStake era)
-> Decoder s (ShelleyInstantStake era)
forall a b. (a -> b) -> a -> b
$ do
      Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake <- 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 (ShelleyInstantStake era)
Interns (Credential 'Staking)
credInterns, Interns (CompactForm Coin)
forall a. Monoid a => a
mempty)
      Map Ptr (CompactForm Coin)
sisPtrStake <- Decoder s (Map Ptr (CompactForm Coin))
forall s. Decoder s (Map Ptr (CompactForm Coin))
forall a s. DecCBOR a => Decoder s a
decCBOR
      ShelleyInstantStake era -> Decoder s (ShelleyInstantStake era)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyInstantStake era -> Decoder s (ShelleyInstantStake era))
-> ShelleyInstantStake era -> Decoder s (ShelleyInstantStake era)
forall a b. (a -> b) -> a -> b
$ ShelleyInstantStake {Map Ptr (CompactForm Coin)
Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
sisPtrStake :: Map Ptr (CompactForm Coin)
sisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
sisPtrStake :: Map Ptr (CompactForm Coin)
..}

instance Semigroup (ShelleyInstantStake era) where
  ShelleyInstantStake Map (Credential 'Staking) (CompactForm Coin)
cs1 Map Ptr (CompactForm Coin)
ps1 <> :: ShelleyInstantStake era
-> ShelleyInstantStake era -> ShelleyInstantStake era
<> ShelleyInstantStake Map (Credential 'Staking) (CompactForm Coin)
cs2 Map Ptr (CompactForm Coin)
ps2 =
    Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
ShelleyInstantStake ((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) ((CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> Map Ptr (CompactForm Coin)
-> Map Ptr (CompactForm Coin)
-> Map Ptr (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 Ptr (CompactForm Coin)
ps1 Map Ptr (CompactForm Coin)
ps2)

instance Monoid (ShelleyInstantStake era) where
  mempty :: ShelleyInstantStake era
mempty = Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
forall era.
Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> ShelleyInstantStake era
ShelleyInstantStake Map (Credential 'Staking) (CompactForm Coin)
forall k a. Map k a
Map.empty Map Ptr (CompactForm Coin)
forall k a. Map k a
Map.empty

instance Default (ShelleyInstantStake era) where
  def :: ShelleyInstantStake era
def = ShelleyInstantStake era
forall a. Monoid a => a
mempty

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

toIncrementalStakePairs :: KeyValue e a => ShelleyInstantStake era -> [a]
toIncrementalStakePairs :: forall e a era. KeyValue e a => ShelleyInstantStake era -> [a]
toIncrementalStakePairs iStake :: ShelleyInstantStake era
iStake@(ShelleyInstantStake Map (Credential 'Staking) (CompactForm Coin)
_ Map Ptr (CompactForm Coin)
_) =
  let ShelleyInstantStake {Map Ptr (CompactForm Coin)
Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake :: forall era.
ShelleyInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
sisPtrStake :: forall era. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
sisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
sisPtrStake :: Map Ptr (CompactForm Coin)
..} = ShelleyInstantStake 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)
sisCredentialStake
      , Key
"pointers" Key -> Map Ptr (CompactForm Coin) -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Ptr (CompactForm Coin)
sisPtrStake
      ]

instance EraStake ShelleyEra where
  type InstantStake ShelleyEra = ShelleyInstantStake ShelleyEra
  instantStakeCredentialsL :: Lens'
  (InstantStake ShelleyEra)
  (Map (Credential 'Staking) (CompactForm Coin))
instantStakeCredentialsL = (Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> InstantStake ShelleyEra -> f (InstantStake ShelleyEra)
(Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> ShelleyInstantStake ShelleyEra
-> f (ShelleyInstantStake ShelleyEra)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'Staking) (CompactForm Coin)
 -> f (Map (Credential 'Staking) (CompactForm Coin)))
-> ShelleyInstantStake era -> f (ShelleyInstantStake era)
shelleyInstantStakeCredentialsL
  addInstantStake :: UTxO ShelleyEra
-> InstantStake ShelleyEra -> InstantStake ShelleyEra
addInstantStake = UTxO ShelleyEra
-> InstantStake ShelleyEra -> InstantStake ShelleyEra
UTxO ShelleyEra
-> ShelleyInstantStake ShelleyEra -> ShelleyInstantStake ShelleyEra
forall era.
EraTxOut era =>
UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
addShelleyInstantStake
  deleteInstantStake :: UTxO ShelleyEra
-> InstantStake ShelleyEra -> InstantStake ShelleyEra
deleteInstantStake = UTxO ShelleyEra
-> InstantStake ShelleyEra -> InstantStake ShelleyEra
UTxO ShelleyEra
-> ShelleyInstantStake ShelleyEra -> ShelleyInstantStake ShelleyEra
forall era.
EraTxOut era =>
UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
deleteShelleyInstantStake
  resolveInstantStake :: InstantStake ShelleyEra -> UMap -> Stake
resolveInstantStake = InstantStake ShelleyEra -> UMap -> Stake
ShelleyInstantStake ShelleyEra -> UMap -> Stake
forall era.
(EraStake era, InstantStake era ~ ShelleyInstantStake era) =>
ShelleyInstantStake era -> UMap -> Stake
resolveShelleyInstantStake

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

addShelleyInstantStake ::
  EraTxOut era => UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
addShelleyInstantStake :: forall era.
EraTxOut era =>
UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
addShelleyInstantStake = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
applyUTxOShelleyInstantStake ((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))

deleteShelleyInstantStake ::
  EraTxOut era => UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
deleteShelleyInstantStake :: forall era.
EraTxOut era =>
UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
deleteShelleyInstantStake = (CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
applyUTxOShelleyInstantStake ((Word64 -> Word64 -> Word64)
-> CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a b. Coercible a b => a -> b
coerce ((-) @Word64))

applyUTxOShelleyInstantStake ::
  EraTxOut era =>
  (CompactForm Coin -> CompactForm Coin -> CompactForm Coin) ->
  UTxO era ->
  ShelleyInstantStake era ->
  ShelleyInstantStake era
applyUTxOShelleyInstantStake :: forall era.
EraTxOut era =>
(CompactForm Coin -> CompactForm Coin -> CompactForm Coin)
-> UTxO era -> ShelleyInstantStake era -> ShelleyInstantStake era
applyUTxOShelleyInstantStake CompactForm Coin -> CompactForm Coin -> CompactForm Coin
f (UTxO Map TxIn (TxOut era)
u) ShelleyInstantStake era
instantStake =
  (ShelleyInstantStake era -> TxOut era -> ShelleyInstantStake era)
-> ShelleyInstantStake era
-> Map TxIn (TxOut era)
-> ShelleyInstantStake era
forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' ShelleyInstantStake era -> TxOut era -> ShelleyInstantStake era
accum ShelleyInstantStake era
instantStake 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 :: ShelleyInstantStake era -> TxOut era -> ShelleyInstantStake era
accum ans :: ShelleyInstantStake era
ans@(ShelleyInstantStake {Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake :: forall era.
ShelleyInstantStake era
-> Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake :: Map (Credential 'Staking) (CompactForm Coin)
sisCredentialStake, Map Ptr (CompactForm Coin)
sisPtrStake :: forall era. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
sisPtrStake :: Map Ptr (CompactForm Coin)
sisPtrStake}) 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
_ (StakeRefPtr Ptr
stakingPtr) ->
              ShelleyInstantStake era
ans
                { sisPtrStake = Map.alter (keepOrDeleteCompact cc) stakingPtr sisPtrStake
                }
            Addr Network
_ PaymentCredential
_ (StakeRefBase Credential 'Staking
stakingKeyHash) ->
              ShelleyInstantStake era
ans
                { sisCredentialStake = Map.alter (keepOrDeleteCompact cc) stakingKeyHash sisCredentialStake
                }
            Addr
_other -> ShelleyInstantStake era
ans

-- The invariant in `InstantStake` is that stake is never zero.
resolveShelleyInstantStake ::
  (EraStake era, InstantStake era ~ ShelleyInstantStake era) =>
  ShelleyInstantStake era -> UM.UMap -> Stake
resolveShelleyInstantStake :: forall era.
(EraStake era, InstantStake era ~ ShelleyInstantStake era) =>
ShelleyInstantStake era -> UMap -> Stake
resolveShelleyInstantStake instantStake :: ShelleyInstantStake era
instantStake@ShelleyInstantStake {Map Ptr (CompactForm Coin)
sisPtrStake :: forall era. ShelleyInstantStake era -> Map Ptr (CompactForm Coin)
sisPtrStake :: Map Ptr (CompactForm Coin)
sisPtrStake} umap :: UMap
umap@(UM.UMap Map (Credential 'Staking) UMElem
triplesMap Map Ptr (Credential 'Staking)
ptrMap) =
  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
$ (Map (Credential 'Staking) (CompactForm Coin)
 -> Ptr
 -> CompactForm Coin
 -> Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
-> Map Ptr (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking) (CompactForm Coin)
-> Ptr
-> CompactForm Coin
-> Map (Credential 'Staking) (CompactForm Coin)
addPtrStake Map (Credential 'Staking) (CompactForm Coin)
credentialStakeMap Map Ptr (CompactForm Coin)
sisPtrStake
  where
    !credentialStakeMap :: Map (Credential 'Staking) (CompactForm Coin)
credentialStakeMap = InstantStake era
-> UMap -> Map (Credential 'Staking) (CompactForm Coin)
forall era.
EraStake era =>
InstantStake era
-> UMap -> Map (Credential 'Staking) (CompactForm Coin)
resolveActiveInstantStakeCredentials InstantStake era
ShelleyInstantStake era
instantStake UMap
umap
    addPtrStake :: Map (Credential 'Staking) (CompactForm Coin)
-> Ptr
-> CompactForm Coin
-> Map (Credential 'Staking) (CompactForm Coin)
addPtrStake !Map (Credential 'Staking) (CompactForm Coin)
acc Ptr
ptr CompactForm Coin
ptrStake = Map (Credential 'Staking) (CompactForm Coin)
-> Maybe (Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
forall a. a -> Maybe a -> a
fromMaybe Map (Credential 'Staking) (CompactForm Coin)
acc (Maybe (Map (Credential 'Staking) (CompactForm Coin))
 -> Map (Credential 'Staking) (CompactForm Coin))
-> Maybe (Map (Credential 'Staking) (CompactForm Coin))
-> Map (Credential 'Staking) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ do
      Credential 'Staking
cred <- Ptr -> Map Ptr (Credential 'Staking) -> Maybe (Credential 'Staking)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking)
ptrMap
      -- Ensure only active staking credential receive Ptr delegations
      RDPair
_ <- UMElem -> Maybe RDPair
UM.umElemRDActive (UMElem -> Maybe RDPair) -> Maybe UMElem -> Maybe RDPair
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Credential 'Staking
-> Map (Credential 'Staking) UMElem -> Maybe UMElem
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking
cred Map (Credential 'Staking) UMElem
triplesMap
      let plusPtrStake :: Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
plusPtrStake =
            CompactForm Coin -> Maybe (CompactForm Coin)
forall a. a -> Maybe a
Just (CompactForm Coin -> Maybe (CompactForm Coin))
-> (Maybe (CompactForm Coin) -> CompactForm Coin)
-> Maybe (CompactForm Coin)
-> Maybe (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
              Maybe (CompactForm Coin)
Nothing -> CompactForm Coin
ptrStake
              Just CompactForm Coin
curStake -> CompactForm Coin
curStake CompactForm Coin -> CompactForm Coin -> CompactForm Coin
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin
ptrStake
      -- instant stake is guaranteed to be non-zero due to minUTxO, so no need to guard against mempty
      Map (Credential 'Staking) (CompactForm Coin)
-> Maybe (Map (Credential 'Staking) (CompactForm Coin))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map (Credential 'Staking) (CompactForm Coin)
 -> Maybe (Map (Credential 'Staking) (CompactForm Coin)))
-> Map (Credential 'Staking) (CompactForm Coin)
-> Maybe (Map (Credential 'Staking) (CompactForm Coin))
forall a b. (a -> b) -> a -> b
$! (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 Maybe (CompactForm Coin) -> Maybe (CompactForm Coin)
plusPtrStake Credential 'Staking
cred Map (Credential 'Staking) (CompactForm Coin)
acc