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

Commit d3e9d56

Browse files
intricateintricate
committed
[CDEC-552] Add golden and round-trip tests for core data types
1 parent 6fa6493 commit d3e9d56

File tree

149 files changed

+7517
-296
lines changed

Some content is hidden

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

149 files changed

+7517
-296
lines changed

‎core/cardano-sl-core.cabal

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -264,19 +264,26 @@ test-suite test
264264
other-modules:
265265
Spec
266266
Test.Pos.Core.AddressSpec
267+
Test.Pos.Core.Bi
267268
Test.Pos.Core.CborSpec
268269
Test.Pos.Core.Chrono
269270
Test.Pos.Core.ChronoSpec
270271
Test.Pos.Core.CoinSpec
272+
Test.Pos.Core.ExampleHelpers
273+
Test.Pos.Core.Gen
274+
Test.Pos.Core.Json
271275
Test.Pos.Core.LimitsSpec
272276
Test.Pos.Core.SeedSpec
273277
Test.Pos.Core.SlottingSpec
274278

275279
Test.Pos.Core.Arbitrary
276280
Test.Pos.Core.Arbitrary.Unsafe
277281

278-
build-depends: base
282+
build-depends: aeson
283+
, base
284+
, base16-bytestring
279285
, bytestring
286+
, cardano-crypto
280287
, cardano-sl-binary
281288
, cardano-sl-binary-test
282289
, cardano-sl-core
@@ -285,9 +292,14 @@ test-suite test
285292
, cardano-sl-util
286293
, cardano-sl-util-test
287294
, containers
295+
, cryptonite
296+
, deepseq
297+
, ed25519
288298
, formatting
289299
, generic-arbitrary
300+
, hedgehog
290301
, hspec
302+
, pvss
291303
, QuickCheck
292304
, quickcheck-instances
293305
, random
@@ -296,6 +308,7 @@ test-suite test
296308
, time-units
297309
, universum >= 0.1.11
298310
, unordered-containers
311+
, vector
299312

300313
ghc-options: -threaded
301314
-rtsopts

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

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,8 +9,6 @@ module Pos.Aeson.Core.Configuration
99
import Data.Aeson.TH (deriveJSON)
1010
import Serokell.Aeson.Options (defaultOptions)
1111

12-
import Pos.Aeson.Genesis ()
13-
import Pos.Core.Configuration.Core (CoreConfiguration (..), GenesisConfiguration (..))
12+
import Pos.Core.Configuration.Core (CoreConfiguration (..))
1413

15-
deriveJSON defaultOptions ''GenesisConfiguration
1614
deriveJSON defaultOptions ''CoreConfiguration

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -29,11 +29,12 @@ import Pos.Core.Configuration.Protocol as E
2929
import Pos.Core.Genesis (GenesisData (..), GenesisDelegation, GenesisInitializer (..),
3030
GenesisProtocolConstants (..), GenesisSpec (..),
3131
genesisProtocolConstantsToProtocolConstants, mkGenesisDelegation)
32-
import Pos.Core.Genesis.Canonical (SchemaError)
32+
import Pos.Core.Genesis.Canonical ()
3333
import Pos.Core.Genesis.Generate (GeneratedGenesisData (..), generateGenesisData)
3434
import Pos.Core.Slotting (Timestamp)
3535
import Pos.Crypto.Configuration as E
3636
import Pos.Crypto.Hashing (Hash, hashRaw, unsafeHash)
37+
import Pos.Util.Json.Canonical (SchemaError (..))
3738
import Pos.Util.Util (leftToPanic)
3839

3940
-- | Coarse catch-all configuration constraint for use by depending modules.

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

Lines changed: 74 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,11 +19,19 @@ module Pos.Core.Configuration.Core
1919
, defaultCoreConfiguration
2020
) where
2121

22-
import Universum
22+
import Prelude
23+
import Universum hiding (fail, (<>))
2324

25+
import Data.Aeson (FromJSON, ToJSON, Value (..), genericToEncoding, pairs, parseJSON,
26+
toEncoding, (.:))
27+
import Data.Aeson.Encoding (pairStr)
28+
import Data.Aeson.Types (typeMismatch)
29+
import qualified Data.HashMap.Strict as HM
30+
import Data.Monoid ((<>))
2431
import Data.Reflection (Given (..), give)
32+
import Serokell.Aeson.Options (defaultOptions)
2533

