{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns      #-}
{-| A node client that shows the balance of the wallet
-}
module Convex.Wallet.NodeClient.BalanceClient(
  BalanceClientEnv(..),
  balanceClientEnv,
  balanceClient
  ) where

import           Cardano.Api                (BlockInMode, CardanoMode, Env)
import qualified Cardano.Api                as C
import           Control.Concurrent.STM     (TVar, atomically, newTVarIO,
                                             writeTVar)
import           Control.Monad              (when)
import           Control.Monad.IO.Class     (MonadIO (..))
import           Control.Monad.Trans.Maybe  (runMaybeT)
import           Convex.MonadLog            (MonadLogKatipT (..), logInfo,
                                             logInfoS)
import           Convex.NodeClient.Fold     (CatchingUp (..), catchingUp,
                                             catchingUpWithNode, foldClient)
import           Convex.NodeClient.Resuming (resumingClient)
import           Convex.NodeClient.Types    (PipelinedLedgerStateClient)
import           Convex.Utils               (toShelleyPaymentCredential)
import           Convex.Utxos               (PrettyBalance (..),
                                             PrettyUtxoChange (..), UtxoSet,
                                             apply)
import qualified Convex.Utxos               as Utxos
import           Convex.Wallet.WalletState  (WalletState, chainPoint, utxoSet)
import qualified Convex.Wallet.WalletState  as WalletState
import qualified Katip                      as K

data BalanceClientEnv =
  BalanceClientEnv
    { BalanceClientEnv -> FilePath
bceFile  :: FilePath
    , BalanceClientEnv -> TVar WalletState
bceState :: TVar WalletState
    }

balanceClientEnv :: FilePath -> WalletState -> IO BalanceClientEnv
balanceClientEnv :: FilePath -> WalletState -> IO BalanceClientEnv
balanceClientEnv FilePath
bceFile WalletState
initialState =
  FilePath -> TVar WalletState -> BalanceClientEnv
BalanceClientEnv FilePath
bceFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (TVar a)
newTVarIO WalletState
initialState

balanceClient :: K.LogEnv -> K.Namespace -> BalanceClientEnv -> WalletState -> C.PaymentCredential -> Env -> PipelinedLedgerStateClient
balanceClient :: LogEnv
-> Namespace
-> BalanceClientEnv
-> WalletState
-> PaymentCredential
-> Env
-> PipelinedLedgerStateClient
balanceClient LogEnv
logEnv Namespace
ns BalanceClientEnv
clientEnv WalletState
walletState PaymentCredential
wallet Env
env =
  let cp :: ChainPoint
cp = WalletState -> ChainPoint
chainPoint WalletState
walletState
      i :: CatchingUp
i  = ChainPoint -> Maybe BlockNo -> Maybe ChainPoint -> CatchingUp
catchingUpWithNode ChainPoint
cp forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  in [ChainPoint]
-> (ResumingFrom -> PipelinedLedgerStateClient)
-> PipelinedLedgerStateClient
resumingClient [ChainPoint
cp] forall a b. (a -> b) -> a -> b
$ \ResumingFrom
_ ->
      forall s.
s
-> Env
-> (CatchingUp -> s -> BlockInMode CardanoMode -> IO (Maybe s))
-> PipelinedLedgerStateClient
foldClient
        (CatchingUp
i, WalletState -> UtxoSet CtxTx ()
utxoSet WalletState
walletState)
        Env
env
        (LogEnv
-> Namespace
-> BalanceClientEnv
-> PaymentCredential
-> CatchingUp
-> (CatchingUp, UtxoSet CtxTx ())
-> BlockInMode CardanoMode
-> IO (Maybe (CatchingUp, UtxoSet CtxTx ()))
applyBlock LogEnv
logEnv Namespace
ns BalanceClientEnv
clientEnv PaymentCredential
wallet)

{-| Apply a new block
-}
applyBlock :: K.LogEnv -> K.Namespace -> BalanceClientEnv -> C.PaymentCredential -> CatchingUp -> (CatchingUp, UtxoSet C.CtxTx ()) -> BlockInMode CardanoMode -> IO (Maybe (CatchingUp, UtxoSet C.CtxTx ()))
applyBlock :: LogEnv
-> Namespace
-> BalanceClientEnv
-> PaymentCredential
-> CatchingUp
-> (CatchingUp, UtxoSet CtxTx ())
-> BlockInMode CardanoMode
-> IO (Maybe (CatchingUp, UtxoSet CtxTx ()))
applyBlock LogEnv
logEnv Namespace
ns BalanceClientEnv{FilePath
bceFile :: FilePath
bceFile :: BalanceClientEnv -> FilePath
bceFile, TVar WalletState
bceState :: TVar WalletState
bceState :: BalanceClientEnv -> TVar WalletState
bceState} PaymentCredential
wallet CatchingUp
c (CatchingUp
oldC, UtxoSet CtxTx ()
state) BlockInMode CardanoMode
block = forall c (m :: * -> *) a.
LogItem c =>
LogEnv -> c -> Namespace -> KatipContextT m a -> m a
K.runKatipContextT LogEnv
logEnv () Namespace
ns forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadLogKatipT m a -> KatipContextT m a
runMonadLogKatipT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  let change :: UtxoChange CtxTx ()
change = AddressCredential
-> UtxoSet CtxTx ()
-> BlockInMode CardanoMode
-> UtxoChange CtxTx ()
Utxos.extract_ (PaymentCredential -> AddressCredential
toShelleyPaymentCredential PaymentCredential
wallet) UtxoSet CtxTx ()
state BlockInMode CardanoMode
block
      newUTxOs :: UtxoSet CtxTx ()
newUTxOs = forall ctx a. UtxoSet ctx a -> UtxoChange ctx a -> UtxoSet ctx a
apply UtxoSet CtxTx ()
state UtxoChange CtxTx ()
change
      C.BlockInMode (forall era. Block era -> BlockHeader
C.getBlockHeader -> BlockHeader
header) EraInMode era CardanoMode
_ = BlockInMode CardanoMode
block
      newState :: WalletState
newState = UtxoSet CtxTx () -> BlockHeader -> WalletState
WalletState.walletState UtxoSet CtxTx ()
newUTxOs BlockHeader
header

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall ctx a. UtxoChange ctx a -> Bool
Utxos.null UtxoChange CtxTx ()
change) forall a b. (a -> b) -> a -> b
$ do
    forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ forall ctx a. UtxoChange ctx a -> PrettyUtxoChange ctx a
