module Tendermint.SDK.Modules.Validators.EndBlock where

import           Control.Monad.State                      (MonadTrans (lift),
                                                           execStateT, forM_,
                                                           modify)
import qualified Data.Map.Strict                          as Map
import qualified Data.Set                                 as Set
import qualified Network.ABCI.Types.Messages.FieldTypes   as ABCI
import qualified Network.ABCI.Types.Messages.Request      as Request
import           Polysemy                                 (Members, Sem)
import           Tendermint.SDK.BaseApp                   (BlockEffs,
                                                           EndBlockResult (..))
import qualified Tendermint.SDK.BaseApp.Store.List        as L
import qualified Tendermint.SDK.BaseApp.Store.Map         as M
import qualified Tendermint.SDK.BaseApp.Store.Var         as V
import           Tendermint.SDK.Modules.Validators.Keeper
import           Tendermint.SDK.Modules.Validators.Store
import           Tendermint.SDK.Modules.Validators.Types


endBlock
  :: Members BlockEffs r
  => Members ValidatorsEffs r
  => Request.EndBlock
  -> Sem r EndBlockResult
endBlock :: EndBlock -> Sem r EndBlockResult
endBlock _ = do
  Map PubKey_ Word64
updatesMap <- Sem r (Map PubKey_ Word64)
forall (r :: [Effect]).
MemberWithError ValidatorsKeeper r =>
Sem r (Map PubKey_ Word64)
getQueuedUpdates
  Set PubKey_
curValKeySet <- Sem r (Set PubKey_)
forall (r :: [Effect]).
MemberWithError ValidatorsKeeper r =>
Sem r (Set PubKey_)
getValidatorsKeys

  -- update the Validators map and key set
  Set PubKey_
newValKeySet <- (StateT (Set PubKey_) (Sem r) ()
 -> Set PubKey_ -> Sem r (Set PubKey_))
-> Set PubKey_
-> StateT (Set PubKey_) (Sem r) ()
-> Sem r (Set PubKey_)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (Set PubKey_) (Sem r) ()
-> Set PubKey_ -> Sem r (Set PubKey_)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT Set PubKey_
curValKeySet (StateT (Set PubKey_) (Sem r) () -> Sem r (Set PubKey_))
-> StateT (Set PubKey_) (Sem r) () -> Sem r (Set PubKey_)
forall a b. (a -> b) -> a -> b
$
    [(PubKey_, Word64)]
-> ((PubKey_, Word64) -> StateT (Set PubKey_) (Sem r) ())
-> StateT (Set PubKey_) (Sem r) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map PubKey_ Word64 -> [(PubKey_, Word64)]
forall k a. Map k a -> [(k, a)]
Map.toList Map PubKey_ Word64
updatesMap) (((PubKey_, Word64) -> StateT (Set PubKey_) (Sem r) ())
 -> StateT (Set PubKey_) (Sem r) ())
-> ((PubKey_, Word64) -> StateT (Set PubKey_) (Sem r) ())
-> StateT (Set PubKey_) (Sem r) ()
forall a b. (a -> b) -> a -> b
$ \(key :: PubKey_
key, newPower :: Word64
newPower) ->
      if Word64
newPower Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then do
        -- delete from Validators map and key set
        Sem r () -> StateT (Set PubKey_) (Sem r) ()
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r () -> StateT (Set PubKey_) (Sem r) ())
-> Sem r () -> StateT (Set PubKey_) (Sem r) ()
forall a b. (a -> b) -> a -> b
$ PubKey_ -> Map PubKey_ Word64 -> Sem r ()
forall (r :: [Effect]) k v.
(Member WriteStore r, RawKey k) =>
k -> Map k v -> Sem r ()
M.delete PubKey_
key Map PubKey_ Word64
validatorsMap
        (Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ())
-> (Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ()
forall a b. (a -> b) -> a -> b
$ PubKey_ -> Set PubKey_ -> Set PubKey_
forall a. Ord a => a -> Set a -> Set a
Set.delete PubKey_
key
      else do
        -- update power in Validators map and ensure key is in key set
        Sem r () -> StateT (Set PubKey_) (Sem r) ()
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Sem r () -> StateT (Set PubKey_) (Sem r) ())
-> Sem r () -> StateT (Set PubKey_) (Sem r) ()
forall a b. (a -> b) -> a -> b
$ PubKey_ -> Word64 -> Map PubKey_ Word64 -> Sem r ()
forall (r :: [Effect]) k v.
(Member WriteStore r, RawKey k, HasCodec v) =>
k -> v -> Map k v -> Sem r ()
M.insert PubKey_
key Word64
newPower Map PubKey_ Word64
validatorsMap
        (Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ())
-> (Set PubKey_ -> Set PubKey_) -> StateT (Set PubKey_) (Sem r) ()
forall a b. (a -> b) -> a -> b
$ PubKey_ -> Set PubKey_ -> Set PubKey_
forall a. Ord a => a -> Set a -> Set a
Set.insert PubKey_
key

  -- store new set of validator keys
  KeySet -> Var KeySet -> Sem r ()
forall (r :: [Effect]) a.
(Member WriteStore r, HasCodec a) =>
a -> Var a -> Sem r ()
V.putVar (Set PubKey_ -> KeySet
KeySet Set PubKey_
newValKeySet) Var KeySet
validatorsKeySet

  -- reset the updatesList to empty
  (ValidatorUpdate_ -> Bool) -> List ValidatorUpdate_ -> Sem r ()
forall (r :: [Effect]) a.
(Members '[Error AppError, ReadStore, WriteStore] r, HasCodec a) =>
(a -> Bool) -> List a -> Sem r ()
L.deleteWhen (Bool -> ValidatorUpdate_ -> Bool
forall a b. a -> b -> a
const Bool
True) List ValidatorUpdate_
updatesList

  -- return EndBlockResult with validator updates for Tendermint
  EndBlockResult -> Sem r EndBlockResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EndBlockResult -> Sem r EndBlockResult)
-> EndBlockResult -> Sem r EndBlockResult
forall a b. (a -> b) -> a -> b
$ [ValidatorUpdate] -> Maybe ConsensusParams -> EndBlockResult
EndBlockResult (((PubKey_, Word64) -> ValidatorUpdate)
-> [(PubKey_, Word64)] -> [ValidatorUpdate]
forall a b. (a -> b) -> [a] -> [b]
map (PubKey_, Word64) -> ValidatorUpdate
forall a. Integral a => (PubKey_, a) -> ValidatorUpdate
convertToValUp (Map PubKey_ Word64 -> [(PubKey_, Word64)]
forall k a. Map k a -> [(k, a)]
Map.assocs Map PubKey_ Word64
updatesMap)) Maybe ConsensusParams
forall a. Maybe a
Nothing
  where
    convertToValUp :: (PubKey_, a) -> ValidatorUpdate
convertToValUp (PubKey_ key :: PubKey
key, power :: a
power) =
      Maybe PubKey -> WrappedVal Int64 -> ValidatorUpdate
ABCI.ValidatorUpdate (PubKey -> Maybe PubKey
forall a. a -> Maybe a
Just PubKey
key) (Int64 -> WrappedVal Int64
forall a. a -> WrappedVal a
ABCI.WrappedVal (a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
power))