Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit 6afcb90

Browse files
ruhatchruhatch
authored
Merge pull request #3549 from input-output-hk/ruhatch/CDEC-509
[CDEC-509] Remove HasGenesisBlockVersionData
2 parents 1df2266 + e0dca5d commit 6afcb90

File tree

47 files changed

+384
-355
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

47 files changed

+384
-355
lines changed

‎auxx/src/Command/Tx.hs

+3-4
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,10 @@ import Pos.Client.Txp.Balances (getOwnUtxoForPk)
3939
import Pos.Client.Txp.Network (prepareMTx, submitTxRaw)
4040
import Pos.Client.Txp.Util (createTx)
4141
import Pos.Core as Core (Config (..), IsBootstrapEraAddr (..),
42-
Timestamp (..), configEpochSlots, deriveFirstHDAddress,
43-
makePubKeyAddress, mkCoin)
42+
Timestamp (..), configBlockVersionData, configEpochSlots,
43+
deriveFirstHDAddress, makePubKeyAddress, mkCoin)
4444
import Pos.Core.Conc (concurrently, currentTime, delay,
4545
forConcurrently, modifySharedAtomic, newSharedAtomic)
46-
import Pos.Core.Configuration (genesisBlockVersionData)
4746
import Pos.Core.Txp (TxAux (..), TxIn (TxInUtxo), TxOut (..),
4847
TxOutAux (..), txaF)
4948
import Pos.Core.Update (BlockVersionData (..))
@@ -93,7 +92,7 @@ sendToAllGenesis
9392
-> SendToAllGenesisParams
9493
-> m ()
9594
sendToAllGenesis coreConfig keysToSend diffusion (SendToAllGenesisParams genesisTxsPerThread txsPerThread conc delay_ tpsSentFile) = do
96-
let genesisSlotDuration = fromIntegral (toMicroseconds $ bvdSlotDuration genesisBlockVersionData) `div` 1000000 :: Int
95+
let genesisSlotDuration = fromIntegral (toMicroseconds $ bvdSlotDuration (configBlockVersionData coreConfig)) `div` 1000000 :: Int
9796
tpsMVar <- newSharedAtomic $ TxCount 0 conc
9897
startTime <- show . toInteger . getTimestamp . Timestamp <$> currentTime
9998
bracket (openFile tpsSentFile WriteMode) (liftIO . hClose) $ \h -> do

‎chain/src/Pos/Chain/Update/Poll/Class.hs

