{-# 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
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
  -- ^ Pointer to the certificate in which the stake credential was registered in.
  , forall era. ShelleyAccountState era -> CompactForm Coin
sasBalance :: {-# UNPACK #-} !(CompactForm Coin)
  -- ^ Current balance of the account
  , forall era. ShelleyAccountState era -> CompactForm Coin
sasDeposit :: {-# UNPACK #-} !(CompactForm Coin)
  -- ^ Deposit amount that was left when staking credential was registered
  , forall era.
ShelleyAccountState era -> StrictMaybe (KeyHash StakePool)
sasStakePoolDelegation :: !(StrictMaybe (KeyHash StakePool))
  -- ^ Potential delegation to a stake pool
  }
  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 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 -- 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
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))
  -- ^ Map from a staking credential to the account state.
  , forall era. ShelleyAccounts era -> Map Ptr (Credential Staking)
saPtrs :: !(Map Ptr (Credential Staking))
  -- ^ A Map from a pointer, to the staking credential. Pointer points to the certificate which
  -- registered the staking credential.
  }
  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 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
            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' = 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
            saPtrs <- decodeMap decCBOR (interns a' <$> decCBOR)
            pure (ShelleyAccounts {saStates, saPtrs}, (a', b, 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
      }

  -- | This lens is explicitely not exported, since it is not safe to overwrite pointers
  -- directly. For accessing this Map use `accountsPtrsMapG` instead.
  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}

  -- | Get the map with all of the pointers and their respective credentials.
  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

  -- | This is a getter for a `Ptr`. It is not a full lens, because it is not only unsafe to modify
  -- a pointer for an existing AccountState due to violation of an invariant in the
  -- `ShelleyAccounts`, but also because once account is registered pointer cannot change. Pointer
  -- describes unique point on chain when registration has occured, which means it can't change.
  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 ->
  -- | Pointer to the certificate that registered the credential
  Ptr ->
  -- | Deposit
  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 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)
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