{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

-- | A 'UMap' (for Unified map) represents
--
-- 1. 4 Maps with the same domain in one direction, as a single `Map` and
-- 2. 1 other `Map` which is an inverse of one of the other 4 Maps.
--
-- The advantage of using `UMap` is that it stores all the information
-- compactly, by exploiting the large amount of sharing in Map #1.
--
-- As for the other Map #2, we don't expect it to have much volume.
module Cardano.Ledger.UMap (
  -- * Constructing a `UMap`
  RDPair (..),
  rdRewardCoin,
  rdDepositCoin,
  UMElem (UMElem),
  umElemRDPair,
  umElemRDActive,
  RewardDelegation (..),
  umElemDRepDelegatedReward,
  umElemDelegations,
  umElemPtrs,
  umElemSPool,
  umElemDRep,
  umElemAsTuple,
  nullUMElem,
  nullUMElemMaybe,
  UMap (..),
  umElemsL,
  empty,
  umInvariant,

  -- * StakeCredentials
  StakeCredentials (..),
  toStakeCredentials,
  domRestrictedStakeCredentials,

  -- * `UView` and its components
  UView (..),
  rewDepUView,
  ptrUView,
  sPoolUView,
  dRepUView,
  unUView,
  unUnifyToVMap,
  rdPairMap,
  rewardMap,
  compactRewardMap,
  depositMap,
  ptrMap,
  invPtrMap,
  sPoolMap,
  dRepMap,
  domRestrictedMap,
  CompactForm (CompactCoin),
  toCompact,
  fromCompact,
  addCompact,
  sumCompactCoin,
  sumRewardsUView,
  sumDepositUView,
  compactCoinOrError,
  unify,
  unUnify,

  -- * Set and Map operations on `UView`s
  nullUView,
  member,
  member',
  notMember,
  delete,
  delete',
  insertWith,
  insertWith',
  insert,
  insert',
  adjust,
  lookup,
  domain,
  range,
  (∪),
  unionL,
  (⨃),
  unionR,
  (∪+),
  unionRewAgg,
  unionKeyDeposits,
  (⋪),
  domDelete,
  (⋫),
  rngDelete,
  (◁),
  domRestrict,

  -- * Derived functions
  findWithDefault,
  size,
  domDeleteAll,
  deleteStakingCredential,
  extractStakingCredential,
)
where

import Cardano.Ledger.BaseTypes (strictMaybe)
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin), compactCoinOrError)
import Cardano.Ledger.Compactible (Compactible (..))
import Cardano.Ledger.Credential (Credential (..), Ptr)
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.DRep (DRep)
import Cardano.Ledger.Keys (KeyHash, KeyRole (..))
import Control.DeepSeq (NFData (..))
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.Aeson (ToJSON (..), object, (.=))
import qualified Data.Aeson as Aeson
import Data.Foldable (Foldable (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.MapExtras as MapExtras (extract, intersectDomPLeft)
import Data.Maybe as Maybe (fromMaybe, isNothing, mapMaybe)
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Set.Internal as SI (Set (Tip))
import qualified Data.VMap as VMap
import GHC.Generics (Generic)
import Lens.Micro (Lens', lens)
import NoThunks.Class (NoThunks (..))
import Prelude hiding (lookup, null)

-- | A Reward-Deposit Pair
-- Used to represent the reward and the deposit for a given (Credential 'Staking c)
data RDPair = RDPair
  { RDPair -> CompactForm Coin
rdReward :: {-# UNPACK #-} !(CompactForm Coin)
  , RDPair -> CompactForm Coin
rdDeposit :: {-# UNPACK #-} !(CompactForm Coin)
  }
  deriving (Int -> RDPair -> ShowS
[RDPair] -> ShowS
RDPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDPair] -> ShowS
$cshowList :: [RDPair] -> ShowS
show :: RDPair -> String
$cshow :: RDPair -> String
showsPrec :: Int -> RDPair -> ShowS
$cshowsPrec :: Int -> RDPair -> ShowS
Show, RDPair -> RDPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RDPair -> RDPair -> Bool
$c/= :: RDPair -> RDPair -> Bool
== :: RDPair -> RDPair -> Bool
$c== :: RDPair -> RDPair -> Bool
Eq, Eq RDPair
RDPair -> RDPair -> Bool
RDPair -> RDPair -> Ordering
RDPair -> RDPair -> RDPair
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
min :: RDPair -> RDPair -> RDPair
$cmin :: RDPair -> RDPair -> RDPair
max :: RDPair -> RDPair -> RDPair
$cmax :: RDPair -> RDPair -> RDPair
>= :: RDPair -> RDPair -> Bool
$c>= :: RDPair -> RDPair -> Bool
> :: RDPair -> RDPair -> Bool
$c> :: RDPair -> RDPair -> Bool
<= :: RDPair -> RDPair -> Bool
$c<= :: RDPair -> RDPair -> Bool
< :: RDPair -> RDPair -> Bool
$c< :: RDPair -> RDPair -> Bool
compare :: RDPair -> RDPair -> Ordering
$ccompare :: RDPair -> RDPair -> Ordering
Ord, forall x. Rep RDPair x -> RDPair
forall x. RDPair -> Rep RDPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RDPair x -> RDPair
$cfrom :: forall x. RDPair -> Rep RDPair x
Generic, Context -> RDPair -> IO (Maybe ThunkInfo)
Proxy RDPair -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy RDPair -> String
$cshowTypeOf :: Proxy RDPair -> String
wNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
noThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> RDPair -> IO (Maybe ThunkInfo)
NoThunks, RDPair -> ()
forall a. (a -> ()) -> NFData a
rnf :: RDPair -> ()
$crnf :: RDPair -> ()
NFData)

-- rdReward and rdDeposit return a (CompactForm Coin), These return a Coin.

rdRewardCoin :: RDPair -> Coin
rdRewardCoin :: RDPair -> Coin
rdRewardCoin RDPair
rdp = forall a. Compactible a => CompactForm a -> a
fromCompact (RDPair -> CompactForm Coin
rdReward RDPair
rdp)

rdDepositCoin :: RDPair -> Coin
rdDepositCoin :: RDPair -> Coin
rdDepositCoin RDPair
rdp = forall a. Compactible a => CompactForm a -> a
fromCompact (RDPair -> CompactForm Coin
rdDeposit RDPair
rdp)

instance EncCBOR RDPair where
  encCBOR :: RDPair -> Encoding
encCBOR RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward, CompactForm Coin
rdDeposit :: CompactForm Coin
rdDeposit :: RDPair -> CompactForm Coin
rdDeposit} =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdReward forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
rdDeposit

instance DecCBOR RDPair where
  decCBOR :: forall s. Decoder s RDPair
decCBOR =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"RDPair" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ CompactForm Coin -> CompactForm Coin -> RDPair
RDPair forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | A `UMElem` compactly represents the range of 4 `Map`s with the same domain
-- as a single n-tuple.
--
-- This space-compacting datatype, and the pattern `UMElem` are equivalent to:
-- @
-- data Elem c = Elem
--   { rdPairT :: !(StrictMaybe RDPair),
--     ptrT :: !(Set Ptr),
--     sPoolT :: !(StrictMaybe (KeyHash 'StakePool c)), -- the stake pool identity
--     dRepT :: !(StrictMaybe (DRep c)),
--   }
--   deriving (Show, Eq, Generic, NoThunks, NFData)
-- @
--
-- To name the constructors of `UMElem` we use the notation @Txxx@ where
-- each @x@ is
-- either @F@ for full, i.e. the component is present,
-- or @E@ for empty, i.e. the component is not present.
--
-- There are four components:
-- 1) the reward-deposit pair as an `RDPair` (CompactForm Coin) (CompactForm Coin) as a pair of Word64s, the first @x@,
-- 2) the set of pointers, the second @x@,
-- 3) the stake pool id (KeyHash 'StakePool c), the third @x@, and
-- 4) the voting delegatee id (DRep c), the fourth @x@.
--
-- So,
-- TEEEE means none of the components are present,
-- TFEEE means only the reward-deposit pair is present,
-- TEFEE means only the set of pointers is present,
-- TEEFE means only the stake pool id is present. etc.
-- TEEEF means only the voting delegatee id is present, and
--
-- The pattern 'UMElem' will correctly use the optimal constructor.
data UMElem c
  = TEEEE
  | TEEEF !(DRep c)
  | TEEFE !(KeyHash 'StakePool c)
  | TEEFF !(KeyHash 'StakePool c) !(DRep c)
  | TEFEE !(Set Ptr)
  | TEFEF !(Set Ptr) !(DRep c)
  | TEFFE !(Set Ptr) !(KeyHash 'StakePool c)
  | TEFFF !(Set Ptr) !(KeyHash 'StakePool c) !(DRep c)
  | TFEEE {-# UNPACK #-} !RDPair
  | TFEEF {-# UNPACK #-} !RDPair !(DRep c)
  | TFEFE {-# UNPACK #-} !RDPair !(KeyHash 'StakePool c)
  | TFEFF {-# UNPACK #-} !RDPair !(KeyHash 'StakePool c) !(DRep c)
  | TFFEE {-# UNPACK #-} !RDPair !(Set Ptr)
  | TFFEF {-# UNPACK #-} !RDPair !(Set Ptr) !(DRep c)
  | TFFFE {-# UNPACK #-} !RDPair !(Set Ptr) !(KeyHash 'StakePool c)
  | TFFFF {-# UNPACK #-} !RDPair !(Set Ptr) !(KeyHash 'StakePool c) !(DRep c)
  deriving (UMElem c -> UMElem c -> Bool
forall c. UMElem c -> UMElem c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UMElem c -> UMElem c -> Bool
$c/= :: forall c. UMElem c -> UMElem c -> Bool
== :: UMElem c -> UMElem c -> Bool
$c== :: forall c. UMElem c -> UMElem c -> Bool
Eq, UMElem c -> UMElem c -> Ordering
forall c. Eq (UMElem c)
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 c. UMElem c -> UMElem c -> Bool
forall c. UMElem c -> UMElem c -> Ordering
forall c. UMElem c -> UMElem c -> UMElem c
min :: UMElem c -> UMElem c -> UMElem c
$cmin :: forall c. UMElem c -> UMElem c -> UMElem c
max :: UMElem c -> UMElem c -> UMElem c
$cmax :: forall c. UMElem c -> UMElem c -> UMElem c
>= :: UMElem c -> UMElem c -> Bool
$c>= :: forall c. UMElem c -> UMElem c -> Bool
> :: UMElem c -> UMElem c -> Bool
$c> :: forall c. UMElem c -> UMElem c -> Bool
<= :: UMElem c -> UMElem c -> Bool
$c<= :: forall c. UMElem c -> UMElem c -> Bool
< :: UMElem c -> UMElem c -> Bool
$c< :: forall c. UMElem c -> UMElem c -> Bool
compare :: UMElem c -> UMElem c -> Ordering
$ccompare :: forall c. UMElem c -> UMElem c -> Ordering
Ord, Int -> UMElem c -> ShowS
forall c. Int -> UMElem c -> ShowS
forall c. [UMElem c] -> ShowS
forall c. UMElem c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UMElem c] -> ShowS
$cshowList :: forall c. [UMElem c] -> ShowS
show :: UMElem c -> String
$cshow :: forall c. UMElem c -> String
showsPrec :: Int -> UMElem c -> ShowS
$cshowsPrec :: forall c. Int -> UMElem c -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (UMElem c) x -> UMElem c
forall c x. UMElem c -> Rep (UMElem c) x
$cto :: forall c x. Rep (UMElem c) x -> UMElem c
$cfrom :: forall c x. UMElem c -> Rep (UMElem c) x
Generic, forall c. Context -> UMElem c -> IO (Maybe ThunkInfo)
forall c. Proxy (UMElem c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (UMElem c) -> String
$cshowTypeOf :: forall c. Proxy (UMElem c) -> String
wNoThunks :: Context -> UMElem c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> UMElem c -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMElem c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> UMElem c -> IO (Maybe ThunkInfo)
NoThunks, forall c. UMElem c -> ()
forall a. (a -> ()) -> NFData a
rnf :: UMElem c -> ()
$crnf :: forall c. UMElem c -> ()
NFData)

instance Crypto c => ToJSON (UMElem c) where
  toJSON :: UMElem c -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => UMElem c -> [a]
toUMElemair
  toEncoding :: UMElem c -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => UMElem c -> [a]
toUMElemair

toUMElemair :: (Aeson.KeyValue e a, Crypto c) => UMElem c -> [a]
toUMElemair :: forall e a c. (KeyValue e a, Crypto c) => UMElem c -> [a]
toUMElemair (UMElem !StrictMaybe RDPair
rd !Set Ptr
ptr !StrictMaybe (KeyHash 'StakePool c)
spool !StrictMaybe (DRep c)
drep) =
  [ Key
"reward" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdReward StrictMaybe RDPair
rd
  , Key
"deposit" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RDPair -> CompactForm Coin
rdDeposit StrictMaybe RDPair
rd
  , Key
"ptr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Set Ptr
ptr
  , Key
"spool" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (KeyHash 'StakePool c)
spool
  , Key
"drep" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (DRep c)
drep
  ]

instance Crypto c => EncCBOR (UMElem c) where
  encCBOR :: UMElem c -> Encoding
encCBOR (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) =
    Word -> Encoding
encodeListLen Word
4 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe RDPair
rd forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Set Ptr
ptrSet forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (KeyHash 'StakePool c)
sPool forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (DRep c)
dRep

instance Crypto c => DecShareCBOR (UMElem c) where
  type Share (UMElem c) = Interns (KeyHash 'StakePool c)
  decShareCBOR :: forall s. Share (UMElem c) -> Decoder s (UMElem c)
decShareCBOR Share (UMElem c)
is =
    forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMElem" (forall a b. a -> b -> a
const Int
4) forall a b. (a -> b) -> a -> b
$
      forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9) (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Set Ptr))) forall a s. DecCBOR a => Decoder s a
decCBOR
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) b s.
(DecCBOR (f b), Monad f) =>
Interns b -> Decoder s (f b)
decShareMonadCBOR Share (UMElem c)
is
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR

-- | A n-Tuple view of the `UMElem`.
-- We can view all of the constructors as an `UMElem`.
umElemAsTuple ::
  UMElem c ->
  (StrictMaybe RDPair, Set Ptr, StrictMaybe (KeyHash 'StakePool c), StrictMaybe (DRep c))
umElemAsTuple :: forall c.
UMElem c
-> (StrictMaybe RDPair, Set Ptr,
    StrictMaybe (KeyHash 'StakePool c), StrictMaybe (DRep c))
umElemAsTuple = \case
  UMElem c
TEEEE -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TEEEF DRep c
v -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TEEFE KeyHash 'StakePool c
s -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. StrictMaybe a
SNothing)
  TEEFF KeyHash 'StakePool c
s DRep c
v -> (forall a. StrictMaybe a
SNothing, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TEFEE Set Ptr
p -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TEFEF Set Ptr
p DRep c
v -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TEFFE Set Ptr
p KeyHash 'StakePool c
s -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. StrictMaybe a
SNothing)
  TEFFF Set Ptr
p KeyHash 'StakePool c
s DRep c
v -> (forall a. StrictMaybe a
SNothing, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TFEEE RDPair
r -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TFEEF RDPair
r DRep c
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TFEFE RDPair
r KeyHash 'StakePool c
s -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. StrictMaybe a
SNothing)
  TFEFF RDPair
r KeyHash 'StakePool c
s DRep c
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, forall a. Set a
Set.empty, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TFFEE RDPair
r Set Ptr
p -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. StrictMaybe a
SNothing)
  TFFEF RDPair
r Set Ptr
p DRep c
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. StrictMaybe a
SNothing, forall a. a -> StrictMaybe a
SJust DRep c
v)
  TFFFE RDPair
r Set Ptr
p KeyHash 'StakePool c
s -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. StrictMaybe a
SNothing)
  TFFFF RDPair
r Set Ptr
p KeyHash 'StakePool c
s DRep c
v -> (forall a. a -> StrictMaybe a
SJust RDPair
r, Set Ptr
p, forall a. a -> StrictMaybe a
SJust KeyHash 'StakePool c
s, forall a. a -> StrictMaybe a
SJust DRep c
v)
{-# INLINE umElemAsTuple #-}

-- | Extract a DRep delegated reward if it is present.
-- We can tell that the pair is present and active when Txxxx has
-- an F in the 1st position (present) and 4rd position (DRep delegated).
--
-- This is equivalent to the pattern (UMElem (SJust r) _ _ (SJust d)) -> Just (r, d)
umElemDRepDelegatedReward :: UMElem c -> Maybe (CompactForm Coin, DRep c)
umElemDRepDelegatedReward :: forall c. UMElem c -> Maybe (CompactForm Coin, DRep c)
umElemDRepDelegatedReward = \case
  TFEEF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} DRep c
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep c
dRep)
  TFEFF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} KeyHash 'StakePool c
_ DRep c
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep c
dRep)
  TFFEF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} Set Ptr
_ DRep c
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep c
dRep)
  TFFFF RDPair {CompactForm Coin
rdReward :: CompactForm Coin
rdReward :: RDPair -> CompactForm Coin
rdReward} Set Ptr
_ KeyHash 'StakePool c
_ DRep c
dRep -> forall a. a -> Maybe a
Just (CompactForm Coin
rdReward, DRep c
dRep)
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemDRepDelegatedReward #-}

-- | Extract a delegated reward-deposit pair if it is present.
-- We can tell that the pair is present and active when Txxxx has
-- an F in the 1st position (present) and 3rd position (delegated).
--
-- This is equivalent to the pattern (UMElem (SJust r) _ (SJust _) _) -> Just r
umElemRDActive :: UMElem c -> Maybe RDPair
umElemRDActive :: forall c. UMElem c -> Maybe RDPair
umElemRDActive = \case
  TFEFE RDPair
rdA KeyHash 'StakePool c
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFEFF RDPair
rdA KeyHash 'StakePool c
_ DRep c
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFFFE RDPair
rdA Set Ptr
_ KeyHash 'StakePool c
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  TFFFF RDPair
rdA Set Ptr
_ KeyHash 'StakePool c
_ DRep c
_ -> forall a. a -> Maybe a
Just RDPair
rdA
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemRDActive #-}

data RewardDelegation c
  = RewardDelegationSPO !(KeyHash 'StakePool c) !(CompactForm Coin)
  | RewardDelegationDRep !(DRep c) !(CompactForm Coin)
  | RewardDelegationBoth !(KeyHash 'StakePool c) !(DRep c) !(CompactForm Coin)

-- | Extract rewards that are either delegated to a DRep or an SPO (or both).
-- We can tell that the pair is present and active when Txxxx has F's in the 1st
-- and either 3rd or 4th or both positions. If there are no rewards or deposits
-- but the delegations still exist, then we return zero coin as reward.
umElemDelegations :: UMElem c -> Maybe (RewardDelegation c)
umElemDelegations :: forall c. UMElem c -> Maybe (RewardDelegation c)
umElemDelegations (UMElem StrictMaybe RDPair
r Set Ptr
_p StrictMaybe (KeyHash 'StakePool c)
s StrictMaybe (DRep c)
d) =
  let reward :: CompactForm Coin
reward = forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe forall a. Monoid a => a
mempty RDPair -> CompactForm Coin
rdReward StrictMaybe RDPair
r
   in case (StrictMaybe (KeyHash 'StakePool c)
s, StrictMaybe (DRep c)
d) of
        (SJust KeyHash 'StakePool c
spo, SJust DRep c
drep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
KeyHash 'StakePool c
-> DRep c -> CompactForm Coin -> RewardDelegation c
RewardDelegationBoth KeyHash 'StakePool c
spo DRep c
drep CompactForm Coin
reward
        (SJust KeyHash 'StakePool c
spo, StrictMaybe (DRep c)
SNothing) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
KeyHash 'StakePool c -> CompactForm Coin -> RewardDelegation c
RewardDelegationSPO KeyHash 'StakePool c
spo CompactForm Coin
reward
        (StrictMaybe (KeyHash 'StakePool c)
SNothing, SJust DRep c
drep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. DRep c -> CompactForm Coin -> RewardDelegation c
RewardDelegationDRep DRep c
drep CompactForm Coin
reward
        (StrictMaybe (KeyHash 'StakePool c)
SNothing, StrictMaybe (DRep c)
SNothing) -> forall a. Maybe a
Nothing
{-# INLINE umElemDelegations #-}

-- | Extract the reward-deposit pair if it is present.
-- We can tell that the reward is present when Txxxx has an F in the first position
--
-- This is equivalent to the pattern (UMElem (SJust r) _ _ _) -> Just r
umElemRDPair :: UMElem c -> Maybe RDPair
umElemRDPair :: forall c. UMElem c -> Maybe RDPair
umElemRDPair = \case
  TFEEE RDPair
r -> forall a. a -> Maybe a
Just RDPair
r
  TFEEF RDPair
r DRep c
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFEFE RDPair
r KeyHash 'StakePool c
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFEFF RDPair
r KeyHash 'StakePool c
_ DRep c
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFEE RDPair
r Set Ptr
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFEF RDPair
r Set Ptr
_ DRep c
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFFE RDPair
r Set Ptr
_ KeyHash 'StakePool c
_ -> forall a. a -> Maybe a
Just RDPair
r
  TFFFF RDPair
r Set Ptr
_ KeyHash 'StakePool c
_ DRep c
_ -> forall a. a -> Maybe a
Just RDPair
r
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemRDPair #-}

-- | Extract the set of pointers if it is non-empty.
-- We can tell that the reward is present when Txxxx has an F in the second position
--
-- This is equivalent to the pattern (UMElem _ p _ _) -> Just p
umElemPtrs :: UMElem c -> Maybe (Set.Set Ptr)
umElemPtrs :: forall c. UMElem c -> Maybe (Set Ptr)
umElemPtrs = \case
  TEFEE Set Ptr
p | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFEF Set Ptr
p DRep c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFFE Set Ptr
p KeyHash 'StakePool c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TEFFF Set Ptr
p KeyHash 'StakePool c
_ DRep c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFEE RDPair
_ Set Ptr
p | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFEF RDPair
_ Set Ptr
p DRep c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFFE RDPair
_ Set Ptr
p KeyHash 'StakePool c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  TFFFF RDPair
_ Set Ptr
p KeyHash 'StakePool c
_ DRep c
_ | Bool -> Bool
not (forall a. Set a -> Bool
Set.null Set Ptr
p) -> forall a. a -> Maybe a
Just Set Ptr
p
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemPtrs #-}

-- | Extract the stake delegatee pool id, if present.
-- We can tell that the pool id is present when Txxxx has an F in the third position
--
-- This is equivalent to the pattern (UMElem _ _ (SJust s) _) -> Just s
umElemSPool :: UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool :: forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool = \case
  TEEFE KeyHash 'StakePool c
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TEEFF KeyHash 'StakePool c
s DRep c
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TEFFE Set Ptr
_ KeyHash 'StakePool c
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TEFFF Set Ptr
_ KeyHash 'StakePool c
s DRep c
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TFEFE RDPair
_ KeyHash 'StakePool c
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TFEFF RDPair
_ KeyHash 'StakePool c
s DRep c
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TFFFE RDPair
_ Set Ptr
_ KeyHash 'StakePool c
s -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool c
s DRep c
_ -> forall a. a -> Maybe a
Just KeyHash 'StakePool c
s
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemSPool #-}

-- | Extract the voting delegatee id, if present.
-- We can tell that the delegatee is present when Txxxx has an F in the fourth position
--
-- This is equivalent to the pattern (UMElem _ _ _ (SJust d)) -> Just d
umElemDRep :: UMElem c -> Maybe (DRep c)
umElemDRep :: forall c. UMElem c -> Maybe (DRep c)
umElemDRep = \case
  TEEEF DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TEEFF KeyHash 'StakePool c
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TEFEF Set Ptr
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TEFFF Set Ptr
_ KeyHash 'StakePool c
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TFEEF RDPair
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TFEFF RDPair
_ KeyHash 'StakePool c
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TFFEF RDPair
_ Set Ptr
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  TFFFF RDPair
_ Set Ptr
_ KeyHash 'StakePool c
_ DRep c
d -> forall a. a -> Maybe a
Just DRep c
d
  UMElem c
_ -> forall a. Maybe a
Nothing
{-# INLINE umElemDRep #-}

-- | A `UMElem` can be extracted and injected into the `TEEEE` ... `TFFFF` constructors.
pattern UMElem ::
  StrictMaybe RDPair ->
  Set Ptr ->
  StrictMaybe (KeyHash 'StakePool c) ->
  StrictMaybe (DRep c) ->
  UMElem c
pattern $bUMElem :: forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
$mUMElem :: forall {r} {c}.
UMElem c
-> (StrictMaybe RDPair
    -> Set Ptr
    -> StrictMaybe (KeyHash 'StakePool c)
    -> StrictMaybe (DRep c)
    -> r)
-> ((# #) -> r)
-> r
UMElem i j k l <- (umElemAsTuple -> (i, j, k, l))
  where
    UMElem StrictMaybe RDPair
i Set Ptr
j StrictMaybe (KeyHash 'StakePool c)
k StrictMaybe (DRep c)
l = case (StrictMaybe RDPair
i, Set Ptr
j, StrictMaybe (KeyHash 'StakePool c)
k, StrictMaybe (DRep c)
l) of
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool c)
SNothing, StrictMaybe (DRep c)
SNothing) -> forall c. UMElem c
TEEEE
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool c)
SNothing, SJust DRep c
d) -> forall c. DRep c -> UMElem c
TEEEF DRep c
d
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, SJust KeyHash 'StakePool c
s, StrictMaybe (DRep c)
SNothing) -> forall c. KeyHash 'StakePool c -> UMElem c
TEEFE KeyHash 'StakePool c
s
      (StrictMaybe RDPair
SNothing, Set Ptr
SI.Tip, SJust KeyHash 'StakePool c
s, SJust DRep c
d) -> forall c. KeyHash 'StakePool c -> DRep c -> UMElem c
TEEFF KeyHash 'StakePool c
s DRep c
d
      (StrictMaybe RDPair
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool c)
SNothing, StrictMaybe (DRep c)
SNothing) -> forall c. Set Ptr -> UMElem c
TEFEE Set Ptr
p
      (StrictMaybe RDPair
SNothing, Set Ptr
p, StrictMaybe (KeyHash 'StakePool c)
SNothing, SJust DRep c
d) -> forall c. Set Ptr -> DRep c -> UMElem c
TEFEF Set Ptr
p DRep c
d
      (StrictMaybe RDPair
SNothing, Set Ptr
p, SJust KeyHash 'StakePool c
s, StrictMaybe (DRep c)
SNothing) -> forall c. Set Ptr -> KeyHash 'StakePool c -> UMElem c
TEFFE Set Ptr
p KeyHash 'StakePool c
s
      (StrictMaybe RDPair
SNothing, Set Ptr
p, SJust KeyHash 'StakePool c
s, SJust DRep c
d) -> forall c. Set Ptr -> KeyHash 'StakePool c -> DRep c -> UMElem c
TEFFF Set Ptr
p KeyHash 'StakePool c
s DRep c
d
      (SJust RDPair
r, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool c)
SNothing, StrictMaybe (DRep c)
SNothing) -> forall c. RDPair -> UMElem c
TFEEE RDPair
r
      (SJust RDPair
r, Set Ptr
SI.Tip, StrictMaybe (KeyHash 'StakePool c)
SNothing, SJust DRep c
d) -> forall c. RDPair -> DRep c -> UMElem c
TFEEF RDPair
r DRep c
d
      (SJust RDPair
r, Set Ptr
SI.Tip, SJust KeyHash 'StakePool c
s, StrictMaybe (DRep c)
SNothing) -> forall c. RDPair -> KeyHash 'StakePool c -> UMElem c
TFEFE RDPair
r KeyHash 'StakePool c
s
      (SJust RDPair
r, Set Ptr
SI.Tip, SJust KeyHash 'StakePool c
s, SJust DRep c
d) -> forall c. RDPair -> KeyHash 'StakePool c -> DRep c -> UMElem c
TFEFF RDPair
r KeyHash 'StakePool c
s DRep c
d
      (SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool c)
SNothing, StrictMaybe (DRep c)
SNothing) -> forall c. RDPair -> Set Ptr -> UMElem c
TFFEE RDPair
r Set Ptr
p
      (SJust RDPair
r, Set Ptr
p, StrictMaybe (KeyHash 'StakePool c)
SNothing, SJust DRep c
d) -> forall c. RDPair -> Set Ptr -> DRep c -> UMElem c
TFFEF RDPair
r Set Ptr
p DRep c
d
      (SJust RDPair
r, Set Ptr
p, SJust KeyHash 'StakePool c
s, StrictMaybe (DRep c)
SNothing) -> forall c. RDPair -> Set Ptr -> KeyHash 'StakePool c -> UMElem c
TFFFE RDPair
r Set Ptr
p KeyHash 'StakePool c
s
      (SJust RDPair
r, Set Ptr
p, SJust KeyHash 'StakePool c
s, SJust DRep c
d) -> forall c.
RDPair -> Set Ptr -> KeyHash 'StakePool c -> DRep c -> UMElem c
TFFFF RDPair
r Set Ptr
p KeyHash 'StakePool c
s DRep c
d

{-# COMPLETE UMElem #-}

-- | A unified map represents 4 Maps with domain @(Credential 'Staking c)@
--
-- 1) Map (Credential 'Staking c) RDPair  -- (RDPair rewardCoin depositCoin)
-- 2) Map (Credential 'Staking c) (Set Ptr)
-- 3) Map (Credential 'Staking c) (StrictMaybe (KeyHash 'StakePool c))
-- 4) Map (Credential 'Staking c) (StrictMaybe (DRep c))
-- and one more map in the inverse direction with @Ptr@ for keys and @(Credential 'Staking c)@ for values.
data UMap c = UMap
  { forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems :: !(Map (Credential 'Staking c) (UMElem c))
  , forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs :: !(Map Ptr (Credential 'Staking c))
  }
  deriving (Int -> UMap c -> ShowS
forall c. Int -> UMap c -> ShowS
forall c. [UMap c] -> ShowS
forall c. UMap c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UMap c] -> ShowS
$cshowList :: forall c. [UMap c] -> ShowS
show :: UMap c -> String
$cshow :: forall c. UMap c -> String
showsPrec :: Int -> UMap c -> ShowS
$cshowsPrec :: forall c. Int -> UMap c -> ShowS
Show, UMap c -> UMap c -> Bool
forall c. UMap c -> UMap c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UMap c -> UMap c -> Bool
$c/= :: forall c. UMap c -> UMap c -> Bool
== :: UMap c -> UMap c -> Bool
$c== :: forall c. UMap c -> UMap c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (UMap c) x -> UMap c
forall c x. UMap c -> Rep (UMap c) x
$cto :: forall c x. Rep (UMap c) x -> UMap c
$cfrom :: forall c x. UMap c -> Rep (UMap c) x
Generic, forall c. Context -> UMap c -> IO (Maybe ThunkInfo)
forall c. Proxy (UMap c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (UMap c) -> String
$cshowTypeOf :: forall c. Proxy (UMap c) -> String
wNoThunks :: Context -> UMap c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> UMap c -> IO (Maybe ThunkInfo)
noThunks :: Context -> UMap c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> UMap c -> IO (Maybe ThunkInfo)
NoThunks, forall c. UMap c -> ()
forall a. (a -> ()) -> NFData a
rnf :: UMap c -> ()
$crnf :: forall c. UMap c -> ()
NFData)

umElemsL :: Lens' (UMap c) (Map (Credential 'Staking c) (UMElem c))
umElemsL :: forall c. Lens' (UMap c) (Map (Credential 'Staking c) (UMElem c))
umElemsL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems (\UMap c
x Map (Credential 'Staking c) (UMElem c)
y -> UMap c
x {umElems :: Map (Credential 'Staking c) (UMElem c)
umElems = Map (Credential 'Staking c) (UMElem c)
y})

-- | All maps unrolled. It is important to note that all fields are lazy, because
-- conversion from UMap can be expensive, thus only fields that are forced will incur that
-- conversion overhead.
data StakeCredentials c = StakeCredentials
  { forall c. StakeCredentials c -> Map (Credential 'Staking c) Coin
scRewards :: Map (Credential 'Staking c) Coin
  , forall c. StakeCredentials c -> Map (Credential 'Staking c) Coin
scDeposits :: Map (Credential 'Staking c) Coin
  , forall c.
StakeCredentials c
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
scSPools :: Map (Credential 'Staking c) (KeyHash 'StakePool c)
  , forall c.
StakeCredentials c -> Map (Credential 'Staking c) (DRep c)
scDReps :: Map (Credential 'Staking c) (DRep c)
  , forall c. StakeCredentials c -> Map Ptr (Credential 'Staking c)
scPtrs :: Map Ptr (Credential 'Staking c)
  , forall c.
StakeCredentials c -> Map (Credential 'Staking c) (Set Ptr)
scPtrsInverse :: Map (Credential 'Staking c) (Set Ptr)
  -- ^ There will be no empty sets in the range
  }
  deriving (Int -> StakeCredentials c -> ShowS
forall c. Int -> StakeCredentials c -> ShowS
forall c. [StakeCredentials c] -> ShowS
forall c. StakeCredentials c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StakeCredentials c] -> ShowS
$cshowList :: forall c. [StakeCredentials c] -> ShowS
show :: StakeCredentials c -> String
$cshow :: forall c. StakeCredentials c -> String
showsPrec :: Int -> StakeCredentials c -> ShowS
$cshowsPrec :: forall c. Int -> StakeCredentials c -> ShowS
Show, StakeCredentials c -> StakeCredentials c -> Bool
forall c. StakeCredentials c -> StakeCredentials c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StakeCredentials c -> StakeCredentials c -> Bool
$c/= :: forall c. StakeCredentials c -> StakeCredentials c -> Bool
== :: StakeCredentials c -> StakeCredentials c -> Bool
$c== :: forall c. StakeCredentials c -> StakeCredentials c -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (StakeCredentials c) x -> StakeCredentials c
forall c x. StakeCredentials c -> Rep (StakeCredentials c) x
$cto :: forall c x. Rep (StakeCredentials c) x -> StakeCredentials c
$cfrom :: forall c x. StakeCredentials c -> Rep (StakeCredentials c) x
Generic, forall c. Context -> StakeCredentials c -> IO (Maybe ThunkInfo)
forall c. Proxy (StakeCredentials c) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (StakeCredentials c) -> String
$cshowTypeOf :: forall c. Proxy (StakeCredentials c) -> String
wNoThunks :: Context -> StakeCredentials c -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall c. Context -> StakeCredentials c -> IO (Maybe ThunkInfo)
noThunks :: Context -> StakeCredentials c -> IO (Maybe ThunkInfo)
$cnoThunks :: forall c. Context -> StakeCredentials c -> IO (Maybe ThunkInfo)
NoThunks, forall c. StakeCredentials c -> ()
forall a. (a -> ()) -> NFData a
rnf :: StakeCredentials c -> ()
$crnf :: forall c. StakeCredentials c -> ()
NFData)

instance Crypto c => ToJSON (UMap c) where
  toJSON :: UMap c -> Value
toJSON = [Pair] -> Value
object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => UMap c -> [a]
toUMapPair
  toEncoding :: UMap c -> Encoding
toEncoding = Series -> Encoding
Aeson.pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a c. (KeyValue e a, Crypto c) => UMap c -> [a]
toUMapPair

toUMapPair :: (Aeson.KeyValue e a, Crypto c) => UMap c -> [a]
toUMapPair :: forall e a c. (KeyValue e a, Crypto c) => UMap c -> [a]
toUMapPair (UMap !Map (Credential 'Staking c) (UMElem c)
m1 !Map Ptr (Credential 'Staking c)
m2) =
  [ Key
"credentials" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking c) (UMElem c)
m1
  , Key
"pointers" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Ptr (Credential 'Staking c)
m2
  ]

instance Crypto c => EncCBOR (UMap c) where
  encCBOR :: UMap c -> Encoding
encCBOR UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} =
    Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap forall a. EncCBOR a => a -> Encoding
encCBOR forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking c) (UMElem c)
umElems forall a. Semigroup a => a -> a -> a
<> forall k v.
(k -> Encoding) -> (v -> Encoding) -> Map k v -> Encoding
encodeMap forall a. EncCBOR a => a -> Encoding
encCBOR forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (Credential 'Staking c)
umPtrs

instance Crypto c => DecShareCBOR (UMap c) where
  type Share (UMap c) = (Interns (Credential 'Staking c), Interns (KeyHash 'StakePool c))
  decSharePlusCBOR :: forall s. StateT (Share (UMap c)) (Decoder s) (UMap c)
decSharePlusCBOR =
    forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
      ( \(Interns (Credential 'Staking c)
a, Interns (KeyHash 'StakePool c)
b) ->
          forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"UMap" (forall a b. a -> b -> a
const Int
2) forall a b. (a -> b) -> a -> b
$ do
            Map (Credential 'Staking c) (UMElem c)
umElems <- forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (forall k. Interns k -> k -> k
interns Interns (Credential 'Staking c)
a forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR) (forall a s. DecShareCBOR a => Share a -> Decoder s a
decShareCBOR Interns (KeyHash 'StakePool c)
b)
            let a' :: Interns (Credential 'Staking c)
a' = forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential 'Staking c) (UMElem c)
umElems forall a. Semigroup a => a -> a -> a
<> Interns (Credential 'Staking c)
a
            Map Ptr (Credential 'Staking c)
umPtrs <-
              forall s a. Version -> Decoder s a -> Decoder s a -> Decoder s a
ifDecoderVersionAtLeast
                (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @9)
                (forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a s. DecCBOR a => Proxy a -> Decoder s ()
dropCBOR (forall {k} (t :: k). Proxy t
Proxy @(Map (Credential 'Staking c) (Set Ptr))))
                forall a b. (a -> b) -> a -> b
$ forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap forall a s. DecCBOR a => Decoder s a
decCBOR (forall k. Interns k -> k -> k
interns Interns (Credential 'Staking c)
a' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR)
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs}, (Interns (Credential 'Staking c)
a', Interns (KeyHash 'StakePool c)
b))
      )

-- | It is worthwhile stating the invariant that holds on a Unified Map.
-- The `umPtrs` and the `ptrT` field of the `umElems` are inverses.
umInvariant :: Credential 'Staking c -> Ptr -> UMap c -> Bool
umInvariant :: forall c. Credential 'Staking c -> Ptr -> UMap c -> Bool
umInvariant Credential 'Staking c
cred Ptr
ptr UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} = Bool
forwards Bool -> Bool -> Bool
&& Bool
backwards
  where
    forwards :: Bool
forwards =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking c
cred Map (Credential 'Staking c) (UMElem c)
umElems of
        Maybe (UMElem c)
Nothing -> Credential 'Staking c
cred forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` Map Ptr (Credential 'Staking c)
umPtrs
        Just (UMElem StrictMaybe RDPair
_r Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_s StrictMaybe (DRep c)
_) ->
          Bool -> Bool
not (forall a. Ord a => a -> Set a -> Bool
Set.member Ptr
ptr Set Ptr
ptrSet)
            Bool -> Bool -> Bool
|| ( case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking c)
umPtrs of
                  Maybe (Credential 'Staking c)
Nothing -> Bool
False
                  Just Credential 'Staking c
cred2 -> Credential 'Staking c
cred forall a. Eq a => a -> a -> Bool
== Credential 'Staking c
cred2
               )
    backwards :: Bool
backwards =
      case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ptr
ptr Map Ptr (Credential 'Staking c)
umPtrs of
        Maybe (Credential 'Staking c)
Nothing -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) -> forall a. Ord a => a -> Set a -> Bool
Set.notMember Ptr
ptr Set Ptr
ptrSet) Map (Credential 'Staking c) (UMElem c)
umElems
        Just Credential 'Staking c
cred' ->
          case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking c
cred' Map (Credential 'Staking c) (UMElem c)
umElems of
            Maybe (UMElem c)
Nothing -> Bool
False
            Just (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) -> forall a. Ord a => a -> Set a -> Bool
Set.member Ptr
ptr Set Ptr
ptrSet

-- | A `UView` lets one view a `UMap` in @n@ different ways,
-- one for each of the elements in a Unified Element `UMElem` @(4)@
-- A @(UView c key value)@ can be used like a @(Map key value)@.
-- It acts like a map, supporting efficient insert, delete, and lookup operations.
data UView c k v where
  RewDepUView ::
    !(UMap c) ->
    UView c (Credential 'Staking c) RDPair
  PtrUView ::
    !(UMap c) ->
    UView c Ptr (Credential 'Staking c)
  SPoolUView ::
    !(UMap c) ->
    UView c (Credential 'Staking c) (KeyHash 'StakePool c)
  DRepUView ::
    !(UMap c) ->
    UView c (Credential 'Staking c) (DRep c)

-- | Construct a `RewDepUView` from the two maps that make up a `UMap`
rewDepUView ::
  Map (Credential 'Staking c) (UMElem c) ->
  Map Ptr (Credential 'Staking c) ->
  UView c (Credential 'Staking c) RDPair
rewDepUView :: forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) RDPair
rewDepUView Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b = forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView (forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b)

-- | Construct a `PtrUView` from the two maps that make up a `UMap`
ptrUView ::
  Map (Credential 'Staking c) (UMElem c) ->
  Map Ptr (Credential 'Staking c) ->
  UView c Ptr (Credential 'Staking c)
ptrUView :: forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c Ptr (Credential 'Staking c)
ptrUView Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b = forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView (forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b)

-- | Construct a `SPoolUView` from the two maps that make up a `UMap`
sPoolUView ::
  Map (Credential 'Staking c) (UMElem c) ->
  Map Ptr (Credential 'Staking c) ->
  UView c (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolUView :: forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolUView Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b = forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView (forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b)

-- | Construct a `DRepUView` from the two maps that make up a `UMap`
dRepUView ::
  Map (Credential 'Staking c) (UMElem c) ->
  Map Ptr (Credential 'Staking c) ->
  UView c (Credential 'Staking c) (DRep c)
dRepUView :: forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (DRep c)
dRepUView Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b = forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
DRepUView (forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map (Credential 'Staking c) (UMElem c)
a Map Ptr (Credential 'Staking c)
b)

-- | Extract the underlying `UMap` from a `UView`
unUView :: UView c k v -> UMap c
unUView :: forall c k v. UView c k v -> UMap c
unUView = \case
  RewDepUView UMap c
um -> UMap c
um
  PtrUView UMap c
um -> UMap c
um
  SPoolUView UMap c
um -> UMap c
um
  DRepUView UMap c
um -> UMap c
um

-- | Materialize a real `Map` from a `View`
-- This is expensive, use it wisely (like maybe once per epoch boundary to make a `SnapShot`)
-- See also domRestrictedMap, which domain-restricts before computing a view.
unUnify :: UView c k v -> Map k v
unUnify :: forall c k v. UView c k v -> Map k v
unUnify = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe RDPair
umElemRDPair Map (Credential 'Staking c) (UMElem c)
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool Map (Credential 'Staking c) (UMElem c)
umElems
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (DRep c)
umElemDRep Map (Credential 'Staking c) (UMElem c)
umElems

-- | Materialize a real `VMap` (Vector Map) from a `UView`
-- This is expensive, use it wisely (like maybe once per epoch boundary to make a `SnapShot`)
unUnifyToVMap :: UView c k v -> VMap.VMap VMap.VB VMap.VB k v
unUnifyToVMap :: forall c k v. UView c k v -> VMap VB VB k v
unUnifyToVMap UView c k v
uview = case UView c k v
uview of
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall c k v. UView c k v -> Int
size UView c k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a} {c}. (a, UMElem c) -> Maybe (a, RDPair)
toRDPair forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking c) (UMElem c)
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall c k v. UView c k v -> Int
size UView c k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a} {c}. (a, UMElem c) -> Maybe (a, KeyHash 'StakePool c)
toSPool forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking c) (UMElem c)
umElems
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ->
    forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
Int -> [(k, v)] -> VMap kv vv k v
VMap.fromListN (forall c k v. UView c k v -> Int
size UView c k v
uview) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe forall {a} {c}. (a, UMElem c) -> Maybe (a, DRep c)
toDRep forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking c) (UMElem c)
umElems
  where
    toRDPair :: (a, UMElem c) -> Maybe (a, RDPair)
toRDPair (a
key, UMElem c
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe RDPair
umElemRDPair UMElem c
t
    toSPool :: (a, UMElem c) -> Maybe (a, KeyHash 'StakePool c)
toSPool (a
key, UMElem c
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool UMElem c
t
    toDRep :: (a, UMElem c) -> Maybe (a, DRep c)
toDRep (a
key, UMElem c
t) = (,) a
key forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe (DRep c)
umElemDRep UMElem c
t

-- | Extract a reward-deposit pairs `Map` from a 'UMap'
rdPairMap :: UMap c -> Map (Credential 'Staking c) RDPair
rdPairMap :: forall c. UMap c -> Map (Credential 'Staking c) RDPair
rdPairMap UMap c
x = forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap c
x

-- | Extract a rewards `Map` from a 'UMap'
rewardMap :: UMap c -> Map (Credential 'Staking c) Coin
rewardMap :: forall c. UMap c -> Map (Credential 'Staking c) Coin
rewardMap UMap c
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward) forall a b. (a -> b) -> a -> b
$ forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap c
x

-- | Extract a compact rewards `Map` from a 'UMap'
compactRewardMap :: UMap c -> Map (Credential 'Staking c) (CompactForm Coin)
compactRewardMap :: forall c. UMap c -> Map (Credential 'Staking c) (CompactForm Coin)
compactRewardMap UMap c
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map RDPair -> CompactForm Coin
rdReward forall a b. (a -> b) -> a -> b
$ forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap c
x

-- | Extract a deposits `Map` from a 'UMap'
depositMap :: UMap c -> Map (Credential 'Staking c) Coin
depositMap :: forall c. UMap c -> Map (Credential 'Staking c) Coin
depositMap UMap c
x = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit) forall a b. (a -> b) -> a -> b
$ forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap c
x

-- | Extract a pointers `Map` from a 'UMap'
ptrMap :: UMap c -> Map Ptr (Credential 'Staking c)
ptrMap :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
ptrMap UMap c
x = forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView UMap c
x

-- | Extract a pointers `Map` from a 'UMap'
invPtrMap :: UMap c -> Map (Credential 'Staking c) (Set Ptr)
invPtrMap :: forall c. UMap c -> Map (Credential 'Staking c) (Set Ptr)
invPtrMap UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} =
  forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
    (\Map (Credential 'Staking c) (Set Ptr)
ans Credential 'Staking c
k (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) -> if forall a. Set a -> Bool
Set.null Set Ptr
ptrSet then Map (Credential 'Staking c) (Set Ptr)
ans else forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking c
k Set Ptr
ptrSet Map (Credential 'Staking c) (Set Ptr)
ans)
    forall k a. Map k a
Map.empty
    Map (Credential 'Staking c) (UMElem c)
umElems

-- | Extract a stake pool delegations `Map` from a 'UMap'
sPoolMap :: UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap :: forall c.
UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap UMap c
x = forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView UMap c
x

-- | Extract a delegated-representatives `Map` from a 'UMap'
dRepMap :: UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap :: forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap UMap c
x = forall c k v. UView c k v -> Map k v
unUnify forall a b. (a -> b) -> a -> b
$ forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
DRepUView UMap c
x

-- | Extract a domain-restricted `Map` of a `UMap`.
-- If `Set k` is small this should be efficient.
domRestrictedMap :: Set k -> UView c k v -> Map k v
domRestrictedMap :: forall k c v. Set k -> UView c k v -> Map k v
domRestrictedMap Set k
setk = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe RDPair
umElemRDPair (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking c) (UMElem c)
umElems Set k
setk)
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map Ptr (Credential 'Staking c)
umPtrs Set k
setk
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking c) (UMElem c)
umElems Set k
setk)
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (DRep c)
umElemDRep (forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking c) (UMElem c)
umElems Set k
setk)

toStakeCredentials :: UMap c -> StakeCredentials c
toStakeCredentials :: forall c. UMap c -> StakeCredentials c
toStakeCredentials UMap c
umap =
  StakeCredentials
    { scRewards :: Map (Credential 'Staking c) Coin
scRewards = forall c. UMap c -> Map (Credential 'Staking c) Coin
rewardMap UMap c
umap
    , scDeposits :: Map (Credential 'Staking c) Coin
scDeposits = forall c. UMap c -> Map (Credential 'Staking c) Coin
depositMap UMap c
umap
    , scSPools :: Map (Credential 'Staking c) (KeyHash 'StakePool c)
scSPools = forall c.
UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap UMap c
umap
    , scDReps :: Map (Credential 'Staking c) (DRep c)
scDReps = forall c. UMap c -> Map (Credential 'Staking c) (DRep c)
dRepMap UMap c
umap
    , scPtrs :: Map Ptr (Credential 'Staking c)
scPtrs = forall c. UMap c -> Map Ptr (Credential 'Staking c)
ptrMap UMap c
umap
    , scPtrsInverse :: Map (Credential 'Staking c) (Set Ptr)
scPtrsInverse = forall c. UMap c -> Map (Credential 'Staking c) (Set Ptr)
invPtrMap UMap c
umap
    }

domRestrictedStakeCredentials :: Set (Credential 'Staking c) -> UMap c -> StakeCredentials c
domRestrictedStakeCredentials :: forall c.
Set (Credential 'Staking c) -> UMap c -> StakeCredentials c
domRestrictedStakeCredentials Set (Credential 'Staking c)
setk UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} =
  let umElems' :: Map (Credential 'Staking c) (UMElem c)
umElems' = forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (Credential 'Staking c) (UMElem c)
umElems Set (Credential 'Staking c)
setk
      ptrs :: Map (Credential 'Staking c) (Set Ptr)
ptrs = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (Set Ptr)
umElemPtrs Map (Credential 'Staking c) (UMElem c)
umElems'
   in StakeCredentials
        { scRewards :: Map (Credential 'Staking c) Coin
scRewards = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem c
e -> forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdReward forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe RDPair
umElemRDPair UMElem c
e) Map (Credential 'Staking c) (UMElem c)
umElems'
        , scDeposits :: Map (Credential 'Staking c) Coin
scDeposits = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\UMElem c
e -> forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. RDPair -> CompactForm Coin
rdDeposit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. UMElem c -> Maybe RDPair
umElemRDPair UMElem c
e) Map (Credential 'Staking c) (UMElem c)
umElems'
        , scSPools :: Map (Credential 'Staking c) (KeyHash 'StakePool c)
scSPools = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool Map (Credential 'Staking c) (UMElem c)
umElems'
        , scDReps :: Map (Credential 'Staking c) (DRep c)
scDReps = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall c. UMElem c -> Maybe (DRep c)
umElemDRep Map (Credential 'Staking c) (UMElem c)
umElems'
        , scPtrs :: Map Ptr (Credential 'Staking c)
scPtrs = Map Ptr (Credential 'Staking c)
umPtrs forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.restrictKeys` forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking c) (Set Ptr)
ptrs
        , scPtrsInverse :: Map (Credential 'Staking c) (Set Ptr)
scPtrsInverse = Map (Credential 'Staking c) (Set Ptr)
ptrs
        }

-- | All `View`s are `Foldable`
instance Foldable (UView c k) where
  foldMap :: forall m a. Monoid m => (a -> m) -> UView c k a -> m
foldMap a -> m
f = \case
    RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking c -> UMElem c -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum :: m -> Credential 'Staking c -> UMElem c -> m
accum m
ans Credential 'Staking c
_ (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f RDPair
rd
        accum m
ans Credential 'Staking c
_ UMElem c
_ = m
ans
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Map Ptr (Credential 'Staking c)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking c -> UMElem c -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum :: m -> Credential 'Staking c -> UMElem c -> m
accum m
ans Credential 'Staking c
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
sd) StrictMaybe (DRep c)
_) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f KeyHash 'StakePool c
sd
        accum m
ans Credential 'Staking c
_ UMElem c
_ = m
ans
    DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey m -> Credential 'Staking c -> UMElem c -> m
accum forall a. Monoid a => a
mempty Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum :: m -> Credential 'Staking c -> UMElem c -> m
accum m
ans Credential 'Staking c
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
vd)) = m
ans forall a. Semigroup a => a -> a -> a
<> a -> m
f DRep c
vd
        accum m
ans Credential 'Staking c
_ UMElem c
_ = m
ans

  foldr :: forall a b. (a -> b -> b) -> b -> UView c k a -> b
foldr a -> b -> b
accum b
ans0 = \case
    RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem c -> b -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: UMElem c -> b -> b
accum' (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) b
ans = a -> b -> b
accum RDPair
rd b
ans
        accum' UMElem c
_ b
ans = b
ans
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr a -> b -> b
accum b
ans0 Map Ptr (Credential 'Staking c)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem c -> b -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: UMElem c -> b -> b
accum' (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
sd) StrictMaybe (DRep c)
_) b
ans = a -> b -> b
accum KeyHash 'StakePool c
sd b
ans
        accum' UMElem c
_ b
ans = b
ans
    DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> b) -> b -> Map k a -> b
Map.foldr UMElem c -> b -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: UMElem c -> b -> b
accum' (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
vd)) b
ans = a -> b -> b
accum DRep c
vd b
ans
        accum' UMElem c
_ b
ans = b
ans

  foldl' :: forall b a. (b -> a -> b) -> b -> UView c k a -> b
foldl' b -> a -> b
accum b
ans0 = \case
    RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem c -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: b -> UMElem c -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe RDPair
umElemRDPair
    -- umInvariant` for `PtrUView` does not matter here. We just return a `Map` and not a `UMap`.
    PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> a -> b
accum b
ans0 Map Ptr (Credential 'Staking c)
umPtrs
    SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem c -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: b -> UMElem c -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool
    DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' b -> UMElem c -> b
accum' b
ans0 Map (Credential 'Staking c) (UMElem c)
umElems
      where
        accum' :: b -> UMElem c -> b
accum' b
ans = forall b a. b -> (a -> b) -> Maybe a -> b
maybe b
ans (b -> a -> b
accum b
ans) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe (DRep c)
umElemDRep

  length :: forall a. UView c k a -> Int
length = forall c k v. UView c k v -> Int
size

-- | `null` for an `UMElem`
nullUMElem :: UMElem c -> Bool
nullUMElem :: forall c. UMElem c -> Bool
nullUMElem = \case
  UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
SNothing StrictMaybe (DRep c)
SNothing | forall a. Set a -> Bool
Set.null Set Ptr
ptrSet -> Bool
True
  UMElem c
_ -> Bool
False

-- | `null` `Maybe` for an `UMElem`
nullUMElemMaybe :: UMElem c -> Maybe (UMElem c)
nullUMElemMaybe :: forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe = \case
  UMElem c
e | forall c. UMElem c -> Bool
nullUMElem UMElem c
e -> forall a. Maybe a
Nothing
  UMElem c
e -> forall a. a -> Maybe a
Just UMElem c
e

-- | Construct an empty `UMap`
empty :: UMap c
empty :: forall c. UMap c
empty = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty

-- | Delete a key and its value from the map-like `UView`, returning a version of the same `UView`.
--
-- In the case of a `PtrUView` we maintain the `umInvariant` and delete the pairs from both
-- `umElems` as well as `umPtrs` of the `UMap`.
delete' :: k -> UView c k v -> UView c k v
delete' :: forall k c v. k -> UView c k v -> UView c k v
delete' k
key = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) RDPair
rewDepUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
  PtrUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking c)
umPtrs of
    Maybe (Credential 'Staking c)
Nothing -> forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView forall a b. (a -> b) -> a -> b
$ forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map (Credential 'Staking c) (UMElem c)
umElems Map Ptr (Credential 'Staking c)
umPtrs
    Just Credential 'Staking c
cred -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c Ptr (Credential 'Staking c)
ptrUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem c -> Maybe (UMElem c)
go Credential 'Staking c
cred Map (Credential 'Staking c) (UMElem c)
umElems) (forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
key Map Ptr (Credential 'Staking c)
umPtrs)
      where
        go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.delete k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet forall a. StrictMaybe a
SNothing StrictMaybe (DRep c)
dRep
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (DRep c)
dRepUView (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
_) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool forall a. StrictMaybe a
SNothing

delete :: k -> UView c k v -> UMap c
delete :: forall k c v. k -> UView c k v -> UMap c
delete k
k UView c k v
m = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall k c v. k -> UView c k v -> UView c k v
delete' k
k UView c k v
m

-- | Insert with combination
--
-- If `k` exists as a key in the (map-like) `UView`:
--
--   1. to keep the old value
--   > insertWith' (\ old new -> old) k v view
--
--   2. to replace the old value with the new value
--   > insertWith' (\ old new -> new) k v view
--
--   3. to combine the old and new values with summation
--   > insertWith' (\ old new -> old + new) k v view
--
-- If `k` does not exist as a key in the `UView`,
--   the combining function is ignored, and
--   the key `k` and the value `v` are inserted into the map-like `UView`
--   > insertWith' ignoredCombiningFunction k v view
insertWith' :: (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' :: forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' v -> v -> v
combine k
key v
val = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) RDPair
rewDepUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (UMElem c) -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      -- Here 'val' is (CompactForm Coin), but the UMap stores Word64,
      -- so there is some implict coercion going on here using the UMElem pattern
      go :: Maybe (UMElem c) -> Maybe (UMElem c)
go = \case
        Maybe (UMElem c)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem (forall a. a -> StrictMaybe a
SJust v
val) forall a. Set a
Set.empty forall a. StrictMaybe a
SNothing forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) -> forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem (forall a. a -> StrictMaybe a
SJust v
val) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
        Just (UMElem (SJust RDPair
old) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) -> forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine RDPair
old v
val) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
  -- Here `key` is a pointer, and `val` a stake credential.
  -- We use the combining function to combine only the val, i.e. the stake credential.
  -- We do not use the combining function to combine the key, i.e. the pointer.
  -- We also maintain the `umInvariant`.
  PtrUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} ->
    let
      -- We consider what both the old and new stake credentials are
      -- in order to be able to `retract` the pointer to the old credential later on.
      (v
oldCred, v
newCred) = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking c)
umPtrs of
        Maybe (Credential 'Staking c)
Nothing -> (v
val, v
val)
        Just Credential 'Staking c
oldVal -> (Credential 'Staking c
oldVal, v -> v -> v
combine Credential 'Staking c
oldVal v
val)
      -- Delete the old pointer from the set in UMElem, but also delete the whole n-tuple if it goes null.
      -- and, add the new pointer to the set in UMElem after retracting the old one.
      newUmElem :: Map v (UMElem c)
newUmElem = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem c -> Maybe (UMElem c)
addPtr v
newCred forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update UMElem c -> Maybe (UMElem c)
delPtr v
oldCred Map (Credential 'Staking c) (UMElem c)
umElems
        where
          addPtr :: UMElem c -> Maybe (UMElem c)
addPtr (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.insert k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
          delPtr :: UMElem c -> Maybe (UMElem c)
delPtr (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd (forall a. Ord a => a -> Set a -> Set a
Set.delete k
key Set Ptr
ptrSet) StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
      -- `newUmPtr` replaces the old one if one it exists.
      newUmPtr :: Map k v
newUmPtr = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
key v
newCred Map Ptr (Credential 'Staking c)
umPtrs
     in
      forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView forall a b. (a -> b) -> a -> b
$ forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap Map v (UMElem c)
newUmElem Map k v
newUmPtr
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (UMElem c) -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      go :: Maybe (UMElem c) -> Maybe (UMElem c)
go = \case
        Maybe (UMElem c)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem forall a. StrictMaybe a
SNothing forall a. Set a
Set.empty (forall a. a -> StrictMaybe a
SJust v
val) forall a. StrictMaybe a
SNothing
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
SNothing StrictMaybe (DRep c)
dRep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (forall a. a -> StrictMaybe a
SJust v
val) StrictMaybe (DRep c)
dRep
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (SJust KeyHash 'StakePool c
old) StrictMaybe (DRep c)
dRep) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet (forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine KeyHash 'StakePool c
old v
val) StrictMaybe (DRep c)
dRep
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c)
-> UView c (Credential 'Staking c) (DRep c)
dRepUView (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe (UMElem c) -> Maybe (UMElem c)
go k
key Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
    where
      go :: Maybe (UMElem c) -> Maybe (UMElem c)
go = \case
        Maybe (UMElem c)
Nothing -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem forall a. StrictMaybe a
SNothing forall a. Set a
Set.empty forall a. StrictMaybe a
SNothing forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust v
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
SNothing) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust v
val
        Just (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool (SJust DRep c
old)) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool forall a b. (a -> b) -> a -> b
$ forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$ v -> v -> v
combine DRep c
old v
val

insertWith :: (v -> v -> v) -> k -> v -> UView c k v -> UMap c
insertWith :: forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UMap c
insertWith v -> v -> v
combine k
k v
v UView c k v
uview = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' v -> v -> v
combine k
k v
v UView c k v
uview

insert' :: k -> v -> UView c k v -> UView c k v
insert' :: forall k v c. k -> v -> UView c k v -> UView c k v
insert' = forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' forall a b. (a -> b) -> a -> b
$ \v
_old v
new -> v
new

insert :: k -> v -> UView c k v -> UMap c
insert :: forall k v c. k -> v -> UView c k v -> UMap c
insert k
k v
v UView c k v
uview = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall k v c. k -> v -> UView c k v -> UView c k v
insert' k
k v
v UView c k v
uview

-- | Adjust a `UView`, just like `Map.adjust`.
-- This is implemented only for reward-deposit pairs.
adjust :: (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
adjust :: forall k c. (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
adjust RDPair -> RDPair
f k
k (RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs}) = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust UMElem c -> UMElem c
go k
k Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
  where
    go :: UMElem c -> UMElem c
go (UMElem (SJust RDPair
rd) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem (forall a. a -> StrictMaybe a
SJust (RDPair -> RDPair
f RDPair
rd)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
    go (UMElem StrictMaybe RDPair
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep

-- | Lookup a `UView`, just like `Map.lookup`.
lookup :: k -> UView c k v -> Maybe v
lookup :: forall k c v. k -> UView c k v -> Maybe v
lookup k
key = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking c) (UMElem c)
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall c. UMElem c -> Maybe RDPair
umElemRDPair
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking c) (UMElem c)
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
key Map (Credential 'Staking c) (UMElem c)
umElems forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall c. UMElem c -> Maybe (DRep c)
umElemDRep

-- | `null` for a `UView`, just like `Map.null`
nullUView :: UView c k v -> Bool
nullUView :: forall c k a. UView c k a -> Bool
nullUView = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe RDPair
umElemRDPair) Map (Credential 'Staking c) (UMElem c)
umElems
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Map k a -> Bool
Map.null Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe (KeyHash 'StakePool c)
umElemSPool) Map (Credential 'Staking c) (UMElem c)
umElems
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMElem c -> Maybe (DRep c)
umElemDRep) Map (Credential 'Staking c) (UMElem c)
umElems

-- | Get the domain of the `Map`-like `UView`
domain :: UView c k v -> Set k
domain :: forall c k v. UView c k v -> Set k
domain = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a} {c}. Ord a => Set a -> a -> UMElem c -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set a -> a -> UMElem c -> Set a
accum Set a
ans a
k (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem c
_ = Set a
ans
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Map k a -> Set k
Map.keysSet Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a} {c}. Ord a => Set a -> a -> UMElem c -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set a -> a -> UMElem c -> Set a
accum Set a
ans a
k (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
_) StrictMaybe (DRep c)
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem c
_ = Set a
ans
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {a} {c}. Ord a => Set a -> a -> UMElem c -> Set a
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set a -> a -> UMElem c -> Set a
accum Set a
ans a
k (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
_)) = forall a. Ord a => a -> Set a -> Set a
Set.insert a
k Set a
ans
      accum Set a
ans a
_ UMElem c
_ = Set a
ans

-- | Get the range of the `Map`-like `UView`
range :: UView c k v -> Set v
range :: forall c k v. UView c k v -> Set v
range = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall {c}. Set RDPair -> UMElem c -> Set RDPair
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set RDPair -> UMElem c -> Set RDPair
accum Set RDPair
ans (UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert RDPair
rd Set RDPair
ans
      accum Set RDPair
ans UMElem c
_ = Set RDPair
ans
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [a]
Map.elems Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall {c}.
Set (KeyHash 'StakePool c)
-> UMElem c -> Set (KeyHash 'StakePool c)
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set (KeyHash 'StakePool c)
-> UMElem c -> Set (KeyHash 'StakePool c)
accum Set (KeyHash 'StakePool c)
ans (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
sPool) StrictMaybe (DRep c)
_) = forall a. Ord a => a -> Set a -> Set a
Set.insert KeyHash 'StakePool c
sPool Set (KeyHash 'StakePool c)
ans
      accum Set (KeyHash 'StakePool c)
ans UMElem c
_ = Set (KeyHash 'StakePool c)
ans
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> forall a b k. (a -> b -> a) -> a -> Map k b -> a
Map.foldl' forall {c}. Set (DRep c) -> UMElem c -> Set (DRep c)
accum forall a. Set a
Set.empty Map (Credential 'Staking c) (UMElem c)
umElems
    where
      accum :: Set (DRep c) -> UMElem c -> Set (DRep c)
accum Set (DRep c)
ans (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
dRep)) = forall a. Ord a => a -> Set a -> Set a
Set.insert DRep c
dRep Set (DRep c)
ans
      accum Set (DRep c)
ans UMElem c
_ = Set (DRep c)
ans

-- | Union with left preference.
-- So if k, already exists, do nothing, if it doesn't exist insert it.
--
-- Spec:
-- evalUnified (RewDepUView u1 ∪ singleton hk mempty)
-- evalUnified (Ptrs u2 ∪ singleton ptr hk)
unionL, (∪) :: UView c k v -> (k, v) -> UMap c
UView c k v
view ∪ :: forall c k v. UView c k v -> (k, v) -> UMap c
∪ (k
k, v
v) = forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UMap c
insertWith forall a b. a -> b -> a
const k
k v
v UView c k v
view
unionL :: forall c k v. UView c k v -> (k, v) -> UMap c
unionL = forall c k v. UView c k v -> (k, v) -> UMap c
(∪)

-- | Union with right preference.
-- So if k, already exists, then old v is overwritten with the new v.
--
-- Special rules apply for the `RewDepUView`, where only the `rdReward`
-- field of the `RDPair` is overwritten, and the old `rdDeposit` value persists.
--
-- Note: In this case it is an invariant that the domain of the `Map` on the right side
-- is a subset of the domain of the RewDepUView. See the single case in
-- module Cardano.Ledger.Shelley.Rules.Delegs, in the dealing with Withdrawals's where
-- it is used at this type.
--
-- Spec:
-- evalUnified (delegations ds ⨃ singleton hk dpool)
-- evalUnified (rewards' ⨃ wdrls_')
unionR, (⨃) :: UView c k v -> Map k v -> UMap c
(RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs}) ⨃ :: forall c k v. UView c k v -> Map k v -> UMap c
⨃ Map k v
rightUmap = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {k} {c}.
Ord k =>
Map k (UMElem c) -> k -> RDPair -> Map k (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
umElems Map k v
rightUmap) Map Ptr (Credential 'Staking c)
umPtrs
  where
    accum :: Map k (UMElem c) -> k -> RDPair -> Map k (UMElem c)
accum !Map k (UMElem c)
ans k
k (RDPair CompactForm Coin
r CompactForm Coin
_) = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust UMElem c -> UMElem c
overwrite k
k Map k (UMElem c)
ans
      where
        overwrite :: UMElem c -> UMElem c
overwrite (UMElem (SJust (RDPair CompactForm Coin
_ CompactForm Coin
d)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem (forall a. a -> StrictMaybe a
SJust (CompactForm Coin -> CompactForm Coin -> RDPair
RDPair CompactForm Coin
r CompactForm Coin
d)) Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
        overwrite UMElem c
x = UMElem c
x
UView c k v
view ⨃ Map k v
mp = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {c} {k} {v}. UView c k v -> k -> v -> UView c k v
accum UView c k v
view Map k v
mp
  where
    accum :: UView c k v -> k -> v -> UView c k v
accum UView c k v
ans k
k v
v = forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' (\v
_old v
new -> v
new) k
k v
v UView c k v
ans
unionR :: forall c k v. UView c k v -> Map k v -> UMap c
unionR = forall c k v. UView c k v -> Map k v -> UMap c
(⨃)

-- | Add the reward from the `Map` on the right side to the reward in the `UView` on the left.
-- This is only implemented and is applicable to `RewDepUView`s.
--
-- We presume that the domain of the `Map` on the right, is a subset of the domain of the `UView` on the left.
--
-- Spec:
-- evalUnified (rewards dState ∪+ registeredAggregated)
-- evalUnified (rewards' ∪+ update)
-- evalUnified (RewDepUView u0 ∪+ refunds)
unionRewAgg
  , (∪+) ::
    UView c (Credential 'Staking c) RDPair ->
    Map (Credential 'Staking c) (CompactForm Coin) ->
    UMap c
unionRewAgg :: forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
unionRewAgg UView c (Credential 'Staking c) RDPair
view Map (Credential 'Staking c) (CompactForm Coin)
m = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {c}.
UMap c -> Credential 'Staking c -> CompactForm Coin -> UMap c
accum (forall c k v. UView c k v -> UMap c
unUView UView c (Credential 'Staking c) RDPair
view) Map (Credential 'Staking c) (CompactForm Coin)
m
  where
    accum :: UMap c -> Credential 'Staking c -> CompactForm Coin -> UMap c
accum UMap c
umap Credential 'Staking c
key CompactForm Coin
ccoin = forall k c. (RDPair -> RDPair) -> k -> UView c k RDPair -> UMap c
adjust RDPair -> RDPair
combine Credential 'Staking c
key (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap c
umap)
      where
        combine :: RDPair -> RDPair
combine (RDPair CompactForm Coin
r CompactForm Coin
d) = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
r CompactForm Coin
ccoin) CompactForm Coin
d
∪+ :: forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
(∪+) = forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
unionRewAgg

-- | Add the deposit from the `Map` on the right side to the deposit in the `UView` on the left.
-- This is only implemented and is applicable to `RewDepUView`s.
unionKeyDeposits :: UView c k RDPair -> Map k (CompactForm Coin) -> UMap c
unionKeyDeposits :: forall c k. UView c k RDPair -> Map k (CompactForm Coin) -> UMap c
unionKeyDeposits UView c k RDPair
view Map k (CompactForm Coin)
m = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' forall {c} {k}.
UView c k RDPair -> k -> CompactForm Coin -> UView c k RDPair
accum UView c k RDPair
view Map k (CompactForm Coin)
m
  where
    accum :: UView c k RDPair -> k -> CompactForm Coin -> UView c k RDPair
accum UView c k RDPair
vw k
key CompactForm Coin
ccoin = forall v k c. (v -> v -> v) -> k -> v -> UView c k v -> UView c k v
insertWith' RDPair -> RDPair -> RDPair
combine k
key (CompactForm Coin -> CompactForm Coin -> RDPair
RDPair (Word64 -> CompactForm Coin
CompactCoin Word64
0) CompactForm Coin
ccoin) UView c k RDPair
vw
    -- If the key isn't present in the `UMap` the combining function is ignored
    -- and the new `RDPair` is inserted in the `UMap`. Ref: haddock for `insertWith'`.
    combine :: RDPair -> RDPair -> RDPair
combine (RDPair CompactForm Coin
r CompactForm Coin
d) (RDPair CompactForm Coin
_ CompactForm Coin
newD) = CompactForm Coin -> CompactForm Coin -> RDPair
RDPair CompactForm Coin
r (CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
d CompactForm Coin
newD)

-- | Delete all keys in the given `Set` from the domain of the given map-like `UView`.
--
-- Spec:
-- evalUnified (setSingleton hk ⋪ RewDepUView u0)
-- evalUnified (setSingleton hk ⋪ SPoolUView u1)
domDelete, (⋪) :: Set k -> UView c k v -> UMap c
Set k
set ⋪ :: forall k c v. Set k -> UView c k v -> UMap c
⋪ UView c k v
view = forall c k v. UView c k v -> UMap c
unUView (forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k c v. k -> UView c k v -> UView c k v
delete') UView c k v
view Set k
set)
domDelete :: forall k c v. Set k -> UView c k v -> UMap c
domDelete = forall k c v. Set k -> UView c k v -> UMap c
(⋪)

-- | Delete the stake credentials in the domain and all associated ranges from the `UMap`
-- This can be expensive when there are many pointers associated with the credential.
domDeleteAll :: Set (Credential 'Staking c) -> UMap c -> UMap c
domDeleteAll :: forall c. Set (Credential 'Staking c) -> UMap c -> UMap c
domDeleteAll Set (Credential 'Staking c)
ks UMap c
umap = forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr' forall c. Credential 'Staking c -> UMap c -> UMap c
deleteStakingCredential UMap c
umap Set (Credential 'Staking c)
ks

-- | Completely remove the staking credential from the UMap, including all associated
-- pointers.
deleteStakingCredential :: Credential 'Staking c -> UMap c -> UMap c
deleteStakingCredential :: forall c. Credential 'Staking c -> UMap c -> UMap c
deleteStakingCredential Credential 'Staking c
cred = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Credential 'Staking c -> UMap c -> (Maybe (UMElem c), UMap c)
extractStakingCredential Credential 'Staking c
cred

-- | Just like `deleteStakingCredential`, but also returned the removed element.
extractStakingCredential :: Credential 'Staking c -> UMap c -> (Maybe (UMElem c), UMap c)
extractStakingCredential :: forall c.
Credential 'Staking c -> UMap c -> (Maybe (UMElem c), UMap c)
extractStakingCredential Credential 'Staking c
cred umap :: UMap c
umap@UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} =
  case forall k b. Ord k => k -> Map k b -> (Maybe b, Map k b)
MapExtras.extract Credential 'Staking c
cred Map (Credential 'Staking c) (UMElem c)
umElems of
    (Maybe (UMElem c)
Nothing, Map (Credential 'Staking c) (UMElem c)
_) -> (forall a. Maybe a
Nothing, UMap c
umap)
    (e :: Maybe (UMElem c)
e@(Just (UMElem StrictMaybe RDPair
_ Set Ptr
ptrs StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_)), Map (Credential 'Staking c) (UMElem c)
umElems') ->
      ( Maybe (UMElem c)
e
      , UMap
          { umElems :: Map (Credential 'Staking c) (UMElem c)
umElems = Map (Credential 'Staking c) (UMElem c)
umElems'
          , umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs = Map Ptr (Credential 'Staking c)
umPtrs forall k a. Ord k => Map k a -> Set k -> Map k a
`Map.withoutKeys` Set Ptr
ptrs
          }
      )

-- | Delete all elements in the given `Set` from the range of the given map-like `UView`.
-- This is slow for SPoolUView, RewDepUView, and DReps UViews, better hope the sets are small
--
-- Spec:
-- evalUnified (Ptrs u2 ⋫ setSingleton hk)
-- evalUnified (SPoolUView u1 ⋫ retired)
rngDelete, (⋫) :: UView c k v -> Set v -> UMap c
RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} ⋫ :: forall c k v. UView c k v -> Set v -> UMap c
⋫ Set v
rdSet = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
umElems Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
  where
    accum :: Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
ans Credential 'Staking c
key = \case
      UMElem (SJust RDPair
rd) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_
        | forall a. Ord a => a -> Set a -> Bool
Set.member RDPair
rd Set v
rdSet ->
            let go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
_ Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem forall a. StrictMaybe a
SNothing Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go Credential 'Staking c
key Map (Credential 'Staking c) (UMElem c)
ans
      UMElem c
_ -> Map (Credential 'Staking c) (UMElem c)
ans
PtrUView UMap c
um ⋫ Set v
set = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl' forall {c}. UMap c -> Credential 'Staking c -> UMap c
rmCred UMap c
um Set v
set
  where
    rmCred :: UMap c -> Credential 'Staking c -> UMap c
rmCred m :: UMap c
m@UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} Credential 'Staking c
cred = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'Staking c
cred Map (Credential 'Staking c) (UMElem c)
umElems of
      Maybe (UMElem c)
Nothing -> UMap c
m
      Just (UMElem StrictMaybe RDPair
_ Set Ptr
kset StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) ->
        let go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd forall a. Set a
Set.empty StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
dRep
         in forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go Credential 'Staking c
cred Map (Credential 'Staking c) (UMElem c)
umElems) (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map Ptr (Credential 'Staking c)
umPtrs Set Ptr
kset)
SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} ⋫ Set v
sPoolSet = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
umElems Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
  where
    accum :: Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
ans Credential 'Staking c
key = \case
      UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
sPool) StrictMaybe (DRep c)
_
        | forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool c
sPool Set v
sPoolSet ->
            let go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
dRep) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet forall a. StrictMaybe a
SNothing StrictMaybe (DRep c)
dRep
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go Credential 'Staking c
key Map (Credential 'Staking c) (UMElem c)
ans
      UMElem c
_ -> Map (Credential 'Staking c) (UMElem c)
ans
DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems, Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} ⋫ Set v
dRepSet = forall c.
Map (Credential 'Staking c) (UMElem c)
-> Map Ptr (Credential 'Staking c) -> UMap c
UMap (forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
umElems Map (Credential 'Staking c) (UMElem c)
umElems) Map Ptr (Credential 'Staking c)
umPtrs
  where
    accum :: Map (Credential 'Staking c) (UMElem c)
-> Credential 'Staking c
-> UMElem c
-> Map (Credential 'Staking c) (UMElem c)
accum Map (Credential 'Staking c) (UMElem c)
ans Credential 'Staking c
key = \case
      UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
dRep)
        | forall a. Ord a => a -> Set a -> Bool
Set.member DRep c
dRep Set v
dRepSet ->
            let go :: UMElem c -> Maybe (UMElem c)
go (UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool StrictMaybe (DRep c)
_) = forall c. UMElem c -> Maybe (UMElem c)
nullUMElemMaybe forall a b. (a -> b) -> a -> b
$ forall c.
StrictMaybe RDPair
-> Set Ptr
-> StrictMaybe (KeyHash 'StakePool c)
-> StrictMaybe (DRep c)
-> UMElem c
UMElem StrictMaybe RDPair
rd Set Ptr
ptrSet StrictMaybe (KeyHash 'StakePool c)
sPool forall a. StrictMaybe a
SNothing
             in forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update forall c. UMElem c -> Maybe (UMElem c)
go Credential 'Staking c
key Map (Credential 'Staking c) (UMElem c)
ans
      UMElem c
_ -> Map (Credential 'Staking c) (UMElem c)
ans
rngDelete :: forall c k v. UView c k v -> Set v -> UMap c
rngDelete = forall c k v. UView c k v -> Set v -> UMap c
(⋫)

-- | Checks for membership directly against `umElems` instead of a `UView`.
member' :: Credential 'Staking c -> UMap c -> Bool
member' :: forall c. Credential 'Staking c -> UMap c -> Bool
member' Credential 'Staking c
k = forall k a. Ord k => k -> Map k a -> Bool
Map.member Credential 'Staking c
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems

-- | Membership check for a `UView`, just like `Map.member`
--
-- Spec:
-- eval (k ∈ dom (rewards dState))
-- eval (k ∈ dom (rewards ds)))
-- eval (hk ∈ dom (rewards ds))
-- eval (hk ∉ dom (rewards ds))
member, notMember :: k -> UView c k v -> Bool
member :: forall k c v. k -> UView c k v -> Bool
member k
k = \case
  RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking c) (UMElem c)
umElems of
    Just (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) -> Bool
True
    Maybe (UMElem c)
_ -> Bool
False
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Ord k => k -> Map k a -> Bool
Map.member k
k Map Ptr (Credential 'Staking c)
umPtrs
  SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking c) (UMElem c)
umElems of
    Just (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
_) StrictMaybe (DRep c)
_) -> Bool
True
    Maybe (UMElem c)
_ -> Bool
False
  DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map (Credential 'Staking c) (UMElem c)
umElems of
    Just (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
_)) -> Bool
True
    Maybe (UMElem c)
_ -> Bool
False
notMember :: forall k c v. k -> UView c k v -> Bool
notMember k
k UView c k v
um = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall k c v. k -> UView c k v -> Bool
member k
k UView c k v
um

-- | Domain restriction.
--
-- Spec:
-- eval (dom rewards' ◁ iRReserves (_irwd ds) :: RewardAccounts (Crypto era))
-- eval (dom rewards' ◁ iRTreasury (_irwd ds) :: RewardAccounts (Crypto era))
(◁), domRestrict :: UView c k v -> Map k u -> Map k u
RewDepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ◁ :: forall c k v u. UView c k v -> Map k u -> Map k u
◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p} {c}. p -> UMElem c -> Bool
p Map k u
m Map (Credential 'Staking c) (UMElem c)
umElems
  where
    p :: p -> UMElem c -> Bool
p p
_ (UMElem (SJust RDPair
_) Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ StrictMaybe (DRep c)
_) = Bool
True
    p p
_ UMElem c
_ = Bool
False
PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} ◁ Map k u
m = forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection Map k u
m Map Ptr (Credential 'Staking c)
umPtrs
SPoolUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p} {c}. p -> UMElem c -> Bool
p Map k u
m Map (Credential 'Staking c) (UMElem c)
umElems
  where
    p :: p -> UMElem c -> Bool
p p
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ (SJust KeyHash 'StakePool c
_) StrictMaybe (DRep c)
_) = Bool
True
    p p
_ UMElem c
_ = Bool
False
DRepUView UMap {Map (Credential 'Staking c) (UMElem c)
umElems :: Map (Credential 'Staking c) (UMElem c)
umElems :: forall c. UMap c -> Map (Credential 'Staking c) (UMElem c)
umElems} ◁ Map k u
m = forall k v2 v1.
Ord k =>
(k -> v2 -> Bool) -> Map k v1 -> Map k v2 -> Map k v1
intersectDomPLeft forall {p} {c}. p -> UMElem c -> Bool
p Map k u
m Map (Credential 'Staking c) (UMElem c)
umElems
  where
    p :: p -> UMElem c -> Bool
p p
_ (UMElem StrictMaybe RDPair
_ Set Ptr
_ StrictMaybe (KeyHash 'StakePool c)
_ (SJust DRep c
_)) = Bool
True
    p p
_ UMElem c
_ = Bool
False
domRestrict :: forall c k v u. UView c k v -> Map k u -> Map k u
domRestrict = forall c k v u. UView c k v -> Map k u -> Map k u
(◁)

-- | Find the value associated with a key from a `UView`, return the default if the key is not there.
findWithDefault :: v -> k -> UView c k v -> v
findWithDefault :: forall v k c. v -> k -> UView c k v -> v
findWithDefault v
def k
k = forall a. a -> Maybe a -> a
fromMaybe v
def forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k c v. k -> UView c k v -> Maybe v
lookup k
k

-- | A `UView` is a view, so the size of the view is NOT the same as the size of
-- the underlying `UMElem` map.
size :: UView c k v -> Int
size :: forall c k v. UView c k v -> Int
size = \case
  PtrUView UMap {Map Ptr (Credential 'Staking c)
umPtrs :: Map Ptr (Credential 'Staking c)
umPtrs :: forall c. UMap c -> Map Ptr (Credential 'Staking c)
umPtrs} -> forall k a. Map k a -> Int
Map.size Map Ptr (Credential 'Staking c)
umPtrs
  UView c k v
x -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
count v
_v -> Int
count forall a. Num a => a -> a -> a
+ Int
1) Int
0 UView c k v
x

-- | Create a UMap from 4 separate maps. NOTE: For use in tests only.
unify ::
  Map (Credential 'Staking c) RDPair ->
  Map Ptr (Credential 'Staking c) ->
  Map (Credential 'Staking c) (KeyHash 'StakePool c) ->
  Map (Credential 'Staking c) (DRep c) ->
  UMap c
unify :: forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify Map (Credential 'Staking c) RDPair
rd Map Ptr (Credential 'Staking c)
ptr Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPool Map (Credential 'Staking c) (DRep c)
dRep = UMap c
um4
  where
    um1 :: UMap c
um1 = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView c (Credential 'Staking c) RDPair
um Credential 'Staking c
k RDPair
v -> forall k v c. k -> v -> UView c k v -> UView c k v
insert' Credential 'Staking c
k RDPair
v UView c (Credential 'Staking c) RDPair
um) (forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView forall c. UMap c
empty) Map (Credential 'Staking c) RDPair
rd
    um2 :: UMap c
um2 = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView c (Credential 'Staking c) (KeyHash 'StakePool c)
um Credential 'Staking c
k KeyHash 'StakePool c
v -> forall k v c. k -> v -> UView c k v -> UView c k v
insert' Credential 'Staking c
k KeyHash 'StakePool c
v UView c (Credential 'Staking c) (KeyHash 'StakePool c)
um) (forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView UMap c
um1) Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPool
    um3 :: UMap c
um3 = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView c (Credential 'Staking c) (DRep c)
um Credential 'Staking c
k DRep c
v -> forall k v c. k -> v -> UView c k v -> UView c k v
insert' Credential 'Staking c
k DRep c
v UView c (Credential 'Staking c) (DRep c)
um) (forall c. UMap c -> UView c (Credential 'Staking c) (DRep c)
DRepUView UMap c
um2) Map (Credential 'Staking c) (DRep c)
dRep
    um4 :: UMap c
um4 = forall c k v. UView c k v -> UMap c
unUView forall a b. (a -> b) -> a -> b
$ forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' (\UView c Ptr (Credential 'Staking c)
um Ptr
k Credential 'Staking c
v -> forall k v c. k -> v -> UView c k v -> UView c k v
insert' Ptr
k Credential 'Staking c
v UView c Ptr (Credential 'Staking c)
um) (forall c. UMap c -> UView c Ptr (Credential 'Staking c)
PtrUView UMap c
um3) Map Ptr (Credential 'Staking c)
ptr

addCompact :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact :: CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact (CompactCoin Word64
x) (CompactCoin Word64
y) = Word64 -> CompactForm Coin
CompactCoin (Word64
x forall a. Num a => a -> a -> a
+ Word64
y)

sumCompactCoin :: Foldable t => t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin :: forall (t :: * -> *).
Foldable t =>
t (CompactForm Coin) -> CompactForm Coin
sumCompactCoin = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact (Word64 -> CompactForm Coin
CompactCoin Word64
0)

sumRewardsUView :: UView c k RDPair -> CompactForm Coin
sumRewardsUView :: forall c k. UView c k RDPair -> CompactForm Coin
sumRewardsUView = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> RDPair -> CompactForm Coin
accum (Word64 -> CompactForm Coin
CompactCoin Word64
0)
  where
    accum :: CompactForm Coin -> RDPair -> CompactForm Coin
accum CompactForm Coin
ans (RDPair CompactForm Coin
r CompactForm Coin
_) = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
ans CompactForm Coin
r

sumDepositUView :: UView c k RDPair -> CompactForm Coin
sumDepositUView :: forall c k. UView c k RDPair -> CompactForm Coin
sumDepositUView = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' CompactForm Coin -> RDPair -> CompactForm Coin
accum (Word64 -> CompactForm Coin
CompactCoin Word64
0)
  where
    accum :: CompactForm Coin -> RDPair -> CompactForm Coin
accum CompactForm Coin
ans (RDPair CompactForm Coin
_ CompactForm Coin
d) = CompactForm Coin -> CompactForm Coin -> CompactForm Coin
addCompact CompactForm Coin
ans CompactForm Coin
d