+6-6
Original file line numberDiff line numberDiff line change
@@ -77,9 +77,9 @@ class (Monad m, WithLogger m) => MonadPollRead m where
7777
-- ^ Get active proposals for the specified application.
7878
getConfirmedProposals :: m [ConfirmedProposalState]
7979
-- ^ Get all known confirmed proposals.
80-
getEpochTotalStake :: EpochIndex -> m (Maybe Coin)
80+
getEpochTotalStake :: BlockVersionData -> EpochIndex -> m (Maybe Coin)
8181
-- ^ Get total stake from distribution corresponding to given epoch
82-
getRichmanStake :: EpochIndex -> StakeholderId -> m (Maybe Coin)
82+
getRichmanStake :: BlockVersionData -> EpochIndex -> StakeholderId -> m (Maybe Coin)
8383
-- ^ Get stake of ricmhan corresponding to given epoch (if she is
8484
-- really rich)
8585
getOldProposals :: SlotId -> m [UndecidedProposalState]
@@ -115,8 +115,8 @@ instance {-# OVERLAPPABLE #-}
115115
getProposal = lift . getProposal
116116
getProposalsByApp = lift . getProposalsByApp
117117
getConfirmedProposals = lift getConfirmedProposals
118-
getEpochTotalStake = lift . getEpochTotalStake
119-
getRichmanStake e = lift . getRichmanStake e
118+
getEpochTotalStake genesisBvd = lift . getEpochTotalStake genesisBvd
119+
getRichmanStake genesisBvd e = lift . getRichmanStake genesisBvd e
120120
getOldProposals = lift . getOldProposals
121121
getDeepProposals = lift . getDeepProposals
122122
getBlockIssuerStake e = lift . getBlockIssuerStake e
@@ -309,8 +309,8 @@ instance (MonadPollRead m) =>
309309
MM.valuesM
310310
(map (first cpsSoftwareVersion . join (,)) <$> getConfirmedProposals) =<<
311311
use pmConfirmedPropsL
312-
getEpochTotalStake = lift . getEpochTotalStake
313-
getRichmanStake e = lift . getRichmanStake e
312+
getEpochTotalStake genesisBvd = lift . getEpochTotalStake genesisBvd
313+
getRichmanStake genesisBvd e = lift . getRichmanStake genesisBvd e
314314
getOldProposals sl = ether $
315315
map snd <$>
316316
(MM.mapMaybeM getOldProposalPairs extractOld =<< use pmActivePropsL)

‎chain/test/Test/Pos/Chain/Lrc/Arbitrary.hs

+3-4
Original file line numberDiff line numberDiff line change
@@ -16,11 +16,10 @@ import Test.QuickCheck.Arbitrary.Generic (genericShrink)
1616
import Pos.Chain.Lrc (RichmenStakes)
1717
import Pos.Core.Common (Coin, CoinPortion, coinPortionToDouble,
1818
mkCoin, unsafeAddCoin, unsafeGetCoin, unsafeSubCoin)
19-
import Pos.Core.Configuration (HasGenesisBlockVersionData,
20-
genesisBlockVersionData)
2119
import Pos.Core.Update (BlockVersionData (bvdMpcThd))
2220

2321
import Test.Pos.Core.Arbitrary ()
22+
import Test.Pos.Core.Dummy (dummyBlockVersionData)
2423

2524
-- | Wrapper over 'RichmenStakes'. Its 'Arbitrary' instance enforces that the
2625
-- stake distribution inside must be valid with respect to the threshold
@@ -76,5 +75,5 @@ genRichmenStakes thd = do
7675

7776
data GenesisMpcThd
7877

79-
instance HasGenesisBlockVersionData => Reifies GenesisMpcThd CoinPortion where
80-
reflect _ = bvdMpcThd genesisBlockVersionData
78+
instance Reifies GenesisMpcThd CoinPortion where
79+
reflect _ = bvdMpcThd dummyBlockVersionData

‎client/test/Test/Pos/Client/Txp/Mode.hs

+4-5
Original file line numberDiff line numberDiff line change
@@ -22,12 +22,12 @@ import Pos.Chain.Update (HasUpdateConfiguration)
2222
import Pos.Client.Txp.Addresses (MonadAddresses (..))
2323
import Pos.Configuration (HasNodeConfiguration)
2424
import Pos.Core (Address, HasConfiguration, makePubKeyAddressBoot)
25-
import Pos.Core.Configuration (HasGenesisBlockVersionData,
26-
genesisBlockVersionData)
2725
import Pos.Core.Update (BlockVersionData)
2826
import Pos.Crypto (deterministicKeyGen)
2927
import Pos.DB (MonadGState (..))
3028

29+
import Test.Pos.Core.Dummy (dummyBlockVersionData)
30+
3131
----------------------------------------------------------------------------
3232
-- Configuration propagation
3333
----------------------------------------------------------------------------
@@ -37,7 +37,6 @@ type HasTxpConfigurations =
3737
, HasSscConfiguration
3838
, HasConfiguration
3939
, HasUpdateConfiguration
40-
, HasGenesisBlockVersionData
4140
)
4241

4342
----------------------------------------------------------------------------
@@ -86,5 +85,5 @@ instance MonadAddresses TxpTestProperty where
8685
getNewAddress epochSlots = lift . getNewAddress epochSlots
8786
getFakeChangeAddress = lift . getFakeChangeAddress
8887

89-
instance (HasTxpConfigurations, Testable a) => Testable (TxpTestProperty a) where
90-
property = monadic (ioProperty . flip runReaderT genesisBlockVersionData)
88+
instance Testable a => Testable (TxpTestProperty a) where
89+
property = monadic (ioProperty . flip runReaderT dummyBlockVersionData)

