{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.State.Account (
ShelleyAccounts (..),
ShelleyAccountState (..),
ShelleyEraAccounts (mkShelleyAccountState, accountsPtrsMapG, ptrAccountStateG),
shelleyAddAccountState,
registerShelleyAccount,
unregisterShelleyAccount,
) where
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin
import Cardano.Ledger.Credential
import Cardano.Ledger.Hashes
import Cardano.Ledger.Shelley.Era
import Cardano.Ledger.State hiding (balance)
import Control.DeepSeq (NFData (rnf), deepseq, rwhnf)
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.Aeson as Aeson (ToJSON (..), (.=))
import Data.Default
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.MapExtras as Map (extract)
import Data.Typeable
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
data ShelleyAccountState era
= ShelleyAccountState
{ forall era. ShelleyAccountState era -> Ptr
sasPtr :: {-# UNPACK #-} !Ptr
, forall era. ShelleyAccountState era -> CompactForm Coin
sasBalance :: {-# UNPACK #-} !(CompactForm Coin)
, forall era. ShelleyAccountState era -> CompactForm Coin
sasDeposit :: {-# UNPACK #-} !(CompactForm Coin)
, forall era.
ShelleyAccountState era -> StrictMaybe (KeyHash 'StakePool)
sasStakePoolDelegation :: !(StrictMaybe (KeyHash 'StakePool))
}
deriving (Int -> ShelleyAccountState era -> ShowS
[ShelleyAccountState era] -> ShowS
ShelleyAccountState era -> String
(Int -> ShelleyAccountState era -> ShowS)
-> (ShelleyAccountState era -> String)
-> ([ShelleyAccountState era] -> ShowS)
-> Show (ShelleyAccountState era)
forall era. Int -> ShelleyAccountState era -> ShowS
forall era. [ShelleyAccountState era] -> ShowS
forall era. ShelleyAccountState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyAccountState era -> ShowS
showsPrec :: Int -> ShelleyAccountState era -> ShowS
$cshow :: forall era. ShelleyAccountState era -> String
show :: ShelleyAccountState era -> String
$cshowList :: forall era. [ShelleyAccountState era] -> ShowS
showList :: [ShelleyAccountState era] -> ShowS
Show, ShelleyAccountState era -> ShelleyAccountState era -> Bool
(ShelleyAccountState era -> ShelleyAccountState era -> Bool)
-> (ShelleyAccountState era -> ShelleyAccountState era -> Bool)
-> Eq (ShelleyAccountState era)
forall era.
ShelleyAccountState era -> ShelleyAccountState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ShelleyAccountState era -> ShelleyAccountState era -> Bool
== :: ShelleyAccountState era -> ShelleyAccountState era -> Bool
$c/= :: forall era.
ShelleyAccountState era -> ShelleyAccountState era -> Bool
/= :: ShelleyAccountState era -> ShelleyAccountState era -> Bool
Eq, (forall x.
ShelleyAccountState era -> Rep (ShelleyAccountState era) x)
-> (forall x.
Rep (ShelleyAccountState era) x -> ShelleyAccountState era)
-> Generic (ShelleyAccountState era)
forall x.
Rep (ShelleyAccountState era) x -> ShelleyAccountState era
forall x.
ShelleyAccountState era -> Rep (ShelleyAccountState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyAccountState era) x -> ShelleyAccountState era
forall era x.
ShelleyAccountState era -> Rep (ShelleyAccountState era) x
$cfrom :: forall era x.
ShelleyAccountState era -> Rep (ShelleyAccountState era) x
from :: forall x.
ShelleyAccountState era -> Rep (ShelleyAccountState era) x
$cto :: forall era x.
Rep (ShelleyAccountState era) x -> ShelleyAccountState era
to :: forall x.
Rep (ShelleyAccountState era) x -> ShelleyAccountState era
Generic)
instance NoThunks (ShelleyAccountState era)
instance NFData (ShelleyAccountState era) where
rnf :: ShelleyAccountState era -> ()
rnf = ShelleyAccountState era -> ()
forall a. a -> ()
rwhnf
instance Typeable era => EncCBOR (ShelleyAccountState era) where
encCBOR :: ShelleyAccountState era -> Encoding
encCBOR sas :: ShelleyAccountState era
sas@(ShelleyAccountState Ptr
_ CompactForm Coin
_ CompactForm Coin
_ StrictMaybe (KeyHash 'StakePool)
_) =
let ShelleyAccountState {StrictMaybe (KeyHash 'StakePool)
CompactForm Coin
Ptr
sasPtr :: forall era. ShelleyAccountState era -> Ptr
sasBalance :: forall era. ShelleyAccountState era -> CompactForm Coin
sasDeposit :: forall era. ShelleyAccountState era -> CompactForm Coin
sasStakePoolDelegation :: forall era.
ShelleyAccountState era -> StrictMaybe (KeyHash 'StakePool)
sasPtr :: Ptr
sasBalance :: CompactForm Coin
sasDeposit :: CompactForm Coin
sasStakePoolDelegation :: StrictMaybe (KeyHash 'StakePool)
..} = ShelleyAccountState era
sas
in Word -> Encoding
encodeListLen Word
4
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Ptr -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Ptr
sasPtr
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
sasBalance
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
sasDeposit
Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (KeyHash 'StakePool -> Encoding)
-> StrictMaybe (KeyHash 'StakePool) -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe KeyHash 'StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe (KeyHash 'StakePool)
sasStakePoolDelegation
instance Typeable era => DecShareCBOR (ShelleyAccountState era) where
type
Share (ShelleyAccountState era) =
(Interns (KeyHash 'StakePool), Interns (Credential 'DRepRole))
decShareCBOR :: forall s.
Share (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era)
decShareCBOR (Interns (KeyHash 'StakePool)
ks, Interns (Credential 'DRepRole)
_) =
Text
-> (ShelleyAccountState era -> Int)
-> Decoder s (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyAccountState" (Int -> ShelleyAccountState era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era))
-> Decoder s (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era)
forall a b. (a -> b) -> a -> b
$
Ptr
-> CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool)
-> ShelleyAccountState era
forall era.
Ptr
-> CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool)
-> ShelleyAccountState era
ShelleyAccountState
(Ptr
-> CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool)
-> ShelleyAccountState era)
-> Decoder s Ptr
-> Decoder
s
(CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool)
-> ShelleyAccountState era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Ptr
forall s. Decoder s Ptr
forall a s. DecCBOR a => Decoder s a
decCBOR
Decoder
s
(CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool)
-> ShelleyAccountState era)
-> Decoder s (CompactForm Coin)
-> Decoder
s
(CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool) -> ShelleyAccountState era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR
Decoder
s
(CompactForm Coin
-> StrictMaybe (KeyHash 'StakePool) -> ShelleyAccountState era)
-> Decoder s (CompactForm Coin)
-> Decoder
s (StrictMaybe (KeyHash 'StakePool) -> ShelleyAccountState era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (CompactForm Coin)
forall s. Decoder s (CompactForm Coin)
forall a s. DecCBOR a => Decoder s a
decCBOR
Decoder
s (StrictMaybe (KeyHash 'StakePool) -> ShelleyAccountState era)
-> Decoder s (StrictMaybe (KeyHash 'StakePool))
-> Decoder s (ShelleyAccountState era)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (KeyHash 'StakePool)
-> Decoder s (StrictMaybe (KeyHash 'StakePool))
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe (Interns (KeyHash 'StakePool)
-> KeyHash 'StakePool -> KeyHash 'StakePool
forall k. Interns k -> k -> k
interns Interns (KeyHash 'StakePool)
ks (KeyHash 'StakePool -> KeyHash 'StakePool)
-> Decoder s (KeyHash 'StakePool) -> Decoder s (KeyHash 'StakePool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (KeyHash 'StakePool)
forall s. Decoder s (KeyHash 'StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR)
instance ToKeyValuePairs (ShelleyAccountState era) where
toKeyValuePairs :: forall e kv. KeyValue e kv => ShelleyAccountState era -> [kv]
toKeyValuePairs sas :: ShelleyAccountState era
sas@(ShelleyAccountState Ptr
_ CompactForm Coin
_ CompactForm Coin
_ StrictMaybe (KeyHash 'StakePool)
_) =
let ShelleyAccountState {StrictMaybe (KeyHash 'StakePool)
CompactForm Coin
Ptr
sasPtr :: forall era. ShelleyAccountState era -> Ptr
sasBalance :: forall era. ShelleyAccountState era -> CompactForm Coin
sasDeposit :: forall era. ShelleyAccountState era -> CompactForm Coin
sasStakePoolDelegation :: forall era.
ShelleyAccountState era -> StrictMaybe (KeyHash 'StakePool)
sasPtr :: Ptr
sasBalance :: CompactForm Coin
sasDeposit :: CompactForm Coin
sasStakePoolDelegation :: StrictMaybe (KeyHash 'StakePool)
..} = ShelleyAccountState era
sas
in [ Key
"reward" Key -> CompactForm Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
sasBalance
, Key
"balance" Key -> CompactForm Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
sasBalance
, Key
"deposit" Key -> CompactForm Coin -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= CompactForm Coin
sasDeposit
, Key
"ptr" Key -> Ptr -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Ptr
sasPtr
, Key
"spool" Key -> StrictMaybe (KeyHash 'StakePool) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe (KeyHash 'StakePool)
sasStakePoolDelegation
]
deriving via KeyValuePairs (ShelleyAccountState era) instance ToJSON (ShelleyAccountState era)
data ShelleyAccounts era = ShelleyAccounts
{ forall era.
ShelleyAccounts era
-> Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: !(Map (Credential 'Staking) (ShelleyAccountState era))
, forall era. ShelleyAccounts era -> Map Ptr (Credential 'Staking)
saPtrs :: !(Map Ptr (Credential 'Staking))
}
deriving (Int -> ShelleyAccounts era -> ShowS
[ShelleyAccounts era] -> ShowS
ShelleyAccounts era -> String
(Int -> ShelleyAccounts era -> ShowS)
-> (ShelleyAccounts era -> String)
-> ([ShelleyAccounts era] -> ShowS)
-> Show (ShelleyAccounts era)
forall era. Int -> ShelleyAccounts era -> ShowS
forall era. [ShelleyAccounts era] -> ShowS
forall era. ShelleyAccounts era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyAccounts era -> ShowS
showsPrec :: Int -> ShelleyAccounts era -> ShowS
$cshow :: forall era. ShelleyAccounts era -> String
show :: ShelleyAccounts era -> String
$cshowList :: forall era. [ShelleyAccounts era] -> ShowS
showList :: [ShelleyAccounts era] -> ShowS
Show, ShelleyAccounts era -> ShelleyAccounts era -> Bool
(ShelleyAccounts era -> ShelleyAccounts era -> Bool)
-> (ShelleyAccounts era -> ShelleyAccounts era -> Bool)
-> Eq (ShelleyAccounts era)
forall era. ShelleyAccounts era -> ShelleyAccounts era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. ShelleyAccounts era -> ShelleyAccounts era -> Bool
== :: ShelleyAccounts era -> ShelleyAccounts era -> Bool
$c/= :: forall era. ShelleyAccounts era -> ShelleyAccounts era -> Bool
/= :: ShelleyAccounts era -> ShelleyAccounts era -> Bool
Eq, (forall x. ShelleyAccounts era -> Rep (ShelleyAccounts era) x)
-> (forall x. Rep (ShelleyAccounts era) x -> ShelleyAccounts era)
-> Generic (ShelleyAccounts era)
forall x. Rep (ShelleyAccounts era) x -> ShelleyAccounts era
forall x. ShelleyAccounts era -> Rep (ShelleyAccounts era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ShelleyAccounts era) x -> ShelleyAccounts era
forall era x. ShelleyAccounts era -> Rep (ShelleyAccounts era) x
$cfrom :: forall era x. ShelleyAccounts era -> Rep (ShelleyAccounts era) x
from :: forall x. ShelleyAccounts era -> Rep (ShelleyAccounts era) x
$cto :: forall era x. Rep (ShelleyAccounts era) x -> ShelleyAccounts era
to :: forall x. Rep (ShelleyAccounts era) x -> ShelleyAccounts era
Generic)
instance NoThunks (ShelleyAccounts era)
instance NFData (ShelleyAccounts era) where
rnf :: ShelleyAccounts era -> ()
rnf (ShelleyAccounts Map (Credential 'Staking) (ShelleyAccountState era)
accounts Map Ptr (Credential 'Staking)
accountPtr) =
Map (Credential 'Staking) (ShelleyAccountState era)
accounts Map (Credential 'Staking) (ShelleyAccountState era) -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` Map Ptr (Credential 'Staking) -> ()
forall a. NFData a => a -> ()
rnf Map Ptr (Credential 'Staking)
accountPtr
instance Typeable era => EncCBOR (ShelleyAccounts era) where
encCBOR :: ShelleyAccounts era -> Encoding
encCBOR ShelleyAccounts {Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: forall era.
ShelleyAccounts era
-> Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: Map (Credential 'Staking) (ShelleyAccountState era)
saStates, Map Ptr (Credential 'Staking)
saPtrs :: forall era. ShelleyAccounts era -> Map Ptr (Credential 'Staking)
saPtrs :: Map Ptr (Credential 'Staking)
saPtrs} =
Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map (Credential 'Staking) (ShelleyAccountState era) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map (Credential 'Staking) (ShelleyAccountState era)
saStates Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Map Ptr (Credential 'Staking) -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Map Ptr (Credential 'Staking)
saPtrs
instance Typeable era => DecShareCBOR (ShelleyAccounts era) where
type
Share (ShelleyAccounts era) =
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool), Interns (Credential 'DRepRole))
decSharePlusCBOR :: forall s.
StateT
(Share (ShelleyAccounts era)) (Decoder s) (ShelleyAccounts era)
decSharePlusCBOR =
((Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole))))
-> StateT
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole))
(Decoder s)
(ShelleyAccounts era)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT
( \(Interns (Credential 'Staking)
a, Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
c) ->
Text
-> ((ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Int)
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ShelleyAccounts" (Int
-> (ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Int
forall a b. a -> b -> a
const Int
2) (Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole))))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
forall a b. (a -> b) -> a -> b
$ do
Map (Credential 'Staking) (ShelleyAccountState era)
saStates <- Decoder s (Credential 'Staking)
-> Decoder s (ShelleyAccountState era)
-> Decoder s (Map (Credential 'Staking) (ShelleyAccountState era))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap (Interns (Credential 'Staking)
-> Credential 'Staking -> Credential 'Staking
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a (Credential 'Staking -> Credential 'Staking)
-> Decoder s (Credential 'Staking)
-> Decoder s (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR) (Share (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (ShelleyAccountState era)
-> Decoder s (ShelleyAccountState era)
decShareCBOR (Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
c))
let a' :: Interns (Credential 'Staking)
a' = Map (Credential 'Staking) (ShelleyAccountState era)
-> Interns (Credential 'Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential 'Staking) (ShelleyAccountState era)
saStates Interns (Credential 'Staking)
-> Interns (Credential 'Staking) -> Interns (Credential 'Staking)
forall a. Semigroup a => a -> a -> a
<> Interns (Credential 'Staking)
a
Map Ptr (Credential 'Staking)
saPtrs <- Decoder s Ptr
-> Decoder s (Credential 'Staking)
-> Decoder s (Map Ptr (Credential 'Staking))
forall k s v.
Ord k =>
Decoder s k -> Decoder s v -> Decoder s (Map k v)
decodeMap Decoder s Ptr
forall s. Decoder s Ptr
forall a s. DecCBOR a => Decoder s a
decCBOR (Interns (Credential 'Staking)
-> Credential 'Staking -> Credential 'Staking
forall k. Interns k -> k -> k
interns Interns (Credential 'Staking)
a' (Credential 'Staking -> Credential 'Staking)
-> Decoder s (Credential 'Staking)
-> Decoder s (Credential 'Staking)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Credential 'Staking)
forall s. Decoder s (Credential 'Staking)
forall a s. DecCBOR a => Decoder s a
decCBOR)
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
-> Decoder
s
(ShelleyAccounts era,
(Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
Interns (Credential 'DRepRole)))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ShelleyAccounts {Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: Map (Credential 'Staking) (ShelleyAccountState era)
saStates, Map Ptr (Credential 'Staking)
saPtrs :: Map Ptr (Credential 'Staking)
saPtrs :: Map Ptr (Credential 'Staking)
saPtrs}, (Interns (Credential 'Staking)
a', Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
c))
)
instance ToKeyValuePairs (ShelleyAccounts era) where
toKeyValuePairs :: forall e kv. KeyValue e kv => ShelleyAccounts era -> [kv]
toKeyValuePairs sa :: ShelleyAccounts era
sa@(ShelleyAccounts Map (Credential 'Staking) (ShelleyAccountState era)
_ Map Ptr (Credential 'Staking)
_) =
let ShelleyAccounts {Map Ptr (Credential 'Staking)
Map (Credential 'Staking) (ShelleyAccountState era)
saStates :: forall era.
ShelleyAccounts era
-> Map (Credential 'Staking) (ShelleyAccountState era)
saPtrs :: forall era. ShelleyAccounts era -> Map Ptr (Credential 'Staking)
saStates :: Map (Credential 'Staking) (ShelleyAccountState era)
saPtrs :: Map Ptr (Credential 'Staking)
..} = ShelleyAccounts era
sa
in [ Key
"credentials" Key -> Map (Credential 'Staking) (ShelleyAccountState era) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (Credential 'Staking) (ShelleyAccountState era)
saStates
, Key
"pointers" Key -> Map Ptr (Credential 'Staking) -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map Ptr (Credential 'Staking)
saPtrs
]
deriving via KeyValuePairs (ShelleyAccounts era) instance ToJSON (ShelleyAccounts era)
instance Default (ShelleyAccounts era) where
def :: ShelleyAccounts era
def = Map (Credential 'Staking) (ShelleyAccountState era)
-> Map Ptr (Credential 'Staking) -> ShelleyAccounts era
forall era.
Map (Credential 'Staking) (ShelleyAccountState era)
-> Map Ptr (Credential 'Staking) -> ShelleyAccounts era
ShelleyAccounts Map (Credential 'Staking) (ShelleyAccountState era)
forall a. Monoid a => a
mempty Map Ptr (Credential 'Staking)
forall a. Monoid a => a
mempty
instance EraAccounts ShelleyEra where
type AccountState ShelleyEra = ShelleyAccountState ShelleyEra
type Accounts ShelleyEra = ShelleyAccounts ShelleyEra
addAccountState :: Credential 'Staking
-> AccountState ShelleyEra
-> Accounts ShelleyEra
-> Accounts ShelleyEra
addAccountState = Credential 'Staking
-> AccountState ShelleyEra
-> Accounts ShelleyEra
-> Accounts ShelleyEra
forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> AccountState era -> Accounts era -> Accounts era
shelleyAddAccountState
accountsMapL :: Lens'
(Accounts ShelleyEra)
(Map (Credential 'Staking) (AccountState ShelleyEra))
accountsMapL = (Accounts ShelleyEra
-> Map (Credential 'Staking) (AccountState ShelleyEra))
-> (Accounts ShelleyEra
-> Map (Credential 'Staking) (AccountState ShelleyEra)
-> Accounts ShelleyEra)
-> Lens'
(Accounts ShelleyEra)
(Map (Credential 'Staking) (AccountState ShelleyEra))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Accounts ShelleyEra
-> Map (Credential 'Staking) (AccountState ShelleyEra)
ShelleyAccounts ShelleyEra
-> Map (Credential 'Staking) (ShelleyAccountState ShelleyEra)
forall era.
ShelleyAccounts era
-> Map (Credential 'Staking) (ShelleyAccountState era)
saStates ((Accounts ShelleyEra
-> Map (Credential 'Staking) (AccountState ShelleyEra)
-> Accounts ShelleyEra)
-> Lens'
(Accounts ShelleyEra)
(Map (Credential 'Staking) (AccountState ShelleyEra)))
-> (Accounts ShelleyEra
-> Map (Credential 'Staking) (AccountState ShelleyEra)
-> Accounts ShelleyEra)
-> Lens'
(Accounts ShelleyEra)
(Map (Credential 'Staking) (AccountState ShelleyEra))
forall a b. (a -> b) -> a -> b
$ \Accounts ShelleyEra
sas Map (Credential 'Staking) (AccountState ShelleyEra)
asMap -> Accounts ShelleyEra
sas {saStates = asMap}
balanceAccountStateL :: Lens' (AccountState ShelleyEra) (CompactForm Coin)
balanceAccountStateL = (AccountState ShelleyEra -> CompactForm Coin)
-> (AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState ShelleyEra -> CompactForm Coin
ShelleyAccountState ShelleyEra -> CompactForm Coin
forall era. ShelleyAccountState era -> CompactForm Coin
sasBalance ((AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin))
-> (AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ \AccountState ShelleyEra
sas CompactForm Coin
b -> AccountState ShelleyEra
sas {sasBalance = b}
depositAccountStateL :: Lens' (AccountState ShelleyEra) (CompactForm Coin)
depositAccountStateL = (AccountState ShelleyEra -> CompactForm Coin)
-> (AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState ShelleyEra -> CompactForm Coin
ShelleyAccountState ShelleyEra -> CompactForm Coin
forall era. ShelleyAccountState era -> CompactForm Coin
sasDeposit ((AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin))
-> (AccountState ShelleyEra
-> CompactForm Coin -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ \AccountState ShelleyEra
sas CompactForm Coin
d -> AccountState ShelleyEra
sas {sasDeposit = d}
stakePoolDelegationAccountStateL :: Lens' (AccountState ShelleyEra) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL =
(AccountState ShelleyEra -> Maybe (KeyHash 'StakePool))
-> (AccountState ShelleyEra
-> Maybe (KeyHash 'StakePool) -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (Maybe (KeyHash 'StakePool))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (StrictMaybe (KeyHash 'StakePool) -> Maybe (KeyHash 'StakePool)
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe (KeyHash 'StakePool) -> Maybe (KeyHash 'StakePool))
-> (ShelleyAccountState ShelleyEra
-> StrictMaybe (KeyHash 'StakePool))
-> ShelleyAccountState ShelleyEra
-> Maybe (KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyAccountState ShelleyEra -> StrictMaybe (KeyHash 'StakePool)
forall era.
ShelleyAccountState era -> StrictMaybe (KeyHash 'StakePool)
sasStakePoolDelegation) ((AccountState ShelleyEra
-> Maybe (KeyHash 'StakePool) -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (Maybe (KeyHash 'StakePool)))
-> (AccountState ShelleyEra
-> Maybe (KeyHash 'StakePool) -> AccountState ShelleyEra)
-> Lens' (AccountState ShelleyEra) (Maybe (KeyHash 'StakePool))
forall a b. (a -> b) -> a -> b
$ \AccountState ShelleyEra
sas Maybe (KeyHash 'StakePool)
d ->
AccountState ShelleyEra
sas {sasStakePoolDelegation = maybeToStrictMaybe d}
unregisterAccount :: Credential 'Staking
-> Accounts ShelleyEra
-> (Maybe (AccountState ShelleyEra), Accounts ShelleyEra)
unregisterAccount = Credential 'Staking
-> Accounts ShelleyEra
-> (Maybe (AccountState ShelleyEra), Accounts ShelleyEra)
forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterShelleyAccount
instance ShelleyEraAccounts ShelleyEra
class EraAccounts era => ShelleyEraAccounts era where
mkShelleyAccountState :: Ptr -> CompactForm Coin -> AccountState era
default mkShelleyAccountState ::
AccountState era ~ ShelleyAccountState era =>
Ptr ->
CompactForm Coin ->
AccountState era
mkShelleyAccountState Ptr
ptr CompactForm Coin
deposit =
ShelleyAccountState
{ sasPtr :: Ptr
sasPtr = Ptr
ptr
, sasBalance :: CompactForm Coin
sasBalance = CompactForm Coin
forall a. Monoid a => a
mempty
, sasDeposit :: CompactForm Coin
sasDeposit = CompactForm Coin
deposit
, sasStakePoolDelegation :: StrictMaybe (KeyHash 'StakePool)
sasStakePoolDelegation = StrictMaybe (KeyHash 'StakePool)
forall a. StrictMaybe a
SNothing
}
accountsPtrsMapL :: Lens' (Accounts era) (Map Ptr (Credential 'Staking))
default accountsPtrsMapL ::
Accounts era ~ ShelleyAccounts era =>
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
accountsPtrsMapL = (Accounts era -> Map Ptr (Credential 'Staking))
-> (Accounts era -> Map Ptr (Credential 'Staking) -> Accounts era)
-> Lens' (Accounts era) (Map Ptr (Credential 'Staking))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Accounts era -> Map Ptr (Credential 'Staking)
ShelleyAccounts era -> Map Ptr (Credential 'Staking)
forall era. ShelleyAccounts era -> Map Ptr (Credential 'Staking)
saPtrs ((Accounts era -> Map Ptr (Credential 'Staking) -> Accounts era)
-> Lens' (Accounts era) (Map Ptr (Credential 'Staking)))
-> (Accounts era -> Map Ptr (Credential 'Staking) -> Accounts era)
-> Lens' (Accounts era) (Map Ptr (Credential 'Staking))
forall a b. (a -> b) -> a -> b
$ \Accounts era
as Map Ptr (Credential 'Staking)
ptrsMap -> Accounts era
as {saPtrs = ptrsMap}
accountsPtrsMapG :: SimpleGetter (Accounts era) (Map Ptr (Credential 'Staking))
accountsPtrsMapG = (Map Ptr (Credential 'Staking)
-> Const r (Map Ptr (Credential 'Staking)))
-> Accounts era -> Const r (Accounts era)
forall era.
ShelleyEraAccounts era =>
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
accountsPtrsMapL
ptrAccountStateG :: SimpleGetter (AccountState era) Ptr
default ptrAccountStateG ::
AccountState era ~ ShelleyAccountState era =>
SimpleGetter (AccountState era) Ptr
ptrAccountStateG = (ShelleyAccountState era -> Ptr)
-> SimpleGetter (ShelleyAccountState era) Ptr
forall s a. (s -> a) -> SimpleGetter s a
to ShelleyAccountState era -> Ptr
forall era. ShelleyAccountState era -> Ptr
sasPtr
shelleyAddAccountState ::
ShelleyEraAccounts era =>
Credential Staking ->
AccountState era ->
Accounts era ->
Accounts era
shelleyAddAccountState :: forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> AccountState era -> Accounts era -> Accounts era
shelleyAddAccountState Credential 'Staking
cred AccountState era
accountState Accounts era
accounts =
Accounts era
accounts
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> (Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential 'Staking
-> AccountState era
-> Map (Credential 'Staking) (AccountState era)
-> Map (Credential 'Staking) (AccountState era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential 'Staking
cred AccountState era
accountState
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map Ptr (Credential 'Staking)
-> Identity (Map Ptr (Credential 'Staking)))
-> Accounts era -> Identity (Accounts era)
forall era.
ShelleyEraAccounts era =>
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
accountsPtrsMapL ((Map Ptr (Credential 'Staking)
-> Identity (Map Ptr (Credential 'Staking)))
-> Accounts era -> Identity (Accounts era))
-> (Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ptr
-> Credential 'Staking
-> Map Ptr (Credential 'Staking)
-> Map Ptr (Credential 'Staking)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (AccountState era
accountState AccountState era -> Getting Ptr (AccountState era) Ptr -> Ptr
forall s a. s -> Getting a s a -> a
^. Getting Ptr (AccountState era) Ptr
forall era.
ShelleyEraAccounts era =>
SimpleGetter (AccountState era) Ptr
SimpleGetter (AccountState era) Ptr
ptrAccountStateG) Credential 'Staking
cred
registerShelleyAccount ::
ShelleyEraAccounts era =>
Credential 'Staking ->
Ptr ->
CompactForm Coin ->
Maybe (KeyHash 'StakePool) ->
Accounts era ->
Accounts era
registerShelleyAccount :: forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> Ptr
-> CompactForm Coin
-> Maybe (KeyHash 'StakePool)
-> Accounts era
-> Accounts era
registerShelleyAccount Credential 'Staking
cred Ptr
ptr CompactForm Coin
deposit Maybe (KeyHash 'StakePool)
mStakePool = Credential 'Staking
-> AccountState era -> Accounts era -> Accounts era
forall era.
EraAccounts era =>
Credential 'Staking
-> AccountState era -> Accounts era -> Accounts era
addAccountState Credential 'Staking
cred AccountState era
accountState
where
accountState :: AccountState era
accountState =
Ptr -> CompactForm Coin -> AccountState era
forall era.
ShelleyEraAccounts era =>
Ptr -> CompactForm Coin -> AccountState era
mkShelleyAccountState Ptr
ptr CompactForm Coin
deposit AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era)
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
Lens' (AccountState era) (Maybe (KeyHash 'StakePool))
stakePoolDelegationAccountStateL ((Maybe (KeyHash 'StakePool)
-> Identity (Maybe (KeyHash 'StakePool)))
-> AccountState era -> Identity (AccountState era))
-> Maybe (KeyHash 'StakePool)
-> AccountState era
-> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (KeyHash 'StakePool)
mStakePool
unregisterShelleyAccount ::
ShelleyEraAccounts era =>
Credential 'Staking ->
Accounts era ->
(Maybe (AccountState era), Accounts era)
unregisterShelleyAccount :: forall era.
ShelleyEraAccounts era =>
Credential 'Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterShelleyAccount Credential 'Staking
cred Accounts era
accounts = (Maybe (AccountState era)
mAccountState, Accounts era
newAccounts)
where
(Maybe (AccountState era)
mAccountState, Map (Credential 'Staking) (AccountState era)
newAccountsMap) = Credential 'Staking
-> Map (Credential 'Staking) (AccountState era)
-> (Maybe (AccountState era),
Map (Credential 'Staking) (AccountState era))
forall k b. Ord k => k -> Map k b -> (Maybe b, Map k b)
Map.extract Credential 'Staking
cred (Accounts era
accounts Accounts era
-> Getting
(Map (Credential 'Staking) (AccountState era))
(Accounts era)
(Map (Credential 'Staking) (AccountState era))
-> Map (Credential 'Staking) (AccountState era)
forall s a. s -> Getting a s a -> a
^. Getting
(Map (Credential 'Staking) (AccountState era))
(Accounts era)
(Map (Credential 'Staking) (AccountState era))
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL)
removePtr :: AccountState era -> Accounts era -> Accounts era
removePtr AccountState era
accountState = (Map Ptr (Credential 'Staking)
-> Identity (Map Ptr (Credential 'Staking)))
-> Accounts era -> Identity (Accounts era)
forall era.
ShelleyEraAccounts era =>
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
Lens' (Accounts era) (Map Ptr (Credential 'Staking))
accountsPtrsMapL ((Map Ptr (Credential 'Staking)
-> Identity (Map Ptr (Credential 'Staking)))
-> Accounts era -> Identity (Accounts era))
-> (Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking))
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Ptr
-> Map Ptr (Credential 'Staking) -> Map Ptr (Credential 'Staking)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (AccountState era
accountState AccountState era -> Getting Ptr (AccountState era) Ptr -> Ptr
forall s a. s -> Getting a s a -> a
^. Getting Ptr (AccountState era) Ptr
forall era.
ShelleyEraAccounts era =>
SimpleGetter (AccountState era) Ptr
SimpleGetter (AccountState era) Ptr
ptrAccountStateG)
newAccounts :: Accounts era
newAccounts =
Accounts era
accounts
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
Lens' (Accounts era) (Map (Credential 'Staking) (AccountState era))
accountsMapL ((Map (Credential 'Staking) (AccountState era)
-> Identity (Map (Credential 'Staking) (AccountState era)))
-> Accounts era -> Identity (Accounts era))
-> Map (Credential 'Staking) (AccountState era)
-> Accounts era
-> Accounts era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Credential 'Staking) (AccountState era)
newAccountsMap
Accounts era -> (Accounts era -> Accounts era) -> Accounts era
forall a b. a -> (a -> b) -> b
& (Accounts era -> Accounts era)
-> (AccountState era -> Accounts era -> Accounts era)
-> Maybe (AccountState era)
-> Accounts era
-> Accounts era
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Accounts era -> Accounts era
forall a. a -> a
id AccountState era -> Accounts era -> Accounts era
forall {era} {era}.
(Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond
(CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
(TypeError ...),
Assert
(OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
(TypeError ...),
ShelleyEraAccounts era, ShelleyEraAccounts era) =>
AccountState era -> Accounts era -> Accounts era
removePtr Maybe (AccountState era)
mAccountState