{-# LANGUAGE RankNTypes #-}

-- | Utilities for manipulating in-memory SSC state.

-- TODO: the names for functions are pretty bad
module Pos.Chain.Ssc.Mem
       (
       -- * 'MonadSscMem'
         SscMemTag
       , MonadSscMem
       , askSscMem
       , syncingStateWith

       -- * Local state
       , SscLocalQuery
       , SscLocalUpdate
       , sscRunLocalQuery
       , sscRunLocalSTM

       -- * Global state
       , SscGlobalQuery
       , SscGlobalUpdate
       , sscRunGlobalQuery
       , sscRunGlobalUpdate
       ) where

import           Universum

import           Control.Monad.Morph (hoist)
import qualified Crypto.Random as Rand

import           Pos.Chain.Ssc.Types (SscGlobalState, SscLocalData, SscState,
                     sscGlobal, sscLocal)
import           Pos.Util.Util (HasLens (..))
import           Pos.Util.Wlog (NamedPureLogger, WithLogger, launchNamedPureLog)

----------------------------------------------------------------------------
-- MonadSscMem
----------------------------------------------------------------------------

data SscMemTag

type MonadSscMem ctx m = (MonadReader ctx m, HasLens SscMemTag ctx SscState)

askSscMem :: MonadSscMem ctx m => m SscState
askSscMem = view (lensOf @SscMemTag)

-- | Applies state changes to given var.
syncingStateWith
    :: TVar s
    -> StateT s (NamedPureLogger STM) a
    -> NamedPureLogger STM a
syncingStateWith var action = do
    oldV <- lift $ readTVar var
    (res, newV) <- runStateT action oldV
    lift $ writeTVar var newV
    return res

----------------------------------------------------------------------------
-- Local
----------------------------------------------------------------------------

type SscLocalQuery a =
    forall m . (MonadReader SscLocalData m, WithLogger m) => m a

type SscLocalUpdate a =
    forall m . (MonadState SscLocalData m, WithLogger m, Rand.MonadRandom m) => m a

-- | Run something that reads 'SscLocalData' in 'MonadSscMem'.
-- 'MonadIO' is also needed to use stm.
sscRunLocalQuery
    :: forall ctx m a.
       (MonadSscMem ctx m, MonadIO m)
    => ReaderT SscLocalData m a -> m a
sscRunLocalQuery action = do
    localVar <- sscLocal <$> askSscMem
    ld <- readTVarIO localVar
    runReaderT action ld

-- | Run STM transaction which modifies 'SscLocalData' and also can log.
sscRunLocalSTM
    :: forall ctx m a.
       (MonadSscMem ctx m, MonadIO m, WithLogger m)
    => StateT SscLocalData (NamedPureLogger STM) a -> m a
sscRunLocalSTM action = do
    localVar <- sscLocal <$> askSscMem
    launchNamedPureLog atomically $ syncingStateWith localVar action

----------------------------------------------------------------------------
-- Global
----------------------------------------------------------------------------

type SscGlobalQuery a =
    forall m . (MonadReader SscGlobalState m) => m a

type SscGlobalUpdate a =
    forall m . (MonadState SscGlobalState m, WithLogger m, Rand.MonadRandom m) => m a

-- | Run something that reads 'SscGlobalState' in 'MonadSscMem'.
-- 'MonadIO' is also needed to use stm.
sscRunGlobalQuery
    :: (MonadSscMem ctx m, MonadIO m)
    => ReaderT SscGlobalState m a -> m a
sscRunGlobalQuery action = do
    globalVar <- sscGlobal <$> askSscMem
    gs <- readTVarIO globalVar
    runReaderT action gs

sscRunGlobalUpdate
    :: (MonadSscMem ctx m, Rand.MonadRandom m, WithLogger m, MonadIO m)
    => StateT SscGlobalState
       (NamedPureLogger (Rand.MonadPseudoRandom Rand.ChaChaDRG)) a
    -> m a
sscRunGlobalUpdate action = do
    globalVar <- sscGlobal <$> askSscMem
    seed <- Rand.drgNew
    launchNamedPureLog atomically $
        syncingStateWith globalVar $
        executeMonadBaseRandom seed action
  where
    -- (... MonadPseudoRandom) a -> (... n) a
    executeMonadBaseRandom seed =
        hoist $ hoist (pure . fst . Rand.withDRG seed)