‎core/cardano-sl-core.cabal

-1
Original file line numberDiff line numberDiff line change
@@ -94,7 +94,6 @@ library
9494
Pos.Core.Common.TxSizeLinear
9595

9696
-- Configuration
97-
Pos.Core.Configuration.BlockVersionData
9897
Pos.Core.Configuration.Core
9998
Pos.Core.Configuration.GenesisHash
10099

‎core/src/Pos/Core/Configuration.hs

+2-8
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,6 @@ import qualified Text.JSON.Canonical as Canonical
4646

4747
import Pos.Binary.Class (Raw)
4848
import Pos.Core.Common (BlockCount, SharedSeed)
49-
import Pos.Core.Configuration.BlockVersionData as E
5049
import Pos.Core.Configuration.Core as E
5150
import Pos.Core.Configuration.GenesisHash as E
5251
import Pos.Core.Genesis (GeneratedSecrets, GenesisAvvmBalances,
@@ -136,10 +135,7 @@ configFtsSeed :: Config -> SharedSeed
136135
configFtsSeed = gdFtsSeed . configGenesisData
137136

138137
-- | Coarse catch-all configuration constraint for use by depending modules.
139-
type HasConfiguration =
140-
( HasCoreConfiguration
141-
, HasGenesisBlockVersionData
142-
)
138+
type HasConfiguration = HasCoreConfiguration
143139

144140
canonicalGenesisJson :: GenesisData -> (BSL.ByteString, Hash Raw)
145141
canonicalGenesisJson theGenesisData = (canonicalJsonBytes, jsonHash)
@@ -210,7 +206,6 @@ withCoreConfigurations conf@CoreConfiguration{..} fn confDir mSystemStart mSeed
210206
(show theGenesisHash) (show expectedHash)
211207

212208
withCoreConfiguration conf $
213-
withGenesisBlockVersionData (gdBlockVersionData theGenesisData) $
214209
act $
215210
Config
216211
{ configProtocolMagic = pm
@@ -252,7 +247,6 @@ withGenesisSpec
252247
withGenesisSpec theSystemStart conf@CoreConfiguration{..} fn val = case ccGenesis of
253248
GCSrc {} -> error "withGenesisSpec called with GCSrc"
254249
GCSpec spec ->
255-
withGenesisBlockVersionData (gsBlockVersionData spec) $
256250
let
257251
-- Generate
258252
GeneratedGenesisData {..} =
@@ -272,7 +266,7 @@ withGenesisSpec theSystemStart conf@CoreConfiguration{..} fn val = case ccGenesi
272266
, gdStartTime = theSystemStart
273267
, gdVssCerts = ggdVssCerts
274268
, gdNonAvvmBalances = ggdNonAvvm
275-
, gdBlockVersionData = genesisBlockVersionData
269+
, gdBlockVersionData = gsBlockVersionData spec
276270
, gdProtocolConsts = gsProtocolConstants spec
277271
, gdAvvmDistr = ggdAvvm
278272
, gdFtsSeed = gsFtsSeed spec

‎core/src/Pos/Core/Configuration/BlockVersionData.hs

-20
This file was deleted.

‎core/test/Test/Pos/Core/Arbitrary.hs

+1-2
Original file line numberDiff line numberDiff line change
@@ -52,7 +52,6 @@ import Pos.Core (AddrAttributes (..), AddrSpendingData (..),
5252
mkMultiKeyDistr, unsafeCoinPortionFromDouble,
5353
unsafeGetCoin, unsafeSubCoin)
5454
import Pos.Core.Attributes (Attributes (..), UnparsedFields (..))
55-
import Pos.Core.Configuration (HasGenesisBlockVersionData)
5655
import Pos.Core.Constants (sharedSeedLength)
5756
import Pos.Core.Delegation (HeavyDlgIndex (..), LightDlgIndices (..))
5857
import qualified Pos.Core.Genesis as G
@@ -511,7 +510,7 @@ instance Arbitrary TxFeePolicy where
511510
-- Arbitrary types from 'Pos.Core.Genesis'
512511
----------------------------------------------------------------------------
513512

514-
instance HasGenesisBlockVersionData => Arbitrary G.TestnetBalanceOptions where
513+
instance Arbitrary G.TestnetBalanceOptions where
515514
arbitrary = do
516515
-- We have at least 2 owned addresses in system so we can send
517516
-- transactions in block-gen/tests.

‎core/test/Test/Pos/Core/Dummy.hs

+1
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Test.Pos.Core.Dummy
1818
, dummyGenesisSecretsPoor
1919
, dummyCoreConfiguration
2020
, dummyGenesisSpec
21+
, dummyBlockVersionData
2122
, dummyGenesisData
2223
, dummyGenesisDataStartTime
2324
, dummyGenesisHash

‎db/src/Pos/DB/Block/Logic/Creation.hs

+8-8
Original file line numberDiff line numberDiff line change
@@ -35,9 +35,9 @@ import Pos.Chain.Update (HasUpdateConfiguration, curSoftwareVersion,
3535
lastKnownBlockVersion)
3636
import Pos.Core as Core (BlockCount, Config (..), EpochIndex,
3737
EpochOrSlot (..), SlotId (..), configBlkSecurityParam,
38-
configEpochSlots, epochIndexL, flattenSlotId,
39-
getEpochOrSlot, kChainQualityThreshold, kEpochSlots,
40-
localSlotIndexMinBound)
38+
configBlockVersionData, configEpochSlots, epochIndexL,
39+
flattenSlotId, getEpochOrSlot, kChainQualityThreshold,
40+
kEpochSlots, localSlotIndexMinBound)
4141
import Pos.Core.Context (HasPrimaryKey, getOurSecretKey)
4242
import Pos.Core.Exception (assertionFailed, reportFatalError)
4343
import Pos.Core.JsonLog (CanJsonLog (..))
@@ -273,7 +273,7 @@ createMainBlockInternal coreConfig sId pske = do
273273
msgFmt = "We are trying to create main block, our tip header is\n"%build
274274
createMainBlockFinish :: BlockHeader -> ExceptT Text m MainBlock
275275
createMainBlockFinish prevHeader = do
276-
rawPay <- lift $ getRawPayload k (headerHash prevHeader) sId
276+
rawPay <- lift $ getRawPayload coreConfig (headerHash prevHeader) sId
277277
sk <- getOurSecretKey
278278
-- 100 bytes is substracted to account for different unexpected
279279
-- overhead. You can see that in bitcoin blocks are 1-2kB less
@@ -426,14 +426,14 @@ data RawPayload = RawPayload
426426
}
427427

