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

Commit 334944b

Browse files
ruhatchruhatch
committed
[CDEC-509] Remove HasGenesisHash in favour of explicit parameters
1 parent cc689a6 commit 334944b

File tree

54 files changed

+515
-454
lines changed

Some content is hidden

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

54 files changed

+515
-454
lines changed

‎auxx/src/Command/Rollback.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@ import Formatting (build, int, sformat, string, (%))
1414

1515
import Pos.Chain.Block (Blund, mainBlockTxPayload)
1616
import Pos.Chain.Txp (flattenTxPayload)
17-
import Pos.Core as Core (Config, difficultyL, epochIndexL)
17+
import Pos.Core as Core (Config (..), difficultyL, epochIndexL)
1818
import Pos.Core.Chrono (NewestFirst, _NewestFirst)
1919
import Pos.Core.Txp (TxAux)
2020
import Pos.DB.Block (BypassSecurityCheck (..),
@@ -37,8 +37,9 @@ rollbackAndDump
3737
-> m ()
3838
rollbackAndDump coreConfig numToRollback outFile = withStateLock HighPriority ApplyBlockWithRollback $ \_ -> do
3939
printTipDifficulty
40-
blundsMaybeEmpty <- modifyBlunds <$>
41-
DB.loadBlundsFromTipByDepth (fromIntegral numToRollback)
40+
blundsMaybeEmpty <- modifyBlunds <$> DB.loadBlundsFromTipByDepth
41+
(configGenesisHash coreConfig)
42+
(fromIntegral numToRollback)
4243
logInfo $ sformat ("Loaded "%int%" blunds") (length blundsMaybeEmpty)
4344
case _Wrapped nonEmpty blundsMaybeEmpty of
4445
Nothing -> pass

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

+11-11
Original file line numberDiff line numberDiff line change
@@ -32,8 +32,8 @@ import Test.QuickCheck.Arbitrary.Generic (genericArbitrary,
3232
import Pos.Binary.Class (biSize)
3333
import Pos.Chain.Block (HeaderHash)
3434
import qualified Pos.Chain.Block as Block
35-
import Pos.Core (GenesisHash (..), HasGenesisHash, genesisHash,
36-
localSlotIndexMaxBound, localSlotIndexMinBound)
35+
import Pos.Core (GenesisHash (..), localSlotIndexMaxBound,
36+
localSlotIndexMinBound)
3737
import qualified Pos.Core as Core
3838
import Pos.Core.Attributes (areAttributesKnown)
3939
import qualified Pos.Core.Delegation as Core
@@ -46,7 +46,7 @@ import Test.Pos.Chain.Ssc.Arbitrary (SscPayloadDependsOnSlot (..),
4646
import Test.Pos.Chain.Update.Arbitrary (genUpdatePayload)
4747
import Test.Pos.Core.Arbitrary (genSlotId)
4848
import Test.Pos.Core.Arbitrary.Txp (genTxPayload)
49-
import Test.Pos.Core.Dummy (dummyEpochSlots)
49+
import Test.Pos.Core.Dummy (dummyEpochSlots, dummyGenesisHash)
5050
import Test.Pos.Crypto.Dummy (dummyProtocolMagic)
5151

5252
newtype BodyDependsOnSlot b = BodyDependsOnSlot
@@ -96,9 +96,9 @@ instance Arbitrary Block.GenesisBody where
9696
arbitrary = genericArbitrary
9797
shrink = genericShrink
9898

99-
instance HasGenesisHash => Arbitrary Block.GenesisBlock where
99+
instance Arbitrary Block.GenesisBlock where
100100
arbitrary = Block.mkGenesisBlock dummyProtocolMagic
101-
<$> (maybe (Left (GenesisHash genesisHash)) Right <$> arbitrary)
101+
<$> (maybe (Left dummyGenesisHash) Right <$> arbitrary)
102102
<*> arbitrary
103103
<*> arbitrary
104104
shrink = genericShrink
@@ -234,7 +234,7 @@ genMainBlock pm prevHash difficulty = do
234234
<*> pure extraHeaderData
235235
pure $ Block.UnsafeGenericBlock header body extraBodyData
236236

237-
instance HasGenesisHash => Arbitrary Block.MainBlock where
237+
instance Arbitrary Block.MainBlock where
238238
arbitrary = do
239239
slot <- arbitrary
240240
BodyDependsOnSlot {..} <- arbitrary :: Gen (BodyDependsOnSlot Block.MainBlockchain)
@@ -247,7 +247,7 @@ instance HasGenesisHash => Arbitrary Block.MainBlock where
247247
<*> pure (hash extraBodyData)
248248
header <-
249249
Block.mkMainHeader dummyProtocolMagic
250-
<$> (maybe (Left (GenesisHash genesisHash)) Right <$> arbitrary)
250+
<$> (maybe (Left dummyGenesisHash) Right <$> arbitrary)
251251
<*> pure slot
252252
<*> arbitrary
253253
<*> pure Nothing
@@ -357,11 +357,11 @@ bhlEpochs = 2
357357
--
358358
-- Note that a leader is generated for each slot.
359359
-- (Not exactly a leader - see previous comment)
360-
instance HasGenesisHash => Arbitrary BlockHeaderList where
360+
instance Arbitrary BlockHeaderList where
361361
arbitrary = do
362362
incompleteEpochSize <- choose (1, dummyEpochSlots - 1)
363363
let slot = Core.SlotId 0 localSlotIndexMinBound
364-
generateBHL (GenesisHash genesisHash) True slot (dummyEpochSlots * bhlEpochs + incompleteEpochSize)
364+
generateBHL dummyGenesisHash True slot (dummyEpochSlots * bhlEpochs + incompleteEpochSize)
365365

366366
generateBHL
367367
:: GenesisHash
@@ -404,13 +404,13 @@ newtype HeaderAndParams = HAndP
404404
-- already been done in the 'Arbitrary' instance of the 'BlockHeaderList'
405405
-- type, so it is used here and at most 3 blocks are taken from the generated
406406
-- list.
407-
instance HasGenesisHash => Arbitrary HeaderAndParams where
407+
instance Arbitrary HeaderAndParams where
408408
arbitrary = do
409409
-- This integer is used as a seed to randomly choose a slot down below
410410
seed <- arbitrary :: Gen Int
411411
startSlot <- Core.SlotId <$> choose (0, bhlMaxStartingEpoch) <*> arbitrary
412412
(headers, leaders) <- first reverse . getHeaderList <$>
413-
(generateBHL (GenesisHash genesisHash) True startSlot =<< choose (1, 2))
413+
(generateBHL dummyGenesisHash True startSlot =<< choose (1, 2))
414414
let num = length headers
415415
-- 'skip' is the random number of headers that should be skipped in
416416
-- the header chain. This ensures different parts of it are chosen

‎chain/test/Test/Pos/Chain/Block/Arbitrary/Generate.hs

+2-3
Original file line numberDiff line numberDiff line change
@@ -14,16 +14,15 @@ import qualified Test.QuickCheck.Gen as QC
1414
import qualified Test.QuickCheck.Random as QC
1515

1616
import Pos.Chain.Block (MainBlock)
17-
import Pos.Core (HasGenesisHash, ProtocolMagic)
17+
import Pos.Core (ProtocolMagic)
1818

1919
-- Also brings in the 'Arbitrary' instance for 'MainBlock'.
2020
import Test.Pos.Chain.Block.Arbitrary (genMainBlock)
2121

2222
-- | Use 'Arbitrary' instances to generate a 'MainBlock'.
2323
-- These require magical configurations.
2424
generateMainBlockWithConfiguration
25-
:: HasGenesisHash
26-
=> Int -- ^ Seed for random generator.
25+
:: Int -- ^ Seed for random generator.
2726
-> Int -- ^ Size of the generated value (see QuickCheck docs).
2827
-> MainBlock
2928
generateMainBlockWithConfiguration genSeed = QC.unGen arbitrary qcGen

‎chain/test/Test/Pos/Chain/Block/BlockSpec.hs

+9-13
Original file line numberDiff line numberDiff line change
@@ -26,24 +26,22 @@ import Pos.Chain.Block (BlockHeader (..), BlockSignature (..),
2626
MainExtraHeaderData (..), MainToSign (..), headerHash,
2727
mkBodyProof, mkGenericHeader, mkGenesisHeader)
2828
import qualified Pos.Chain.Block as Block
29-
import Pos.Core (EpochIndex (..), GenesisHash (..), HasConfiguration,
30-
SlotId (..), difficultyL, genesisHash)
29+
import Pos.Core (EpochIndex (..), GenesisHash (..), SlotId (..),
30+
difficultyL)
3131
import Pos.Core.Attributes (mkAttributes)
3232
import Pos.Core.Chrono (NewestFirst (..))
33-
import Pos.Core.Configuration (withGenesisSpec)
3433
import Pos.Core.Delegation (HeavyDlgIndex (..), LightDlgIndices (..))
3534
import Pos.Crypto (ProtocolMagic (..), ProxySecretKey (pskIssuerPk),
3635
SecretKey, SignTag (..), createPsk, proxySign, sign,
3736
toPublic)
3837

3938
import Test.Pos.Chain.Block.Arbitrary as BT
40-
import Test.Pos.Core.Dummy (dummyCoreConfiguration)
39+
import Test.Pos.Core.Dummy (dummyGenesisHash)
4140
import Test.Pos.Crypto.Dummy (dummyProtocolMagic)
4241

4342
-- This tests are quite slow, hence max success is at most 20.
4443
spec :: Spec
45-
spec = withGenesisSpec 0 dummyCoreConfiguration id $ \_ ->
46-
describe "Block properties" $ modifyMaxSuccess (min 20) $ do
44+
spec = describe "Block properties" $ modifyMaxSuccess (min 20) $ do
4745
describe "mkMainHeader" $ do
4846
prop mainHeaderFormationDesc mainHeaderFormation
4947
describe "mkGenesisHeader" $ do
@@ -79,16 +77,15 @@ spec = withGenesisSpec 0 dummyCoreConfiguration id $ \_ ->
7977
-- the ensuing failed tests.
8078

8179
genesisHeaderFormation
82-
:: HasConfiguration
83-
=> Maybe BlockHeader
80+
:: Maybe BlockHeader
8481
-> EpochIndex
8582
-> GenesisBody
8683
-> Property
8784
genesisHeaderFormation prevHeader epoch body = header === manualHeader
8885
where
8986
header = mkGenesisHeader
9087
dummyProtocolMagic
91-
(maybe (Left (GenesisHash genesisHash)) Right prevHeader)
88+
(maybe (Left dummyGenesisHash) Right prevHeader)
9289
epoch
9390
body
9491
manualHeader = UnsafeGenericBlockHeader
@@ -98,7 +95,7 @@ genesisHeaderFormation prevHeader epoch body = header === manualHeader
9895
, _gbhConsensus = consensus h proof
9996
, _gbhExtra = GenesisExtraHeaderData $ mkAttributes ()
10097
}
101-
h = maybe genesisHash headerHash prevHeader
98+
h = maybe (getGenesisHash dummyGenesisHash) headerHash prevHeader
10299
proof = mkBodyProof @GenesisBlockchain body
103100
difficulty = maybe 0 (view difficultyL) prevHeader
104101
consensus _ _ = GenesisConsensusData
@@ -107,8 +104,7 @@ genesisHeaderFormation prevHeader epoch body = header === manualHeader
107104
}
108105

109106
mainHeaderFormation
110-
:: HasConfiguration
111-
=> Maybe BlockHeader
107+
:: Maybe BlockHeader
112108
-> SlotId
113109
-> Either SecretKey (SecretKey, SecretKey, Bool)
114110
-> MainBody
@@ -132,7 +128,7 @@ mainHeaderFormation prevHeader slotId signer body extra =
132128
, _gbhConsensus = consensus proof
133129
, _gbhExtra = extra
134130
}
135-
prevHash = maybe genesisHash headerHash prevHeader
131+
prevHash = maybe (getGenesisHash dummyGenesisHash) headerHash prevHeader
136132
proof = mkBodyProof @MainBlockchain body
137133
(sk, pSk) = either (, Nothing) mkProxySk signer
138134
mkProxySk (issuerSK, delegateSK, isSigEpoch) =

