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

module Cardano.Ledger.Conway.State.Account (
  ConwayAccountState (..),
  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 hiding (balance)
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
  = ConwayAccountState
  { forall era. ConwayAccountState era -> CompactForm Coin
casBalance :: {-# UNPACK #-} !(CompactForm Coin)
  -- ^ Current balance of the account
  , forall era. ConwayAccountState era -> CompactForm Coin
casDeposit :: {-# UNPACK #-} !(CompactForm Coin)
  -- ^ Deposit amount that was left when staking credential was registered
  , forall era.
ConwayAccountState era -> StrictMaybe (KeyHash 'StakePool)
casStakePoolDelegation :: !(StrictMaybe (KeyHash 'StakePool))
  -- ^ Potential delegation to a stake pool
  , forall era. ConwayAccountState era -> StrictMaybe DRep
casDRepDelegation :: !(StrictMaybe DRep)
  -- ^ Potential delegation to a 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)

instance NoThunks (ConwayAccountState era)

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

instance Typeable era => 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, Typeable (ConwayAccounts era)
Typeable (ConwayAccounts era) =>
(ConwayAccounts era -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (ConwayAccounts era) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [ConwayAccounts era] -> Size)
-> EncCBOR (ConwayAccounts era)
ConwayAccounts era -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayAccounts era] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayAccounts era) -> Size
forall era. Typeable era => Typeable (ConwayAccounts era)
forall era. Typeable era => ConwayAccounts era -> Encoding
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayAccounts era] -> Size
forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayAccounts era) -> Size
$cencCBOR :: forall era. Typeable era => ConwayAccounts era -> Encoding
encCBOR :: ConwayAccounts era -> Encoding
$cencodedSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayAccounts era) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (ConwayAccounts era) -> Size
$cencodedListSizeExpr :: forall era.
Typeable era =>
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayAccounts era] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [ConwayAccounts era] -> Size
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
      Map (Credential 'Staking) (ConwayAccountState era)
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' :: Interns (Credential 'Staking)
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
      (ConwayAccounts era,
 (Interns (Credential 'Staking), Interns (KeyHash 'StakePool),
  Interns (Credential 'DRepRole)))
-> Decoder
     s
     (ConwayAccounts 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 (ConwayAccounts {Map (Credential 'Staking) (ConwayAccountState era)
caStates :: Map (Credential 'Staking) (ConwayAccountState era)
caStates :: Map (Credential 'Staking) (ConwayAccountState era)
caStates}, (Interns (Credential 'Staking)
a', Interns (KeyHash 'StakePool)
b, Interns (Credential 'DRepRole)
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 era
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 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

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)