{-# LANGUAGE TemplateHaskell #-}

module Tendermint.SDK.Modules.Validators.Keeper where

import qualified Data.Map.Strict                         as Map
import           Data.Maybe                              (fromMaybe)
import qualified Data.Set                                as Set
import           Data.Word                               (Word64)
import           Network.ABCI.Types.Messages.FieldTypes
import           Polysemy                                (Members, Sem,
                                                          interpret, makeSem)
import           Polysemy.Error                          (Error)
import           Tendermint.SDK.BaseApp                  (AppError, ReadStore,
                                                          WriteStore)
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.Store
import           Tendermint.SDK.Modules.Validators.Types


data ValidatorsKeeper m a where
  GetValidatorsKeys :: ValidatorsKeeper m (Set.Set PubKey_)
  GetPowerOf :: PubKey_ -> ValidatorsKeeper m Word64
  GetQueuedUpdates :: ValidatorsKeeper m (Map.Map PubKey_ Word64)
  QueueUpdate :: PubKey_ -> Word64 -> ValidatorsKeeper m ()

makeSem ''ValidatorsKeeper

type ValidatorsEffs = '[ValidatorsKeeper]

eval
  :: Members [ReadStore, WriteStore, Error AppError] r
  => Sem (ValidatorsKeeper : r) a
  -> Sem r a
eval :: Sem (ValidatorsKeeper : r) a -> Sem r a
eval = (forall x (m :: * -> *). ValidatorsKeeper m x -> Sem r x)
-> Sem (ValidatorsKeeper : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *]) a.
FirstOrder e "interpret" =>
(forall x (m :: * -> *). e m x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret (\case
  GetValidatorsKeys -> Sem r x
forall (r :: [(* -> *) -> * -> *]).
Members '[ReadStore, Error AppError] r =>
Sem r (Set PubKey_)
getValidatorsKeysF
  GetPowerOf key -> PubKey_ -> Sem r Word64
forall (r :: [(* -> *) -> * -> *]).
Members '[ReadStore, Error AppError] r =>
PubKey_ -> Sem r Word64
getPowerOfF PubKey_
key
  GetQueuedUpdates -> Sem r x
forall (r :: [(* -> *) -> * -> *]).
Members '[ReadStore, Error AppError] r =>
Sem r (Map PubKey_ Word64)
getQueuedUpdatesF
  QueueUpdate key power -> PubKey_ -> Word64 -> Sem r ()
forall (r :: [(* -> *) -> * -> *]).
Members '[ReadStore, WriteStore, Error AppError] r =>
PubKey_ -> Word64 -> Sem r ()
queueUpdateF PubKey_
key Word64
power
  )

getValidatorsKeysF
  :: Members [ReadStore, Error AppError] r
  => Sem r (Set.Set PubKey_)
getValidatorsKeysF :: Sem r (Set PubKey_)
getValidatorsKeysF =
  (Maybe KeySet -> Set PubKey_)
-> Sem r (Maybe KeySet) -> Sem r (Set PubKey_)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set PubKey_
-> (KeySet -> Set PubKey_) -> Maybe KeySet -> Set PubKey_
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set PubKey_
forall a. Set a
Set.empty (\(KeySet x :: Set PubKey_
x) -> Set PubKey_
x)) (Sem r (Maybe KeySet) -> Sem r (Set PubKey_))
-> Sem r (Maybe KeySet) -> Sem r (Set PubKey_)
forall a b. (a -> b) -> a -> b
$ Var KeySet -> Sem r (Maybe KeySet)
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[ReadStore, Error AppError] r, HasCodec a) =>
Var a -> Sem r (Maybe a)
V.takeVar Var KeySet
validatorsKeySet

getPowerOfF
  :: Members [ReadStore, Error AppError] r
  => PubKey_
  -> Sem r Word64