‎client/src/Pos/Client/Txp/History.hs

+5-5
Original file line numberDiff line numberDiff line change
@@ -45,8 +45,7 @@ import Pos.Chain.Txp (ToilVerFailure, Tx (..), TxAux (..), TxId,
4545
applyTxToUtxo, evalUtxoM, flattenTxPayload, genesisUtxo,
4646
runUtxoM, topsortTxs, txOutAddress, utxoGet, utxoToLookup)
4747
import Pos.Core as Core (Address, ChainDifficulty, Config (..),
48-
GenesisHash (..), HasConfiguration, Timestamp (..),
49-
difficultyL, genesisHash)
48+
Timestamp (..), difficultyL)
5049
import Pos.Core.Genesis (GenesisData)
5150
import Pos.Core.JsonLog (CanJsonLog (..))
5251
import Pos.Crypto (WithHash (..), withHash)
@@ -215,14 +214,15 @@ type TxHistoryEnv ctx m =
215214

216215
getBlockHistoryDefault
217216
:: forall ctx m
218-
. (HasConfiguration, TxHistoryEnv ctx m)
217+
. TxHistoryEnv ctx m
219218
=> Core.Config
220219
-> [Address]
221220
-> m (Map TxId TxHistoryEntry)
222221
getBlockHistoryDefault coreConfig addrs = do
222+
let genesisHash = configGenesisHash coreConfig
223223
let bot = headerHash $ genesisBlock0
224224
(configProtocolMagic coreConfig)
225-
(GenesisHash genesisHash)
225+
genesisHash
226226
(genesisLeaders coreConfig)
227227
sd <- GS.getSlottingData
228228
systemStart <- getSystemStartM
@@ -243,7 +243,7 @@ getBlockHistoryDefault coreConfig addrs = do
243243
(genesisUtxoLookup $ configGenesisData coreConfig)
244244
(deriveAddrHistoryBlk addrs getBlockTimestamp hist blk)
245245