428428
getRawPayload :: MonadCreateBlock ctx m
429-
=> BlockCount
429+
=> Core.Config
430430
-> HeaderHash
431431
-> SlotId
432432
-> m RawPayload
433-
getRawPayload k tip slotId = do
433+
getRawPayload coreConfig tip slotId = do
434434
localTxs <- txGetPayload tip -- result is topsorted
435-
sscData <- sscGetLocalPayload k slotId
436-
usPayload <- usPreparePayload tip slotId
435+
sscData <- sscGetLocalPayload (configBlkSecurityParam coreConfig) slotId
436+
usPayload <- usPreparePayload (configBlockVersionData coreConfig) tip slotId
437437
dlgPayload <- getDlgMempool
438438
let rawPayload =
439439
RawPayload

‎db/src/Pos/DB/Block/Logic/Internal.hs

+3-3
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import Pos.Chain.Ssc (HasSscConfiguration, MonadSscMem, SscBlock)
4343
import Pos.Chain.Txp (TxpConfiguration)
4444
import Pos.Chain.Update (PollModifier)
4545
import Pos.Core as Core (Config (..), configBlkSecurityParam,
46-
configEpochSlots, epochIndexL)
46+
configBlockVersionData, configEpochSlots, epochIndexL)
4747
import Pos.Core.Chrono (NE, NewestFirst (..), OldestFirst (..))
4848
import Pos.Core.Exception (assertionFailed)
4949
import Pos.Core.Reporting (MonadReporting)
@@ -133,7 +133,7 @@ normalizeMempool coreConfig txpConfig = do
133133
-- within block application.
134134
sscNormalize coreConfig
135135
txpNormalize coreConfig txpConfig
136-
usNormalize
136+
usNormalize (configBlockVersionData coreConfig)
137137

