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

Commit efb498f

Browse files
intricateintricate
authored
[CDEC-286] Remove field accessors from FakeUtxoCoinDistribution (#3246)
* [CDEC-286] Remove field accessors from 'FakeUtxoCoinDistribution' data type. * [CDEC-286] Add strictness annotation to 'FakeUtxoCoinDistribution' data constructor fields (since they were strict previously) * [CDEC-286] Modify AddressRange and DistributionAmount such that they are newtypes * [CDEC-286] Add documentation to record fields for AddressRange and DistributionAmount. * [CDEC-286] Add round-trip and golden tests for types in Dbgen * [CDEC-286] Reorganize library and test-suite modules in tools * [CDEC-286] Run stylish-haskell and pkgs/generate.sh
1 parent 66fe2e1 commit efb498f

24 files changed

+400
-72
lines changed

‎pkgs/default.nix

+34-3
Original file line numberDiff line numberDiff line change
@@ -17352,16 +17352,19 @@ license = stdenv.lib.licenses.mit;
1735217352
, cardano-report-server
1735317353
, cardano-sl
1735417354
, cardano-sl-binary
17355+
, cardano-sl-binary-test
1735517356
, cardano-sl-block
1735617357
, cardano-sl-client
1735717358
, cardano-sl-core
1735817359
, cardano-sl-core-test
1735917360
, cardano-sl-crypto
1736017361
, cardano-sl-db
1736117362
, cardano-sl-infra
17363+
, cardano-sl-networking
1736217364
, cardano-sl-txp
1736317365
, cardano-sl-update
1736417366
, cardano-sl-util
17367+
, cardano-sl-util-test
1736517368
, cardano-sl-wallet
1736617369
, containers
1736717370
, cpphs
@@ -17372,6 +17375,7 @@ license = stdenv.lib.licenses.mit;
1737217375
, filepath
1737317376
, formatting
1737417377
, Glob
17378+
, hedgehog
1737517379
, hourglass
1737617380
, hspec
1737717381
, lens
@@ -17420,20 +17424,44 @@ configureFlags = [
1742017424
isLibrary = true;
1742117425
isExecutable = true;
1742217426
libraryHaskellDepends = [
17427+
acid-state-exts
1742317428
aeson
17429+
ansi-terminal
1742417430
base
17431+
bytestring
17432+
cardano-sl
17433+
cardano-sl-client
17434+
cardano-sl-core
17435+
cardano-sl-core-test
17436+
cardano-sl-db
17437+
cardano-sl-infra
17438+
cardano-sl-networking
17439+
cardano-sl-txp
17440+
cardano-sl-util
17441+
cardano-sl-wallet
17442+
containers
17443+
data-default
1742517444
directory
1742617445
filepath
17446+
log-warper
17447+
network-transport-tcp
17448+
optparse-applicative
17449+
optparse-generic
1742717450
parsers
17451+
QuickCheck
17452+
stm
17453+
string-conv
1742817454
text
17455+
time
17456+
time-units
1742917457
trifecta
1743017458
universum
17459+
unordered-containers
1743117460
];
1743217461
executableHaskellDepends = [
1743317462
acid-state-exts
1743417463
aeson
1743517464
aeson-options
17436-
ansi-terminal
1743717465
ansi-wl-pprint
1743817466
asn1-encoding
1743917467
asn1-types
@@ -17453,6 +17481,7 @@ cardano-sl-core-test
1745317481
cardano-sl-crypto
1745417482
cardano-sl-db
1745517483
cardano-sl-infra
17484+
cardano-sl-networking
1745617485
cardano-sl-txp
1745717486
cardano-sl-update
1745817487
cardano-sl-util
@@ -17475,12 +17504,10 @@ network-transport-tcp
1747517504
optparse-applicative
1747617505
optparse-generic
1747717506
process
17478-
QuickCheck
1747917507
safe-exceptions
1748017508
serokell-util
1748117509
silently
1748217510
stm
17483-
string-conv
1748417511
tabl
1748517512
tar
1748617513
text
@@ -17501,9 +17528,13 @@ cpphs
1750117528
testHaskellDepends = [
1750217529
aeson
1750317530
base
17531+
cardano-sl-binary-test
17532+
cardano-sl-util-test
1750417533
directory
17534+
hedgehog
1750517535
hspec
1750617536
temporary
17537+
universum
1750717538
];
1750817539
testToolDepends = [
1750917540
cpphs

‎tools/cardano-sl-tools.cabal

+52-22
Original file line numberDiff line numberDiff line change
@@ -32,38 +32,26 @@ Flag postmortem
3232
executable dbgen
3333
hs-source-dirs: src/dbgen
3434
main-is: Main.hs
35-
other-modules: CLI
36-
, Lib
37-
, Rendering
38-
, Stats
39-
, Types
40-
, QueryMethods
4135
if !flag(for-installer)
4236
build-depends: base >= 4.7 && < 5
4337
, acid-state-exts
44-
, aeson
45-
, ansi-terminal
46-
, bytestring
4738
, cardano-sl
4839
, cardano-sl-client
4940
, cardano-sl-core
5041
, cardano-sl-core-test
5142
, cardano-sl-db
5243
, cardano-sl-infra
44+
, cardano-sl-networking
45+
, cardano-sl-tools
5346
, cardano-sl-txp
5447
, cardano-sl-util
5548
, cardano-sl-wallet
5649
, containers
5750
, data-default
5851
, log-warper
5952
, network-transport-tcp >= 0.6
60-
, optparse-applicative
61-
, optparse-applicative
62-
, optparse-generic
6353
, optparse-generic
64-
, QuickCheck
6554
, stm
66-
, string-conv
6755
, text
6856
, time
6957
, time-units
@@ -543,20 +531,54 @@ executable genesis-hash
543531
buildable: True
544532

545533
library
546-
hs-source-dirs: .
534+
hs-source-dirs: src
547535
default-language: Haskell2010
548536
exposed-modules:
549-
Launcher.Environment
550-
Launcher.Logging
537+
-- Launcher
538+
Pos.Tools.Launcher.Environment
539+
Pos.Tools.Launcher.Logging
540+
541+
-- Dbgen
542+
Pos.Tools.Dbgen.CLI
543+
Pos.Tools.Dbgen.Lib
544+
Pos.Tools.Dbgen.Rendering
545+
Pos.Tools.Dbgen.Stats
546+
Pos.Tools.Dbgen.Types
551547

552548
build-depends: aeson
553-
, base
549+
, base >= 4.7 && < 5
550+
, acid-state-exts
551+
, aeson
552+
, ansi-terminal
553+
, bytestring
554+
, cardano-sl
555+
, cardano-sl-client
556+
, cardano-sl-core
557+
, cardano-sl-core-test
558+
, cardano-sl-db
559+
, cardano-sl-infra
560+
, cardano-sl-networking
561+
, cardano-sl-txp
562+
, cardano-sl-util
563+
, cardano-sl-wallet
564+
, containers
565+
, data-default
554566
, directory
555567
, filepath
568+
, log-warper
569+
, network-transport-tcp >= 0.6
570+
, optparse-applicative
571+
, optparse-generic
556572
, parsers
573+
, QuickCheck
574+
, stm
575+
, string-conv
557576
, text
577+
, time
578+
, time-units
558579
, trifecta
559-
, universum
580+
, universum >= 0.1.11
581+
, unordered-containers
560582

561583
test-suite cardano-sl-tools-test
562584
main-is: Test.hs
@@ -565,15 +587,23 @@ test-suite cardano-sl-tools-test
565587
Spec
566588

567589
-- Subject
568-
Test.Launcher.Environment
590+
Test.Pos.Tools.Launcher.Environment
591+
592+
-- Dbgen Tests
593+
Test.Pos.Tools.Dbgen.Gen
594+
Test.Pos.Tools.Dbgen.Json
569595

570596
type: exitcode-stdio-1.0
571-
build-depends: base
572-
, aeson
597+
build-depends: aeson
598+
, base
599+
, cardano-sl-binary-test
573600
, cardano-sl-tools
601+
, cardano-sl-util-test
574602
, directory
603+
, hedgehog
575604
, hspec
576605
, temporary
606+
, universum
577607

578608
hs-source-dirs: test
579609
default-language: Haskell2010

‎tools/src/dbgen/CLI.hs renamed to ‎tools/src/Pos/Tools/Dbgen/CLI.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module CLI where
1+
module Pos.Tools.Dbgen.CLI where
22

33
import Universum
44

@@ -11,7 +11,7 @@ import Pos.Wallet.Web.ClientTypes.Instances ()
1111
import Pos.Wallet.Web.ClientTypes.Types (AccountId, CAccountId (..))
1212
import Text.Read (readMaybe)
1313

14-
import Types (Method (..))
14+
import Pos.Tools.Dbgen.Types (Method (..))
1515

1616
data CLI = CLI
1717
{ config :: FilePath

‎tools/src/dbgen/Lib.hs renamed to ‎tools/src/Pos/Tools/Dbgen/Lib.hs

+51-17
Original file line numberDiff line numberDiff line change
@@ -2,17 +2,20 @@
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE GADTs #-}
5+
{-# LANGUAGE NoImplicitPrelude #-}
6+
{-# LANGUAGE OverloadedStrings #-}
57
{-# LANGUAGE RankNTypes #-}
8+
{-# LANGUAGE RecordWildCards #-}
69
{-# LANGUAGE ScopedTypeVariables #-}
710
{-# LANGUAGE TypeApplications #-}
811
{-# LANGUAGE ViewPatterns #-}
912

10-
module Lib where
13+
module Pos.Tools.Dbgen.Lib where
1114

1215
import Universum
1316

14-
import Data.Aeson (FromJSON (..), ToJSON, eitherDecodeStrict,
15-
withObject, (.:))
17+
import Data.Aeson (FromJSON (..), ToJSON (..), eitherDecodeStrict,
18+
object, withObject, (.:), (.=))
1619
import qualified Data.ByteString as B
1720
import Data.Function (id)
1821
import qualified Data.List.NonEmpty as NE
@@ -49,9 +52,9 @@ import Test.QuickCheck (Gen, arbitrary, choose, frequency, generate,
4952
vectorOf)
5053
import Text.Printf (printf)
5154

52-
import CLI (CLI (..))
53-
import Rendering (green, renderAccountId, say)
54-
import Types (UberMonad)
55+
import Pos.Tools.Dbgen.CLI (CLI (..))
56+
import Pos.Tools.Dbgen.Rendering (green, renderAccountId, say)
57+
import Pos.Tools.Dbgen.Types (UberMonad)
5558

5659
import Test.Pos.Core.Arbitrary.Txp ()
5760

@@ -65,7 +68,9 @@ _exampleSpec = GenSpec
6568
{ walletSpec = WalletSpec
6669
{ accounts = 1
6770
, accountSpec = AccountSpec { addresses = 100 }
68-
, fakeUtxoCoinDistr = RangeDistribution { amount = 1000, range = 100 }
71+
, fakeUtxoCoinDistr = RangeDistribution
72+
AddressRange { unAddressRange = 100 }
73+
DistributionAmount { unDistributionAmount = 1000 }
6974
, fakeTxsHistory = SimpleTxsHistory 100 3
7075
}
7176
, wallets = 1
@@ -103,6 +108,22 @@ data AccountSpec = AccountSpec
103108
instance FromJSON AccountSpec
104109
instance ToJSON AccountSpec
105110

111+
newtype AddressRange = AddressRange
112+
{ unAddressRange :: Integer
113+
-- ^ The amount of addresses to distribute coins to.
114+
} deriving (Show, Eq, Generic)
115+
116+
instance FromJSON AddressRange
117+
instance ToJSON AddressRange
118+
119+
newtype DistributionAmount = DistributionAmount
120+
{ unDistributionAmount :: Integer
121+
-- ^ The amount of coins to distribute.
122+
} deriving (Show, Eq, Generic)
123+
124+
instance FromJSON DistributionAmount
125+
instance ToJSON DistributionAmount
126+
106127
-- TODO(ks): The question here is whether we need to support some other
107128
-- strategies for distributing money, like maybe using a fixed amount
108129
-- of `toAddress` to cap the distribution - we have examples where we
@@ -112,11 +133,10 @@ data FakeUtxoCoinDistribution
112133
= NoDistribution
113134
-- ^ Do not distribute the coins.
114135
| RangeDistribution
115-
{ range :: !Integer
136+
AddressRange
116137
-- ^ Distributes to only XX addresses.
117-
, amount :: !Integer
138+
DistributionAmount
118139
-- ^ The amount we want to distribute to those addresses.
119-
}
120140
-- ^ TODO(adn): For now we KISS, later we can add more type constructors
121141
deriving (Show, Eq, Generic)
122142

@@ -132,10 +152,18 @@ instance FromJSON FakeUtxoCoinDistribution where
132152
distrType <- o .: "type"
133153
case distrType of
134154
"none" -> pure NoDistribution
135-
"range" -> RangeDistribution <$> o .: "range" <*> o .: "amount"
155+
"range" -> RangeDistribution
156+
<$> (AddressRange <$> o .: "range")
157+
<*> (DistributionAmount <$> o .: "amount")
136158
_ -> fail ("Unknown type: " ++ distrType)
137159

138-
instance ToJSON FakeUtxoCoinDistribution
160+
instance ToJSON FakeUtxoCoinDistribution where
161+
toJSON NoDistribution = object ["type" .= ("none" :: String)]
162+
toJSON (RangeDistribution (AddressRange ar) (DistributionAmount da)) =
163+
object [ "type" .= ("range" :: String)
164+
, "range" .= ar
165+
, "amount" .= da
166+
]
139167

140168
type NumOfOutgoingAddresses = Int
141169
type NumberOfBatches = Int
@@ -162,7 +190,13 @@ instance FromJSON FakeTxsHistory where
162190
"simple" -> SimpleTxsHistory <$> o .: "txsCount" <*> o .: "numOutgoingAddress"
163191
_ -> fail ("Unknown type: " ++ distrType)
164192

165-
instance ToJSON FakeTxsHistory
193+
instance ToJSON FakeTxsHistory where
194+
toJSON NoHistory = object ["type" .= ("none" :: String)]
195+
toJSON (SimpleTxsHistory txsCount numOutgoingAddress) =
196+
object [ "type" .= ("simple" :: String)
197+
, "txsCount" .= txsCount
198+
, "numOutgoingAddress" .= numOutgoingAddress
199+
]
166200

167201

168202
--
@@ -340,20 +374,20 @@ generateRealTxHistE outputAddresses = do
340374

341375

342376
generateFakeUtxo :: FakeUtxoCoinDistribution -> AccountId -> UberMonad ()
343-
generateFakeUtxo NoDistribution _ = pure ()
344-
generateFakeUtxo RangeDistribution{..} aId = do
377+
generateFakeUtxo NoDistribution _ = pure ()
378+
generateFakeUtxo (RangeDistribution ar da) aId = do
345379

346380
db <- askWalletDB
347381
ws <- getWalletSnapshot db
348382

349-
let fromAddr = range
383+
let fromAddr = unAddressRange ar
350384
-- First let's generate the initial addesses where we will fake money from.
351385
genCAddresses <- timed $ forM [1..fromAddr] (const $ genAddress aId)
352386

353387
let generatedAddresses = rights $ map unwrapCAddress genCAddresses
354388

355389
let coinAmount :: Coin
356-
coinAmount = mkCoin $ fromIntegral amount
390+
coinAmount = mkCoin $ fromIntegral $ unDistributionAmount da
357391

358392
let txsOut :: [TxOutAux]
359393
txsOut = map (\address -> TxOutAux $ TxOut address coinAmount) generatedAddresses

0 commit comments

Comments
 (0)