{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

-- | Working with the Byron spec chain state
module Ouroboros.Consensus.ByronSpec.Ledger.Accessors (
    -- * ChainState getters
    GetChainState
  , getChainStateDIState
  , getChainStateHash
  , getChainStateSlot
  , getChainStateUPIState
  , getChainStateUtxoState
    -- * ChainState modifiers
  , ModChainState
  , modChainStateDIState
  , modChainStateSlot
  , modChainStateUPIState
  , modChainStateUtxoState
    -- * Auxiliary
  , getDIStateDSState
  , modDIStateDSState
  ) where

import qualified Byron.Spec.Chain.STS.Rule.Chain as Spec
import qualified Byron.Spec.Ledger.Core as Spec
import qualified Byron.Spec.Ledger.Delegation as Spec
import qualified Byron.Spec.Ledger.STS.UTXO as Spec
import qualified Byron.Spec.Ledger.Update as Spec
import qualified Control.State.Transition as Spec

{-------------------------------------------------------------------------------
  Accessors
-------------------------------------------------------------------------------}

type GetChainState    a = Spec.State Spec.CHAIN -> a
type ModChainState a = forall m. Applicative m => (a -> m a)
                       -> Spec.State Spec.CHAIN -> m (Spec.State Spec.CHAIN)

getChainStateSlot :: GetChainState Spec.Slot
getChainStateSlot :: GetChainState Slot
getChainStateSlot (Slot
a, Seq VKeyGenesis
_, Hash
_, UTxOState
_, DIState
_, UPIState
_) = Slot
a

modChainStateSlot :: ModChainState Spec.Slot
modChainStateSlot :: ModChainState Slot
modChainStateSlot Slot -> m Slot
fn (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, UPIState
f) = (, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, UPIState
f) (Slot
 -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> m Slot
-> m (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Slot -> m Slot
fn Slot
a

getChainStateHash :: GetChainState Spec.Hash
getChainStateHash :: GetChainState Hash
getChainStateHash (Slot
_, Seq VKeyGenesis
_, Hash
c, UTxOState
_, DIState
_, UPIState
_) = Hash
c

getChainStateUtxoState :: GetChainState Spec.UTxOState
getChainStateUtxoState :: GetChainState UTxOState
getChainStateUtxoState (Slot
_, Seq VKeyGenesis
_, Hash
_, UTxOState
d, DIState
_, UPIState
_) = UTxOState
d

modChainStateUtxoState :: ModChainState Spec.UTxOState
modChainStateUtxoState :: ModChainState UTxOState
modChainStateUtxoState UTxOState -> m UTxOState
fn (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, UPIState
f) = (Slot
a, Seq VKeyGenesis
b, Hash
c, , DIState
e, UPIState
f) (UTxOState
 -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> m UTxOState
-> m (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOState -> m UTxOState
fn UTxOState
d

getChainStateDIState :: GetChainState Spec.DIState
getChainStateDIState :: GetChainState DIState
getChainStateDIState (Slot
_, Seq VKeyGenesis
_, Hash
_, UTxOState
_, DIState
e, UPIState
_) = DIState
e

modChainStateDIState :: ModChainState Spec.DIState
modChainStateDIState :: ModChainState DIState
modChainStateDIState DIState -> m DIState
fn (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, UPIState
f) = (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, , UPIState
f) (DIState
 -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> m DIState
-> m (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DIState -> m DIState
fn DIState
e

getChainStateUPIState :: GetChainState Spec.UPIState
getChainStateUPIState :: GetChainState UPIState
getChainStateUPIState (Slot
_, Seq VKeyGenesis
_, Hash
_, UTxOState
_, DIState
_, UPIState
f) = UPIState
f

modChainStateUPIState :: ModChainState Spec.UPIState
modChainStateUPIState :: ModChainState UPIState
modChainStateUPIState UPIState -> m UPIState
fn (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, UPIState
f) = (Slot
a, Seq VKeyGenesis
b, Hash
c, UTxOState
d, DIState
e, ) (UPIState
 -> (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState))
-> m UPIState
-> m (Slot, Seq VKeyGenesis, Hash, UTxOState, DIState, UPIState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UPIState -> m UPIState
fn UPIState
f

{-------------------------------------------------------------------------------
  'Spec.DSState' is a sub-state of 'Spec.DIState'

  There is a lens in Ledger.Delegation to do this but we are phasing out @lens@
  across all repos, so don't want to depend on it here
-------------------------------------------------------------------------------}

-- | Extract 'Spec.DSState' from 'Spec.DIState'
getDIStateDSState :: Spec.DIState -> Spec.DSState
getDIStateDSState :: DIState -> DSState
getDIStateDSState Spec.DIState{[(Slot, (VKeyGenesis, VKey))]
Set (Epoch, VKeyGenesis)
Map VKeyGenesis Slot
Bimap VKeyGenesis VKey
_dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateDelegationMap :: DIState -> Bimap VKeyGenesis VKey
_dIStateLastDelegation :: DIState -> Map VKeyGenesis Slot
_dIStateScheduledDelegations :: DIState -> [(Slot, (VKeyGenesis, VKey))]
_dIStateKeyEpochDelegations :: DIState -> Set (Epoch, VKeyGenesis)
..} = Spec.DSState {
      _dSStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dSStateScheduledDelegations = [(Slot, (VKeyGenesis, VKey))]
_dIStateScheduledDelegations
    , _dSStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dSStateKeyEpochDelegations  = Set (Epoch, VKeyGenesis)
_dIStateKeyEpochDelegations
    }

-- | Update 'Spec.DIState' from 'Spec.DSState'
modDIStateDSState :: Applicative m
                  => (Spec.DSState -> m Spec.DSState)
                  -> Spec.DIState -> m Spec.DIState
modDIStateDSState :: forall (m :: * -> *).
Applicative m =>
(DSState -> m DSState) -> DIState -> m DIState
modDIStateDSState DSState -> m DSState
f diState :: DIState
diState@Spec.DIState{[(Slot, (VKeyGenesis, VKey))]
Set (Epoch, VKeyGenesis)
Map VKeyGenesis Slot
Bimap VKeyGenesis VKey
_dIStateDelegationMap :: DIState -> Bimap VKeyGenesis VKey
_dIStateLastDelegation :: DIState -> Map VKeyGenesis Slot
_dIStateScheduledDelegations :: DIState -> [(Slot, (VKeyGenesis, VKey))]
_dIStateKeyEpochDelegations :: DIState -> Set (Epoch, VKeyGenesis)
_dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
..} =
    DSState -> DIState
update (DSState -> DIState) -> m DSState -> m DIState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DSState -> m DSState
f (DIState -> DSState
getDIStateDSState DIState
diState)
  where
    update :: Spec.DSState -> Spec.DIState
    update :: DSState -> DIState
update Spec.DSState{[(Slot, (VKeyGenesis, VKey))]
Set (Epoch, VKeyGenesis)
_dSStateScheduledDelegations :: DSState -> [(Slot, (VKeyGenesis, VKey))]
_dSStateKeyEpochDelegations :: DSState -> Set (Epoch, VKeyGenesis)
_dSStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dSStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
..} = Spec.DIState{
          _dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateScheduledDelegations = [(Slot, (VKeyGenesis, VKey))]
_dSStateScheduledDelegations
        , _dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateKeyEpochDelegations  = Set (Epoch, VKeyGenesis)
_dSStateKeyEpochDelegations
          -- The rest stays the same
        , _dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateDelegationMap        = Bimap VKeyGenesis VKey
_dIStateDelegationMap
        , _dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateLastDelegation       = Map VKeyGenesis Slot
_dIStateLastDelegation
        }