26-
import qualified Data.HashMap.Strict as HM
34+
import Pos.Aeson.Genesis ()
2735
import Pos.Binary.Class (Raw)
2836
import Pos.Core.Common (Coeff (..), SharedSeed (..), TxFeePolicy (..), TxSizeLinear (..),
2937
unsafeCoinPortionFromDouble)
@@ -47,7 +55,70 @@ data GenesisConfiguration
4755
, gcsHash :: !(Hash Raw)
4856
-- ^ Hash of canonically encoded 'GenesisData'.
4957
}
50-
deriving (Show)
58+
deriving (Eq, Show, Generic)
59+
60+
instance ToJSON GenesisConfiguration where
61+
toEncoding (GCSrc gcsFile gcsHash) =
62+
pairs . pairStr "src"
63+
. pairs $ pairStr "file"
64+
(toEncoding gcsFile) <> pairStr "hash" (toEncoding gcsHash)
65+
66+
toEncoding (GCSpec value) =
67+
genericToEncoding defaultOptions (GCSpec value)
68+
69+
instance FromJSON GenesisConfiguration where
70+
parseJSON (Object o)
71+
| HM.member "src" o = GCSrc <$> ((o .: "src") >>= (.: "file"))
72+
<*> ((o .: "src") >>= (.: "hash"))
73+
| HM.member "spec" o = do
74+
-- GCSpec Object
75+
specO <- o .: "spec"
76+
77+
-- GenesisAvvmBalances
78+
avvmDistrO <- specO .: "avvmDistr"
79+
avvmDistr <- parseJSON (avvmDistrO)
80+
81+
-- SharedSeed
82+
ftsSeed <- specO .: "ftsSeed"
83+
84+
-- GenesisDelegation
85+
heavyDelegationO <- specO .: "heavyDelegation"
86+
heavyDelegation <- parseJSON (heavyDelegationO)
87+
88+
-- BlockVersionData
89+
blockVersionDataO <- specO .: "blockVersionData"
90+
blockVersionData <- parseJSON blockVersionDataO
91+
92+
-- GenesisProtocolConstants
93+
protocolConstantsO <- specO .: "protocolConstants"
94+
protocolConstants <- parseJSON protocolConstantsO
95+
96+
-- GenesisInitializer
97+
initializerO <- specO .: "initializer"
98+
testBalanceO <- initializerO .: "testBalance"
99+
testBalance <- parseJSON testBalanceO
100+
fakeAvvmBalanceO <- (initializerO .: "fakeAvvmBalance")
101+
fakeAvvmBalance <- parseJSON fakeAvvmBalanceO
102+
avvmBalanceFactor <- initializerO .: "avvmBalanceFactor"
103+
useHeavyDlg <- initializerO .: "useHeavyDlg"
104+
seed <- initializerO .: "seed"
105+
106+
return . GCSpec $
107+
UnsafeGenesisSpec
108+
(GenesisAvvmBalances avvmDistr)
109+
ftsSeed
110+
heavyDelegation
111+
blockVersionData
112+
protocolConstants
113+
(GenesisInitializer
114+
testBalance
115+
fakeAvvmBalance
116+
avvmBalanceFactor
117+
useHeavyDlg
118+
seed)
119+
| otherwise = fail "Incorrect JSON encoding for GenesisConfiguration"
120+
121+
parseJSON invalid = typeMismatch "GenesisConfiguration" invalid
51122

