Skip to content

Commit

Permalink
use BYRON genesis for initial cluster funds
Browse files Browse the repository at this point in the history
  Indeed, there are no initial funds in the Shelley genesis. The current state of affairs was doing really weird/wrong things but we didn't quite noticed because so far, we haven't enabled a single test in the shelley scenarios that uses Byron funds. Yet, we still need to be careful about parsing the initial key->value map of initial funds for sequential wallets
  • Loading branch information
KtorZ committed Jul 24, 2020
1 parent e13d364 commit f580554
Show file tree
Hide file tree
Showing 3 changed files with 2,750 additions and 3,825 deletions.
97 changes: 62 additions & 35 deletions lib/shelley/src/Cardano/Wallet/Shelley/Launch.hs
Original file line number Diff line number Diff line change
Expand Up @@ -80,13 +80,16 @@ import Cardano.Wallet.Primitive.Types
, PoolId (..)
, ProtocolMagic (..)
, SlotLength (..)
, TxOut
)
import Cardano.Wallet.Shelley
( SomeNetworkDiscriminant (..) )
import Cardano.Wallet.Shelley.Compatibility
( NodeVersionData )
import Cardano.Wallet.Unsafe
( unsafeFromHex )
( unsafeFromHex, unsafeRunExceptT )
import Control.Arrow
( first, second )
import Control.Concurrent
( threadDelay )
import Control.Concurrent.Async
Expand Down Expand Up @@ -119,6 +122,8 @@ import Data.ByteString.Base58
( bitcoinAlphabet, decodeBase58 )
import Data.Either
( isLeft, isRight )
import Data.Function
( (&) )
import Data.Functor
( ($>), (<&>) )
import Data.List
Expand Down Expand Up @@ -166,6 +171,8 @@ import Test.Utils.Paths
import Test.Utils.StaticServer
( withStaticServer )

import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Chain.UTxO as Legacy
import qualified Cardano.Wallet.Byron.Compatibility as Byron
import qualified Cardano.Wallet.Shelley.Compatibility as Shelley
import qualified Data.Aeson as Aeson
Expand All @@ -180,8 +187,6 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Vector as V
import qualified Data.Yaml as Yaml
import qualified Shelley.Spec.Ledger.Address as SL
import qualified Shelley.Spec.Ledger.Coin as SL

-- | Shelley hard fork network configuration has two genesis datas.
-- As a special case for mainnet, we hardcode the byron genesis data.
Expand Down Expand Up @@ -306,25 +311,28 @@ parseGenesisData = \case
-- ordering on the keys when parsing the map. Because this wallet uses sequential
-- derivation, it relies on addresses being discovered in a certain order.
newtype PreserveInitialFundsOrdering =
PreserveInitialFundsOrdering
( ShelleyGenesis TPraosStandardCrypto
, [(SL.Addr TPraosStandardCrypto, SL.Coin)]
)
PreserveInitialFundsOrdering [TxOut]
deriving (Show)

instance FromJSON PreserveInitialFundsOrdering where
parseJSON source = do
json <- parseJSON source
base <- clearField "initialFunds" json >>= parseJSON
initialFunds <- flip (Aeson.withObject "ShelleyGenesis") source $ \obj ->
obj .: "initialFunds"
pure $ PreserveInitialFundsOrdering
( base
, mconcat (Map.toList <$> initialFunds)
)
initialFunds <- flip (Aeson.withObject "ByronGenesis") source $ \obj ->
obj .: "nonAvvmBalances"
let outs = mconcat (Map.toList <$> initialFunds)
& map (first unsafeMkAddress)
& map (second unsafeMkLovelace)
& map (Byron.fromTxOut . uncurry Legacy.TxOut)
pure $ PreserveInitialFundsOrdering outs
where
clearField field = withObject
(pure . HM.update (const (Just $ Aeson.Object mempty)) field)
unsafeMkAddress =
either bomb id . Byron.decodeAddressBase58
where
bomb = error "PreserveInitialFundsOrdering: address not valid base58"

unsafeMkLovelace =
either bomb id . Byron.mkLovelace . read
where
bomb = error "PreserveInitialFundsOrdering: invalid lovelace value"

--------------------------------------------------------------------------------
-- For Integration
Expand Down Expand Up @@ -768,37 +776,52 @@ genConfig
-- ^ Genesis block start time
-> IO (FilePath, Block, NetworkParameters, NodeVersionData)
genConfig dir severity systemStart = do
-- we need to specify genesis file location every run in tmp
let withAddedKey k v = withObject (pure . HM.insert k (toJSON v))
let startTime = round @_ @Int . utcTimeToPOSIXSeconds $ systemStart
let systemStart' = posixSecondsToUTCTime . fromRational . toRational $ startTime