138138
-- | Applies a definitely valid prefix of blocks. This function is unsafe,
139139
-- use it only if you understand what you're doing. That means you can break
@@ -236,7 +236,7 @@ rollbackBlocksUnsafe coreConfig bsc scb toRollback = do
236236
-- We don't normalize other mempools, because they are normalized
237237
-- in 'applyBlocksUnsafe' and we always ensure that some blocks
238238
-- are applied after rollback.
239-
dlgNormalizeOnRollback $ configProtocolMagic coreConfig
239+
dlgNormalizeOnRollback coreConfig
240240
sanityCheckDB $ configGenesisData coreConfig
241241

242242

‎db/src/Pos/DB/Block/Logic/VAR.hs

+1-2
Original file line numberDiff line numberDiff line change
@@ -100,8 +100,7 @@ verifyBlocksPrefix coreConfig currentSlot blocks = runExceptT $ do
100100
TxpGlobalSettings {..} <- view (lensOf @TxpGlobalSettings)
101101
txUndo <- withExceptT (VerifyBlocksError . pretty) $
102102
ExceptT $ tgsVerifyBlocks dataMustBeKnown $ map toTxpBlock blocks
103-
pskUndo <- withExceptT VerifyBlocksError
104-
$ dlgVerifyBlocks (configProtocolMagic coreConfig) blocks
103+
pskUndo <- withExceptT VerifyBlocksError $ dlgVerifyBlocks coreConfig blocks
105104
(pModifier, usUndos) <- withExceptT (VerifyBlocksError . pretty) $
106105
ExceptT $ usVerifyBlocks coreConfig dataMustBeKnown (map toUpdateBlock blocks)
107106

‎db/src/Pos/DB/Block/Lrc.hs

+5-4
Original file line numberDiff line numberDiff line change
@@ -30,8 +30,9 @@ import Pos.Chain.Ssc (MonadSscMem, noReportNoSecretsForEpoch1)
3030
import Pos.Chain.Update (BlockVersionState (..))
3131
import Pos.Core as Core (Coin, Config (..), EpochIndex,
3232
EpochOrSlot (..), SharedSeed, SlotCount, StakeholderId,
33-
configBlkSecurityParam, configEpochSlots, configK,
34-
crucialSlot, epochIndexL, getEpochOrSlot)
33+
configBlkSecurityParam, configBlockVersionData,
34+
configEpochSlots, configK, crucialSlot, epochIndexL,
35+
getEpochOrSlot)
3536
import Pos.Core.Chrono (NE, NewestFirst (..), toOldestFirst)
3637
import Pos.Core.Conc (forConcurrently)
3738
import Pos.Core.Reporting (HasMisbehaviorMetrics (..),
@@ -87,7 +88,7 @@ lrcSingleShot coreConfig epoch = do
8788
%build) epoch
8889
tryAcquireExclusiveLock epoch lock onAcquiredLock
8990
where
90-
consumers = allLrcConsumers @ctx @m
91+
consumers = allLrcConsumers @ctx @m (configBlockVersionData coreConfig)
9192
for_thEpochMsg = sformat (" for "%ords%" epoch") epoch
9293
onAcquiredLock = do
9394
logDebug "lrcSingleShot has acquired LRC lock"
@@ -153,7 +154,7 @@ lrcDo coreConfig epoch consumers = do
153154
blundsToRollback <- DB.loadBlundsFromTipWhile genesisHash whileAfterCrucial
154155
blundsToRollbackNE <-
155156
maybeThrow UnknownBlocksForLrc (atLeastKNewestFirst blundsToRollback)
156-
seed <- sscCalculateSeed epoch >>= \case
157+
seed <- sscCalculateSeed (configBlockVersionData coreConfig) epoch >>= \case
157158
Right s -> do
158159
logInfo $ sformat
159160
("Calculated seed for epoch "%build%" successfully") epoch