52123
data CoreConfiguration = CoreConfiguration
53124
{

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
module Pos.Core.Genesis
2-
( module Pos.Core.Genesis.Canonical
3-
, module Pos.Core.Genesis.Generate
2+
( module Pos.Core.Genesis.Generate
43

54
, module Pos.Core.Genesis.AvvmBalances
65
, module Pos.Core.Genesis.Data
@@ -13,7 +12,7 @@ module Pos.Core.Genesis
1312
, module Pos.Core.Genesis.WStakeholders
1413
) where
1514

16-
import Pos.Core.Genesis.Canonical
15+
import Pos.Core.Genesis.Canonical ()
1716
import Pos.Core.Genesis.Generate
1817

1918
import Pos.Core.Genesis.AvvmBalances

‎core/src/Pos/Core/Genesis/Canonical.hs

Lines changed: 3 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -3,17 +3,14 @@
33
-- | Canonical encoding of 'GenesisData'.
44

55
module Pos.Core.Genesis.Canonical
6-
( SchemaError(..)
6+
(
77
) where
88

99
import Universum
1010

1111
import Control.Lens (_Left)
12-
import Control.Monad.Except (MonadError (..))
1312
import Data.Fixed (Fixed (..))
1413
import qualified Data.HashMap.Strict as HM
15-
import qualified Data.Text.Buildable as Buildable
16-
import qualified Data.Text.Lazy.Builder as Builder (fromText)
1714
import Data.Time.Units (Millisecond, Second, convertUnit)
1815
import Data.Typeable (typeRep)
1916
import Formatting (formatToString)
@@ -52,32 +49,12 @@ import Pos.Core.Genesis.ProtocolConstants (GenesisProtocolConstants (.
5249
import Pos.Core.Genesis.VssCertificatesMap (GenesisVssCertificatesMap (..))
5350
import Pos.Core.Genesis.WStakeholders (GenesisWStakeholders (..))
5451

52+
import Pos.Util.Json.Canonical ()
53+
5554
----------------------------------------------------------------------------
5655
-- Primitive standard/3rdparty types
5756
----------------------------------------------------------------------------
5857

59-
data SchemaError = SchemaError
60-
{ seExpected :: !Text
61-
, seActual :: !(Maybe Text)
62-
} deriving (Show)
63-
64-
instance Buildable SchemaError where
65-
build SchemaError{..} = mconcat
66-
[ "expected " <> Builder.fromText seExpected
67-
, case seActual of
68-
Nothing -> mempty
69-
Just actual -> " but got " <> Builder.fromText actual
70-
]
71-
72-
instance (Monad m, Applicative m, MonadError SchemaError m) => ReportSchemaErrors m where
73-
expected expec actual = throwError SchemaError
74-
{ seExpected = fromString expec
75-
, seActual = fmap fromString actual
76-
}
77-
78-
instance Monad m => ToJSON m Int32 where
79-
toJSON = pure . JSNum . fromIntegral
80-
8158
instance Monad m => ToJSON m Word16 where
8259
toJSON = pure . JSNum . fromIntegral
8360

@@ -304,10 +281,6 @@ wrapConstructor =
304281
-- External
305282
---------------------------------------------------------------------------
306283

307-
instance (ReportSchemaErrors m) => FromJSON m Int32 where
308-
fromJSON (JSNum i) = pure . fromIntegral $ i
309-
fromJSON val = expectedButGotValue "Int32" val
310-
311284
instance (ReportSchemaErrors m) => FromJSON m Word16 where
312285
fromJSON (JSNum i) = pure . fromIntegral $ i
313286
fromJSON val = expectedButGotValue "Word16" val

‎core/src/Pos/Core/Genesis/Initializer.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ data GenesisInitializer = GenesisInitializer
2929
-- 1. Keep it secret and use genesis data generated from it.
3030
-- 2. Just use it directly and keep it public if you want
3131
-- to deploy testing cluster.
32-
} deriving (Show)
32+
} deriving (Eq, Show)
3333

3434
instance Buildable GenesisInitializer where
3535
build GenesisInitializer {..} = bprint
@@ -59,7 +59,7 @@ data TestnetBalanceOptions = TestnetBalanceOptions
5959
-- ^ Portion of stake owned by all richmen together.
6060
, tboUseHDAddresses :: !Bool
6161
-- ^ Whether generate plain addresses or with hd payload.
62-
} deriving (Show)
62+
} deriving (Eq, Show)
6363

6464
instance Buildable TestnetBalanceOptions where
6565
build TestnetBalanceOptions {..} =
@@ -81,7 +81,7 @@ instance Buildable TestnetBalanceOptions where
8181
data FakeAvvmOptions = FakeAvvmOptions
8282
{ faoCount :: !Word
8383
, faoOneBalance :: !Word64
84-
} deriving (Show, Generic)
84+
} deriving (Eq, Show, Generic)
8585

8686
instance Buildable FakeAvvmOptions where
8787
build = genericF

‎core/src/Pos/Core/Genesis/Spec.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ data GenesisSpec = UnsafeGenesisSpec
3333
-- ^ Other constants which affect consensus.
3434
, gsInitializer :: !GenesisInitializer
3535
-- ^ Other data which depend on genesis type.
36-
} deriving (Show, Generic)
36+
} deriving (Eq, Show, Generic)
3737

3838
-- | Safe constructor for 'GenesisSpec'. Throws error if something
3939
-- goes wrong.

0 commit comments

Comments
 (0)