246-
fst <$> GS.foldlUpWhileM getBlock bot filterFunc (pure ... foldStep) mempty
246+
fst <$> GS.foldlUpWhileM (getBlock genesisHash) bot filterFunc (pure ... foldStep) mempty
247247

248248
getLocalHistoryDefault
249249
:: forall ctx m. TxHistoryEnv ctx m

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

+5-4
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ import Universum
3939
import Control.Exception (throwIO)
4040
import qualified Data.ByteString as BS
4141
import qualified Data.ByteString.Lazy as BSL
42+
import Data.Coerce (coerce)
4243
import System.FilePath ((</>))
4344
import System.IO.Error (userError)
4445
import qualified Text.JSON.Canonical as Canonical
@@ -73,6 +74,7 @@ data Config = Config
7374
, configProtocolConstants :: ProtocolConstants
7475
, configGeneratedSecrets :: Maybe GeneratedSecrets
7576
, configGenesisData :: GenesisData
77+
, configGenesisHash :: GenesisHash
7678
}
7779

7880
configK :: Config -> Int
@@ -136,7 +138,6 @@ configFtsSeed = gdFtsSeed . configGenesisData
136138
-- | Coarse catch-all configuration constraint for use by depending modules.
137139
type HasConfiguration =
138140
( HasCoreConfiguration
139-
, HasGenesisHash
140141
, HasGenesisBlockVersionData
141142
)
142143