PrettyUtxoChange UtxoChange CtxTx ()
change
    forall a (m :: * -> *). (Pretty a, MonadLog m) => a -> m ()
logInfo forall a b. (a -> b) -> a -> b
$ forall ctx a. UtxoSet ctx a -> PrettyBalance ctx a
PrettyBalance UtxoSet CtxTx ()
newUTxOs

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CatchingUp -> Bool
catchingUp CatchingUp
oldC Bool -> Bool -> Bool
&&  Bool -> Bool
not (CatchingUp -> Bool
catchingUp CatchingUp
c)) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *). MonadLog m => FilePath -> m ()
logInfoS FilePath
"Caught up with node"

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ CatchingUp -> Bool
catchingUp CatchingUp
c) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> WalletState -> IO ()
WalletState.writeToFile FilePath
bceFile WalletState
newState)

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ TVar WalletState -> WalletState -> IO ()
writeState TVar WalletState
bceState WalletState
newState

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (CatchingUp
c, UtxoSet CtxTx ()
newUTxOs)

writeState :: TVar WalletState -> WalletState -> IO ()
writeState :: TVar WalletState -> WalletState -> IO ()
writeState TVar WalletState
tvar WalletState
state = forall a. STM a -> IO a
atomically (forall a. TVar a -> a -> STM ()
writeTVar TVar WalletState
tvar WalletState
state)