‎db/src/Pos/DB/Delegation/Logic/Mempool.hs

+16-9
Original file line numberDiff line numberDiff line change
@@ -30,11 +30,12 @@ import Pos.Chain.Delegation (DlgMemPool, DlgPayload (..),
3030
MonadDelegation, cmPskMods, dwMessageCache, dwPoolSize,
3131
dwProxySKPool, dwTip, emptyCedeModifier, isRevokePsk,
3232
pskToDlgEdgeAction)
33-
import Pos.Core (addressHash, epochIndexL)
33+
import Pos.Core as Core (Config (..), addressHash,
34+
configBlockVersionData, epochIndexL)
3435
import Pos.Core.Conc (currentTime)
3536
import Pos.Core.Delegation (ProxySKHeavy)
3637
import Pos.Core.Update (bvdMaxBlockSize)
37-
import Pos.Crypto (ProtocolMagic, ProxySecretKey (..), PublicKey)
38+
import Pos.Crypto (ProxySecretKey (..), PublicKey)
3839
import Pos.DB (MonadDBRead, MonadGState)
3940
import qualified Pos.DB as DB
4041
import Pos.DB.Delegation.Cede.Holders (evalMapCede)
@@ -128,25 +129,27 @@ processProxySKHeavy
128129
, HasLens' ctx StateLock
129130
, MonadMask m
130131
)
131-
=> ProtocolMagic -> ProxySKHeavy -> m PskHeavyVerdict
132-
processProxySKHeavy pm psk =
132+
=> Core.Config -> ProxySKHeavy -> m PskHeavyVerdict
133+
processProxySKHeavy coreConfig psk =
133134
withStateLockNoMetrics LowPriority $ \_stateLockHeader ->
134-
processProxySKHeavyInternal pm psk
135+
processProxySKHeavyInternal coreConfig psk
135136

136137
-- | Main logic of heavy psk processing, doesn't have
137138
-- synchronization. Should be called __only__ if you are sure that
138139
-- 'StateLock' is taken already.
139140
processProxySKHeavyInternal ::
140141
forall ctx m. (ProcessHeavyConstraint ctx m)
141-
=> ProtocolMagic
142+
=> Core.Config
142143
-> ProxySKHeavy
143144
-> m PskHeavyVerdict
144-
processProxySKHeavyInternal pm psk = do
145+
processProxySKHeavyInternal coreConfig psk = do
145146
curTime <- microsecondsToUTC <$> currentTime
146147
dbTip <- DB.getTipHeader
147148
let dbTipHash = headerHash dbTip
148149
let headEpoch = dbTip ^. epochIndexL
149-
richmen <- getDlgRichmen "Delegation.Logic#processProxySKHeavy" headEpoch
150+
richmen <- getDlgRichmen (configBlockVersionData coreConfig)
151+
"Delegation.Logic#processProxySKHeavy"
152+
headEpoch
150153
maxBlockSize <- bvdMaxBlockSize <$> DB.gsAdoptedBVData
151154
let iPk = pskIssuerPk psk
152155

@@ -169,7 +172,11 @@ processProxySKHeavyInternal pm psk = do
169172
(const (error "processProxySKHeavyInternal:can't happen",True))) $
170173
evalMapCede cedeModifier $
171174
runExceptT $
172-
dlgVerifyPskHeavy pm richmen (CheckForCycle True) headEpoch psk
175+
dlgVerifyPskHeavy (configProtocolMagic coreConfig)
176+
richmen
177+
(CheckForCycle True)
178+
headEpoch
179+
psk
173180

174181
-- Here the memory state is the same.
175182
runDelegationStateAction $ do

0 commit comments

Comments
 (0)