@@ -210,13 +211,13 @@ withCoreConfigurations conf@CoreConfiguration{..} fn confDir mSystemStart mSeed
210211

211212
withCoreConfiguration conf $
212213
withGenesisBlockVersionData (gdBlockVersionData theGenesisData) $
213-
withGenesisHash theGenesisHash $
214214
act $
215215
Config
216216
{ configProtocolMagic = pm
217217
, configProtocolConstants = pc
218218
, configGeneratedSecrets = Nothing
219219
, configGenesisData = theGenesisData
220+
, configGenesisHash = GenesisHash $ coerce theGenesisHash
220221
}
221222

222223
-- If a 'GenesisSpec' is given, we ensure we have a start time (needed if
@@ -278,15 +279,15 @@ withGenesisSpec theSystemStart conf@CoreConfiguration{..} fn val = case ccGenesi
278279
}
279280
-- Anything will do for the genesis hash. A hash of "patak" was used
280281
-- before, and so it remains.
281-
theGenesisHash = unsafeHash @Text "patak"
282+
theGenesisHash = GenesisHash $ coerce $ unsafeHash @Text "patak"
282283
in withCoreConfiguration conf $
283-
withGenesisHash theGenesisHash $
284284
val $
285285
Config
286286
{ configProtocolMagic = pm
287287
, configProtocolConstants = pc
288288
, configGeneratedSecrets = Just ggdSecrets
289289
, configGenesisData = theGenesisData
290+
, configGenesisHash = theGenesisHash
290291
}
291292
where
292293
pm = gpcProtocolMagic (gsProtocolConstants spec)

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