----
-- Configuration
Yaml.decodeFileThrow (source </> "node.config")
>>= withAddedKey "ShelleyGenesisFile" shelleyGenesisFile
>>= withAddedKey "ByronGenesisFile" byronGenesisFile
>>= withAddedKey "minSeverity" Debug
>>= withObject (addMinSeverityStdout severity)
>>= Yaml.encodeFile (dir </> "node.config")

let startTime = round @_ @Int . utcTimeToPOSIXSeconds $ systemStart
let systemStart' = posixSecondsToUTCTime . fromRational . toRational $ startTime
Yaml.decodeFileThrow @_ @Aeson.Value (source </> "shelley-genesis.yaml")
>>= withObject (pure . updateSystemStart systemStart')
>>= withObject transformInitialFunds
>>= Aeson.encodeFile shelleyGenesisFile

----
-- Byron Genesis
Yaml.decodeFileThrow @_ @Aeson.Value (source </> "byron-genesis.yaml")
>>= withAddedKey "startTime" startTime
>>= withObject transformInitialFunds
>>= Aeson.encodeFile byronGenesisFile

PreserveInitialFundsOrdering (genesis, initialFunds) <-
Yaml.decodeFileThrow (source </> "shelley-genesis.yaml")
>>= withObject (pure . updateSystemStart systemStart)
>>= either fail pure . Aeson.parseEither parseJSON
----
-- Shelley Genesis
Yaml.decodeFileThrow @_ @Aeson.Value (source </> "shelley-genesis.yaml")
>>= withObject (pure . updateSystemStart systemStart')
>>= Aeson.encodeFile shelleyGenesisFile

let nm = sgNetworkMagic genesis
let (networkParameters, block0) = Shelley.fromGenesisData genesis initialFunds
----
-- Initial Funds.
PreserveInitialFundsOrdering initialFunds <-
Yaml.decodeFileThrow @_ @Aeson.Value (source </> "byron-genesis.yaml")
>>= withAddedKey "startTime" startTime
>>= either fail pure . Aeson.parseEither parseJSON
(byronGenesisData, byronGenesisHash) <- unsafeRunExceptT
$ withExceptT show
$ readGenesisData byronGenesisFile
let gp = genesisParameters $ fst $ Byron.fromGenesisData
(byronGenesisData, byronGenesisHash)
let block0 = Byron.genesisBlockFromTxOuts gp initialFunds

----
-- Parameters
shelleyGenesis <- Yaml.decodeFileThrow
@_ @(ShelleyGenesis TPraosStandardCrypto) shelleyGenesisFile
let networkMagic = sgNetworkMagic shelleyGenesis
let networkParameters = fst $ Shelley.fromGenesisData shelleyGenesis []
let versionData =
( NodeToClientVersionData $ NetworkMagic nm
( NodeToClientVersionData $ NetworkMagic networkMagic
, nodeToClientCodecCBORTerm
)

Expand All @@ -818,6 +841,10 @@ genConfig dir severity systemStart = do
byronGenesisFile :: FilePath
byronGenesisFile = dir </> "byron-genesis.json"

-- we need to specify genesis file location every run in tmp
withAddedKey k v = withObject (pure . HM.insert k (toJSON v))


-- | Generate a topology file from a list of peers.
genTopology :: FilePath -> [Int] -> IO FilePath
genTopology dir peers = do
Expand Down Expand Up @@ -1035,7 +1062,7 @@ sendFaucetFundsTo tr dir allTargets = do
] ++ outputs

tx <- signTx tr dir file [faucetPrv]
submitTx tr "facuet tx" tx
submitTx tr "faucet tx" tx

-- TODO: Use split package?
-- https://stackoverflow.com/questions/12876384/grouping-a-list-into-lists-of-n-elements-in-haskell
Expand Down Expand Up @@ -1329,7 +1356,7 @@ addMinSeverityStdout severity ob = case HM.lookup "setupScribes" ob of
transformInitialFunds
:: Aeson.Object
-> IO Aeson.Object
transformInitialFunds = pure . HM.update toObject "initialFunds"
transformInitialFunds = pure . HM.update toObject "nonAvvmBalances"
where
toObject = \case
Aeson.Array xs ->
Expand Down
Loading

0 comments on commit f580554

Please sign in to comment.