getPowerOfF :: PubKey_ -> Sem r Word64
getPowerOfF key :: PubKey_
key =
  (Maybe Word64 -> Word64) -> Sem r (Maybe Word64) -> Sem r Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe 0) (Sem r (Maybe Word64) -> Sem r Word64)
-> Sem r (Maybe Word64) -> Sem r Word64
forall a b. (a -> b) -> a -> b
$ PubKey_ -> Map PubKey_ Word64 -> Sem r (Maybe Word64)
forall (r :: [(* -> *) -> * -> *]) k v.
(Members '[Error AppError, ReadStore] r, RawKey k, HasCodec v) =>
k -> Map k v -> Sem r (Maybe v)
M.lookup PubKey_
key Map PubKey_ Word64
validatorsMap

getQueuedUpdatesF
  :: Members [ReadStore, Error AppError] r
  => Sem r (Map.Map PubKey_ Word64)
getQueuedUpdatesF :: Sem r (Map PubKey_ Word64)
getQueuedUpdatesF = (Map PubKey_ Word64 -> ValidatorUpdate_ -> Map PubKey_ Word64)
-> Map PubKey_ Word64
-> List ValidatorUpdate_
-> Sem r (Map PubKey_ Word64)
forall (r :: [(* -> *) -> * -> *]) a b.
(Members '[Error AppError, ReadStore] r, HasCodec a) =>
(b -> a -> b) -> b -> List a -> Sem r b
L.foldl (\m :: Map PubKey_ Word64
m (ValidatorUpdate_ ValidatorUpdate{..}) ->
  (Maybe Word64 -> Maybe Word64)
-> PubKey_ -> Map PubKey_ Word64 -> Map PubKey_ Word64
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64)
-> (Maybe Word64 -> Word64) -> Maybe Word64 -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe (WrappedVal Int64 -> Word64
forall a b. (Integral a, Num b) => WrappedVal a -> b
toWord WrappedVal Int64
validatorUpdatePower)) (Maybe PubKey -> PubKey_
toPK_ Maybe PubKey
validatorUpdatePubKey) Map PubKey_ Word64
m) Map PubKey_ Word64
forall k a. Map k a
Map.empty List ValidatorUpdate_
updatesList
  where
    toWord :: WrappedVal a -> b
toWord (WrappedVal x :: a
x) = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
    toPK_ :: Maybe PubKey -> PubKey_
toPK_ = PubKey -> PubKey_
PubKey_ (PubKey -> PubKey_)
-> (Maybe PubKey -> PubKey) -> Maybe PubKey -> PubKey_
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKey -> Maybe PubKey -> PubKey
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> PubKey
forall a. HasCallStack => [Char] -> a
error "Bad ValidatorUpdate with Nothing PubKey found in queued updates")

queueUpdateF
  :: Members [ReadStore, WriteStore, Error AppError] r
  => PubKey_
  -> Word64
  -> Sem r ()
queueUpdateF :: PubKey_ -> Word64 -> Sem r ()
queueUpdateF (PubKey_ key :: PubKey
key) power :: Word64
power =
  ValidatorUpdate_ -> List ValidatorUpdate_ -> Sem r ()
forall (r :: [(* -> *) -> * -> *]) a.
(Members '[Error AppError, ReadStore, WriteStore] r, HasCodec a) =>
a -> List a -> Sem r ()
L.append (ValidatorUpdate -> ValidatorUpdate_
ValidatorUpdate_(Maybe PubKey -> WrappedVal Int64 -> ValidatorUpdate
ValidatorUpdate (PubKey -> Maybe PubKey
forall a. a -> Maybe a
Just PubKey
key) (Word64 -> WrappedVal Int64
forall a a. (Integral a, Num a) => a -> WrappedVal a
wrapInt Word64
power))) List ValidatorUpdate_
updatesList
  where
    wrapInt :: a -> WrappedVal a
wrapInt p :: a
p = a -> WrappedVal a
forall a. a -> WrappedVal a
WrappedVal (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p)