+1-16
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,9 @@
11
{-# LANGUAGE Rank2Types #-}
22

33
module Pos.Core.Configuration.GenesisHash
4-
( HasGenesisHash
5-
, withGenesisHash
6-
, GenesisHash (..)
7-
, genesisHash
4+
( GenesisHash (..)
85
) where
96

10-
import Data.Coerce (coerce)
11-
import Data.Reflection (Given (..), give)
12-
13-
import Pos.Binary.Class (Raw)
147
import Pos.Crypto.Hashing (Hash)
158

169
newtype GenesisHash = GenesisHash { getGenesisHash :: forall a . Hash a }
17-
18-
type HasGenesisHash = Given GenesisHash
19-
20-
withGenesisHash :: (Hash Raw) -> (HasGenesisHash => r) -> r
21-
withGenesisHash gh = give (GenesisHash (coerce gh))
22-
23-
genesisHash :: HasGenesisHash => Hash a
24-
genesisHash = getGenesisHash given

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

+16-9
Original file line numberDiff line numberDiff line change
@@ -20,16 +20,20 @@ module Test.Pos.Core.Dummy
2020
, dummyGenesisSpec
2121
, dummyGenesisData
2222
, dummyGenesisDataStartTime
23+
, dummyGenesisHash
2324
) where
2425

2526
import Universum
2627

28+
import Data.Coerce (coerce)
29+
2730
import Pos.Core (BlockCount, Coeff (..), Config (..),
2831
CoreConfiguration (..), EpochIndex (..),
29-
GenesisConfiguration (..), ProtocolConstants (..),
30-
SharedSeed (..), SlotCount, Timestamp, TxFeePolicy (..),
31-
TxSizeLinear (..), VssMaxTTL (..), VssMinTTL (..),
32-
kEpochSlots, kSlotSecurityParam, pcBlkSecurityParam,
32+
GenesisConfiguration (..), GenesisHash (..),
33+
ProtocolConstants (..), SharedSeed (..), SlotCount,
34+
Timestamp, TxFeePolicy (..), TxSizeLinear (..),
35+
VssMaxTTL (..), VssMinTTL (..), kEpochSlots,
36+
kSlotSecurityParam, pcBlkSecurityParam,
3337
unsafeCoinPortionFromDouble)
3438
import Pos.Core.Genesis (FakeAvvmOptions (..),
3539
GeneratedGenesisData (..), GeneratedSecrets (..),
@@ -41,7 +45,7 @@ import Pos.Core.Genesis (FakeAvvmOptions (..),
4145
gsSecretKeys, gsSecretKeysPoor, gsSecretKeysRich,
4246
noGenesisDelegation)
4347
import Pos.Core.Update (BlockVersionData (..), SoftforkRule (..))
44-
import Pos.Crypto (SecretKey)
48+
import Pos.Crypto (SecretKey, unsafeHash)
4549

4650
import Test.Pos.Crypto.Dummy (dummyProtocolMagic)
4751

@@ -50,13 +54,13 @@ dummyConfig = dummyConfigStartTime 0
5054

5155
dummyConfigStartTime :: Timestamp -> Config
5256
dummyConfigStartTime systemStart = Config
53-
{ configProtocolMagic = dummyProtocolMagic
57+
{ configProtocolMagic = dummyProtocolMagic
5458
, configProtocolConstants = dummyProtocolConstants
55-
, configGeneratedSecrets = Just dummyGeneratedSecrets
56-
, configGenesisData = dummyGenesisDataStartTime systemStart
59+
, configGeneratedSecrets = Just dummyGeneratedSecrets
60+
, configGenesisData = dummyGenesisDataStartTime systemStart
61+
, configGenesisHash = dummyGenesisHash
5762
}
5863

59-
6064
dummyProtocolConstants :: ProtocolConstants
6165
dummyProtocolConstants = ProtocolConstants
6266
{ pcK = 10
@@ -160,3 +164,6 @@ dummyGenesisDataStartTime systemStart = GenesisData
160164
, gdAvvmDistr = ggdAvvm dummyGeneratedGenesisData
161165
, gdFtsSeed = dummyFtsSeed
162166
}
167+
168+
dummyGenesisHash :: GenesisHash
169+
dummyGenesisHash = GenesisHash $ coerce $ unsafeHash @Text "patak"

0 commit comments

Comments
 (0)