{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.State.Account (
  ConwayAccountState (
    ConwayAccountState,
    casBalance,
    casDeposit,
    casStakePoolDelegation,
    casDRepDelegation
  ),
  ConwayAccounts (..),
  ConwayEraAccounts (..),
  accountStateDelegatee,
  registerConwayAccount,
  unregisterConwayAccount,
  lookupDRepDelegation,
) where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Binary
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway.Era
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Credential
import Cardano.Ledger.Hashes
import Cardano.Ledger.State
import Control.DeepSeq (NFData (rnf), rwhnf)
import Control.Monad.Trans.State.Strict (StateT (..))
import Data.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
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data ConwayAccountState era
  = CASNoDelegation
      -- | Current balance of the account
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Deposit amount that was left when staking credential was registered
      {-# UNPACK #-} !(CompactForm Coin)
  | CASStakePool
      -- | Current balance of the account
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Deposit amount that was left when staking credential was registered
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Delegation to a stake pool
      !(KeyHash StakePool)
  | CASDRep
      -- | Current balance of the account
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Deposit amount that was left when staking credential was registered
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Delegation to a DRep
      !DRep
  | CASStakePoolAndDRep
      -- | Current balance of the account
      {-# UNPACK #-} !(CompactForm Coin)
      {-# UNPACK #-} !(CompactForm Coin)
      -- | Delegation to a stake pool
      -- ^ Deposit amount that was left when staking credential was registered
      !(KeyHash StakePool)
      -- | Delegation to a DRep
      !DRep
  deriving (Int -> ConwayAccountState era -> ShowS
[ConwayAccountState era] -> ShowS
ConwayAccountState era -> String
(Int -> ConwayAccountState era -> ShowS)
-> (ConwayAccountState era -> String)
-> ([ConwayAccountState era] -> ShowS)
-> Show (ConwayAccountState era)
forall era. Int -> ConwayAccountState era -> ShowS
forall era. [ConwayAccountState era] -> ShowS
forall era. ConwayAccountState era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayAccountState era -> ShowS
showsPrec :: Int -> ConwayAccountState era -> ShowS
$cshow :: forall era. ConwayAccountState era -> String
show :: ConwayAccountState era -> String
$cshowList :: forall era. [ConwayAccountState era] -> ShowS
showList :: [ConwayAccountState era] -> ShowS
Show, ConwayAccountState era -> ConwayAccountState era -> Bool
(ConwayAccountState era -> ConwayAccountState era -> Bool)
-> (ConwayAccountState era -> ConwayAccountState era -> Bool)
-> Eq (ConwayAccountState era)
forall era.
ConwayAccountState era -> ConwayAccountState era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ConwayAccountState era -> ConwayAccountState era -> Bool
== :: ConwayAccountState era -> ConwayAccountState era -> Bool
$c/= :: forall era.
ConwayAccountState era -> ConwayAccountState era -> Bool
/= :: ConwayAccountState era -> ConwayAccountState era -> Bool
Eq, (forall x.
 ConwayAccountState era -> Rep (ConwayAccountState era) x)
-> (forall x.
    Rep (ConwayAccountState era) x -> ConwayAccountState era)
-> Generic (ConwayAccountState era)
forall x. Rep (ConwayAccountState era) x -> ConwayAccountState era
forall x. ConwayAccountState era -> Rep (ConwayAccountState era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayAccountState era) x -> ConwayAccountState era
forall era x.
ConwayAccountState era -> Rep (ConwayAccountState era) x
$cfrom :: forall era x.
ConwayAccountState era -> Rep (ConwayAccountState era) x
from :: forall x. ConwayAccountState era -> Rep (ConwayAccountState era) x
$cto :: forall era x.
Rep (ConwayAccountState era) x -> ConwayAccountState era
to :: forall x. Rep (ConwayAccountState era) x -> ConwayAccountState era
Generic)

viewConwayAccountState ::
  ConwayAccountState era ->
  (CompactForm Coin, CompactForm Coin, StrictMaybe (KeyHash StakePool), StrictMaybe DRep)
viewConwayAccountState :: forall era.
ConwayAccountState era
-> (CompactForm Coin, CompactForm Coin,
    StrictMaybe (KeyHash StakePool), StrictMaybe DRep)
viewConwayAccountState (CASNoDelegation CompactForm Coin
x CompactForm Coin
y) = (CompactForm Coin
x, CompactForm Coin
y, StrictMaybe (KeyHash StakePool)
forall a. StrictMaybe a
SNothing, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
viewConwayAccountState (CASStakePool CompactForm Coin
x CompactForm Coin
y KeyHash StakePool
z) = (CompactForm Coin
x, CompactForm Coin
y, KeyHash StakePool -> StrictMaybe (KeyHash StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash StakePool
z, StrictMaybe DRep
forall a. StrictMaybe a
SNothing)
viewConwayAccountState (CASDRep CompactForm Coin
x CompactForm Coin
y DRep
w) = (CompactForm Coin
x, CompactForm Coin
y, StrictMaybe (KeyHash StakePool)
forall a. StrictMaybe a
SNothing, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
w)
viewConwayAccountState (CASStakePoolAndDRep CompactForm Coin
x CompactForm Coin
y KeyHash StakePool
z DRep
w) = (CompactForm Coin
x, CompactForm Coin
y, KeyHash StakePool -> StrictMaybe (KeyHash StakePool)
forall a. a -> StrictMaybe a
SJust KeyHash StakePool
z, DRep -> StrictMaybe DRep
forall a. a -> StrictMaybe a
SJust DRep
w)

pattern ConwayAccountState ::
  CompactForm Coin ->
  CompactForm Coin ->
  StrictMaybe (KeyHash StakePool) ->
  StrictMaybe DRep ->
  ConwayAccountState era
pattern $mConwayAccountState :: forall {r} {era}.
ConwayAccountState era
-> (CompactForm Coin
    -> CompactForm Coin
    -> StrictMaybe (KeyHash StakePool)
    -> StrictMaybe DRep
    -> r)
-> ((# #) -> r)
-> r
$bConwayAccountState :: forall era.
CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash StakePool)
-> StrictMaybe DRep
-> ConwayAccountState era
ConwayAccountState
  { forall era. ConwayAccountState era -> CompactForm Coin
casBalance
  , forall era. ConwayAccountState era -> CompactForm Coin
casDeposit
  , forall era.
ConwayAccountState era -> StrictMaybe (KeyHash StakePool)
casStakePoolDelegation
  , forall era. ConwayAccountState era -> StrictMaybe DRep
casDRepDelegation
  } <-
  (viewConwayAccountState -> (casBalance, casDeposit, casStakePoolDelegation, casDRepDelegation))
  where
    ConwayAccountState CompactForm Coin
x CompactForm Coin
y StrictMaybe (KeyHash StakePool)
SNothing StrictMaybe DRep
SNothing = CompactForm Coin -> CompactForm Coin -> ConwayAccountState era
forall era.
CompactForm Coin -> CompactForm Coin -> ConwayAccountState era
CASNoDelegation CompactForm Coin
x CompactForm Coin
y
    ConwayAccountState CompactForm Coin
x CompactForm Coin
y (SJust KeyHash StakePool
z) StrictMaybe DRep
SNothing = CompactForm Coin
-> CompactForm Coin -> KeyHash StakePool -> ConwayAccountState era
forall era.
CompactForm Coin
-> CompactForm Coin -> KeyHash StakePool -> ConwayAccountState era
CASStakePool CompactForm Coin
x CompactForm Coin
y KeyHash StakePool
z
    ConwayAccountState CompactForm Coin
x CompactForm Coin
y StrictMaybe (KeyHash StakePool)
SNothing (SJust DRep
w) = CompactForm Coin
-> CompactForm Coin -> DRep -> ConwayAccountState era
forall era.
CompactForm Coin
-> CompactForm Coin -> DRep -> ConwayAccountState era
CASDRep CompactForm Coin
x CompactForm Coin
y DRep
w
    ConwayAccountState CompactForm Coin
x CompactForm Coin
y (SJust KeyHash StakePool
z) (SJust DRep
w) = CompactForm Coin
-> CompactForm Coin
-> KeyHash StakePool
-> DRep
-> ConwayAccountState era
forall era.
CompactForm Coin
-> CompactForm Coin
-> KeyHash StakePool
-> DRep
-> ConwayAccountState era
CASStakePoolAndDRep CompactForm Coin
x CompactForm Coin
y KeyHash StakePool
z DRep
w

{-# COMPLETE ConwayAccountState #-}

instance NoThunks (ConwayAccountState era)

instance NFData (ConwayAccountState era) where
  rnf :: ConwayAccountState era -> ()
rnf = ConwayAccountState era -> ()
forall a. a -> ()
rwhnf

instance EncCBOR (ConwayAccountState era) where
  encCBOR :: ConwayAccountState era -> Encoding
encCBOR cas :: ConwayAccountState era
cas@(ConwayAccountState CompactForm Coin
_ CompactForm Coin
_ StrictMaybe (KeyHash StakePool)
_ StrictMaybe DRep
_) =
    let ConwayAccountState {StrictMaybe (KeyHash StakePool)
StrictMaybe DRep
CompactForm Coin
casBalance :: forall era. ConwayAccountState era -> CompactForm Coin
casDeposit :: forall era. ConwayAccountState era -> CompactForm Coin
casStakePoolDelegation :: forall era.
ConwayAccountState era -> StrictMaybe (KeyHash StakePool)
casDRepDelegation :: forall era. ConwayAccountState era -> StrictMaybe DRep
casBalance :: CompactForm Coin
casDeposit :: CompactForm Coin
casStakePoolDelegation :: StrictMaybe (KeyHash StakePool)
casDRepDelegation :: StrictMaybe DRep
..} = ConwayAccountState era
cas
     in Word -> Encoding
encodeListLen Word
4
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
casBalance
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> CompactForm Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR CompactForm Coin
casDeposit
          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)
casStakePoolDelegation
          Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (DRep -> Encoding) -> StrictMaybe DRep -> Encoding
forall a. (a -> Encoding) -> StrictMaybe a -> Encoding
encodeNullStrictMaybe DRep -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR StrictMaybe DRep
casDRepDelegation

instance Typeable era => DecShareCBOR (ConwayAccountState era) where
  type
    Share (ConwayAccountState era) =
      (Interns (KeyHash StakePool), Interns (Credential DRepRole))
  decShareCBOR :: forall s.
Share (ConwayAccountState era)
-> Decoder s (ConwayAccountState era)
decShareCBOR (Interns (KeyHash StakePool)
ks, Interns (Credential DRepRole)
cd) =
    Text
-> (ConwayAccountState era -> Int)
-> Decoder s (ConwayAccountState era)
-> Decoder s (ConwayAccountState era)
forall a s. Text -> (a -> Int) -> Decoder s a -> Decoder s a
decodeRecordNamed Text
"ConwayAccountState" (Int -> ConwayAccountState era -> Int
forall a b. a -> b -> a
const Int
4) (Decoder s (ConwayAccountState era)
 -> Decoder s (ConwayAccountState era))
-> Decoder s (ConwayAccountState era)
-> Decoder s (ConwayAccountState era)
forall a b. (a -> b) -> a -> b
$
      CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash StakePool)
-> StrictMaybe DRep
-> ConwayAccountState era
forall era.
CompactForm Coin
-> CompactForm Coin
-> StrictMaybe (KeyHash StakePool)
-> StrictMaybe DRep
-> ConwayAccountState era
ConwayAccountState
        (CompactForm Coin
 -> CompactForm Coin
 -> StrictMaybe (KeyHash StakePool)
 -> StrictMaybe DRep
 -> ConwayAccountState era)
-> Decoder s (CompactForm Coin)
-> Decoder
     s
     (CompactForm Coin
      -> StrictMaybe (KeyHash StakePool)
      -> StrictMaybe DRep
      -> ConwayAccountState era)
forall (f :: * -> *) a b. Functor 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)
   -> StrictMaybe DRep
   -> ConwayAccountState era)
-> Decoder s (CompactForm Coin)
-> Decoder
     s
     (StrictMaybe (KeyHash StakePool)
      -> StrictMaybe DRep -> ConwayAccountState 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)
   -> StrictMaybe DRep -> ConwayAccountState era)
-> Decoder s (StrictMaybe (KeyHash StakePool))
-> Decoder s (StrictMaybe DRep -> ConwayAccountState 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)
        Decoder s (StrictMaybe DRep -> ConwayAccountState era)
-> Decoder s (StrictMaybe DRep)
-> Decoder s (ConwayAccountState 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 DRep -> Decoder s (StrictMaybe DRep)
forall s a. Decoder s a -> Decoder s (StrictMaybe a)
decodeNullStrictMaybe (Share DRep -> Decoder s DRep
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s. Share DRep -> Decoder s DRep
decShareCBOR Share DRep
Interns (Credential DRepRole)
cd)

instance ToKeyValuePairs (ConwayAccountState era) where
  toKeyValuePairs :: forall e kv. KeyValue e kv => ConwayAccountState era -> [kv]
toKeyValuePairs cas :: ConwayAccountState era
cas@(ConwayAccountState CompactForm Coin
_ CompactForm Coin
_ StrictMaybe (KeyHash StakePool)
_ StrictMaybe DRep
_) =
    let ConwayAccountState {StrictMaybe (KeyHash StakePool)
StrictMaybe DRep
CompactForm Coin
casBalance :: forall era. ConwayAccountState era -> CompactForm Coin
casDeposit :: forall era. ConwayAccountState era -> CompactForm Coin
casStakePoolDelegation :: forall era.
ConwayAccountState era -> StrictMaybe (KeyHash StakePool)
casDRepDelegation :: forall era. ConwayAccountState era -> StrictMaybe DRep
casBalance :: CompactForm Coin
casDeposit :: CompactForm Coin
casStakePoolDelegation :: StrictMaybe (KeyHash StakePool)
casDRepDelegation :: StrictMaybe DRep
..} = ConwayAccountState era
cas
     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
casBalance -- deprecated
        , 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
casBalance
        , 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
casDeposit
        , 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)
casStakePoolDelegation
        , Key
"drep" Key -> StrictMaybe DRep -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= StrictMaybe DRep
casDRepDelegation
        ]

deriving via KeyValuePairs (ConwayAccountState era) instance ToJSON (ConwayAccountState era)

newtype ConwayAccounts era = ConwayAccounts
  { forall era.
ConwayAccounts era
-> Map (Credential Staking) (ConwayAccountState era)
caStates :: Map (Credential Staking) (ConwayAccountState era)
  -- ^ Map from a staking credential to the account state.
  }
  deriving (Int -> ConwayAccounts era -> ShowS
[ConwayAccounts era] -> ShowS
ConwayAccounts era -> String
(Int -> ConwayAccounts era -> ShowS)
-> (ConwayAccounts era -> String)
-> ([ConwayAccounts era] -> ShowS)
-> Show (ConwayAccounts era)
forall era. Int -> ConwayAccounts era -> ShowS
forall era. [ConwayAccounts era] -> ShowS
forall era. ConwayAccounts era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ConwayAccounts era -> ShowS
showsPrec :: Int -> ConwayAccounts era -> ShowS
$cshow :: forall era. ConwayAccounts era -> String
show :: ConwayAccounts era -> String
$cshowList :: forall era. [ConwayAccounts era] -> ShowS
showList :: [ConwayAccounts era] -> ShowS
Show, ConwayAccounts era -> ConwayAccounts era -> Bool
(ConwayAccounts era -> ConwayAccounts era -> Bool)
-> (ConwayAccounts era -> ConwayAccounts era -> Bool)
-> Eq (ConwayAccounts era)
forall era. ConwayAccounts era -> ConwayAccounts era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. ConwayAccounts era -> ConwayAccounts era -> Bool
== :: ConwayAccounts era -> ConwayAccounts era -> Bool
$c/= :: forall era. ConwayAccounts era -> ConwayAccounts era -> Bool
/= :: ConwayAccounts era -> ConwayAccounts era -> Bool
Eq, (forall x. ConwayAccounts era -> Rep (ConwayAccounts era) x)
-> (forall x. Rep (ConwayAccounts era) x -> ConwayAccounts era)
-> Generic (ConwayAccounts era)
forall x. Rep (ConwayAccounts era) x -> ConwayAccounts era
forall x. ConwayAccounts era -> Rep (ConwayAccounts era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (ConwayAccounts era) x -> ConwayAccounts era
forall era x. ConwayAccounts era -> Rep (ConwayAccounts era) x
$cfrom :: forall era x. ConwayAccounts era -> Rep (ConwayAccounts era) x
from :: forall x. ConwayAccounts era -> Rep (ConwayAccounts era) x
$cto :: forall era x. Rep (ConwayAccounts era) x -> ConwayAccounts era
to :: forall x. Rep (ConwayAccounts era) x -> ConwayAccounts era
Generic, ConwayAccounts era -> Encoding
(ConwayAccounts era -> Encoding) -> EncCBOR (ConwayAccounts era)
forall era. ConwayAccounts era -> Encoding
forall a. (a -> Encoding) -> EncCBOR a
$cencCBOR :: forall era. ConwayAccounts era -> Encoding
encCBOR :: ConwayAccounts era -> Encoding
EncCBOR, Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
Proxy (ConwayAccounts era) -> String
(Context -> ConwayAccounts era -> IO (Maybe ThunkInfo))
-> (Context -> ConwayAccounts era -> IO (Maybe ThunkInfo))
-> (Proxy (ConwayAccounts era) -> String)
-> NoThunks (ConwayAccounts era)
forall era. Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
forall era. Proxy (ConwayAccounts era) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall era. Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
noThunks :: Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall era. Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> ConwayAccounts era -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall era. Proxy (ConwayAccounts era) -> String
showTypeOf :: Proxy (ConwayAccounts era) -> String
NoThunks, ConwayAccounts era -> ()
(ConwayAccounts era -> ()) -> NFData (ConwayAccounts era)
forall era. ConwayAccounts era -> ()
forall a. (a -> ()) -> NFData a
$crnf :: forall era. ConwayAccounts era -> ()
rnf :: ConwayAccounts era -> ()
NFData, ConwayAccounts era
ConwayAccounts era -> Default (ConwayAccounts era)
forall era. ConwayAccounts era
forall a. a -> Default a
$cdef :: forall era. ConwayAccounts era
def :: ConwayAccounts era
Default, [ConwayAccounts era] -> Value
[ConwayAccounts era] -> Encoding
ConwayAccounts era -> Bool
ConwayAccounts era -> Value
ConwayAccounts era -> Encoding
(ConwayAccounts era -> Value)
-> (ConwayAccounts era -> Encoding)
-> ([ConwayAccounts era] -> Value)
-> ([ConwayAccounts era] -> Encoding)
-> (ConwayAccounts era -> Bool)
-> ToJSON (ConwayAccounts era)
forall era. [ConwayAccounts era] -> Value
forall era. [ConwayAccounts era] -> Encoding
forall era. ConwayAccounts era -> Bool
forall era. ConwayAccounts era -> Value
forall era. ConwayAccounts era -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall era. ConwayAccounts era -> Value
toJSON :: ConwayAccounts era -> Value
$ctoEncoding :: forall era. ConwayAccounts era -> Encoding
toEncoding :: ConwayAccounts era -> Encoding
$ctoJSONList :: forall era. [ConwayAccounts era] -> Value
toJSONList :: [ConwayAccounts era] -> Value
$ctoEncodingList :: forall era. [ConwayAccounts era] -> Encoding
toEncodingList :: [ConwayAccounts era] -> Encoding
$comitField :: forall era. ConwayAccounts era -> Bool
omitField :: ConwayAccounts era -> Bool
ToJSON)

instance Typeable era => DecShareCBOR (ConwayAccounts era) where
  type
    Share (ConwayAccounts era) =
      (Interns (Credential Staking), Interns (KeyHash StakePool), Interns (Credential DRepRole))
  decSharePlusCBOR :: forall s.
StateT
  (Share (ConwayAccounts era)) (Decoder s) (ConwayAccounts era)
decSharePlusCBOR =
    (Share (ConwayAccounts era)
 -> Decoder s (ConwayAccounts era, Share (ConwayAccounts era)))
-> StateT
     (Share (ConwayAccounts era)) (Decoder s) (ConwayAccounts era)
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Share (ConwayAccounts era)
  -> Decoder s (ConwayAccounts era, Share (ConwayAccounts era)))
 -> StateT
      (Share (ConwayAccounts era)) (Decoder s) (ConwayAccounts era))
-> (Share (ConwayAccounts era)
    -> Decoder s (ConwayAccounts era, Share (ConwayAccounts era)))
-> StateT
     (Share (ConwayAccounts era)) (Decoder s) (ConwayAccounts era)
forall a b. (a -> b) -> a -> b
$ \(Interns (Credential Staking)
a, Interns (KeyHash StakePool)
b, Interns (Credential DRepRole)
c) -> do
      caStates <- Decoder s (Credential Staking)
-> Decoder s (ConwayAccountState era)
-> Decoder s (Map (Credential Staking) (ConwayAccountState 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 (ConwayAccountState era)
-> Decoder s (ConwayAccountState era)
forall a s. DecShareCBOR a => Share a -> Decoder s a
forall s.
Share (ConwayAccountState era)
-> Decoder s (ConwayAccountState era)
decShareCBOR (Interns (KeyHash StakePool)
b, Interns (Credential DRepRole)
c))
      let a' = Map (Credential Staking) (ConwayAccountState era)
-> Interns (Credential Staking)
forall k a. Ord k => Map k a -> Interns k
internsFromMap Map (Credential Staking) (ConwayAccountState era)
caStates Interns (Credential Staking)
-> Interns (Credential Staking) -> Interns (Credential Staking)
forall a. Semigroup a => a -> a -> a
<> Interns (Credential Staking)
a
      pure (ConwayAccounts {caStates}, (a', b, c))

instance EraAccounts ConwayEra where
  type AccountState ConwayEra = ConwayAccountState ConwayEra
  type Accounts ConwayEra = ConwayAccounts ConwayEra

  addAccountState :: Credential Staking
-> AccountState ConwayEra
-> Accounts ConwayEra
-> Accounts ConwayEra
addAccountState Credential Staking
cred AccountState ConwayEra
accountState = (Map (Credential Staking) (AccountState ConwayEra)
 -> Identity (Map (Credential Staking) (AccountState ConwayEra)))
-> Accounts ConwayEra -> Identity (Accounts ConwayEra)
(Map (Credential Staking) (AccountState ConwayEra)
 -> Identity (Map (Credential Staking) (AccountState ConwayEra)))
-> ConwayAccounts ConwayEra -> Identity (ConwayAccounts ConwayEra)
forall era.
EraAccounts era =>
Lens' (Accounts era) (Map (Credential Staking) (AccountState era))
Lens'
  (Accounts ConwayEra)
  (Map (Credential Staking) (AccountState ConwayEra))
accountsMapL ((Map (Credential Staking) (AccountState ConwayEra)
  -> Identity (Map (Credential Staking) (AccountState ConwayEra)))
 -> ConwayAccounts ConwayEra -> Identity (ConwayAccounts ConwayEra))
-> (Map (Credential Staking) (AccountState ConwayEra)
    -> Map (Credential Staking) (AccountState ConwayEra))
-> ConwayAccounts ConwayEra
-> ConwayAccounts ConwayEra
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Credential Staking
-> AccountState ConwayEra
-> Map (Credential Staking) (AccountState ConwayEra)
-> Map (Credential Staking) (AccountState ConwayEra)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Credential Staking
cred AccountState ConwayEra
accountState

  accountsMapL :: Lens'
  (Accounts ConwayEra)
  (Map (Credential Staking) (AccountState ConwayEra))
accountsMapL = (Accounts ConwayEra
 -> Map (Credential Staking) (AccountState ConwayEra))
-> (Accounts ConwayEra
    -> Map (Credential Staking) (AccountState ConwayEra)
    -> Accounts ConwayEra)
-> Lens'
     (Accounts ConwayEra)
     (Map (Credential Staking) (AccountState ConwayEra))
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Accounts ConwayEra
-> Map (Credential Staking) (AccountState ConwayEra)
ConwayAccounts ConwayEra
-> Map (Credential Staking) (ConwayAccountState ConwayEra)
forall era.
ConwayAccounts era
-> Map (Credential Staking) (ConwayAccountState era)
caStates ((Accounts ConwayEra
  -> Map (Credential Staking) (AccountState ConwayEra)
  -> Accounts ConwayEra)
 -> Lens'
      (Accounts ConwayEra)
      (Map (Credential Staking) (AccountState ConwayEra)))
-> (Accounts ConwayEra
    -> Map (Credential Staking) (AccountState ConwayEra)
    -> Accounts ConwayEra)
-> Lens'
     (Accounts ConwayEra)
     (Map (Credential Staking) (AccountState ConwayEra))
forall a b. (a -> b) -> a -> b
$ \Accounts ConwayEra
cas Map (Credential Staking) (AccountState ConwayEra)
asMap -> Accounts ConwayEra
cas {caStates = asMap}

  balanceAccountStateL :: Lens' (AccountState ConwayEra) (CompactForm Coin)
balanceAccountStateL = (AccountState ConwayEra -> CompactForm Coin)
-> (AccountState ConwayEra
    -> CompactForm Coin -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (CompactForm Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState ConwayEra -> CompactForm Coin
ConwayAccountState ConwayEra -> CompactForm Coin
forall era. ConwayAccountState era -> CompactForm Coin
casBalance ((AccountState ConwayEra
  -> CompactForm Coin -> AccountState ConwayEra)
 -> Lens' (AccountState ConwayEra) (CompactForm Coin))
-> (AccountState ConwayEra
    -> CompactForm Coin -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ \AccountState ConwayEra
cas CompactForm Coin
b -> AccountState ConwayEra
cas {casBalance = b}

  depositAccountStateL :: Lens' (AccountState ConwayEra) (CompactForm Coin)
depositAccountStateL = (AccountState ConwayEra -> CompactForm Coin)
-> (AccountState ConwayEra
    -> CompactForm Coin -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (CompactForm Coin)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens AccountState ConwayEra -> CompactForm Coin
ConwayAccountState ConwayEra -> CompactForm Coin
forall era. ConwayAccountState era -> CompactForm Coin
casDeposit ((AccountState ConwayEra
  -> CompactForm Coin -> AccountState ConwayEra)
 -> Lens' (AccountState ConwayEra) (CompactForm Coin))
-> (AccountState ConwayEra
    -> CompactForm Coin -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ \AccountState ConwayEra
cas CompactForm Coin
d -> AccountState ConwayEra
cas {casDeposit = d}

  stakePoolDelegationAccountStateL :: Lens' (AccountState ConwayEra) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL =
    (AccountState ConwayEra -> Maybe (KeyHash StakePool))
-> (AccountState ConwayEra
    -> Maybe (KeyHash StakePool) -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (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))
-> (ConwayAccountState ConwayEra
    -> StrictMaybe (KeyHash StakePool))
-> ConwayAccountState ConwayEra
-> Maybe (KeyHash StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayAccountState ConwayEra -> StrictMaybe (KeyHash StakePool)
forall era.
ConwayAccountState era -> StrictMaybe (KeyHash StakePool)
casStakePoolDelegation) ((AccountState ConwayEra
  -> Maybe (KeyHash StakePool) -> AccountState ConwayEra)
 -> Lens' (AccountState ConwayEra) (Maybe (KeyHash StakePool)))
-> (AccountState ConwayEra
    -> Maybe (KeyHash StakePool) -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (Maybe (KeyHash StakePool))
forall a b. (a -> b) -> a -> b
$ \AccountState ConwayEra
cas Maybe (KeyHash StakePool)
d ->
      AccountState ConwayEra
cas {casStakePoolDelegation = maybeToStrictMaybe d}

  unregisterAccount :: Credential Staking
-> Accounts ConwayEra
-> (Maybe (AccountState ConwayEra), Accounts ConwayEra)
unregisterAccount = Credential Staking
-> Accounts ConwayEra
-> (Maybe (AccountState ConwayEra), Accounts ConwayEra)
forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterConwayAccount

class EraAccounts era => ConwayEraAccounts era where
  mkConwayAccountState :: CompactForm Coin -> AccountState era
  default mkConwayAccountState ::
    AccountState era ~ ConwayAccountState era =>
    CompactForm Coin ->
    AccountState era
  mkConwayAccountState CompactForm Coin
deposit =
    ConwayAccountState
      { casBalance :: CompactForm Coin
casBalance = CompactForm Coin
forall a. Monoid a => a
mempty
      , casDeposit :: CompactForm Coin
casDeposit = CompactForm Coin
deposit
      , casStakePoolDelegation :: StrictMaybe (KeyHash StakePool)
casStakePoolDelegation = StrictMaybe (KeyHash StakePool)
forall a. StrictMaybe a
SNothing
      , casDRepDelegation :: StrictMaybe DRep
casDRepDelegation = StrictMaybe DRep
forall a. StrictMaybe a
SNothing
      }

  dRepDelegationAccountStateL :: Lens' (AccountState era) (Maybe DRep)

instance ConwayEraAccounts ConwayEra where
  dRepDelegationAccountStateL :: Lens' (AccountState ConwayEra) (Maybe DRep)
dRepDelegationAccountStateL =
    (AccountState ConwayEra -> Maybe DRep)
-> (AccountState ConwayEra -> Maybe DRep -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (Maybe DRep)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (StrictMaybe DRep -> Maybe DRep
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe (StrictMaybe DRep -> Maybe DRep)
-> (ConwayAccountState ConwayEra -> StrictMaybe DRep)
-> ConwayAccountState ConwayEra
-> Maybe DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayAccountState ConwayEra -> StrictMaybe DRep
forall era. ConwayAccountState era -> StrictMaybe DRep
casDRepDelegation) ((AccountState ConwayEra -> Maybe DRep -> AccountState ConwayEra)
 -> Lens' (AccountState ConwayEra) (Maybe DRep))
-> (AccountState ConwayEra -> Maybe DRep -> AccountState ConwayEra)
-> Lens' (AccountState ConwayEra) (Maybe DRep)
forall a b. (a -> b) -> a -> b
$ \AccountState ConwayEra
cas Maybe DRep
d ->
      AccountState ConwayEra
cas {casDRepDelegation = maybeToStrictMaybe d}

lookupDRepDelegation :: ConwayEraAccounts era => Credential Staking -> Accounts era -> Maybe DRep
lookupDRepDelegation :: forall era.
ConwayEraAccounts era =>
Credential Staking -> Accounts era -> Maybe DRep
lookupDRepDelegation Credential Staking
cred Accounts era
accounts = do
  accountState <- Credential Staking -> Accounts era -> Maybe (AccountState era)
forall era.
EraAccounts era =>
Credential Staking -> Accounts era -> Maybe (AccountState era)
lookupAccountState Credential Staking
cred Accounts era
accounts
  accountState ^. dRepDelegationAccountStateL

registerConwayAccount ::
  ConwayEraAccounts era =>
  Credential Staking ->
  -- | Deposit
  CompactForm Coin ->
  Maybe Delegatee ->
  Accounts era ->
  Accounts era
registerConwayAccount :: forall era.
ConwayEraAccounts era =>
Credential Staking
-> CompactForm Coin
-> Maybe Delegatee
-> Accounts era
-> Accounts era
registerConwayAccount Credential Staking
cred CompactForm Coin
deposit Maybe Delegatee
mDelegatee 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
  where
    accountState :: AccountState era
accountState =
      case Maybe Delegatee
mDelegatee of
        Maybe Delegatee
Nothing -> CompactForm Coin -> AccountState era
forall era.
ConwayEraAccounts era =>
CompactForm Coin -> AccountState era
mkConwayAccountState CompactForm Coin
deposit
        Just Delegatee
delegatee ->
          CompactForm Coin -> AccountState era
forall era.
ConwayEraAccounts era =>
CompactForm Coin -> AccountState era
mkConwayAccountState 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
.~ Delegatee -> Maybe (KeyHash StakePool)
getStakePoolDelegatee Delegatee
delegatee
            AccountState era
-> (AccountState era -> AccountState era) -> AccountState era
forall a b. a -> (a -> b) -> b
& (Maybe DRep -> Identity (Maybe DRep))
-> AccountState era -> Identity (AccountState era)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL ((Maybe DRep -> Identity (Maybe DRep))
 -> AccountState era -> Identity (AccountState era))
-> Maybe DRep -> AccountState era -> AccountState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Delegatee -> Maybe DRep
getDRepDelegatee Delegatee
delegatee

unregisterConwayAccount ::
  EraAccounts era =>
  -- | Credential to unregister
  Credential Staking ->
  -- | `Accounts` to remove the account state from
  Accounts era ->
  -- | Returns `Just` whenever account was registered and `Nothing` otherwise. Produced `Accounts`
  -- will have the account state removed, if it was present there to begin with.
  (Maybe (AccountState era), Accounts era)
unregisterConwayAccount :: forall era.
EraAccounts era =>
Credential Staking
-> Accounts era -> (Maybe (AccountState era), Accounts era)
unregisterConwayAccount 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)
    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

accountStateDelegatee :: ConwayEraAccounts era => AccountState era -> Maybe Delegatee
accountStateDelegatee :: forall era.
ConwayEraAccounts era =>
AccountState era -> Maybe Delegatee
accountStateDelegatee AccountState era
accountState =
  Maybe (KeyHash StakePool) -> Maybe DRep -> Maybe Delegatee
mkDelegatee
    (AccountState era
accountState AccountState era
-> Getting
     (Maybe (KeyHash StakePool))
     (AccountState era)
     (Maybe (KeyHash StakePool))
-> Maybe (KeyHash StakePool)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (KeyHash StakePool))
  (AccountState era)
  (Maybe (KeyHash StakePool))
forall era.
EraAccounts era =>
Lens' (AccountState era) (Maybe (KeyHash StakePool))
Lens' (AccountState era) (Maybe (KeyHash StakePool))
stakePoolDelegationAccountStateL)
    (AccountState era
accountState AccountState era
-> Getting (Maybe DRep) (AccountState era) (Maybe DRep)
-> Maybe DRep
forall s a. s -> Getting a s a -> a
^. Getting (Maybe DRep) (AccountState era) (Maybe DRep)
forall era.
ConwayEraAccounts era =>
Lens' (AccountState era) (Maybe DRep)
Lens' (AccountState era) (Maybe DRep)
dRepDelegationAccountStateL)