{-# 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 (a, _, _, _, _, _) = Slot
a

modChainStateSlot :: ModChainState Spec.Slot
modChainStateSlot :: (Slot -> m Slot) -> State CHAIN -> m (State CHAIN)
modChainStateSlot Slot -> m Slot
fn (a, b, c, d, e, 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 (_, _, c, _, _, _) = Hash
c

getChainStateUtxoState :: GetChainState Spec.UTxOState
getChainStateUtxoState :: GetChainState UTxOState
getChainStateUtxoState (_, _, _, d, _, _) = UTxOState
d

modChainStateUtxoState :: ModChainState Spec.UTxOState
modChainStateUtxoState :: (UTxOState -> m UTxOState) -> State CHAIN -> m (State CHAIN)
modChainStateUtxoState UTxOState -> m UTxOState
fn (a, b, c, d, e, 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 (_, _, _, _, e, _) = DIState
e

modChainStateDIState :: ModChainState Spec.DIState
modChainStateDIState :: (DIState -> m DIState) -> State CHAIN -> m (State CHAIN)
modChainStateDIState DIState -> m DIState
fn (a, b, c, d, e, 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 (_, _, _, _, _, f) = UPIState
f

modChainStateUPIState :: ModChainState Spec.UPIState
modChainStateUPIState :: (UPIState -> m UPIState) -> State CHAIN -> m (State CHAIN)
modChainStateUPIState UPIState -> m UPIState
fn (a, b, c, d, e, 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
_dIStateScheduledDelegations :: DIState -> [(Slot, (VKeyGenesis, VKey))]
_dIStateLastDelegation :: DIState -> Map VKeyGenesis Slot
_dIStateKeyEpochDelegations :: DIState -> Set (Epoch, VKeyGenesis)
_dIStateDelegationMap :: DIState -> Bimap VKeyGenesis VKey
_dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateDelegationMap :: Bimap VKeyGenesis VKey
..} = DSState :: [(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis) -> DSState
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 :: (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
_dIStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dIStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dIStateLastDelegation :: Map VKeyGenesis Slot
_dIStateDelegationMap :: Bimap VKeyGenesis VKey
_dIStateScheduledDelegations :: DIState -> [(Slot, (VKeyGenesis, VKey))]
_dIStateLastDelegation :: DIState -> Map VKeyGenesis Slot
_dIStateKeyEpochDelegations :: DIState -> Set (Epoch, VKeyGenesis)
_dIStateDelegationMap :: DIState -> Bimap VKeyGenesis VKey
..} =
    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)
_dSStateKeyEpochDelegations :: Set (Epoch, VKeyGenesis)
_dSStateScheduledDelegations :: [(Slot, (VKeyGenesis, VKey))]
_dSStateKeyEpochDelegations :: DSState -> Set (Epoch, VKeyGenesis)
_dSStateScheduledDelegations :: DSState -> [(Slot, (VKeyGenesis, VKey))]
..} = DIState :: Bimap VKeyGenesis VKey
-> Map VKeyGenesis Slot
-> [(Slot, (VKeyGenesis, VKey))]
-> Set (Epoch, VKeyGenesis)
-> DIState
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
        }