Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Light Mode: implement getPoolLifeCycleStatus #3320

Merged
merged 6 commits into from
Jun 13, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions lib/shelley/cardano-wallet.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -120,7 +120,10 @@ library
Cardano.Wallet.Shelley.Compatibility.Ledger
Cardano.Wallet.Shelley.Network
Cardano.Wallet.Shelley.Network.Blockfrost
Cardano.Wallet.Shelley.Network.Blockfrost.Conversion
Cardano.Wallet.Shelley.Network.Blockfrost.Error
Cardano.Wallet.Shelley.Network.Blockfrost.Fixture
Cardano.Wallet.Shelley.Network.Blockfrost.Monad
Cardano.Wallet.Shelley.Network.Discriminant
Cardano.Wallet.Shelley.Network.Node
Cardano.Wallet.Shelley.Transaction
Expand Down
91 changes: 21 additions & 70 deletions lib/shelley/src/Cardano/Wallet/Shelley.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,10 +28,6 @@ module Cardano.Wallet.Shelley

import Prelude

import Cardano.Pool.DB
( DBLayer (..) )
import Cardano.Pool.DB.Log
( PoolDbLog )
import Cardano.Wallet.Api
( ApiLayer, ApiV2 )
import Cardano.Wallet.Api.Server
Expand Down Expand Up @@ -82,7 +78,6 @@ import Cardano.Wallet.Primitive.Types
( Block
, NetworkParameters (..)
, NetworkParameters
, PoolMetadataGCStatus (..)
, ProtocolParameters (..)
, Settings (..)
, SlottingParameters (..)
Expand All @@ -98,7 +93,7 @@ import Cardano.Wallet.Primitive.Types.RewardAccount
import Cardano.Wallet.Primitive.Types.Tx
( SealedTx )
import Cardano.Wallet.Registry
( HasWorkerCtx (..), traceAfterThread )
( HasWorkerCtx (..) )
import Cardano.Wallet.Shelley.Api.Server
( server )
import Cardano.Wallet.Shelley.BlockchainSource
Expand All @@ -118,10 +113,9 @@ import Cardano.Wallet.Shelley.Network.Discriminant
( SomeNetworkDiscriminant (..), networkDiscriminantToId )
import Cardano.Wallet.Shelley.Pools
( StakePoolLayer (..)
, StakePoolLog (..)
, monitorMetadata
, monitorStakePools
, newStakePoolLayer
, withBlockfrostStakePoolLayer
, withNodeStakePoolLayer
, withStakePoolDbLayer
)
import Cardano.Wallet.Shelley.Tracers as Tracers
( TracerSeverities
Expand All @@ -139,18 +133,16 @@ import Cardano.Wallet.TokenMetadata
( newMetadataClient )
import Cardano.Wallet.Transaction
( TransactionLayer )
import Control.Monad
( forM_, void, (>=>) )
import Control.Monad.Trans.Class
( lift )
import Control.Monad.Trans.Cont
( ContT (ContT), evalContT )
import Control.Tracer
( Tracer, contramap, traceWith )
( Tracer, traceWith )
import Data.Function
( (&) )
import Data.Maybe
( fromJust, fromMaybe )
( fromJust )
import Data.Proxy
( Proxy (..) )
import Data.Text
Expand All @@ -171,14 +163,7 @@ import System.IOManager
( withIOManager )
import Type.Reflection
( Typeable )
import UnliftIO.Concurrent
( forkFinally, forkIOWithUnmask, killThread )
import UnliftIO.MVar
( modifyMVar_, newMVar )
import UnliftIO.STM
( newTVarIO )

import qualified Cardano.Pool.DB as PoolDb
import qualified Cardano.Pool.DB.Sqlite as Pool
import qualified Cardano.Wallet.Api.Server as Server
import qualified Cardano.Wallet.DB.Sqlite as Sqlite
Expand Down Expand Up @@ -251,17 +236,21 @@ serveWallet
network
netParams
sTolerance
stakePoolDbLayer <- withStakePoolDbLayer
poolsDbTracer
databaseDir
mPoolDatabaseDecorator
netLayer
stakePoolLayer <- withStakePoolLayer
poolsEngineTracer
settings
stakePoolDbLayer
netParams
netLayer
stakePoolLayer <- case blockchainSource of
NodeSource _ _ -> do
stakePoolDbLayer <- withStakePoolDbLayer
poolsDbTracer
databaseDir
mPoolDatabaseDecorator
netLayer
withNodeStakePoolLayer
poolsEngineTracer
settings
stakePoolDbLayer
netParams
netLayer
BlockfrostSource bfProject -> do
withBlockfrostStakePoolLayer poolsEngineTracer bfProject network
randomApi <- withRandomApi netLayer
icarusApi <- withIcarusApi netLayer
shelleyApi <- withShelleyApi netLayer
Expand Down Expand Up @@ -401,44 +390,6 @@ serveWallet
tokenMetaClient
coworker

withStakePoolDbLayer
:: Tracer IO PoolDbLog
-> Maybe FilePath
-> Maybe (Pool.DBDecorator IO)
-> NetworkLayer IO block
-> ContT r IO (PoolDb.DBLayer IO)
withStakePoolDbLayer poolDbTracer databaseDir poolDbDecorator netLayer =
ContT $ Pool.withDecoratedDBLayer
(fromMaybe Pool.undecoratedDB poolDbDecorator)
poolDbTracer
(Pool.defaultFilePath <$> databaseDir)
(neverFails "withPoolsMonitoring never forecasts into the future" $
timeInterpreter netLayer)

withStakePoolLayer
:: Tracer IO StakePoolLog
-> Maybe Settings
-> PoolDb.DBLayer IO
-> NetworkParameters
-> NetworkLayer IO (CardanoBlock StandardCrypto)
-> ContT ExitCode IO StakePoolLayer
withStakePoolLayer tr settings dbLayer@DBLayer{..} netParams netLayer =
lift $ do
gcStatus <- newTVarIO NotStarted
forM_ settings $ atomically . putSettings
void $ forkFinally
(monitorStakePools tr netParams netLayer dbLayer)
(traceAfterThread (contramap MsgExitMonitoring tr))

-- fixme: needs to be simplified as part of ADP-634
let NetworkParameters{slottingParameters} = netParams
startMetadataThread = forkIOWithUnmask
($ monitorMetadata gcStatus tr slottingParameters dbLayer)
metadataThread <- newMVar =<< startMetadataThread
let restartMetadataThread = modifyMVar_ metadataThread $
killThread >=> const startMetadataThread
newStakePoolLayer gcStatus netLayer dbLayer restartMetadataThread

withNtpClient :: Tracer IO NtpTrace -> ContT r IO NtpClient
withNtpClient tr = do
iom <- ContT withIOManager
Expand Down
Loading